R Plotly版本4.9.0中plotly_click的错误,新版本中是否存在bug？

ig9co6j1  于 2023-01-18  发布在  其他
关注(0)|答案(3)|浏览(121)

更新3：新测试应用程序存在下拉按钮问题

library(shiny)
library(shinydashboard)
library(plotly)
library(shinyWidgets)

rm(list = ls(), envir = environment()) ## to prevent cross over from old runs

testData = data.frame(day = sample(seq(as.Date('1999/01/01'), as.Date('2000/01/01'), by="day"), 24), frequency = sample(1:5, 24, replace = T ), datecoloring = sample(1:2, 24, replace = T ))
testData$dayPOSIXct <- as.POSIXct(testData$day)

dateRangeMin <- min(testData$day)
dateRangeMax <- max(testData$day)



  ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar( 
      menuItem("Testpage", tabName = "Testpage", icon = icon("home"))
                      ),
    dashboardBody( 
      tabItems(
        # 1) Test Tab ---------------------------------------------------------------

        tabItem(tabName = "Testpage",
            actionButton(inputId = 'Load', label = 'Data'),
            dropdownButton(inputId= "TestButton", label = NULL,
              plotlyOutput('testplot', width = 700, height = 500),
              icon = icon("list-alt"), 
              tooltip = tooltipOptions(title = "Click to open and render the plot"), width = "1670px")

        )
      )
      ),
    title = "Dashboard example"
  )

server <- function(input, output,session) {

  values <- reactiveValues()

  observeEvent(input$Load, { 
    values$testData <- testData
  })

  output$testplot <- renderPlotly({
    req(values$testData)
    p <-  plot_ly(data = values$testData, source = 'testplot',
                  color  = as.factor(values$testData$datecoloring), colors = c('#339fff', '#eaf5ff'),
                  opacity= 0.5, showlegend = T,
                  marker = list(line = list(width = 2, color = '#0000ff')),
                  hoverinfo = "text",
                  text = ~paste('Files:', values$testData$frequency, '<br>Date:', format(values$testData$day, format = '%Y-%m-%d'), sep = ' '))%>%
      add_bars( x = ~dayPOSIXct, y =  ~frequency,   type = "bar", width = 36000000
      )

    p
  })

  relayout_data <- reactive({
    req(values$testData)
    event_data("plotly_relayout", source = "testplot")
  })

  observeEvent(relayout_data(),{
    print(relayout_data())
  })  
}
shinyApp(ui, server)

**更新2：**通过正确使用req()的方法，无论是否将event_data的观察与对event_data执行某些操作的代码分离，确实可以规避该问题。例如：

relayout_data <- reactive({
req(values$testData)
event_data("plotly_relayout", source = "testplot")

 })

  observeEvent(relayout_data(),{
    print(relayout_data())
  })

然而，这似乎无法为绘图位于内部（即下拉按钮面板或闪亮应用程序的其他选项卡/页面）的情况提供解决方案。加载绘图所需的数据后，req（）得到满足，代码将触发，但绘图仍未呈现，因为它不在当前屏幕中。

更新：github上也报告了该问题，尚未提供真实的的解决方案https://github.com/ropensci/plotly/issues/1528
原始问题/帖子：

今天我更新了我所有的软件包在R和突然我得到了一个长长的错误列表来自新的plotly版本4.9.0在R与我的R闪亮的应用程序。
所有这些误差涉及plotly_relayout、plotly_click等。
警告：未注册与源ID“DateRangeHisto”绑定的“plotly_relayout”事件。要获取此事件数据，请将event_register(p, 'plotly_relayout')添加到要从中获取事件数据的绘图（p）。
我试着用各种方法添加event_register，但是没有效果。我想新版本中有bug吧？
这是一个毫无意义的虚拟应用程序，它会在4.9.0版本中产生bug，并更新了所有软件包。

更新：当数据不可用于绘图时似乎会发生错误尽管plot_ly块中有req()，但event_data会导致错误。以前版本的plotly不会发生这种情况.....因此，如何消除这种情况是现在的问题

library(shiny)
    library(plotly)


rm(list = ls(), envir = environment()) ## to prevent cross over from old runs

testData = data.frame(day = sample(seq(as.Date('1999/01/01'), as.Date('2000/01/01'), by="day"), 24), frequency = sample(1:5, 24, replace = T ), datecoloring = sample(1:2, 24, replace = T ))
testData$dayPOSIXct <- as.POSIXct(testData$day)

dateRangeMin <- min(testData$day)
dateRangeMax <- max(testData$day)
if(!require('shiny')){ install.packages('shiny', dependencies=TRUE)}
if(!require('shinyWidgets')){ install.packages('shinyWidgets', dependencies=TRUE)}
if(!require('plotly')){ install.packages('plotly', dependencies=TRUE)}
if(!require('htmlwidgets')){ install.packages('htmlwidgets')}

ui <- fluidPage(
  actionButton(inputId = 'Load', label = 'Data'),
  plotlyOutput('testplot', width = 700, height = 500)

)

server <- function(input, output,session) {

  values <- reactiveValues()

  observeEvent(input$Load, { 
    values$testData <- testData
    })

  output$testplot <- renderPlotly({ 
    req(values$testData)
    p <-  plot_ly(data = values$testData, source = 'testplot',
                  color  = as.factor(values$testData$datecoloring), colors = c('#339fff', '#eaf5ff'),
                  opacity= 0.5, showlegend = T,
                  marker = list(line = list(width = 2, color = '#0000ff')),
                  hoverinfo = "text",
                  text = ~paste('Files:', values$testData$frequency, '<br>Date:', format(values$testData$day, format = '%Y-%m-%d'), sep = ' '))%>%
      add_bars( x = ~dayPOSIXct, y =  ~frequency,   type = "bar", width = 36000000
      )
    p
  })

  observeEvent(event_data("plotly_relayout", source = "testplot"),{
    #any code here, doesn't matter, bug happens already
  })

}

shinyApp(ui, server)

会话信息

sessionInfo()
R version 3.5.3 (2019-03-11)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
[1] LC_COLLATE=Dutch_Netherlands.1252  LC_CTYPE=Dutch_Netherlands.1252    LC_MONETARY=Dutch_Netherlands.1252 LC_NUMERIC=C                       LC_TIME=Dutch_Netherlands.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] plotly_4.9.0  ggplot2_3.1.1 shiny_1.3.2  

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.1         pillar_1.4.0       compiler_3.5.3     later_0.8.0        colourpicker_1.0.3 plyr_1.8.4         shinyjs_1.0        tools_3.5.3        digest_0.6.19      viridisLite_0.3.0 
[11] jsonlite_1.6       tibble_2.1.1       gtable_0.3.0       pkgconfig_2.0.2    rlang_0.3.4        rstudioapi_0.10    crosstalk_1.0.0    yaml_2.2.0         httr_1.4.0         withr_2.1.2       
[21] dplyr_0.8.1        htmlwidgets_1.3    grid_3.5.3         DT_0.6             tidyselect_0.2.5   glue_1.3.1         data.table_1.12.2  R6_2.4.0           tidyr_0.8.3        purrr_0.3.2       
[31] magrittr_1.5       scales_1.0.0       promises_1.0.1     htmltools_0.3.6    assertthat_0.2.1   mime_0.6           xtable_1.8-4       colorspace_1.4-1   httpuv_1.5.1       miniUI_0.1.1.1    
[41] lazyeval_0.2.2     munsell_0.5.0      crayon_1.3.4
r

3条答案

按热度按时间
l5tcr1uw

l5tcr1uw1#

问题是observeEvent试图在渲染之前访问event_data。您可以通过将req()也用于您的event_data()来解决此问题。Plotly 4.9.0确实在此方面似乎更为严格。

library(shiny)
library(shinydashboard)
library(plotly)
library(shinyWidgets)

rm(list = ls(), envir = environment()) ## to prevent cross over from old runs

testData = data.frame(day = sample(seq(as.Date('1999/01/01'), as.Date('2000/01/01'), by="day"), 24), frequency = sample(1:5, 24, replace = T ), datecoloring = sample(1:2, 24, replace = T ))
testData$dayPOSIXct <- as.POSIXct(testData$day)

dateRangeMin <- min(testData$day)
dateRangeMax <- max(testData$day)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Testpage", tabName = "Testpage", icon = icon("home"))
    )
  ),
  dashboardBody( 
    tabItems(
      # 1) Test Tab ---------------------------------------------------------------

      tabItem(tabName = "Testpage",
              actionButton(inputId = 'Load', label = 'Data'),
              dropdownButton(inputId = "TestButton", label = NULL,
                             plotlyOutput('testplot', width = 700, height = 500),
                             icon = icon("list-alt"), 
                             tooltip = tooltipOptions(title = "Click to open and render the plot"), width = "1670px")

      )
    )
  ),
  title = "Dashboard example"
)

server <- function(input, output, session) {

  # output$testplot <- renderPlotly({plot_ly(data.frame(NULL), source = 'testplot')})

  values <- reactiveValues()

  observeEvent(input$Load, {
    values$testData <- testData
  })

  output$testplot <- renderPlotly({
    req(values$testData)
    p <-  plot_ly(data = values$testData, source = 'testplot',
                  color  = as.factor(values$testData$datecoloring), colors = c('#339fff', '#eaf5ff'),
                  opacity= 0.5, showlegend = T,
                  marker = list(line = list(width = 2, color = '#0000ff')),
                  hoverinfo = "text",
                  text = ~paste('Files:', values$testData$frequency, '<br>Date:', format(values$testData$day, format = '%Y-%m-%d'), sep = ' '))%>%
      add_bars( x = ~dayPOSIXct, y =  ~frequency,   type = "bar", width = 36000000)
    p 
  })

  relayout_data <- reactive({
    req(values$testData)
    req(input$TestButton_state)
    event_data("plotly_relayout", source = "testplot")
  })

  observeEvent(relayout_data(),{
    print(relayout_data())
  })  
}
shinyApp(ui, server)
赞(0）分享  回复(0）举报  2023-01-18
mqkwyuun

mqkwyuun2#

我遇到了同样的问题，避免警告的一个可能方法是使用suspended = TRUE启动处于挂起状态的监视event_data的observeEvent，例如

observer <- observeEvent(event_data("plotly_relayout", source = "testplot"), suspended = TRUE, {
        print(event_data("plotly_relayout", source = "testplot"))
      })

然后，仅在定义绘图对象p后，通过在renderPlotly内添加observer$resume()创建绘图后才开始观察。
下面的最小shiny-app通过观察event_data("plotly_click")在uiOutput中的绘图来说明这一点，该绘图只有在选择了actionButton和checkbox之后才可用：

library(shiny)
library(plotly)

ui <- fluidPage(

    ## button
    actionButton("load", label = "New data"),
    ## checkbox
    checkboxInput("show", label = "Show plot"),
    ## plot 
    uiOutput("plot_ui"),
    ## click events
    tableOutput("clicked")

)

server <- function(input, output, session) {

  ## reactive values
  r <- reactiveValues(
      data = NULL,
      suspended = TRUE,
      clicked = NULL
  )

  ## load data 
  observeEvent(input$load, { 
        r$data <- data.frame(x= 1:100, y = rnorm(100))
      })

  ## show plot only if checkbox is selected
  output$plot_ui <- renderUI({
        req(input$show)
        plotlyOutput("plot") 
      })

  ## plotly plot
  output$plot <- renderPlotly({
        req(r$data)
        p <- plot_ly(data = r$data, x = ~x, y = ~y, mode = "markers", type = "scatter", source = "plot")
        ## resume observer only if suspended 
        if(r$suspended) {
          observer$resume()
          r$suspended <- FALSE
        }
        return(p)
      })

  ## observe click events
  observer <- observeEvent(event_data("plotly_click", source = "plot"), suspended = TRUE, {
        r$clicked <- rbind(r$clicked, event_data("plotly_click", source = "plot"))
      })  

  ## display clicked points
  output$clicked <- renderTable(
      r$clicked
  )

}

shinyApp(ui, server)

注意：无功值r$suspended确保了只有当观测器的状态实际上被挂起时才调用observer$resume()。

赞(0）分享  回复(0）举报  2023-01-18
ve7v8dk2

ve7v8dk23#

试试这个：

relayout_data <- reactive({
  req(input[[testplot]])
  event_data("plotly_relayout", source = "testplot")
 })
赞(0）分享  回复(0）举报  2023-01-18
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com