在 R Shiny 中单击绘图图例中的名称时发生的事件

Question

我想在用户点击绘图的图例时显示一些信息。例如在下面的代码中，如果用户单击图例中的 "drat" 名称以取消显示这些数据，我想打印一段文字说 "drat and qsec are selected".

我看过这个 Whosebug 的post：但它适用于标签。就我而言，标签不是可用参数。我已经测试了不同的 plotly 事件，但是 none return 当我点击图例时的任何信息（见下面的代码）。

有没有办法获得这些信息？

谢谢

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)

Answer 1

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)

Answer 2

只是为了完整起见：使用 plotlyProxy:

无需额外的 JS 即可完成相同的操作

library(shiny)
library(plotly)

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("clickedLegendItem"),
  verbatimTextOutput("doubleclickedLegendItem")
)

server <- function(input, output, session) {
  
  output$plot <- renderPlotly({
    p <- plot_ly(source = "mySource")
    for(name in c("drat", "wt", "qsec"))
    {
      p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
    }
    p %>% event_register('plotly_legendclick') %>% event_register('plotly_legenddoubleclick')
  })
  
  myPlotlyProxy <- plotlyProxy("plot")
  
  legendClickEvents <- reactive({
    event_data(source = "mySource", "plotly_legendclick")
  })
  
  legendDoubleclickEvents <- reactive({
    event_data(source = "mySource", "plotly_legenddoubleclick")
  })
  
  output$clickedLegendItem <- renderPrint({
    clickedItem <- legendClickEvents()$name
    if (is.null(clickedItem)){"Clicked item appears here"} else {clickedItem}
  })
  
  output$doubleclickedLegendItem <- renderPrint({
    doubleclickedItem <- legendDoubleclickEvents()$name
    if (is.null(doubleclickedItem)){"Doubleclicked item appears here"} else {doubleclickedItem}
  })
}

shinyApp(ui, server)

在 R Shiny 中单击绘图图例中的名称时发生的事件

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

r

shiny

plotly

r-plotly