R Shiny : How to update an input object before a reactive statement gets executed

Question

我正在基于出色的 R Shiny 包构建一个探索性视觉应用。该应用程序要做的一件事是读取一个实数值的“测量”列并显示这些测量值的箱线图。此外，还有一个可选的 selectInput 小部件，允许用户选择要深入研究的 group 变量。 group 变量基本上包含具有分类值的列的名称，例如性别(女性与男性)、国家(美国、加拿大等)。因此，如果从 group selectInput 中选择“gender”，应用程序将显示两个箱线图，一个是女性，另一个是男性。

为了让用户能够灵活地关注某些类别，比如只说女性，我想出了 checkboxGroupInput ，它只在选择 group 变量时显示choices 和 selected 最初都设置为 group 变量的所有类别。因此，例如，当用户只想查看女性的箱线图时，他/她可以轻松取消选中男性的复选框，男性的箱线图将被移除，而女性的箱线图将保留。

正在关注 warmoverflow的建议，这是一个可复制的玩具示例

# global setup
library(shiny)
library(ggplot2)
library(dplyr)
set.seed(12345)
dummy_data <- data.frame(
    Value = c(rnorm(50), 2 + rnorm(50)),
    Gender = c(rep('Female', 50), rep('Male', 50)),
    Country = c(rep('US', 50), rep('CA', 50)),
    stringsAsFactors = FALSE
)

# ui function
ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectInput('group', 'Group',
                        c('Choose'='', setdiff(names(dummy_data), 'Value'))),
            uiOutput('group_select')
        ),
        mainPanel(plotOutput('box_plot'))
    )
)

# server function
server <- function(input, output) {

    # the group level select/unselect widget
    output$group_select <- renderUI({
        req(input$group)
        data <- dummy_data
        group_levels <- unique(data[[input$group]])
        conditionalPanel(
            condition = "input.group != ''",
            checkboxGroupInput('group_select', input$group,
                               choices = group_levels, selected = group_levels)
        )
    })

    # filter the data if group variable is selected
    data_to_plot <- reactive({
        data <- dummy_data
        if(!(is.null(input$group) || input$group == '')) {
            data <- data %>% 
                mutate_(group_ = input$group) %>%
                filter(group_ %in% input$group_select)
        } else {
            data$group_ <- as.factor(rep.int(1, nrow(data)))
        }
        return(data)
    })

    # show the boxplot
    output$box_plot <- renderPlot({
        data <- data_to_plot()
        validate(
            need(!(is.null(data) || nrow(data) == 0),
                 'There are no data to plot!')
        )
        ggplot(data = data, aes(factor(group_), Value)) + geom_boxplot()
    })
}

shinyApp(ui = ui, server = server)

好吧，代码可以运行，但是 reactive 语句不必要地运行了两次，一次是 input$group 更新时，另一次是 input$group_select 更新时已更新，因为您会注意到错误消息“没有要绘制的数据!”当您从组下拉列表中选择“性别”时。所以我的问题是:有没有办法确保以下执行顺序:

1. input$group 已更新 ->
2. input$group_select 得到更新 ->
3. reactive 使用更新的 input$group 和 input$group_select 得到(重新)执行

我几乎花了一整天的时间寻找解决方案，但收效甚微。

• Roger Day 似乎在 Using sendInputMessage and receiveMessage to make shiny input objects reactive 中解决了这个问题.但他的方法涉及创建一个 jstree，这对我来说完全是一个陌生的领域，看起来他已经从他的 Github 中删除了解决方案。
• 另一个可能的线索是使用此处描述的 observeEvent (R shiny Observe running Before loading of UI and this causes Null parameters)。但是，当您在 input$group_select 中取消选择一个或多个类别时，observeEvent 会忽略它。

正如 Roger Day 所指出的那样，它的困难在于输入更新函数通常不是响应式(Reactive)的，因此(根据我的实验和理解)比响应式(Reactive)语句更晚执行。或者，如果有一种方法可以使输入更新函数具有反应性，则可以应用优先级值以所需的方式更改执行顺序。

非常感谢任何输入!抱歉，描述太长了!

Answer 1

我想我已经找到了解决办法。 UnnamedUser中提到的方向和 warmoverflow是正确的。总体思路是创建一个 react 值来表示，或者更准确地说是监视用户选择的 group 类别，并检测 group 变量(使用 observe) 和 group 变量选择类别(使用 observe)，然后通过在 服务器功能。

# use a reactive value to represent group level selection
group_selects <- reactiveValues(value = NULL)
observe({
    input$group
    if(is.null(input$group) || input$group == '')
        group_selects$value <- NULL
    else {
        data <- dummy_data
        group_selects$value <- unique(data[[input$group]])
    }
})
observe({
    input$group_select
    group_selects$value <- input$group_select
})

然后使用group_selects$value替换数据操作 block 中的input$group_select

# filter the data if group variable is selected
data_to_plot <- reactive({
    data <- dummy_data
    if(!(is.null(input$group) || input$group == '')) {
        req(group_selects$value)                        # To prevent unnecessary re-run
        data <- data %>% 
            mutate_(group_ = input$group) %>%
            filter(group_ %in% group_selects$value)     # Replaced input$group_select
    } else {
        data$group_ <- as.factor(rep.int(1, nrow(data)))
    }
    return(data)
})