如何在R-Shiny中连接dateRangeInput和slideInput

问题描述

在我的Shiny-app中，我必须按时间子集一个数据帧。对我来说最方便的Widget是sliderInput，但是我也想允许从日历中选择特定日期的可能性，就像我对daterangeInput所做的那样，因为数据集跨越了多年的每日数据。我尝试链接两个对象，当daterange更改时更新滑块，反之亦然，使用两个单独的renderUI（）。通常，这很好，但是在某些情况下，我陷入了一个无限循环，在此循环中，slider和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],max = max(data$Date))
  })
 

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

您能帮助我，如何避免陷入无限循环吗？

解决方法

为避免递归，可以使用两个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,change_daterange()) > reactdelay) {
      change_slider(Sys.time())
      updateSliderInput(session,"slider",value = c(input$daterange[[1]],input$daterange[[2]]))
    }
  })
}

shinyApp(ui,server)