Question

我们如何使“ Shiny”中的“ sliderInputs”“懒惰”以刷新？

上下文

在以下基本的可复制Shiny应用中，第三个sliderinput取决于第二个sliderinput，例如：

2018年没有“第二学期”的可能值

类似地，secondslider输入取决于第一个sliderinput，例如：

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

尽管以下应用可以正常运行，但用户的体验并非最佳，因为每次用户更改一个值时，滑块输入都会刷新。重要的是，每个滑块输入都必须更新其选择（因为每次用户与滑块输入进行交互时范围都会改变）。

但是，我希望在新的作用域有效的时候保留相关的sliderinputs值。

我应该如何进行？我猜有些观察者，隔离或 shinyjs 可能会有所帮助，但到目前为止我无法使它起作用。

预期行为

例如：

对于产品C，期间selectInput从2017年切换到2018年，粒度selectInput应该保留“ Trimester 1”
如果在2018年期间产品selectInput从C切换到B，粒度selectInput应该保持“三个月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()
    )
  })

  # 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“惰性”并仅在需要时刷新

1 个答案: