Как сделать слайд-входы в Shiny «ленивыми» для обновления?
КОНТЕКСТ
В следующем базовом воспроизводимом приложении Shiny третий ввод слайдера зависит от ввода второго слайдера, в том смысле, что (например):
- нет никакого возможного значения «Семестр 2» для 2018
Аналогично, ввод секундного слайдера зависит от ввода первого слайдера, в том смысле, что (например):
- Для продукта C
- Гранулярность selectInput должен оставить «Триместр 1» в случае, если период selectInput переключается с 2017 на 2018 для продукта C
- Granularity selectInput должен сохранять «Триместр 1» в случае, если Product selectInput переключается с C на B для периода 2018
- Период должен сохранять свое значение при изменении продукта (в случае, еслизначение не существует, затем следует выбрать первое значение из списка)
Спасибо!
МИНИМАЛЬНЫЙ РЕПРОДУКЦИОННЫЙ ПРИМЕР
# 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)
ОБЗОР DUMMY DATASET
