[英]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".例如,在下面的代码中,如果用户单击图例中的“drat”名称以取消显示这些数据,我想打印一个文本,说明“选择了 drat 和 qsec”。
I have seen this stackoverflow's post: R shiny and plotly getting legend click events but it works with labels.我已经看过这个 stackoverflow 的帖子: R 闪亮并且有情节地获取图例点击事件,但它适用于标签。 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)
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)
Just for the sake of completeness: The same can be done without additional JS using plotlyProxy
:只是为了完整起见:使用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)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.