restrict combinations of input selectizeInput in r shiny - javascript

I am building a small app to summarize some data. my results table has the value of a number of categories that sum to a given total. Now I would like users to be able to input different categories and get the sum of the statistics of those categories OR show them the total of all categories (so selecting all the categories gives the same as just selecting the total). To make the app look a bit cleaner I would like to simply use a single selectizeInput. However, that would mean that if the user selects the category total they should not be able to select any of the other 3 categories and if any of the 3 categories is selected total should be deselected. Otherwise, if the user selects all inputs including the total the sum sum to 2*Total (in my example 20 instead of 10).
Small example (based on https://shiny.rstudio.com/articles/selectize.html)
df <- data.frame(x = c("Total", "A", "B", "C"),
sum_res = c(10, 5, 3, 2))
library(shiny)
ui <- fluidPage(title = 'Selectize examples',
sidebarLayout(
sidebarPanel(
selectizeInput(
'e2',
'2. Multi-select',
multiple = TRUE,
selected = "Total",
choices = df$x
)
),
mainPanel(
helpText('Output of the examples in the left:'),
verbatimTextOutput('ex_out'),
verbatimTextOutput('sum')
)
))
server <- function(input, output) {
output$ex_out <- renderPrint({
str(list(input$e2))
})
output$sum <- renderPrint({
df %>%
filter(x %in% input$e2) %>%
summarise(sum = sum(sum_res))
})
}
shinyApp(ui, server)
This is somewhat related, but not exactly the same as Selectizeinput inputs be mutually exclusive R Shiny.
Ideally this solution would be in the custom javascript within the selectizeInput(), but could also be serverside.

One way to do it is to ignore other selections when Total is selected. Try this
df <- data.frame(x = c("A", "B", "C"),
sum_res = c(5, 3, 2))
library(shiny)
ui <- fluidPage(title = 'Selectize examples',
sidebarLayout(
sidebarPanel(
selectizeInput(
'e2',
'2. Multi-select',
multiple = TRUE,
selected = "Total",
choices = c("Total",unique(df$x))
)
),
mainPanel(
helpText('Output of the examples in the left:'),
verbatimTextOutput('ex_out'),
verbatimTextOutput('sum')
)
))
server <- function(input, output) {
output$ex_out <- renderPrint({
str(list(input$e2))
})
output$sum <- renderPrint({
if ("Total" %in% input$e2 | length(input$e2)==3) df1 <- df
else df1 <- df %>% filter(x %in% input$e2)
df1 %>% summarise(sum = sum(sum_res))
})
}
shinyApp(ui, server)

Related

How to format numbers in a specific row using js in a table rendered with rhandsontable?

In the simplified code at the bottom of this post, I believe it is js that is used for formatting outputs of the table rendered using rhandsontable. I play around with row/column formatting with some success in the js section of the code. However, as illustrated below, how would I format row 2 of the table so that it is shown as an integer (rounded to digits = 0, so there are no decimals) with commas separating the thousands, for all columns as they are added?
I've played around with the usual formatC(), etc., with no luck. Looks like the answer might lie in js.
Code:
library(rhandsontable)
library(shiny)
mydata <- data.frame('Series 1' = c(1,2000.39,3,4),check.names = FALSE)
rownames(mydata) <- c('A','B','C','D')
ui <- fluidPage(
rHandsontableOutput("mytable"),
textInput('NewCol', 'Enter new column name'),
actionButton("goButton", "Update Table")
)
server <- function(input, output) {
output$mytable = renderRHandsontable(df())
df <- eventReactive(input$goButton, {
if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
newcol <- data.frame(NROW(mydata))
newcol[2,] <- c(1234.22)
names(newcol) <- input$NewCol
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100)%>%
hot_cols(
renderer = "function(instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.NumericRenderer.apply(this, arguments);
// format as integers first 2 rows:
if(row == 0 || row == 1){td.innerHTML = `${value}`;}
// shade 2nd row:
if(row == 1){td.style.background='#eff0f1'}
// format as % the 2nd set of 2 rows:
if(row == 2 || row == 3){td.innerHTML = `${Number.parseFloat(value*100)}%`}
}") %>%
hot_row(c(2), readOnly = TRUE) # makes row 2 read-only
}, ignoreNULL = FALSE)
observe(if (!is.null(input$mytable)) mydata <<- hot_to_r(input$mytable))
}
shinyApp(ui,server)
One option would be to use the formatter functions provided by the Internationalization API to format your numbers using e.g. Intl.NumberFormat. To get a comma as the grouping mark you could use e.g. US locale:
library(rhandsontable)
library(shiny)
mydata <- data.frame('Series 1' = c(1,2000.39,3,4),check.names = FALSE)
rownames(mydata) <- c('A','B','C','D')
ui <- fluidPage(
rHandsontableOutput("mytable"),
textInput('NewCol', 'Enter new column name'),
actionButton("goButton", "Update Table")
)
server <- function(input, output) {
output$mytable = renderRHandsontable(df())
df <- eventReactive(input$goButton, {
if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
newcol <- data.frame(NROW(mydata))
newcol[2,] <- c(1234.22)
names(newcol) <- input$NewCol
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100)%>%
hot_cols(
renderer = "function(instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.NumericRenderer.apply(this, arguments);
const formatter = new Intl.NumberFormat('en-US', {
maximumFractionDigits: 0
})
// format as integers first 2 rows:
if(row == 0 || row == 1){td.innerHTML = `${value}`;}
// shade 2nd row:
if(row == 1){td.style.background='#eff0f1'}
// format as % the 2nd set of 2 rows:
if(row == 2 || row == 3){td.innerHTML = `${Number.parseFloat(value*100)}%`}
// format second row as numbers:
if(row == 1) { td.innerHTML = `${formatter.format(value)}`;}
}
") %>%
hot_row(c(2), readOnly = TRUE) # makes row 2 read-only
}, ignoreNULL = FALSE)
observe(if (!is.null(input$mytable)) mydata <<- hot_to_r(input$mytable))
}
shinyApp(ui,server)
#stefan has a nice answer. My present answer does not provide the desired output but I think it is instructive.
The rhandsontable package includes the (old version of the) Numbro library. Theoretically one should get the desired output by doing:
// shade and format second row
if(row == 1){
td.style.background = '#eff0f1';
td.innerHTML = numbro(value).format('0,0');
}
But there's a bug in this version of Numbro I think, and this does not display the desired format, there are the decimal digits.
For example if you want one decimal digit: numbro(value).format('0,0.0').
The formatting to percentage works: numbro(value).format('0%').
Alternative: d3.format
If you want to use a flexible library for number formatting, d3-format is very nice.
This gives the desired output:
// shade and format second row
if(row == 1){
td.style.background = '#eff0f1';
td.innerHTML = d3.format(',.0f')(value);
}
after including the d3-format library in your UI:
ui <- fluidPage(
tags$head(
tags$script(src = "https://cdn.jsdelivr.net/npm/d3-format#3")
),
......

R Shiny Code gets executed multiple times when sending it to Javascript

I have this app:
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(includeScript("www/script.js"),
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(session, input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
observe({
if(input$bins > 25) {
Message1 = input$bins
session$sendCustomMessage("bla", Message1)
}
})
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
My Oberserver checks if the value is larger than 25. I send the value to Javascript.
$( document ).ready(function() {
Shiny.addCustomMessageHandler("bla", dosomething);
function dosomething(Message1) {
alert(Message1)
}
});
The code works perfectly, BUT every time i change the slider, the code seems to get executed one more time than before. After changing it 2 times, I get 3 alerts for example. Why is that happening and what can I do against it?
The reason this is so broken is that your observe() is inside the renderPlot() function. Generally speaking, observers should not be inside render functions, it's almost always a recipe for very strange undefined behaviours to happen!
Simply moving the observer outside of the render function fixes your problem. This also fixes another problem you didn't mention, that the alert box was actually showing the previous number rather than the current one.
For completeness, this is the correct server code:
server <- function(session, input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
observe({
if(input$bins > 25) {
Message1 = input$bins
session$sendCustomMessage("bla", Message1)
}
})
}

Heatmaps on Physical Images (2d or 3d) using .js library for R Shiny App?

I am in the circuit board manufacturing industry, and we measure the temperature at a variety of locations on our circuit boards in an effort to identify if certain components are exceeding their required temperatures.
I have some exposure to .js visualization libraries, RStudio and Shiny. I would like to implement this application into an existing R or ShinyDashboard that I am developing.
What I would like to accomplish is to have a 2d or 3d image of my circuit board, and a heatmap that takes the maximum temperature and shows it on that image. My data sets have columns of temperatures over time for up to 20 different locations.
I know this is a crude description, but I was wondering if anyone has any initial suggestions to accomplish this?
Update1
This is the result of running the first code:
Update2
Here is the sample dataset that I would like to base this heatmap off of.
https://docs.google.com/spreadsheets/d/11I19uQyND7YehKrYd-NPiib4bQSHmHmWENFvausigvU/edit?usp=sharing
You could use ggplot for something like this, for example:
library(grid)
library(ggplot2)
# Download image
library(jpeg)
download.file("http://www.expresspcb.com/wp-content/uploads/2015/06/PhotoProductionPCB_TL_800.jpg","pcb.jpg")
img <- readJPEG("/home/oskar/pcb.jpg")
## Load image, use this if you can't download image
#library(png)
#img <- readPNG(system.file("img", "Rlogo.png", package="png"))
g <- rasterGrob(img, interpolate=TRUE,width=1,height=1)
coords <- data.frame("x"=c(0,1),"y"=c(0,1))
# Simulate data
df <- data.frame("x.pos" = c(runif(200),runif(20,min=0.5,max=0.8)),
"y.pos" = c(runif(200),runif(20,min=0.5,max=0.8)),
"heat" = c(runif(200),runif(20,min=0.7,max=1)))
# Show overlay of image and heatmap
ggplot(data=df,aes(x=x.pos,y=y.pos,fill=heat)) +
annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
stat_density2d( alpha=0.2,aes(fill = ..level..), geom="polygon" ) +
scale_fill_gradientn(colours = rev( rainbow(3) )) +
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0))
# Show where max temperature is
dat.max = df[which.max(df$heat),]
ggplot(data=coords,aes(x=x,y=y)) +
annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
geom_point(data=dat.max,aes(x=x.pos,y=y.pos), shape=21,size=5,color="black",fill="red") +
geom_text(data=dat.max,aes(x=x.pos,y=y.pos,label=round(heat,3)),vjust=-1,color="red",size=10)
The ggplot image part is from here
You can also bin the data manually and overlay it on the image like this (run this part after the script above):
# bin data manually
# Manually set number of rows and columns in the matrix containing sums of heat for each square in grid
nrows <- 30
ncols <- 30
# Define image coordinate ranges
x.range <- c(0,1) # x-coord range
y.range <- c(0,1) # x-coord range
# Create matrix and set all entries to 0
heat.density.dat <- matrix(nrow=nrows,ncol=ncols)
heat.density.dat[is.na(heat.density.dat)] <- 0
# Subdivide the coordinate ranges to n+1 values so that i-1,i gives a segments start and stop coordinates
x.seg <- seq(from=min(x.range),to=max(x.range),length.out=ncols+1)
y.seg <- seq(from=min(y.range),to=max(y.range),length.out=nrows+1)
# List to hold found values
a <- list()
cnt <- 1
for( ri in 2:(nrows+1)){
for ( ci in 2:(ncols+1)){
# Get current segments, for example x.vals = [0.2, 0.3]
x.vals <- x.seg [c(ri-1,ri)]
y.vals <- y.seg [c(ci-1,ci)]
# Find which of the entries in the data.frame that has x or y coordinates in the current grid
x.inds <- which( ((df$x.pos >= min(x.vals)) & (df$x.pos <= max(x.vals)))==T )
y.inds <- which( ((df$y.pos >= min(y.vals)) & (df$y.pos <= max(y.vals)))==T )
# Find which entries has both x and y in current grid
inds <- which( x.inds %in% y.inds )
# If there's any such coordinates
if (length(inds) > 0){
# Append to list
a[[cnt]] <- data.frame("x.start"=min(x.vals), "x.stop"=max(x.vals),
"y.start"=min(y.vals), "y.stop"=max(y.vals),
"acc.heat"=sum(df$heat[inds],na.rm = T) )
# Increment counter variable
cnt <- cnt + 1
}
}
}
# Construct data.frame from list
heat.dens.df <- do.call(rbind,a)
# Plot again
ggplot(data=heat.dens.df,aes(x=x.start,y=y.start)) +
annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
geom_rect(data=heat.dens.df, aes(xmin=x.start, xmax=x.stop, ymin=y.start, ymax=y.stop, fill=acc.heat), alpha=0.5) +
scale_fill_gradientn(colours = rev( rainbow(3) )) +
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0))
Coordinate conversion from your data to my format can be done like:
sensor.data <- read.csv("~/Sample_Dataset.csv - Sample_Dataset.csv.csv")
# Create position -> coord conversion
pos.names <- names(sensor.data)[ grep("*Pos",names(sensor.data)) ] # Get column names with "Pos" in them
mock.coords <<- list()
lapply(pos.names, function(name){
# Create mocup coords between 0-1
mock.coords[[name]] <<- data.frame("x"=runif(1),"y"=runif(1))
})
# Change format of your data matrix
df.l <- list()
cnt <- 1
for (i in 1:nrow(sensor.data)){
for (j in 1:length(pos.names)){
name <- pos.names[j]
curr.coords <- mock.coords[[name]]
df.l[[cnt]] <- data.frame("x.pos"=curr.coords$x,
"y.pos"=curr.coords$x,
"heat" =sensor.data[i,j])
cnt <- cnt + 1
}
}
# Create matrix
df <- do.call(rbind, df.l)

R shiny leaflet javascript addons - heatmap

Trying to use one of the javascript addons for leaflet - specifically the heatmap functionality - https://github.com/Leaflet/Leaflet.heat
Thing is - I want to incorporate this into Shiny, but leaflet for R doesn't seem to have this addon included by default, so I would have to somehow include this JS manually. The closest I got to figuring out how to do this is through a post on rCharts that showed this:
server.R.
HeatMap$addAssets(jshead = c("http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js"))
HeatMap$setTemplate(afterScript = sprintf("<script>
var addressPoints = %s
var heat = L.heatLayer(addressPoints).addTo(map)
</script>",
rjson::toJSON(dt)))
(taken from: https://github.com/ramnathv/rCharts/issues/498 )
But being not too familiar with JS, and new to leaflet it's still not quite clear how it can be incorporated from beginning to end - i.e. taking this JS from github and ending up with a heatmap created using leaflet on the dataset 'quakes'.
My server side code is something like the following:
library(leaflet)
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles("OpenMapSurfer.Roads",
options = providerTileOptions(noWrap = TRUE))
%>% addMarkers(clusterOptions = markerClusterOptions(), data = quakes))
Where instead of clusterOptions I would like to add a heatmap of the magnitude of the earthquakes (the dataset 'quakes' is included in R so you can see it for yourself).
Any help on figuring this out would be very much appreciated! :)
The setTemplate(afterscript...) bit doesn't work in shiny. Instead you need to use tags$() and render the heatmap output separately to the map.
Here is a basic app that uses heatmaps (inspired by this SO answer )
server.R
library(shiny)
library(rCharts)
dat <- data.frame(Offence = c("Assault","Assault","Assault","Weapon","Assault","Burglary"),
Date = c("2015-10-02","2015-10-03","2015-10-04","2015-04-12","2015-06-30","2015-09-04"),
Longitude = c(-122.3809, -122.3269, -122.3342, -122.2984, -122.3044, -122.2754),
Latitude = c(47.66796,47.63436,47.57665,47.71930,47.60616,47.55392),
intensity = c(10,20,30,40,50,30000))
shinyServer(function(input, output, session) {
output$baseMap <- renderMap({
baseMap <- Leaflet$new()
baseMap$setView(c(47.5982623,-122.3415519) ,12)
baseMap$tileLayer(provider="Esri.WorldStreetMap")
baseMap
})
output$heatMap <- renderUI({
## here I'm creating the JSON through 'paste0()'.
## you can also use jsonlite::toJSON or RJSONIO::toJSON
j <- paste0("[",dat[,"Latitude"], ",", dat[,"Longitude"], ",", dat[,"intensity"], "]", collapse=",")
j <- paste0("[",j,"]")
j
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
var heat = L.heatLayer(addressPoints).addTo(map)"
, j
))))
})
})
ui.R
library(shiny)
library(rCharts)
shinyUI(fluidPage(
mainPanel(
headerPanel("title"),
chartOutput("baseMap", "leaflet"),
tags$style('.leaflet {height: 500px;}'),
tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
uiOutput('heatMap')
)
))
Edit - Using Google Maps
There is also a way to do this in the development version of googleway. For this you'll need a valid Google API key, and currently it only works in a browser
## devtools::install_github("googleway")
library(googleway)
library(magrittr)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton(inputId = "traffic", label = "traffic"),
box(width = 10,
height = 600,
google_mapOutput("myMap")
)
)
)
server <- function(input, output){
map_key <- "your_valid_api_key"
## https://developers.google.com/maps/documentation/javascript/get-api-key
## set up some data-------
pl <- "~s|dF}{~rZnNoExBq#|#SfAIjA#~Et#fBBp#Iv#QxCoArNqGfA_#dB]`KgAfVkC|Gu#rAYf#Q|#i#p#m#n#{#^u#`#kAR_ALiADuACiAIeAOy#_#qA{#uB{#sB]gAUmAOaB?oCTkKr#kZZiN?s#Cq#EQDOLILFn#A\\CpI_A|AQjB[BGPOX#LHz#CpAKT?v#KpHu#vD]LGt#Ix#I\\QBGLOVCPJd#Dj#GnFq#`PaBp#KfBQzA[zAq#nAaAx#aA~ByDp#yAXe#VSVO#EVWPCRDJLBF#Hd#TrDj#rK`ADEJGJ#JFBFrSxBJOPCNHHPdBLnCb#bBb#lAf#zA~#lAbApAzAt#nAxA|C~BhHrAxD~AtEb#|#xAtBpBlBzCbB`AZhIhBrFpA|AZl#HRDLENGXORe#DKJSf#wD`#cDt#}INq#ZuEt#mHfBsN~BkS`CmR\\eDnAiKzAcM`CePNmAhAsGXmArAgFtDsM|DaOh#sC^kCf#kDb#uDl#kI\\sHn#yM?gDEoAOsA[}BUiBUsC#qCNuBViBrCcPp#oGHW|#oPBuDI_DKqAy#wD{Ja^}#oFY_CWoDIqBGqEBsENqE`C{^JuA\\aDj#oDn#cDxAcFz#yBtC{Fp#eAn#_An#s#t#}#j#g#bCaBtCsA`GiAzBm#`C}#jBmA~CiC~DcDjCwAfAa#bBe#nBa#pCYlCArDBlCHhCGnC_#~A]vBk#hAa#lF_CnMaGbDeArD}#vB[zEe#jFS`GFfBFxBJzO\\zZfAfCJdEPbDNvDRnEHvD?tEE~BQhC[zAYnCu#bA]dBm#bIkDtBy#bAYhB[rDYxJ[nB#vAHfBLbCf#|C~#vAp#nCdB|A`A`CzApAr#|Al#rBl#bBZbUbCZBzBDvBEtAMnF_AvB[vBOlCAlBFnBXbDr#~Bv#z#`#bBfAdD~BtB`Bv#f#nAn#x#ZZJ~A\\dBTdADtBEbAGnEg#dFi#`DYdDQdF?|DNfCV`BTlCl#dNvD`HnBdLvClAZn#DzB^hCRd#?fA?|#Ih#O`#Ud#a#h#w#\\u#Pm#Lw#HoBq#qK]eLUcIE{DC{AD}Fn#eSLeCJs#RwFRkDf#sCj#aE`AsFhAuGh#gDt#wEp#}En#_FPeBRkDByBCgBEgAS}B{#oEsA}Dy#eCi#yBGq#?s#Ds#V}#Rg#r#u#ZOj#Ml#Az#PrA^fBb#j#HV#f#e#`B}AbB_B]Ie#KeASiO}CmH_B{L}Bk#QTqBTgCAm#g#kCSaAs#V{CdAmDrAuAh#{#Ra#H{#D{Af#wBt#gAb#]ReBl#"
df_line <- decode_pl(pl)
set.seed(123)
df_line$weight <- runif(nrow(df_line), min = 1, max = 100)
## ------------
## plot the map
output$myMap <- renderGoogle_map({
google_map(key = map_key, data = df_line, search_box = F) %>%
add_heatmap(weight = "weight") %>%
add_traffic()
})
}
shinyApp(ui, server)

How can I produce plots like this?

I have come across this kind of a plot that performs hierarchical clustering over a given set of timeseries data. Can someone tell me how to draw such plots?
I am open to implementations in R or Javascript, especially using d3.js.
You can always create the plot by hand:
with base graphics, you the fig parameter
allows you to add plots inside another plot.
# Sample data
n <- 100
k <- 6
d <- matrix(rnorm(k*n),nc=k)
d[,2] <- d[,1] # To help check the results
colnames(d) <- LETTERS[1:k]
x <- apply(d,2,cumsum)
r <- hclust(dist(t(d)))
# Plot
op <- par(mar=c(0,0,0,0),oma=c(0,2,0,0))
plot(NA,ylim=c(.5,k+.5), xlim=c(0,4),axes=FALSE)
# Dendrogram. See ?hclust for details.
xc <- yc <- rep(NA,k)
o <- 1:k
o[r$order] <- 1:k
for(i in 1:(k-1)) {
a <- r$merge[i,1]
x1 <- if( a<0 ) o[-a] else xc[a]
y1 <- if( a<0 ) 0 else yc[a]
b <- r$merge[i,2]
x2 <- if( b<0 ) o[-b] else xc[b]
y2 <- if( b<0 ) 0 else yc[b]
lines(
3+c(y1,i,i,y2)/k,
c(x1,x1,x2,x2),
lwd=k-i
)
xc[i] <- (x1+x2)/2
yc[i] <- i
}
# Time series
axis(2,1:k,colnames(d)[r$order],las=1)
u <- par()$usr
for(i in 1:k) {
f <- c(0,3,i-.5,i+.5)
f <- c(
(f[1]-u[1])/(u[2]-u[1]),
(f[2]-u[1])/(u[2]-u[1]),
(f[3]-u[3])/(u[4]-u[3]),
(f[4]-u[3])/(u[4]-u[3])
)
par(new=TRUE,fig=f)
plot(x[,r$order[i]],axes=FALSE,xlab="",ylab="",main="",type="l",col="navy",lwd=2)
box()
}
par(op)
(After writing this, I realize that it is probably easier to do with layout...)

Categories