在下面的示例中(暂时忽略var Select 逻辑)，是否可以使用updateSliderInput来更改年份滑块类型，如果是input$slider_type == 'one'(缺省值)，则只接受一个值，如果是input$slider_type == 'two'，则是一个值范围？
如果不是，是否需要uiOutput%/renderUI%的方法，或者是否有第三种方法？
library(tidyverse)
library(shiny)
dta <- tibble(
var =
c(
rep("A", 10),
rep("B", 3),
rep("C", 5)
),
year = c(
1984:1993,
1987:1989,
1990:1994
)
) %>%
mutate(
val = runif(n())
)
ui <- fluidPage(
titlePanel("Dynamic year slider"),
sidebarLayout(
sidebarPanel(
selectInput(
"var_select", "Select variable",
choices = unique(dta$var)[1],
selected = unique(dta$var)[1]
),
selectInput("slider_type", "Select slider type",
choices = c("One value" = "one", "Two values" = "more"),
selected = "one"
),
sliderInput("year_select",
"Select year:",
min = min(subset(dta, var == unique(dta$var)[1])$year),
max = max(subset(dta, var == unique(dta$var)[1])$year),
value = min(subset(dta, var == unique(dta$var)[1])$year),
step = 1,
sep = ''
)
),
mainPanel(
tableOutput("table_output")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
current_var <- reactive(input$var_select)
current_slider_type <- reactive(input$slider_type)
current_year_value <- reactive(input$year_select)
observeEvent(input$var_select, {
message("The selected var is ", current_var())
freezeReactiveValue(input, "year_select")
updateSliderInput(inputId = "year_select",
min = min(subset(dta, var == current_var())$year),
max = max(subset(dta, var == current_var())$year)
)
})
observeEvent(input$slider_type, {
this_slider_type <- current_slider_type()
message("The current slider type is ", this_slider_type)
if (this_slider_type == "more"){
message("current_slider_type is more")
updateSliderInput(inputId = "year_select",
label = "Select years", # this DOES update
value = c(1985, 1987)
# Only the first value is passed through in the update
#the inclusion of a second value does not change the slider type from one which accepts only a single value, to one which accepts a range
)
} else if (this_slider_type == "one"){
message("current_slider_type is one")
updateSliderInput(inputId = "year_select",
label = "Select year",
value = 1986 # this DOES update
)
}
})
output$table_output <- renderTable({
req(input$year_select)
dta %>%
filter(var == input$var_select) %>%
filter(year %in% input$year_select)
})
}
# Run the application
shinyApp(ui = ui, server = server)