R Shiny：如何在执行反应式语句之前更新输入对象

Question

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

为了让用户可以灵活地关注某些类别，比如只说女性，我想出了checkboxGroupInput，它仅在同时选择了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 所指出的，它的困难在于输入更新函数通常不是反应式的，因此（根据我的实验和理解）比反应式语句执行得晚。或者，如果有办法使输入更新函数具有响应性，则可以应用优先级值来以所需的方式改变执行顺序。

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

Answer 1

我想我已经找到了解决办法。 UnnamedUser和warmoverflow提到的方向是对的。总体思路是创建一个反应值来表示，或者更准确地说是监控用户选择的 group 类别，并检测两个 group 变量（使用observe）和group变量选择类别（使用observe），然后通过在server函数中添加以下代码块来相应地修改反应值。

# 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替换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)
})

Answer 2

尝试将两个输入分组到一个 debounce 语句中，如下所示：

trig <- debounce(reactive({list(
    a = input$a,
    b = input$b
)}), 500)
observeEvent(trig(),{print('triggered')})
reactive({
    ins <- trig()
    #Code that does stuff goes here 
    #reference the inputs using ins$a or ins$b
})

您可能需要调整时间，如果更新时间过长，您仍然可能会加倍更新。