добавление / удаление следов в зависимости от события onclick

Question

Я пытаюсь распечатать интерактивную круговую диаграмму.По щелчку на графике следует добавить еще один след.Я использую event_data для этого.Когда трассировка добавлена, при следующем щелчке в любом месте страницы трассировка должна быть удалена.Я не нашел решения для этого.Я не знаю, как перезаписать событие onclick после другого клика.

Следующая проблема - удалить ранее добавленную трассировку.Я думаю, что я мог бы использовать plotlyProxy для этого, как в Удаление следов по имени с использованием 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.Тогда можно управлять сюжетом с помощью реактивного значения.

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)

Я не понял вашей «следующей проблемы».Возможно, откройте новый вопрос и попробуйте уточнить.