如何在 R-Shiny 中连接 dateRangeInput 和 sliderInput答案

【问题标题】：How to connect dateRangeInput and sliderInput in R-Shiny如何在 R-Shiny 中连接 dateRangeInput 和 sliderInput
【发布时间】：2020-08-14 14:10:05
【问题描述】：

在我的 Shiny 应用程序中，我必须按时间对数据帧进行子集化。对我来说最方便的小部件是滑块输入，但我也想允许从日历中选择特定日期的可能性，就像我对 dateRangeInput 所做的那样，因为数据集跨越多年的日常数据。我试图链接它们两者，当 dateRange 更改时更新滑块，反之亦然，使用两个单独的 renderUI()。一般来说，这很好用，但在某些情况下，我会陷入无限循环，其中滑块和 rangeInput 不断地相互失效。无限循环仅在通过滑块更改后触发。

到目前为止，我的方法如下所示：

  output$dateRangeSliderUI <- renderUI({
    date_range_input <- input$dateRangeInput
    data <- isolate(dataset())
    start_date <- default_start
    end_date <- default_end
    
    if (is.null(date_range_input)){
      range_slider <- c(start_date, end_date)
    } else {
      range_slider <- date_range_input
    }
    
    sliderInput("dateRangeSlider",
                label = "Date Range:",
                value = range_slider,
                min = min(data$Date),
                max = max(data$Date),
                step = 1,
                timeFormat = "%F")
  })
  
  output$dateRangeInputUI <- renderUI({  
    date_range_slider <- input$dateRangeSlider
    data <- isolate(dataset$regressions)
    start_date <- default_start
    end_date <- default_end
    
    if (is.null(date_range_slider)){
      range_input <- c(start_date, end_date)
    } else {
      range_input <- date_range_slider
    }
    
    dateRangeInput("dateRangeInput",
                   label = NULL,
                   start = range_input[1],
                   end = range_input[2],
                   min = min(data$Date),
                   max = max(data$Date))
  })

如您所见，这两个小部件仅对彼此的更改做出反应，并且 start_date 和 end_date 说明了启动期间它们仍然为 NULL 的错误。

你能帮我，我如何避免陷入无限循环？

【问题讨论】：

什么是dataset，请提供可重现的例子
它真的不依赖于数据集。但它是每日时间序列的数据框，具有 Date 类的 Date 列。

标签： r shiny shiny-reactivity

【解决方案1】：

为避免递归，您可以使用两个reactiveVal 来存储sliderInput 和dateRange 的上次更新时间。
更新仅在一定延迟后完成，以确保这是手动的：

library(shiny)

ui <- fluidPage(
  sliderInput(
    "slider",
    "Slider",
    min = Sys.Date() - 90,
    max = Sys.Date(),
    value =  c(Sys.Date() - 30, Sys.Date())
  ),
  dateRangeInput(
    "daterange",
    "Input date range",
    start = Sys.Date() - 30,
    end = Sys.Date()
  )
)

server <- function(input, output, session) {
  ## Avoid chain reaction
  reactdelay <- 1
  change_slider <- reactiveVal(Sys.time())
  change_daterange <- reactiveVal(Sys.time())
  
  
  observeEvent(input$slider, {
    if (difftime(Sys.time(), change_slider()) > reactdelay) {
      change_daterange(Sys.time())
      updateDateRangeInput(session,
                           "daterange",
                           start = input$slider[[1]],
                           end = input$slider[[2]])
    }
  })
  observeEvent(input$daterange, {
    if (difftime(Sys.time(), change_daterange()) > reactdelay) {
      change_slider(Sys.time())
      updateSliderInput(session,
                        "slider",
                        value = c(input$daterange[[1]], input$daterange[[2]]))
    }
  })
}

shinyApp(ui, server)

【讨论】：