Linking legends between separate plotly plots in shiny

688 views Asked by At

Is it possible to link legends from separate plotly plots in Shiny? I know you can link plots using click events, such as clicking on certain data points within a graph, but I've not found any info on linking legends.

I will have a dynamic number of plots that will all have the same legend items, so it would be nice for the user to click/unclick a legend item to show/hide a line on all the linked plots. I originally had a nice linked single legend using plotly subplots, but I wasn't able to arrange the positioning of the plots, their titles, and the single legend nicely on the page, hence I'm going back to having separate plotly plots.

I've inserted an example shiny app below as a base for suggestions on how to link the legends:

library(shiny)
library(plotly)

ui <- fluidPage(
    plotlyOutput("plot1"),
    plotlyOutput("plot2")  
)

server <- function(input, output) {
    
    output$plot1 <- renderPlotly({
       
        trace_0 <- rnorm(100, mean = 5)
        trace_1 <- rnorm(100, mean = 0)
        trace_2 <- rnorm(100, mean = -5)
        x <- c(1:100)
        
        data <- data.frame(x, trace_0, trace_1, trace_2)
        
        fig <- plot_ly(data, x = ~x) 
        fig <- fig %>% add_trace(y = ~trace_0, name = 'trace 0',mode = 'lines') 
        fig <- fig %>% add_trace(y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
        fig <- fig %>% add_trace(y = ~trace_2, name = 'trace 2', mode = 'markers')

    })
    
    output$plot2 <- renderPlotly({
        
        trace_0 <- rnorm(100, mean = 5)
        trace_1 <- rnorm(100, mean = 0)
        trace_2 <- rnorm(100, mean = -5)
        x <- c(1:100)
        
        data <- data.frame(x, trace_0, trace_1, trace_2)
        
        fig <- plot_ly(data, x = ~x) 
        fig <- fig %>% add_trace(y = ~trace_0, name = 'trace 0',mode = 'lines') 
        fig <- fig %>% add_trace(y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
        fig <- fig %>% add_trace(y = ~trace_2, name = 'trace 2', mode = 'markers')
        
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

1

There are 1 answers

0
ismirsehregal On BEST ANSWER

You can access the event_data from one of the plots (using plotly_restyle) and repeat them on the other plot via plotlyProxyInvoke the following is a general restyle solution, which should also work for other parameters than the trace visibility:

library(shiny)
library(plotly)

ui <- fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2")
)

server <- function(input, output, session) {
  
  output$plot1 <- renderPlotly({
    
    trace_0 <- rnorm(100, mean = 5)
    trace_1 <- rnorm(100, mean = 0)
    trace_2 <- rnorm(100, mean = -5)
    x <- c(1:100)
    
    data <- data.frame(x, trace_0, trace_1, trace_2)
    
    fig <- plot_ly(data, type = "scatter", mode = 'markers', source = "p1Source") 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_0, name = 'trace 0', mode = 'lines') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_2, name = 'trace 2', mode = 'markers') %>%
      event_register('plotly_restyle')
  })
  
  output$plot2 <- renderPlotly({
    
    trace_0 <- rnorm(100, mean = 5)
    trace_1 <- rnorm(100, mean = 0)
    trace_2 <- rnorm(100, mean = -5)
    x <- c(1:100)
    
    data <- data.frame(x, trace_0, trace_1, trace_2)
    
    fig <- plot_ly(data, type = "scatter", mode = 'markers', showlegend = FALSE) 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_0, name = 'trace 0', mode = 'lines') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_2, name = 'trace 2', mode = 'markers')
    
  })
  
  plot2Proxy <- plotlyProxy("plot2", session)
  
  observe({
    restyle_events <- event_data(source = "p1Source", "plotly_restyle")
    plotlyProxyInvoke(plot2Proxy, "restyle", restyle_events[[1]], restyle_events[[2]])
    # plotlyProxyInvoke(plot2Proxy, "restyle", list(visible = FALSE), 1) # example usage
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

result


If you don't want to hide any legend you could also feed the restyle events of both plots into the same source, which results in mutual changes:

library(shiny)
library(plotly)

ui <- fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2")
)

server <- function(input, output, session) {
  
  trace_0 <- rnorm(100, mean = 5)
  trace_1 <- rnorm(100, mean = 0)
  trace_2 <- rnorm(100, mean = -5)
  x <- c(1:100)
  
  data <- data.frame(x, trace_0, trace_1, trace_2)
  
  fig <- plot_ly(data, type = "scatter", mode = 'markers', source = "mySource") 
  fig <- fig %>% add_trace(x = ~x, y = ~trace_0, name = 'trace 0', mode = 'lines') 
  fig <- fig %>% add_trace(x = ~x, y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
  fig <- fig %>% add_trace(x = ~x, y = ~trace_2, name = 'trace 2', mode = 'markers') %>%
    event_register('plotly_restyle')
  
  output$plot1 <- renderPlotly({
    fig
  })
  
  output$plot2 <- renderPlotly({
    fig
  })
  
  plot1Proxy <- plotlyProxy("plot1", session)
  plot2Proxy <- plotlyProxy("plot2", session)
  
  observe({
    restyle_events <- event_data(source = "mySource", "plotly_restyle")
    plotlyProxyInvoke(plot1Proxy, "restyle", restyle_events[[1]], restyle_events[[2]])
    plotlyProxyInvoke(plot2Proxy, "restyle", restyle_events[[1]], restyle_events[[2]])
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

result

The above is build on the assumption, that the curveNumbers of the traces match. If the traces need to be matched by name plotly_legendclick and plotly_legenddoubleclick or a JS approach would be needed.

Here a related post can be found.