如何在 R-Shiny 中连接 dateRangeInput 和 sliderInput
How to connect dateRangeInput and sliderInput in R-Shiny
在我的 Shiny-app 中,我必须按时间对数据帧进行子集化。对我来说最方便的 Widget 是 sliderInput,但我也想允许从日历中选择特定日期的可能性,就像我使用 dateRangeInput 所做的那样,因为数据集跨越多年的日常数据。我尝试 link 它们中的两个,在 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。
你能帮我吗,我怎样才能避免陷入死循环?
为了避免递归,您可以使用两个 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)
在我的 Shiny-app 中,我必须按时间对数据帧进行子集化。对我来说最方便的 Widget 是 sliderInput,但我也想允许从日历中选择特定日期的可能性,就像我使用 dateRangeInput 所做的那样,因为数据集跨越多年的日常数据。我尝试 link 它们中的两个,在 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。
你能帮我吗,我怎样才能避免陷入死循环?
为了避免递归,您可以使用两个 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)