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将结果发送到闪亮的服务器。然后，可以借助一个无功值来控制该图。

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)

我不了解您的“下一个问题”。也许打开一个新问题并尝试澄清。

在每个onclick事件中以情节方式添加/删除迹线

1 个答案: