Search code examples
rshinyreactive-programmingshiny-server

How to update sliderInput on this shinydashboard?


I'm working on some shiny dashboard and I'm trying to update my sliderInput accordingly to some criteria. Let me put you in context: if I choose "Diaria" in my "analisis_linea_marco_temporal" input, a slider appears at the bottom with a date range for 2021. Since it's conditional, the slider only shows when "Diaria" is selected. Now, suppose that condition is met and I choose 2019 and 2020, what I want is that now the slider input goes from "2019-01-01" to "2020-12-31"; if I choose only 2019, slider goes from "2019-01-01" to "2019-13-31" and so on. The only restriction is that user can't choose 2019 and 2021, if he/she wants all that period, he/she should select all 3 years. Here's my main code:

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)) 

I suspect I need to use eventReactive and observeEvent to achieve what I want and because of that I came with this sketch for my server function but I simply don't know how to do next since this really surpasses my current skills both in R and 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)
  

I really appreciate any idea, suggestion or bibliography. Thanks in advance.


Solution

  • In this case, you may want to consider using dynamic UI. Use the pair of uiOutput() and renderUI to set a date slider placeholder in the UI, then put the condition function in the server.

    Here is a minimum reproducible example, I only kept the relative parts mentioned in your question. The same idea applies to other elements.

    I am not sure I understand your question about the date slider, it seems to me that you can set a range from 2019-01-01 to 2021-09-30, then the user can select any time period in this range.

    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)