简体   繁体   中英

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.

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)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM