如何制作 sliderInput 'lazy' 并仅在需要时刷新

Question

如何让 Shiny 'lazy' 中的 sliderInputs 刷新？

上下文

在以下基本可重现的 Shiny 应用程序中，第三个 sliderinput 取决于第二个 sliderinput，在某种意义上（例如）：

2018 年没有 'Semester 2' 可能值

类似地，secondslider 输入取决于第一个 sliderinput，在某种意义上（例如）：

产品 C 没有“2016”的可能值

虽然下面的应用程序可以运行，但用户体验并不是最佳的，因为每次用户更改一个值时滑块输入都会刷新。每个 sliderinput 更新其 choices 很重要（因为每次用户与 sliderinputs 交互时范围都会改变）。

但是我希望在新范围有效时保留相关的 sliderinputs 值..

我该如何进行？我想一些 observers、isolate 或 shinyjs 可能会有所帮助，但到目前为止我无法让它工作。

预期行为

例如：

粒度 selectInput 应保持 'Trimester 1'，以防产品 C
粒度 selectInput 应保持 'Trimester 1'，以防产品 selectInput 在 2018 年期间从 C 切换到 B
产品更改时，期间应保持其值（如果值不存在，则应选择列表中的第一个值）

谢谢！

最小可重现示例

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

虚拟数据集概述

Answer 1

请尝试以下操作。这似乎太简单了...

# 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(), 
                selected = input$si_period
    )
  })

  # 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(), 
                selected = input$si_granularity
    )
  })

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

基本上我只是添加了 selected = input$si_period 和 selected = input$si_granularity 来保留之前的输入（如果它们仍然存在）。如果不是，他们将默认为每个人的第一选择。

如何制作 sliderInput 'lazy' 并仅在需要时刷新

How to make sliderInput 'lazy' and refresh only whenever required

shiny

shinyjs

shiny-reactivity