How can we make sliderInputs in Shiny 'lazy' to refresh?
CONTEXT
In the following basic reproducible Shiny app, third sliderinput depends on second sliderinput, in the sense that (for example) :
- there is no 'Semester 2' possible value for 2018
Similarly, secondslider input depends on first sliderinput, in the sense that (for example) :
- There is no '2016' possible value for product C
Although the app below works, user experience is not optimal as slider inputs refresh each time one value is changed by the user. It is important that each sliderinput gets its choices updated (as scope is changing each time user interacts with the sliderinputs).
However I would like dependent sliderinputs values to be kept whenever they are valid for the new scope..
How should I proceed? I guess some observers, isolate or shinyjs might help but I could not make it work so far.
EXPECTED BEHAVIOR
As an example :
- Granularity selectInput should keep 'Trimester 1' in case Period selectInput switches from 2017 to 2018 for product C
- Granularity selectInput should keep 'Trimester 1' in case Product selectInput switches from C to B for period 2018
- Period should keep its value when product is changed (in case value does not exist, then first value from the list should be selected)
Thank you!
MINIMAL REPRODUCIBLE EXAMPLE
# Load required packages
library(dplyr)
library(shiny)
# Create dummy dataset
data <- structure(
list(
PRODUCT = c("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B",
"B", "B", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C"),
PERIOD = c(2016, 2016, 2016, 2016, 2016, 2016, 2016, 2017, 2017, 2017, 2017, 2017, 2017, 2017,
2018, 2018, 2018, 2018, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2017, 2017, 2017,
2017, 2017, 2017, 2017, 2018, 2018, 2018, 2018, 2017, 2017, 2017, 2017, 2017, 2017,
2017, 2018, 2018, 2018, 2018),
GRANULARITY = c("Year", "Semester 1", "Semester 2", "Trimester 1", "Trimester 2", "Trimester 3",
"Trimester 4", "Year", "Semester 1", "Semester 2", "Trimester 1", "Trimester 2",
"Trimester 3", "Trimester 4", "Semester 1", "Trimester 1", "Trimester 2",
"Trimester 3", "Year", "Semester 1", "Semester 2", "Trimester 1", "Trimester 2",
"Trimester 3", "Trimester 4", "Year", "Semester 1", "Semester 2", "Trimester 1",
"Trimester 2", "Trimester 3", "Trimester 4", "Semester 1", "Trimester 1",
"Trimester 2", "Trimester 3", "Year", "Semester 1", "Semester 2", "Trimester 1",
"Trimester 2", "Trimester 3", "Trimester 4", "Semester 1", "Trimester 1",
"Trimester 2", "Trimester 3"),
KPI = c(37, 16, 5, 64, 75, 69, 89, 83, 99, 71, 92, 67, 79, 74, 13, 81, 31, 27, 39, 40, 16, 94,
71, 37, 55, 84, 69, 68, 60, 59, 21, 46, 43, 10, 100, 52, 82, 13, 4, 87, 30, 93, 17, 63,
67, 56, 67)),
row.names = c(NA, -47L),
class = c("tbl_df", "tbl", "data.frame")
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Product is a non-reactive input (ok)
selectInput(inputId = "si_product",
label = "Product",
choices = data %>% pull(PRODUCT) %>% unique() %>% sort()
),
# Period is reactive, depends on selected product (e.g. product C has no 2016 data)
uiOutput("uio_period"),
# Granularity is reactive, depends on selected period (e.g. 2018 has no 'semester 2' data)
uiOutput("uio_granularity")
),
mainPanel(verbatimTextOutput("bto_show_kpi"))
)
)
server <- function(session, input, output) {
# Data in scope
data_in_scope <- reactive({
data %>% filter(PRODUCT == input$si_product)
})
# Display products selectinput
output$uio_period <- renderUI({
selectInput(inputId = "si_period",
label = "Period",
choices = data_in_scope() %>%
pull(PERIOD) %>%
unique() %>% sort()
)
})
# Display granularity selectinput
output$uio_granularity <- renderUI({
selectInput(inputId = "si_granularity",
label = "Granularity",
choices = data_in_scope() %>%
filter(PERIOD == input$si_period) %>%
pull(GRANULARITY) %>%
unique() %>% sort()
)
})
# Display KPI
output$bto_show_kpi <- renderPrint({
data %>%
filter(PRODUCT == input$si_product,
PERIOD == input$si_period,
GRANULARITY == input$si_granularity) %>%
pull(KPI)
})
}
shinyApp(ui = ui, server = server)
OVERVIEW OF DUMMY DATASET
