如何使用 freezeReactiveValue 确保选择器选项与数据同步

Question

大家早上好！

我几天来一直在尝试解决这个问题，但无法解决。 我有一个大表，其中有用户正在过滤的许多选项。由于这个表相当大（大约一百万行）并且有许多交互选项，我希望用户选项跟上他们的选择，即如果他们使用选择器 1 选择选项 a，那么选择器 2 将只向他们显示选项与他们的第一个过滤器一致，例如

col1	col2
A	1
A	2
A	3
B	4

如果 col1 的选择器是 A 那么 col2 的选择器应该显示 1,2,3 而不是 4

这可以扩展到许多不同的列。

我主要遵循了一些教程 https://mastering-shiny.org/action-dynamic.html 和 https://gist.github.com/j Cheng5/45813fd5b4ae6b418cc8a081e8d21830 但是这些都要求用户启动在开始。我希望用户能够从任何选择器开始。

我尝试将 freezeReactiveValue 纳入其中，但似乎无法让它发挥作用。

我的示例如下

library(shiny)

df <- mtcars %>% 
    rownames_to_column(var = "car")

car_choices <- c("All", unique(df$car))
cyl_choices <- c("All",unique(df$cyl))

ui <- fluidPage(
    
    titlePanel("Old Faithful Geyser Data"),
    
    sidebarLayout(
        sidebarPanel(
            selectInput(
                inputId = "car_btn",
                label = "car",
                choices = car_choices,
                selected = "All"
            ),
            selectInput(
                inputId = "cyl_btn",
                label = "cyl",
                choices = cyl_choices,
                selected = "All"
            )
        ),
        
        mainPanel(
            plotOutput("distPlot")
        )
    )
)

server <- function(input, output, session) {
    
    data <- reactive({
        df %>% 
            filter(car %in% car_sel(),
                   cyl %in% cyl_sel())
    })
    
    car_sel <- reactive({
        req(input$car_btn)
        if(input$car_btn == "All"){car_choices[-1]}else{input$car_btn}
    })
    
    observeEvent(data(), ignoreInit = T, {
        choices <- c("All", unique(data()$car))
        updateSelectInput(inputId = "car_btn", choices = choices, selected = input$car_btn)
    })
    
    cyl_sel <- reactive({
        req(input$cyl_btn)
        if(input$cyl_btn == "All"){cyl_choices[-1]}else{input$cyl_btn}
    })
    
    observeEvent(data(), ignoreInit = T, {
        choices <- c("All", unique(data()$cyl))
        updateSelectInput(inputId = "cyl_btn", choices = choices, selected = input$cyl_btn)
        
    })
    
    output$distPlot <- renderPlot({

        Sys.sleep(1)#added to slow the reactives down to mimic a large table being filtered
        
        data() %>%
            ggplot(aes(x=cyl))+
            geom_bar()
        
    })
}

shinyApp(ui = ui, server = server)

这可行，但可以创建当数据流经反应时不再适用的选项。如果我添加 freezeReactiveValue ，它应该停止所有依赖项，直到所有内容都通过应用程序完成后永远不会解决。

library(shiny)

df <- mtcars %>% 
    rownames_to_column(var = "car")

car_choices <- c("All", unique(df$car))
cyl_choices <- c("All",unique(df$cyl))

ui <- fluidPage(
    
    titlePanel("Old Faithful Geyser Data"),
    
    sidebarLayout(
        sidebarPanel(
            selectInput(
                inputId = "car_btn",
                label = "car",
                choices = car_choices,
                selected = "All"
            ),
            selectInput(
                inputId = "cyl_btn",
                label = "cyl",
                choices = cyl_choices,
                selected = "All"
            )
        ),
        
        mainPanel(
            plotOutput("distPlot")
        )
    )
)

server <- function(input, output, session) {
    
    data <- reactive({
        df %>% 
            filter(car %in% car_sel(),
                   cyl %in% cyl_sel())
    })
    
    car_sel <- reactive({
        req(input$car_btn)
        if(input$car_btn == "All"){car_choices[-1]}else{input$car_btn}
    })
    
    observeEvent(data(), ignoreInit = T, {
        freezeReactiveValue(input, "car_btn") #freeze added
        choices <- c("All", unique(data()$car))
        updateSelectInput(inputId = "car_btn", choices = choices, selected = input$car_btn)
    })
    
    cyl_sel <- reactive({
        req(input$cyl_btn)
        if(input$cyl_btn == "All"){cyl_choices[-1]}else{input$cyl_btn}
    })
    
    observeEvent(data(), ignoreInit = T, {
        freezeReactiveValue(input, "cyl_btn") #freeze added
        choices <- c("All", unique(data()$cyl))
        updateSelectInput(inputId = "cyl_btn", choices = choices, selected = input$cyl_btn)
        
    })
    
    output$distPlot <- renderPlot({

        Sys.sleep(1)
        
        data() %>%
            ggplot(aes(x=cyl))+
            geom_bar()
        
    })
}

shinyApp(ui = ui, server = server)

显然我在这里误解了一些东西！

任何帮助将不胜感激。

Answer 1

我处理这种情况的方法是分别计算每个过滤器并 然后根据其他过滤器留下的可用选项找到可用的选择。

library(shiny)

tbl <- data.frame(x = c("A", "A", "B", "C"), y = c(1, 2, 2, 3))

ui <- fluidPage(
  selectInput("x", "x", choices = NULL, multiple = TRUE),
  selectInput("y", "y", choices = NULL, multiple = TRUE),
  tableOutput("tbl"),  
)

server <- function(input, output, session) {
  x_matches <- reactive(!isTruthy(input$x) | tbl$x %in% input$x)
  y_matches <- reactive(!isTruthy(input$y) | tbl$y %in% input$y)
  
  output$tbl <- renderTable({
    tbl[x_matches() & y_matches(), , drop = FALSE]
  })
  
  x_choices <- reactive(unique(tbl$x[y_matches()]))
  y_choices <- reactive(unique(tbl$y[x_matches()]))
  
  observe({
    updateSelectInput(session, "x", choices = x_choices(), selected = isolate(input$x))
  })
  observe({
    updateSelectInput(session, "y", choices = y_choices(), selected = isolate(input$y))
  })
}

shinyApp(ui, server)