I’m trying to generate different plots inside a for loop and save them into a list. The problem is that it’s like the data of plotly isn’t static and in every loop all plots are changing.
Here is my code:
library(plotly)
data("iris")
names = names(iris)[-5]
plotList <- list()
for (i in 1:length(names)) {
for (j in 1:length(names)) {
name = paste("plot", i, j, sep = "_")
p <- (plot_ly(data = iris, x = ~get(names[i]), y = ~get(names[j]),
type = "scatter", mode = "markers") %>%
layout(
title = paste(names[i], names[j], sep = " vs "),
xaxis = list(title = names[i]),
yaxis = list(title = names[j])))
plotList[[name]] <- p
}
}
plotList$plot_4_3
plotList$plot_4_4
As you can see if I look at two plots of the list I get the same result, while if I execute the two plots without the for loop I get different results, the correct results:
i <- 4
j <- 3
p <- (plot_ly(data = iris, x = ~get(names[i]), y = ~get(names[j]),
type = "scatter", mode = "markers") %>%
layout(
title = paste(names[i], names[j], sep = " vs "),
xaxis = list(title = names[i]),
yaxis = list(title = names[j])))
p
i <- 4
j <- 4
p <- (plot_ly(data = iris, x = ~get(names[i]), y = ~get(names[j]),
type = "scatter", mode = "markers") %>%
layout(
title = paste(names[i], names[j], sep = " vs "),
xaxis = list(title = names[i]),
yaxis = list(title = names[j])))
p
I would need to make the plotly data static...
Thanks!
Xevi
Add plotly_build:
library(plotly)
data("iris")
names = names(iris)[-5]
plotList <- list()
for (i in 1:length(names)) {
for (j in 1:length(names)) {
name = paste("plot", i, j, sep = "_")
plotList[[name]] <- plotly_build(plot_ly(data = iris, x = ~get(names[i]), y = ~get(names[j]),
type = "scatter", mode = "markers") %>%
layout(
title = paste(names[i], names[j], sep = " vs "),
xaxis = list(title = names[i]),
yaxis = list(title = names[j])))
}
}
plotList$plot_4_3
plotList$plot_4_4
Related
Using the code snippet from the help page here, I'm trying to create a unique main label for each subplot but am not entirely successful. Any suggestions on how to do this?
library(plotly)
vars <- setdiff(names(economics), "date")
plots <- lapply(vars, function(var) {
plot_ly(economics, x = ~date, y = as.formula(paste0("~", var))) %>%
add_lines(name = var) %>% layout(title = paste("Title for", var, sep=' ') )
})
subplot(plots, nrows = length(plots), shareX = TRUE, titleX = FALSE)
I wish I had noticed this question sooner! Here is one way that you can make this happen.
I took the titles out of the plot build. Otherwise, you'll get an error.
library(plotly)
vars <- setdiff(names(economics), "date")
plots <- lapply(vars, function(var) {
plot_ly(economics, x = ~date, y = as.formula(paste0("~", var))) %>%
add_lines(name = var) #%>% layout(title = paste("Title for", var, sep=' '))
})
Then I created a vector of the titles.
nms <- invisible(lapply(vars, function(v){paste0("Title for ", v)}) %>% unlist())
Here I used annotations to create title objects to add to the subplot.
annots = lapply(
1:length(plots),
function(j){
list(x = .5,
y = 1 - (j - 1) * .205,
xanchor = "center",
yanchor = "center",
xref = "paper",
yref = "paper",
showarrow = F,
text = nms[j])
}
)
subplot(plots, nrows = length(plots), shareX = TRUE, titleX = FALSE) %>%
layout(annotations = annots)
parameterslist <- cbind(v =c(40, 50, 60))
for (i in 1:nrow(parameterslist))
outlist[[i]] <- ode(func = model, y = yini, times = times, parms = c(parameterslist[i,], parameters))
outlist <- as.data.frame(outlist)
plot_vdisp_3 <- plot_ly(outlist, x = ~times, y = ~power1, name = 'v=30m/s', type = 'scatter', mode = 'lines') %>%
add_trace(y = ~outlist$y1, name = 'v=40m/s', mode = 'lines+markers') %>%
add_trace(y = ~outlist$y1.1, name = 'v=50m/s', mode = 'lines+markers') %>%
add_trace(y = ~outlist$y1.2, name = 'v=60m/s', mode = 'lines+markers') %>%
layout( title = 'Drag force according to different wind speeds',
xaxis = list(title = 'Time (hours)'),
yaxis = list(title = 'Drag Force'))
plot_vdisp_3
I solved a differential equation and created a dataframe but could not plot properly. Could you please explain what should I change? what does outlist$y1 and outlist$y1.1 mean? I created power1 data frame before. but is it ok? during plotting sometimes I could not see the orange line what is the reason for this?
Thanks.
Here is the part of data frame creation part.
times <- seq(from = 0, to = 25, by = 1)
out <- ode(func = model, y = yini, times = times, parms = parameters, method = "rk4")
model_out <- data.frame(times, out)
power1 <- model_out$y1
force1 <- model_out$y2
temp1 <- model_out$y3
I am running a loop that assigns a plot to a variable. the code then pulls the variable names with the ls() pattern function
while (i > 0) {
assign(paste("fig", i, sep = ""), plot_ly(tot, y = ~gene, color = ~bx, type = "box", boxpoints = "all") %>% layout(annotations = list(x = 0 , y = 1, xanchor = "left",yanchor = "top",yshift = 20,showarrow = FALSE,font = list(size = 20), text = paste("Data", colnames(total)[i+1]))))
i = i-1
if (i == 0){
the code then pulls the variable names with the ls() pattern function and attempts to pass them as a list to subplot.
...
l <- as.list(ls(pattern = "fig"))
l <- do.call(paste, c(l,sep=", "))
fig <- subplot(l,margin = 0.06,nrows=2) %>% layout(showlegend = FALSE)
fig
}
}'
This is where i am experiencing some errors.
Error in [[: subscript out of bounds
Try the following :
library(plotly)
l <- mget(ls(pattern = "fig"))
fig <- subplot(l,margin = 0.06,nrows=2) %>% layout(showlegend = FALSE)
I am trying to generate multiple graphs in Plotly for 30 different sales offices. Each graph would have 3 lines: sales, COGS, and inventory. I would like to keep this on one graph with 30 buttons for the different offices. This is the closest solution I could find on SO:
## Create random data. cols holds the parameter that should be switched
l <- lapply(1:100, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:100)
colnames(df) <- cols
df[["c"]] <- 1:100
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
type = "scatter",
mode = "lines",
x = ~c,
y= ~df[[cols[[1]]]],
name = cols[[1]])
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[-1]) {
p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = FALSE)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(cols, function(col) {
list(method="restyle",
args = list("visible", cols == col),
label = col)
})
)
)
)
print(p)
It works but only on graphs with single lines/traces. How can I modify this code to do the same thing but with graphs with 2 or more traces? or is there a better solution? Any help would be appreciated!
### EXAMPLE 2
#create fake time series data
library(plotly)
set.seed(1)
df <- data.frame(replicate(31,sample(200:500,24,rep=TRUE)))
cols <- paste0(letters, 1:31)
colnames(df) <- cols
#create time series
timeseries <- ts(df[[1]], start = c(2018,1), end = c(2019,12), frequency = 12)
fit <- auto.arima(timeseries, d=1, D=1, stepwise =FALSE, approximation = FALSE)
fore <- forecast(fit, h = 12, level = c(80, 95))
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly() %>%
add_lines(x = time(timeseries), y = timeseries,
color = I("black"), name = "observed") %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 2], ymax = fore$upper[, 2],
color = I("gray95"), name = "95% confidence") %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 1], ymax = fore$upper[, 1],
color = I("gray80"), name = "80% confidence") %>%
add_lines(x = time(fore$mean), y = fore$mean, color = I("blue"), name = "prediction")
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[2:31]) {
timeseries <- ts(df[[col]], start = c(2018,1), end = c(2019,12), frequency = 12)
fit <- auto.arima(timeseries, d=1, D=1, stepwise =FALSE, approximation = FALSE)
fore <- forecast(fit, h = 12, level = c(80, 95))
p <- p %>%
add_lines(x = time(timeseries), y = timeseries,
color = I("black"), name = "observed", visible = FALSE) %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 2], ymax = fore$upper[, 2],
color = I("gray95"), name = "95% confidence", visible = FALSE) %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 1], ymax = fore$upper[, 1],
color = I("gray80"), name = "80% confidence", visible = FALSE) %>%
add_lines(x = time(fore$mean), y = fore$mean, color = I("blue"), name = "prediction", visible = FALSE)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(cols, function(col) {
list(method="restyle",
args = list("visible", cols == col),
label = col)
})
)
)
)
p
You were very close!
If for example you want graphs with 3 traces,
You only need to tweak two things:
Set visible the three first traces,
Modify buttons to show traces in groups of three.
My code:
## Create random data. cols holds the parameter that should be switched
library(plotly)
l <- lapply(1:99, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:99)
colnames(df) <- cols
df[["c"]] <- 1:100
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
type = "scatter",
mode = "lines",
x = ~c,
y= ~df[[cols[[1]]]],
name = cols[[1]])
p <- p %>% add_lines(x = ~c, y = df[[2]], name = cols[[2]], visible = T)
p <- p %>% add_lines(x = ~c, y = df[[3]], name = cols[[3]], visible = T)
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[4:99]) {
print(col)
p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = F)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(0:32, function(col) {
list(method="restyle",
args = list("visible", cols == c(cols[col*3+1],cols[col*3+2],cols[col*3+3])),
label = paste0(cols[col*3+1], " ",cols[col*3+2], " ",cols[col*3+3] ))
})
)
)
)
print(p)
PD: I only use 99 cols because I want 33 groups of 3 graphs
I'm trying to make a shiny app for some user-friendly data analysis of some data I have, and I'd like to change the outputted Plotly plot depending on which file i'm looking at. Basically, I'd like to have one plot outputted at a time, where I can cycle through several plots (that don't change place in my shiny app) depending on which folder and criteria i'm using. Currently I'm struggeling with this, and I don't know exactly what to do from here. I've attached a few images to clarify what I mean and what I want.
This photo shows my UI and how I want my figures to be displayed. I'd like all figures to show in that same location, depending on the selected file.
When I switch to 'Datalogger', a new plot is generated, and it is outputted below the first one. I'd like it to be placed on top of it, in the exact same location.
Any help you can offer would be very welcome.
Best,
T.
Script:
# Load packages
library(shiny)
library(shinythemes)
library(dplyr)
library(readr)
library(lubridate)
library(plotly)
#picarro
time = as.character(seq(as.POSIXct("2018-06-01 12:00:00"), as.POSIXct("2018-06-01 12:10:00"), by=seconds() )); ch4.corr = runif(length(time), 1980, 2000);
data = data.frame(time, ch4.corr); data$time = as.POSIXct(time);
#datalogger
time = as.character(seq(as.POSIXct("2018-06-01 12:00:00"), as.POSIXct("2018-06-01 12:10:00"), by=seconds() )); PressureOut = runif(length(time), 1010, 1020);
dlog = data.frame(time, PressureOut); dlog$time = as.POSIXct(time);
#dronelog
time = as.character(seq(as.POSIXct("2018-06-01 12:00:00"), as.POSIXct("2018-06-01 12:10:00"), by=seconds() ));
ulog = data.frame(time); ulog$time = as.POSIXct(time);
#------------------------------------------------------------------------------
ui <- fluidPage(
titlePanel("Active AirCore analysis"),
hr(),
fluidRow(
column(3,
radioButtons("fileInput", "File",
choices = c("Picarro", "Datalogger", "Dronelog"),
selected = "Picarro"),
hr(),
conditionalPanel(
condition = "input.fileInput == 'Picarro'",
sliderInput("timeInputPicarro", "Time", as.POSIXct(data$time[1]), as.POSIXct(data$time[length(data$time)]), c(as.POSIXct(data$time[1])+minutes(1), as.POSIXct(data$time[length(data$time)])-minutes(1)), timeFormat = "%H:%M:%S", ticks = T, step = seconds(1), pre = "")),
conditionalPanel(
condition = "input.fileInput == 'Datalogger'",
sliderInput("timeInputDatalogger", "Time", as.POSIXct(dlog$time[1]), as.POSIXct(dlog$time[length(dlog$time)]), c(as.POSIXct(dlog$time[1]), as.POSIXct(dlog$time[length(dlog$time)])), timeFormat = "%H:%M:%S", ticks = T, step = seconds(1), pre = "")),
conditionalPanel(
condition = "input.fileInput == 'Dronelog'",
sliderInput("timeInputDronelog", "Time", as.POSIXct(ulog$time[1]), as.POSIXct(ulog$time[length(ulog$time)]), c(as.POSIXct(ulog$time[1])+minutes(1), as.POSIXct(ulog$time[length(ulog$time)])-minutes(1)), timeFormat = "%H:%M:%S", ticks = T, step = seconds(1), pre = "")),
hr(),
conditionalPanel(
condition = "input.fileInput == 'Picarro'",
radioButtons("picarroPlotInput", "Plot type",
choices = c("Time-series", "Process"),
selected = "Time-series")),
conditionalPanel(
condition = "input.fileInput == 'Datalogger'",
radioButtons("dataloggerPlotInput", "Plot type",
choices = c("Time-series", "Altitude"),
selected = "Time-series")),
hr(),
checkboxGroupInput(inputId='sidebarOptions',
label=('Options'),
choices=c('Blabla', 'Store data', 'BlablaBla')),
hr()),
br(),
mainPanel(
plotlyOutput("dataplot"),
hr(),
plotlyOutput("dlogplot")
)
)
)
server <- function(input, output, session) {
datasetInputPic <- reactive({ data = data; })
datasetInputPicSamp <- reactive({ dat = data[(data$time>=input$timeInputPicarro[1]) & (data$time<=input$timeInputPicarro[2]),]; })
datasetInputDatalogger <- reactive({ dlog = dlog })
datasetInputDronelog <- reactive({ ulog = ulog })
output$dataplot <- renderPlotly({
if( (input$fileInput == 'Picarro' ) & (input$picarroPlotInput == 'Time-series')){
data = datasetInputPic();
data$time = as.POSIXct(data$time);
dat = datasetInputPicSamp();
dat$time = as.POSIXct(dat$time);
sec.col = "red";
f = list(size = 8);
x <- list(title = " ")
y <- list(title = "CH<sub>4</sub> [ppb]")
p2 = plot_ly() %>%
add_trace(data = data,
x = ~time,
y = ~ch4.corr,
type = 'scatter',
mode = "markers",
marker = list(size = 3, color = 'black')) %>%
add_trace(data = dat,
x = ~time,
y = ~ch4.corr,
type = 'scatter',
mode = "markers",
marker = list(size = 3, color = sec.col)) %>%
layout(xaxis = x, yaxis = y, title = '', showlegend = F, titlefont = f);
s1 = subplot(p2, margin = 0.06,nrows=1,titleY = TRUE) %>%
layout(showlegend = F, margin = list(l=50, r=0, b=50, t=10), titlefont = f);
s1
}
})
output$dlogplot <- renderPlotly({
if( (input$fileInput == 'Datalogger' ) & (input$dataloggerPlotInput == 'Time-series')){
data = datasetInputDatalogger();
data$time = as.POSIXct(data$time);
x <- list(title = " ")
y <- list(title = "Outside pressure [mbar]")
p1 = plot_ly() %>%
add_trace(data = data,
y = ~PressureOut,
x = ~time,
type = 'scatter',
mode = "markers",
marker = list(size = 3, color = 'black'));
s1 = subplot(p1, margin = 0.07, nrows=2, titleY = TRUE, titleX = FALSE)
layout(s1, showlegend = F, margin = list(l=100, r=100, b=0, t=100), title = "Datalogger data")
s1
}
})
outputOptions(output, c("dataplot", "dlogplot"), suspendWhenHidden = TRUE)
}
runApp(list(ui = ui, server = server))
Your issue is that in your ui you have written:
mainPanel(
plotlyOutput("dataplot"),
hr(),
plotlyOutput("dlogplot")
)
Using this structure, the "dlogplot" will always display below the "dataplot" because you essentially gave it its own position in the main panel that is below the "dataplot". One solution, if you want the plots to be displayed in the same exact spot when clicking the various buttons, is to give only one plotlyOutput. Next you would put conditional if, else if and else in renderPlotly. For example:
output$dataplot <- renderPlotly({
if( (input$fileInput == 'Picarro' ) & (input$picarroPlotInput == 'Time-series')){
data = datasetInputPic();
data$time = as.POSIXct(data$time);
dat = datasetInputPicSamp();
dat$time = as.POSIXct(dat$time);
sec.col = "red";
f = list(size = 8);
x <- list(title = " ")
y <- list(title = "CH<sub>4</sub> [ppb]")
p2 = plot_ly() %>%
add_trace(data = data,
x = ~time,
y = ~ch4.corr,
type = 'scatter',
mode = "markers",
marker = list(size = 3, color = 'black')) %>%
add_trace(data = dat,
x = ~time,
y = ~ch4.corr,
type = 'scatter',
mode = "markers",
marker = list(size = 3, color = sec.col)) %>%
layout(xaxis = x, yaxis = y, title = '', showlegend = F, titlefont = f);
s1 = subplot(p2, margin = 0.06,nrows=1,titleY = TRUE) %>%
layout(showlegend = F, margin = list(l=50, r=0, b=50, t=10), titlefont = f);
s1
}
else if( (input$fileInput == 'Datalogger' ) & (input$dataloggerPlotInput == 'Time-series')){
data = datasetInputDatalogger();
data$time = as.POSIXct(data$time);
x <- list(title = " ")
y <- list(title = "Outside pressure [mbar]")
p1 = plot_ly() %>%
add_trace(data = data,
y = ~PressureOut,
x = ~time,
type = 'scatter',
mode = "markers",
marker = list(size = 3, color = 'black'));
s1 = subplot(p1, margin = 0.07, nrows=2, titleY = TRUE, titleX = FALSE)
layout(s1, showlegend = F, margin = list(l=100, r=100, b=0, t=100), title = "Datalogger data")
s1
}
})
This code will put the "dlogplot" and the "dataplot" in the same position in your main panel. (You would also need to get rid of output$dlogplot <- renderPlotly({...}) so that it isn't also trying to make that plot.)
Try this out and see if it works for your purposes.