Arranging Views in Plotly R with Main Label - r

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)

Related

How do I keep the plotted graph and yaxis aligned when doing stacked subplots with plotly R

I am trying to produce a stack of plots with plotly R but the plotted lines relative to the zero axis are drifting so that what is zero in the top plot is not zero in the bottom plot. Any ideas how to fix this?
Here is an image of the problem:
Assume that the top plot is correct (it is: Gaussian random walk around zero). Then notice that in plots 2:4 from the top down the xaxis drifts upwards but the exact same data is used on all plots. Notice on the y-axis that the number 2 is drifting upwards. I feel that this is a simple issue (pretty fundamental - keeping values aligned to data!) so I think I am missing something obvious so would appreciate it if someone could point out my obvious mistake.
I have tried setting anchor and scaleanchor but this seems to have no effect on the positioning, even when position = 0 and anchor = 'free'.
I have also tried variations on fixedrange and autorange but again no joy.
Here is a reproducible example:
set.seed(2244)
cols <- c('black','red','green','cyan','blue','magenta','yellow','gray')
outlist <- list()
nplots <- c(1,2,3,4)
bounds <- 0
trials <- 0
M <- 1
N <- 50
i <- 1
y <- rnorm(N)
chleaf <- rbinom(N, 1, 0.5)
outmat <- matrix(0, nrow=N, ncol=6)
outmat[,c(1,3)] <- rnorm(dim(outmat)[1]*2, 0, 1)
outmat[,c(2,4)] <- outmat[,c(1,3)]^2
outmat[,c(5,6)] <- y - outmat[,c(1,3)]
for (j in nplots) {
mgrid <- NULL
if ( bounds == 1 ) {
mgrid <- c(min(outmat[,3]-2*sqrt(outmat[,4]))-0.5,
max(outmat[,3]+2*sqrt(outmat[,4]))+0.5)
} else {
mgrid <- c(min(min(outmat[,3]), min(outmat[,5]), min(y))-0.5,
max(max(outmat[,3]), max(outmat[,5]), max(y))+0.5)
}
outlist[[i]] <- plotly::plot_ly() %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,3], type = 'scatter', mode='lines',
showlegend=ifelse(i==1, TRUE, FALSE), name=TeX('\\mu_{t|t-1}'),
line=list(color=cols[1], width=0.5)) %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,3]+2*sqrt(outmat[,4]),
type='scatter', mode='markers', color=I(cols[1]), size=0.5,
showlegend=ifelse(i==1, TRUE, FALSE), name=TeX('\\Sigma_{t|t-1}'),
marker=list(symbol='cross-thin'), visible=ifelse(bounds==1, TRUE, FALSE)) %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,3]-2*sqrt(outmat[,4]),
type='scatter', mode='markers', color=I(cols[1]), size=0.5,
showlegend=FALSE, marker=list(symbol='cross-thin'),
visible=ifelse(bounds==1, TRUE, FALSE)) %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,1], type = 'scatter', mode='lines',
showlegend=ifelse(i==1, TRUE, FALSE), name=TeX('\\mu_{t|t}'),
line=list(color=cols[2], width=0.5)) %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,1]+2*sqrt(outmat[,2]),
type='scatter', mode='markers', color=I(cols[2]), size=0.5,
showlegend=ifelse(i==1, TRUE, FALSE), name=TeX('\\Sigma_{t|t}'),
marker=list(symbol='cross-thin'), visible=ifelse(bounds==1, TRUE, FALSE)) %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,1]-2*sqrt(outmat[,2]),
type='scatter', mode='markers', color=I(cols[2]), size=I(5),
showlegend=FALSE, marker=list(symbol='cross-thin'),
visible=ifelse(bounds==1, TRUE, FALSE)) %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,5], type = 'scatter', mode='lines',
showlegend=ifelse(i==1, TRUE, FALSE), name=TeX('\\hat{y}_{t}'),
line=list(color=cols[3], width=0.5)) %>%
plotly::add_trace(x = 1:(M*N), y = outmat[,6], type = 'scatter', mode='lines',
showlegend=ifelse(i==1, TRUE, FALSE), name=TeX('\\tilde{y}_{t}'),
line=list(color=cols[4], width=0.5)) %>%
plotly::config(mathjax='cdn') %>%
plotly::layout(
xaxis=list(title=list(text='Iterations', standoff=0),
showline=T, showgrid=F, range = c(0, ifelse(N==1, M+0.25, N*M+0.5)),
anchor='y', scaleanchor='x'),
yaxis=list(showline=T, showgrid=F, range=mgrid))
rMe <- 0
for (n in 1:N) {
rMe <- rMe+M
nchleaf <- (M*(n-1)+1):(n*M)*chleaf[(M*(n-1)+1):(n*M)]
xupdates <- nchleaf[which(nchleaf!=0)]
yupdates <- as.vector(sapply(y[n], function(x){rep(x,length(xupdates))}))
outlist[[i]] <- outlist[[i]] %>%
plotly::add_trace(x = c(M*(n-1), n*M), y = c(y[n], y[n]),
type = 'scatter', mode='lines',
showlegend=ifelse((i==1 && n==1), TRUE, FALSE), name='y',
line=list(color = cols[6], dash = ifelse(M==1, 'solid', 'dash'),
width=0.5)) %>%
plotly::add_trace(x = xupdates, y = yupdates,
type='scatter', mode='markers',
showlegend=ifelse((i==2&&n==1), TRUE, FALSE), name='Update',
color=I(cols[5]), size=0.5) %>%
plotly::add_trace(x = rMe, y = mgrid,
type = 'scatter', mode='lines', visible=ifelse(trials==1, TRUE, FALSE),
showlegend=ifelse((trials==1 && i==1 && n==1), TRUE, FALSE), name='Trial',
line=list(color = cols[8], dash = 'dash', width=0.5))
}
i <- i+1
}
fig <- plotly::subplot(outlist, nrows=length(nplots), shareX=TRUE,
which_layout=c(1)) %>%
plotly::config(staticPlot=T, mathjax='cdn', displayModeBar = F)
fig <- fig %>% plotly::layout(
showlegend=TRUE,
legend=list(itemsizing='trace', orientation='h', xanchor='center', x=0.5),
margin=list(b=70, l=45, r=30, t=80),
title=list(text="Test Title"))
# yaxis=list(autorange=TRUE, fixedrange=FALSE))
# xaxis=list(anchor='y', scaleanchor='x'),
# yaxis=list(anchor='x', scaleanchor='y'))
# yaxis=list(range=mgrid))#,
# xaxis=list(title=list(text='Iterations', standoff=0),
# showline=T, showgrid=F, range = c(0, ifelse(N==1, M+0.25, N*M+2))),
# yaxis=list(showline=T, showgrid=F))
Its a bug in the backend of the graphics device ( or similar) . if you touch the scale knob in the export window the scales jump to the right position.
This is a workaround, i think plotly is not the ideal choice for static images since it translates to python using reticulate and its also more focused on dynamic web stuff. So i would not expect a quick bugfix.

using ls() pattern to create list of plots for subplot

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)

plotly plot doesnt show up

I am trying to animate this test data.frame but the plotly plot doesn't even show up! The same code works for original plotly data though. I have doublechecked column's class and they are the same as plotly example. I am now puzzled why this fails.
This also works in marker mode but not in lines mode as you see.
total <- data.frame(replicate(4,sample(0:1, 100, rep=TRUE)))
names(total) <- c("date", "frame", "P1.10", "year")
total$date <- as.numeric(as.character(t(rbind(runif(100, min=2000, max=2010)))))
f.rank <- order(total$date)
total$frame[f.rank] <- 1:nrow(total)
total$P1.10 <- as.numeric(as.character(t(rbind(runif(100, min=1, max=10)))))
total$year <- 2000
p <- total %>%
plot_ly(
x = ~date,
y = ~P1.10,
frame = ~frame,
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F)
) %>%
layout(
xaxis = list(
title = "Date",
zeroline = F
),
yaxis = list(
title = "P1.10",
zeroline = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
hide = T
) %>%
animation_button(
x = 1, xanchor = "right", y = 0, yanchor = "bottom"
)
You have ignored accumulate_by in the example. You also need an ID field. This is the same but using ggplot in combination.
set.seed(123)
library(plotly)
total <- data.frame(replicate(4,sample(0:1, 100, rep=TRUE)))
names(total) <- c("date", "frame", "P1.10", "year")
total$date <- as.numeric(as.character(t(rbind(runif(100, min=2000, max=2010)))))
f.rank <- order(total$date)
total$frame[f.rank] <- 1:nrow(total)
total$ID[f.rank] <- 1:nrow(total)
total$P1.10 <- as.numeric(as.character(t(rbind(runif(100, min=1, max=10)))))
total$year <- 2000
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
total <- total %>%
accumulate_by(~ID)
p <- ggplot(total,aes(ID, P1.10, frame = frame)) +
geom_line()
p <- ggplotly(p) %>%
layout(
title = "",
yaxis = list(
title = "P1.10",
zeroline = F,
tickprefix = "$"
),
xaxis = list(
title = "Date",
zeroline = F,
showgrid = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
currentvalue = list(
prefix = "Day "
)
)

Multiple lines/traces for each button in a Plotly drop down menu in R

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

R - Storing plotly objects inside a list

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

Resources