I'm creating an app where I have regional data on a few vars. The app allows you to select via a selectInput the region the user wants to visualize. For comparison/information purposes, I'd like the user to visualize both the region selected as well as the national average in the plot_ly.
However, I'd like the plot_ly legend to behave as if the regional data is "paired" with the national comparison – i.e., if the regional Var1 trace is clicked on, the national comparison should disappear as well.
Is there a way to do this in Shiny/plotly? I honestly haven't found anything besides checking for the settings "doubleclickedLegendItem" and clickedLegendItem but I have no idea how to pair the traces and then replicate the typical legend behavior.
Alternatively, if this is not possible, would it be possible to show the national comparison trace only when hovering over the regional trace? This would also be an acceptable solution.
Here's a very minimal example of my app:
(currently working on the full app here, 2nd tab: https://iseak.shinyapps.io/_funciona/)
library(shiny)
library(plotly)
library(dplyr)
set.seed(12345)
df <- data.frame(
Region = c(rep("National", 3),
rep("Region1", 3),
rep("Region2", 3)),
Year = c(rep(2018:2020,3)),
Var1 = c(rnorm(3),
rnorm(3,1),
rnorm(3,2)),
Var2 = c(rnorm(3),
rnorm(3,3),
rnorm(3,5))
)
linecolors <- c("blue", "green")
ui = fluidPage(
selectInput("region_sel",
label = "Select a region:",
choices = c("Region1", "Region2")
),
plotlyOutput("plot")
)
server = function(input, output, session) {
subset_data_region <- reactive({
temp_df <- df[df$Region==input$region_sel,]
return(temp_df)
})
subset_data_nat <- df[df$Region=="National",]
output$plot = renderPlotly({
plot_ly(type = 'scatter',
mode = 'lines+markers') %>%
#regional traces
add_trace(data = subset_data_region(),
y = ~Var1,
x = ~Year,
name = "Var1",
line = list(color = linecolors[1]),
marker = list(color = linecolors[1])
) %>%
add_trace(data = subset_data_region(),
y = ~Var2,
x = ~Year,
name = "Var2",
line = list(color = linecolors[2]),
marker = list(color = linecolors[2])
) %>%
#national traces for comparison
add_trace(data = subset_data_nat,
y = ~Var1,
x = ~Year,
name = "Var1",
line = list(color = linecolors[1],
dash = "dash"),
marker = list(color = linecolors[1]),
showlegend = F
) %>%
add_trace(data = subset_data_nat,
y = ~Var2,
x = ~Year,
name = "Var2",
line = list(color = linecolors[2],
dash = "dash"),
marker = list(color = linecolors[2]),
showlegend = F
)
})
}
shinyApp(ui = ui, server = server)
Thank you in advance for any suggestions.
Just in case this helps someone, I found the answer here: yes, it's possible using the legendgroup option:
library(shiny)
library(plotly)
library(dplyr)
set.seed(12345)
df <- data.frame(
Region = c(rep("National", 3),
rep("Region1", 3),
rep("Region2", 3)),
Year = c(rep(2018:2020,3)),
Var1 = c(rnorm(3),
rnorm(3,1),
rnorm(3,2)),
Var2 = c(rnorm(3),
rnorm(3,3),
rnorm(3,5))
)
linecolors <- c("blue", "green")
ui = fluidPage(
selectInput("region_sel",
label = "Select a region:",
choices = c("Region1", "Region2")
),
plotlyOutput("plot")
)
server = function(input, output, session) {
subset_data_region <- reactive({
temp_df <- df[df$Region==input$region_sel,]
return(temp_df)
})
subset_data_nat <- df[df$Region=="National",]
output$plot = renderPlotly({
plot_ly(type = 'scatter',
mode = 'lines+markers') %>%
#regional traces
add_trace(data = subset_data_region(),
y = ~Var1,
x = ~Year,
name = "Var1",
line = list(color = linecolors[1]),
marker = list(color = linecolors[1]),
legendgroup="group1"
) %>%
add_trace(data = subset_data_region(),
y = ~Var2,
x = ~Year,
name = "Var2",
line = list(color = linecolors[2]),
marker = list(color = linecolors[2]),
legendgroup="group2"
) %>%
#national traces for comparison
add_trace(data = subset_data_nat,
y = ~Var1,
x = ~Year,
name = "Var1",
line = list(color = linecolors[1],
dash = "dash"),
marker = list(color = linecolors[1]),
legendgroup="group1",
showlegend = F
) %>%
add_trace(data = subset_data_nat,
y = ~Var2,
x = ~Year,
name = "Var2",
line = list(color = linecolors[2],
dash = "dash"),
marker = list(color = linecolors[2]),
legendgroup="group2",
showlegend = F
)
})
}
shinyApp(ui = ui, server = server)
Here's a link with more info: https://plotly.com/r/legend/#grouped-legend