R plotly: how to observe whether a trace is hidden or shown through legend clicks with multiple plots

Question

I am trying to figure out which traces the user hides from a scatter plot by means of deselecting them in the interactive legend of plotly.

I have read this SO post, and the similar questions linked in the comments below and this brought me closer to the solution

The current solution is only doing partially what I need. Two things I am looking for to improve it is: - how to see which plot's legend is clicked (looking at source 'id' ?) - I can now see that a legend entry is clicked, but I need to be able to see whether it is clicked 'ON'(show trace) or 'OFF'

The output i'm looking for would look something like this: input$trace_plot1 : which is then a list of all traces that are off and which are on, or a single trace nr on every click but that tells whether that specific trace is now "ON" or "OFF"

The goal for me is to link the visual hiding and showing to an overview of all my groups in the data where the user can now give them new names, colors, and choose to keep or drop the group with a button that has a T/F state switch behind it. I would like to link that T/F state of the buttons to the 'show'/'hidden' of traces from a specific plot (since I have 5 copies of these plots in my app showing the data in different stages of the analysis process.

Here is my attempt that does not react to the legend somehow, only to zooom:

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);",
  "  });",
  "}")

iris$group <- c(rep(1,50), rep(2, 50), rep(3,50))

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

)


server <- function(input, output){

  output$plot1 <- renderPlotly({
    p <- plot_ly(source = 'plotly1', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
      layout(showlegend = TRUE)

    p %>% onRender(js)

    })

  output$plot2 <- renderPlotly({
    p <- plot_ly(source = 'plotly2', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
      layout(showlegend = TRUE)

    p %>% onRender(js)

  })

  output$legendItem <- renderPrint({
    d <- input$trace
    if (is.null(d)) "Clicked item appear here" else d
  })

  }

shinyApp(ui = ui, server = server)

EDIT: WORKING SOLUTION THANKS TO THE EXTENSIVE ANSWER from S.L.

library(plotly)
library(shiny)
library(htmlwidgets)

js <- c(
  "function(el, x, inputName){",
  "  var id = el.getAttribute('id');",
  "  var d3 = Plotly.d3;",
  "  el.on('plotly_restyle', function(evtData) {",
  "    var out = {};",
  "    d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
  "      var trace = d3.select(this)[0][0].__data__[0].trace;",
  "      out[trace.name] = trace.visible;",
  "    });",
  "    Shiny.setInputValue(inputName, out);",
  "  });",
  "}")


ui <- fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2"),
  verbatimTextOutput("tracesPlot1"),
  verbatimTextOutput("tracesPlot2")
)

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

output$plot1 <- renderPlotly({
    p1 <- plot_ly()
    p1 <-  add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
    p1 %>% onRender(js, data = "tracesPlot1")    
  })

  output$plot2 <- renderPlotly({
    p2 <- plot_ly()
    p2 <- add_trace(p2, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
    p2 %>% onRender(js, data = "tracesPlot2")  })


  output$tracesPlot1 <- renderPrint({ unlist(input$tracesPlot1)  })

  output$tracesPlot2 <- renderPrint({unlist(input$tracesPlot2)
  })

}

shinyApp(ui, server)

Is it what you want: https://stackoverflow.com/questions/52335837/event-when-clicking-a-name-in-the-legend-of-a-plotlys-graph-in-r-shiny/54505531#54505531 ? — Stéphane Laurent, Feb 22 '19 at 08:37
Possible duplicate of [event when clicking a name in the legend of a plotly's graph in R Shiny](https://stackoverflow.com/questions/52335837/event-when-clicking-a-name-in-the-legend-of-a-plotlys-graph-in-r-shiny) — Wilmar van Ommeren, Feb 22 '19 at 08:38
Ah I will update the question to make sure it's not a duplicate. I would like to see whether they are clicked 'off'. Didn't find the other question Stephane linked, but it reacts to both on and off clicks — Mark, Feb 22 '19 at 08:40
Stephane, or Wilmar, do you have any ideas on how to solve the updated question? — Mark, Feb 22 '19 at 10:12

Stéphane Laurent · Accepted Answer · 2019-02-22T16:21:23.460

Does it help?

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);",
  "  });",
  "  el.on('plotly_restyle', function(evtData) {",
  "    Shiny.setInputValue('visibility', evtData[0].visible);",
  "  });",
  "}")

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({
    trace <- input$trace
    ifelse(is.null(trace), 
           "Clicked item will appear here",
           paste0("Clicked: ", trace, 
                  " --- Visibility: ", input$visibility)
    )
  })
}

shinyApp(ui, server)

EDIT

There's an issue with the previous solution when one double-clicks on a legend item. Here is a better solution:

library(plotly)
library(shiny)
library(htmlwidgets)

js <- c(
  "function(el, x){",
  "  var d3 = Plotly.d3;",
  "  el.on('plotly_restyle', function(evtData) {",
  "    var out = {};",
  "    d3.select('g.legend').selectAll('.traces').each(function(){",
  "      var trace = d3.select(this)[0][0].__data__[0].trace;",
  "      out[trace.name] = trace.visible;",
  "    });",
  "    Shiny.setInputValue('traces', out);",
  "  });",
  "}")


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({
    input$traces
  })
}

shinyApp(ui, server)

If you have multiple plots, add the plot id in the legend selector, and use a function to generate the JavaScript code:

js <- function(i) { 
  c(
  "function(el, x){",
  "  var id = el.getAttribute('id');",
  "  var d3 = Plotly.d3;",
  "  el.on('plotly_restyle', function(evtData) {",
  "    var out = {};",
  "    d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
  "      var trace = d3.select(this)[0][0].__data__[0].trace;",
  "      out[trace.name] = trace.visible;",
  "    });",
  sprintf("    Shiny.setInputValue('traces%d', out);", i),
  "  });",
  "}")
}

Then do p1 %>% onRender(js(1)), p2 %>% onRender(js(2)), ..., and you get the info about the traces visibility in input$traces1, input$traces2, ....

Another way is to pass the desired name in the third argument of the JavaScript function, with the help of the data argument of onRender:

js <- c(
  "function(el, x, inputName){",
  "  var id = el.getAttribute('id');",
  "  var d3 = Plotly.d3;",
  "  el.on('plotly_restyle', function(evtData) {",
  "    var out = {};",
  "    d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
  "      var trace = d3.select(this)[0][0].__data__[0].trace;",
  "      out[trace.name] = trace.visible;",
  "    });",
  "    Shiny.setInputValue(inputName, out);",
  "  });",
  "}")


p1 %>% onRender(js, data = "tracesPlot1")
p2 %>% onRender(js, data = "tracesPlot2")

Hm yes, double click is an issue indeed.... Perhaps putting out a list of all traces and for each one whether it is legendonly or TRUE would be better, but I don't know if that is possible to achieve with javascript. Also, I think this doesn't see any difference between which plot 's legend is clicked if there are 2 plots right? — Mark, Feb 22 '19 at 11:40
Oh wow that does look rather cool indeed. One thing I don't see yet, how would we be able to make the javascript work on two plots, lets say identical trace names (numerical in my case), but create a specific input$traces for each i.e. input$tracesplot1 and input$tracesplot2? — Mark, Feb 22 '19 at 12:17
I seem to have a bug with the data = as input argument approach. It seems plot 2, and thus input$tracesPlot2 actually prints the results of plot1 and also with the list of js approach... I think it is because your javascript creates different numbered outputs, but still both seem to listen to plot1? — Mark, Feb 22 '19 at 16:15
@Mark I have just updated my answer. Can you try ? Now the selector of the legend includes the plot id, that should work. — Stéphane Laurent, Feb 22 '19 at 16:22
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/188902/discussion-between-mark-and-stephane-laurent). — Mark, Feb 22 '19 at 16:27
Yes, solved now! I'm adding a dummy app of my working version at the bottom of the question to give a full working app — Mark, Feb 22 '19 at 16:39
The output/selection does not update if you have a dynamic plot that is re-rendered. Only when you click again on the legend do you get an updated selection. Any fix to make sure it always refers to a "live" plot? — Jan Stanstrup, Nov 02 '20 at 12:52

R plotly: how to observe whether a trace is hidden or shown through legend clicks with multiple plots

1 Answers1

EDIT

Linked