在错误的时刻错误地在Shiny应用中触发event_register

如何解决在错误的时刻错误地在Shiny应用中触发event_register

我正在努力使用一个情节事件监听器，该监听器在预期的时间之后似乎一直处于活动状态。我有两种选择日期范围的方法-sliderInput和plotlyOutput图。虽然Shiny反应性和密谋 event_register 通常会按预期做出响应，但密谋 event_register 也会在不受欢迎的时刻触发-当用户在之后做出selectInput选择时在更早的plotlyOutput拖动范围选择之后，单击了按钮即可重置。

下面的应用程序重现了该问题。协助非常感谢。

require(tidyverse)
require(shiny)
require(plotly)

d = as_tibble(EuStockMarkets) %>% mutate(date = Sys.Date() + (-1860:-1)) %>% 
  pivot_longer(-date,names_to = 'market')

ui = fluidPage(
  sidebarPanel(width = 3,h5('Persistent sparkline to show full date range'),plotOutput("sparkline",height = '100px'),sliderInput('date_range','Date range',min = min(d$date),max = max(d$date),value = range(d$date),step = 1,timeFormat = '%d %b %y'),actionButton('reset_date_range','Reset sliderInput to full range',style='height: 25px; padding: 2px 5px;'),hr(),selectInput('market','Market',choices = unique(d$market),selected = 'DAX'),h4('Steps to reproduce the problem:'),p('1. Drag a date range in the big (plotly) plot. This will apply to sliderInput and main plot will update as intended.'),p('2. Click the button to reset the range.'),p('3. Select a new market.  The sliderInput will revert to the last plotly plot\'s drag range despite the reset.'),h5('Plotly event_register response:'),verbatimTextOutput("brushed")
  ),mainPanel(width = 9,plotlyOutput('plot',height='80vh'))
)

server = function(input,output,session) {
  
  r = reactiveValues() # my app requires a reactive data object
  
  observeEvent(input$market,{
    r$dat = d %>% filter(market == local(input$market))  # filter reactive data

    # Sparkline plot
    output$sparkline = renderPlot({
      d %>% filter(market == input$market) %>% 
        qplot(date,value,label = round(value),geom = 'line',data = .) +
        geom_text(data = function(x){ filter(x,value %in% range(value))},size = 4) +
        theme_void() + scale_y_continuous(expand = c(0.2,0.2))
    },bg="transparent")
    
    # Plotly timeline plot
    output$plot = renderPlotly({
      p = r$dat %>% qplot(date,data = .,geom = 'line') + theme_minimal()
      ggplotly(p) %>% layout(dragmode = "select") %>% event_register("plotly_brushed")
    })
    
    output$brushed <- renderPrint({
      e_dat = event_data("plotly_brushed")
      if(length(na.omit(e_dat$x)) == 2){
        sliderRange <<- as.Date(e_dat$x,origin='1970-01-01')
        updateSliderInput(session,'date_range',value = sliderRange)
        sliderRange <<- NULL # test to ensure e_dat$x isn't persisting somehow
      }
      print(e_dat)
    })
    
  })
  
  # update reactive r$dat if the slider used
  observeEvent(input$date_range,{
    r$dat = d %>% filter(market == local(input$market),date >= input$date_range[1],date <= input$date_range[2])
  })
  
  # reset date selection
  observeEvent(input$reset_date_range,{
    date_range = range(d$date,na.rm = TRUE)
    updateSliderInput(session,min = date_range[1],max = date_range[2],value = date_range)
  })
  
}

shinyApp( ui = ui,server = server)

解决方法

菜鸟错误。.我的intelreport_lists.html只需要移到output$brushed <- renderPrint({ ... })子句之外。