如何更新此闪亮仪表板上的滑块输入？

Posted 2023-03-24

【中文标题】如何更新此闪亮仪表板上的滑块输入？

【英文标题】：How to update sliderInput on this shinydashboard?

【发布时间】：2021-12-14 03:05:38

【问题描述】：

我正在开发一些闪亮的仪表板，并且正在尝试根据某些标准更新我的 sliderInput。 让我把你放在上下文中：如果我在“analisis_linea_marco_temporal”输入中选择“Diaria”，底部会出现一个滑块，其日期范围为 2021 年。由于它是有条件的，因此滑块仅在选择“Diaria”时显示。现在，假设满足条件并且我选择 2019 和 2020，我想要的是现在滑块输入从“2019-01-01”变为“2020-12-31”；如果我只选择 2019，滑块会从“2019-01-01”变为“2019-13-31”，依此类推。唯一的限制是用户不能选择 2019 和 2021，如果他/她想要所有的时间，他/她应该选择所有 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)
  

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

【参考方案1】：

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

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

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

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)

【讨论】：

抱歉回复太晚了。我有一段时间没有从事任何编程任务。感谢您的回答，我会检查它是如何工作的。