r - 在每个 onclick 事件中添加/删除跟踪

Question

我正在尝试打印交互式饼图。单击绘图时，应添加另一条轨迹。我为此使用 event_data。添加跟踪后，下次单击页面上的任意位置时，跟踪将被删除。我没有找到解决方案。我不知道如何在再次点击后覆盖 onclick 事件。

下一个问题是删除之前添加的跟踪。我想我可以像 Removing traces by name using plotlyProxy (or accessing output schema in reactive context) 那样使用 plotlyProxy

之后你可以看到我的代码

library(shiny)
library(data.table)
library(plotly)

ui <- basicPage(
    mainPanel(
      fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
    )
)

server <- function(input, output, session) {
  testdata = data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
                    "Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
                    "Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
  testdata = data.table(testdata)
  testdata_agg = testdata[, sum(Umsatz.Orga), by=Dachorga]


  output$myplot <- renderPlotly({
    p <- testdata_agg %>%
      group_by(Dachorga) %>%
      plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
      add_pie(hole = 0.6) %>%
      layout(title = "Donut charts using Plotly",  showlegend = F,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
    d <- event_data("plotly_click")
    if (!is.null(d)) {
      p = add_pie(p, data = testdata[Dachorga == "Bla"], labels = ~Orga, values = ~Umsatz.Orga, hole = 0.5, 
              hoverinfo = 'label+percent+value', domain = list(
                x = c(0.1, 0.9),
                y = c(0.1, 0.9)),
              marker = list(hover = list(color = "white")))
    }
    p
  })
}

shinyApp(ui = ui, server = server)

抱歉我的英语不好，在此先感谢

Answer 1

可以使用一个小的 javascript 代码来检测对文档的一次点击，并使用 Shiny.setInputValue 将结果发送到 Shiny 的服务器。然后可以在 react 值的帮助下控制剧情。

library(shiny)
library(data.table)
library(plotly)

js <- "
$(document).ready(function(){
  $(document).on('click', function(){
    Shiny.setInputValue('click_on_doc', true, {priority: 'event'});
  })
})"

ui <- basicPage(
  tags$head(tags$script(HTML(js))),
  mainPanel(
    fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
  )
)

server <- function(input, output, session) {
  testdata <- data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
                        "Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
                        "Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
  testdata <- data.table(testdata)
  testdata_agg <- testdata[, sum(Umsatz.Orga), by=Dachorga]

  plot <- testdata_agg %>%
    group_by(Dachorga) %>%
    plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
    add_pie(hole = 0.6) %>%
    layout(title = "Donut charts using Plotly",  showlegend = F,
           xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
           yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

  click <- reactiveVal(FALSE)

  observe({
    event <- !is.null(event_data("plotly_click"))
    click(event)
  })

   observeEvent(input$click_on_doc, {
     click(FALSE)
   })  

  output$myplot <- renderPlotly({
    if (click()) {
      p <- add_pie(plot, data = testdata[Dachorga == "Bla"], labels = ~Orga, 
                   values = ~Umsatz.Orga, hole = 0.5, 
                  hoverinfo = 'label+percent+value', domain = list(
                    x = c(0.1, 0.9),
                    y = c(0.1, 0.9)),
                  marker = list(hover = list(color = "white")))
    }else{
      p <- plot
    }
    p
  })
}

shinyApp(ui = ui, server = server)

我还没有理解你的“下一个问题”。也许打开一个新问题并尝试澄清。