добавление / удаление следов в сюжетном режиме для каждого события onclick

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

Извините за мой плохой английский и заранее спасибо


r r-plotly shiny
person M.K.    schedule 26.11.2018    source источник

Ответы (1)


arrow_upward
2
arrow_downward

Можно использовать небольшой код 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)

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

person Stéphane Laurent    schedule 26.11.2018
comment
Спасибо за вашу помощь. Следующая Проблема решена уже вашим кодом. Я немного изменил ваш javascript-код, используя информацию из ‹stackoverflow.com/questions/42996303/ ›: ‹pre› ‹code› js‹ - $ (document) .ready (function () {$ (document) .on ('click', function () {Shiny .setInputValue ('click_on_doc', true, {priority: 'event'}); Shiny.setInputValue ('. clientValue-plotly_click-A', 'null');})}) ‹/code› ‹/pre› - person M.K.; 27.11.2018