Prevent plotly selected traces from resetting when changing the variable to be plotted in R Shiny
I am trying to make a shiny app, which consists of a sidebar panel and a plot. In the panel, I have radio buttons to select which ID should be plotted. I also have multiple variables which user can turn off and on using plotly legend.
I want the plot to be empty when app first opens. For that, I am using visible = "legendonly" in my plotly. But then, I want to keep the traces that user already activated (by clicking on them in the legend) when the ID is changed in the sidebar panel; however, since plotly get regenerated every time, again it uses visible = "legendonly" option and that causes the plot to reset.
Is there a way to keep the traces (only the ones that are already selected) when a different option gets selected in the sidebar panel?
See a reproducible example below; please note that I made this example to run locally. You need to load data and packages separately into your R session. Data can be found at the bottom of the question.
library(shiny)
library(plotly)
library(lubridate)
### Read mdata into your R session
# UI
uix <- shinyUI(pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
radioButtons('vars', 'ID',
c("1", "2")),
helpText('Select an ID.')
),
mainPanel(
h4("Plot"),
plotlyOutput("myPlot")
)
)
)
# SERVER
serverx <- function(input, output) {
#load("Data/mdata.RData") #comment out this part and load data locally
# a large table, reative to input$show_vars
output$uteTable = renderDataTable({
ute[, input$show_vars, drop = FALSE]
})
output$myPlot = renderPlotly(
{
p <- plot_ly() %>%
layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
yaxis = list(title = "Y"))
## Add the IDs selected in input$vars
for (item in input$vars) {
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == item) -> foo
p <- add_lines(p, data = foo, x = ~Date, y = ~Value, color = ~Variable, visible = "legendonly",
evaluate = TRUE)
p <- p %>% layout(showlegend = TRUE,
legend = list(orientation = "v", # show entries horizontally
xanchor = "center", # use center of legend as anchor
x = 100, y=1))
}
print(p)
})
}
shinyApp(uix, serverx)
Created on 2020-06-12 by the reprex package (v0.3.0)
Question: is it possible to keep the Var1 trace when changing to ID == 2?
Idea: I think it'd be possible if I could change the visible = 'legendonly to TRUE right after app deployment, so it only applies to the first example of the plot. Probably, I need to change evaluate to FALSE as well.
Data:
mdata <- structure(list(Year = c(2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L), Month = c(1L, 1L,
1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L,
5L, 5L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 9L, 9L,
9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 12L, 12L, 12L,
12L), Variable = c("Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2"), ID = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1,
2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2,
1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2), Value = c(187.797761979167,
6.34656438541666, 202.288468333333, 9.2249309375, 130.620451458333,
4.61060465625, 169.033213020833, 7.5226940625, 290.015582677083,
10.8697671666667, 178.527960520833, 7.6340359375, 234.53493728125,
8.32400878125, 173.827054583333, 7.54521947916667, 164.359205635417,
5.55496292708333, 151.75458625, 6.361610625, 190.124467760417,
6.45046077083333, 191.377006770833, 8.04720916666667, 170.714612604167,
5.98860073958333, 210.827157916667, 9.46311385416667, 145.784868927083,
5.16647911458333, 159.9545675, 6.7466725, 147.442681895833, 5.43921594791667,
153.057018958333, 6.39029208333333, 165.6476956875, 5.63139815625,
197.179256875, 8.73210604166667, 148.1879651875, 5.58784840625,
176.859451354167, 7.65670020833333, 186.215496677083, 7.12404453125,
219.104379791667, 9.39468864583333)), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -48L), groups = structure(list(
Year = 2015L, .rows = list(1:48)), row.names = c(NA, -1L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE))
Solution
The following uses plotlyProxy to replace the data for the existing plotly object (and traces) and therefore avoids re-rendering the plot. This approach is faster than re-rendering.
library(shiny)
library(plotly)
library(lubridate)
# UI
uix <- shinyUI(pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
radioButtons('myID', 'ID',
c("1", "2")),
helpText('Select an ID.')
),
mainPanel(
h4("Plot"),
plotlyOutput("myPlot")
)
)
)
# SERVER
serverx <- function(input, output, session) {
output$myPlot = renderPlotly({
p <- plot_ly() %>%
layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
yaxis = list(title = "Y"))
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == 1) -> IDData
p <- add_lines(p, data = IDData, x = ~Date, y = ~Value,
color = ~Variable, visible = "legendonly")
p <- p %>% layout(showlegend = TRUE,
legend = list(orientation = "v", # show entries horizontally
xanchor = "center", # use center of legend as anchor
x = 100, y=1))
p
})
myPlotProxy <- plotlyProxy("myPlot", session)
observe({
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == input$myID) -> IDData
req(IDData)
uniqueVars <- unique(IDData$Variable)
for(i in seq_along(uniqueVars)){
IDData %>% filter(Variable == uniqueVars[i]) -> VarData
plotlyProxyInvoke(myPlotProxy, "restyle", list(x = list(VarData$Date),
y = list(VarData$Value)), list(i-1))
}
})
}
shinyApp(uix, serverx)
For further information please also see chapter "17.3.1 Partial plotly updates" in the plotly book, plotly's function reference and this answer.
Data:
### Read mdata into your R session
mdata <- structure(list(Year = c(2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L), Month = c(1L, 1L,
1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L,
5L, 5L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 9L, 9L,
9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 12L, 12L, 12L,
12L), Variable = c("Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2"), ID = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1,
2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2,
1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2), Value = c(187.797761979167,
6.34656438541666, 202.288468333333, 9.2249309375, 130.620451458333,
4.61060465625, 169.033213020833, 7.5226940625, 290.015582677083,
10.8697671666667, 178.527960520833, 7.6340359375, 234.53493728125,
8.32400878125, 173.827054583333, 7.54521947916667, 164.359205635417,
5.55496292708333, 151.75458625, 6.361610625, 190.124467760417,
6.45046077083333, 191.377006770833, 8.04720916666667, 170.714612604167,
5.98860073958333, 210.827157916667, 9.46311385416667, 145.784868927083,
5.16647911458333, 159.9545675, 6.7466725, 147.442681895833, 5.43921594791667,
153.057018958333, 6.39029208333333, 165.6476956875, 5.63139815625,
197.179256875, 8.73210604166667, 148.1879651875, 5.58784840625,
176.859451354167, 7.65670020833333, 186.215496677083, 7.12404453125,
219.104379791667, 9.39468864583333)), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -48L), groups = structure(list(
Year = 2015L, .rows = list(1:48)), row.names = c(NA, -1L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE))
Edit:
The following is an alternative server function to update the trace data with a single plotlyProxyInvoke call (avoiding the for-loop):
serverx <- function(input, output, session) {
output$myPlot = renderPlotly({
p <- plot_ly() %>%
layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
yaxis = list(title = "Y"))
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == 1) -> IDData
p <- add_lines(p, data = IDData, x = ~Date, y = ~Value,
color = ~Variable, visible = "legendonly")
p <- p %>% layout(showlegend = TRUE,
legend = list(orientation = "v", # show entries horizontally
xanchor = "center", # use center of legend as anchor
x = 100, y=1))
p
})
myPlotProxy <- plotlyProxy("myPlot", session)
IDDataList <- split(mdata %>% mutate(Date = make_date(Year, Month, 15)), ~ ID + Variable)
observe({
selectedIDDataList <- setNames(lapply(list("Date", "Value"), function(i){
unname(lapply(IDDataList[paste0(input$myID, ".Var", c(1L, 2L))], function(j){j[[i]]}))
}), c("x", "y"))
plotlyProxyInvoke(myPlotProxy, "restyle", selectedIDDataList, seq_along(selectedIDDataList)-1)
})
}
- Retrieving expected data.frame for testthat expectation
- How to use an anonymous function with pipe operator?
- R passing RSelenium driver environment as function argument
- Keep file names merging list with lapply?
- replace strings that contains one another
- Stop parsing out zeros after decimals in ggplot2's annotate
- Plot data.tree coloring and labelling by level
- Extracting the date and time out of a date and time format
- How to reshape a dataframe into wide format with specified column pairs
- Show partial segments removed after limit scales for `geom_pointrange`
- Control ggplot2 legend look without affecting the plot
- Concatenate strings over all rows in a single column of a data frame
- Is there some way to keep variable names from.SD+.SDcols together with non .SD variable names in data.table?
- How to create mutually dependent checkbox columns in a DT table?
- A problem with an stacked, grouped and faceted graph y gg plot
- Installing R on Linux: configure: error: libcurl >= 7.28.0 library and headers are required with support for https
- Create a column conditional on multiple other character and numerical columns
- data.frame to array (2 columns)
- Changing options() in a function environment without changing options() in global environment in R?
- pivot(), group_by() and summarise() with nested data
- Why legend is not showing up in plot layout using patchwork in R?
- in dplyr::mutate, dplyr::starts_with works for .before but not .after?
- Finding optimal cut-off points for dividing a variable into equal groups considering ties in which quantiles do not work
- How to add a legend to hline?
- R Shiny Suppress slider handle for sliderInput until click
- brmultinom brglm2 vifs and dredge dont work
- R, how to get current time miliseconds, without extra information ? (Sys.time(), format("%X"))
- Installing multiple versions of R
- Command to see 'R' path that RStudio is using
- Fast pairwise longest common substring from start