Search code examples
rshinyplotlyr-plotly

event when clicking a name in the legend of a plotly's graph in R Shiny


I want to display some information when the user click on the legend of a plotly graph. For example in the code below, if the user clicks on the "drat" name in the legend to unshow these data, I would like to print a text saying "drat and qsec are selected".

I have seen this stackoverflow's post: R shiny and plotly getting legend click events but it works with labels. In my case, labels is not an available parameter. I have tested the different plotly events but none return any information when I click on the legend (see code below).

Is there a way to have this information ?

Thanks

library(plotly)
library(shiny)

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("hover"),
  verbatimTextOutput("click"),
  verbatimTextOutput("brush"),
  verbatimTextOutput("zoom")

)

server <- function(input, output, session) {

  output$plot <- renderPlotly({
    p <- plot_ly()
    for(name in c("drat", "wt", "qsec"))
    {
      p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
    }

    p
  })

  output$hover <- renderPrint({
    d <- event_data("plotly_hover")
    if (is.null(d)) "Hover events appear here (unhover to clear)" else d
  })

  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Click events appear here (double-click to clear)" else d
  })

  output$brush <- renderPrint({
    d <- event_data("plotly_selected")
    if (is.null(d)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else d
  })

  output$zoom <- renderPrint({
    d <- event_data("plotly_relayout")
    if (is.null(d)) "Relayout (i.e., zoom) events appear here" else d
  })

}

shinyApp(ui, server)

Solution

  • library(plotly)
    library(shiny)
    library(htmlwidgets)
    
    js <- c(
      "function(el, x){",
      "  el.on('plotly_legendclick', function(evtData) {",
      "    Shiny.setInputValue('trace', evtData.data[evtData.curveNumber].name);",
      "  });",
      "}")
    
    
    ui <- fluidPage(
      plotlyOutput("plot"),
      verbatimTextOutput("legendItem")
    )
    
    server <- function(input, output, session) {
    
      output$plot <- renderPlotly({
        p <- plot_ly()
        for(name in c("drat", "wt", "qsec"))
        {
          p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
        }
        p %>% onRender(js)
      })
    
      output$legendItem <- renderPrint({
        d <- input$trace
        if (is.null(d)) "Clicked item appear here" else d
      })
    }
    
    shinyApp(ui, server)
    

    enter image description here