Plotly event_register 在 Shiny 应用程序中在错误的时刻失火

Question

我正在与一个似乎在预定时刻之后活跃的事件侦听器作斗争。我有两种选择日期范围的方法 - sliderInput 和 plotlyOutput 图。虽然 Shiny 反应性和 plotly event_register 通常会按预期响应，但 plotly event_register 也会在不受欢迎的情况下开火moment - 当用户在单击按钮后做出 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, value, 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, 'date_range', min = date_range[1], max = date_range[2], value = date_range)
  })
  
}

shinyApp( ui = ui, server = server)

Answer 1

啊菜鸟错误..我的 output$brushed <- renderPrint({ ... }) 只需要移到 observeEvent(input$market, ...) 子句之外。

Plotly event_register 在 Shiny 应用程序中在错误的时刻失火

Plotly event_register in Shiny app misfiring at the wrong moment

r

shiny

r-plotly

ggplotly