如何更新这个 shinydashboard 上的 sliderInput？

Question

我正在处理一些闪亮的仪表板，我正在尝试根据某些标准更新我的 sliderInput。让我把你放在上下文中：如果我在“analisis_linea_marco_temporal”输入中选择“Diaria”，底部会出现一个滑块，日期范围为 2021 年。由于它是有条件的，滑块仅在“Diaria”是select编辑。现在，假设满足条件并且我选择 2019 和 2020，我想要的是现在滑块输入从“2019-01-01”变为“2020-12-31”；如果我只选择 2019 年，滑块将从“2019-01-01”变为“2019-13-31”，依此类推。唯一的限制是用户不能选择 2019 年和 2021 年，如果 he/she 想要所有那个时期，he/she 应该 select 所有 3 年。这是我的主要代码：

años_an_linea <- factor(c("2019", "2020", "2021"), ordered=TRUE)



ui <- dashboardPage(
  dashboardHeader(title="XXX", titleWidth = 650),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Análisis",
                         menuSubItem("Por línea", tabName = "analisis_linea"))
      )
    ),
      dashboardBody(
        tabItem("analisis_linea", "",
                box(width=9, "Análisis por línea",
                    plotlyOutput("analisis_linea_plot", height =400)),
                box(width=3, "Filtros",
                    br(),
                    tags$div(selectInput("analisis_linea_seleccion", "Línea", choices=c("L1",
                                          "L2", "L3", "L4"), 
                                         selected="L1",multiple=TRUE),  
                             style="display:inline-block; height: 45px"),
                    br(),
                    tags$div(selectInput("analisis_linea_año", "Año", choices=c("2019","2020","2021"), 
                                         selected="2021",multiple=TRUE),  
                             style="display:inline-block; height: 45px"),
                    br(),
                    tags$div(selectInput("analisis_linea_marco_temporal", 
                                         "Marco temporal", choices=c("Diaria", "Mensual"), 
                                         selected="Diaria"),
                             style="display:inline-block; height: 45px"),
                    br(),
                    tags$div(conditionalPanel(
                      condition = "input.analisis_linea_marco_temporal ==  'Mensual'",
                      selectInput("mes_analisis_linea", "Mes",
                                  choices= meses_analisis_linea, selected="Enero", 
                                  multiple=TRUE),
                      style="display:inline-block; height: 45px")
                    ),
                    br(),
                    tags$div(selectInput("analisis_linea_categoria_td_tp", "Categoría", 
                                         choices=c("Total", "Tipo de pago", "Tipo de día"), 
                                         selected="Total"),
                             style="display:inline-block; height: 45px"),
                    br(),
                    tags$div(selectInput("analisis_linea_td_tp", "", choices=c(), 
                                         multiple=TRUE),
                             style="display:inline-block; height: 45px")
                ),
                box(width=9,
                    conditionalPanel(
                      condition= "input.analisis_linea_marco_temporal == 'Diaria'",
                      sliderInput("analisis_linea_fecha_diaria", "",
                                  min=base::as.Date("2021-01-01"), max=base::as.Date("2021-09-30"),
                                  value= base::as.Date("2021-01-01"),
                                  timeFormat="%d/%m/%Y")
                    )
                )
                
                
        )     
      )
    )
  
    

server <- function(input, output, session) {}

shinyApp(ui, server, options = list(launch.browser = TRUE))

我怀疑我需要使用 eventReactive 和 observeEvent 来实现我想要的，因此我为我的 server 函数提供了这个草图，但我根本不这样做知道下一步该怎么做，因为这确实超过了我目前在 R 和 shiny

方面的技能

selec_año_analisis <- eventReactive(input$analisis_linea_año, {
      get("años_an_linea")[c(input$analisis_linea_año)]
    })
    
    observeEvent(c(input$analisis_linea_año
                   , input$analisis_linea_marco_temporal), {
      req(selec_año_analisis())
      updateSliderInput(session,"analisis_linea_fecha_diaria")
    }, ignoreNULL = FALSE)

我非常感谢任何想法、建议或参考书目。提前致谢。

Answer 1

在这种情况下，您可能要考虑使用 dynamic UI。使用 uiOutput() 和 renderUI 对在 UI 中设置日期滑块占位符，然后将条件函数放入服务器。

这里是一个最小可复现的例子，我只保留了你问题中提到的相关部分。同样的想法也适用于其他元素。

我不确定我是否理解你关于日期滑块的问题，在我看来你可以设置从 2019-01-01 到 2021-09-30 的范围，然后用户可以 select此范围内的任何时间段。

library(shiny)

ui <- fluidPage(
  selectInput("analisis_linea_marco_temporal",
              "Marco temporal", choices=c("Diaria", "Mensual")),

  uiOutput("date_slider") # UI placeholder
)

server <- function(input, output, session) {

  output$date_slider <- renderUI({ # create UI

    if (input$analisis_linea_marco_temporal == "Diaria"){

      sliderInput("analisis_linea_fecha_diaria", "",
                  min=as.Date("2019-01-01"), max=as.Date("2021-09-30"),
                  value= as.Date("2021-01-01"),
                  timeFormat="%d/%m/%Y")
      }
  })
}

shinyApp(ui, server)

如何更新这个 shinydashboard 上的 sliderInput？

How to update sliderInput on this shinydashboard?

r

shiny

reactive-programming

shiny-server