使用purrr::pwalk基于tibble批量创建shiny的observeEvents实现selectInput跨页同步

我的需求 #

我希望遍历tibble批量创建多个observeEvents，下方附可复现示例。注释掉的手动编写代码可正常运行，但我想要使用purrr::pwalk程序化生成observeEvents，目标是当某一个selectInput被修改时，同步更新跨标签页的其他对应selectInput。

可复现示例 #

library(shiny)
library(purrr)
library(tibble)

choices1 <- c('A', 'B', 'C', 'D')
choices2 <- c('E', 'F', 'G', 'H')

dat_inputs <- tribble(
  ~ observe_input, ~ input_id,
  'tab11',         'tab21',
  'tab11',         'tab31',
  'tab21',         'tab11',
  'tab21',         'tab31',
  'tab31',         'tab11',
  'tab31',         'tab21'
)

ui <- navbarPage(
  title = 'Test Navbar Page',
  tabPanel(
    title = 'Tab 1',
    selectInput('tab11', 'Tab 11', choices = choices1),
    selectInput('tab12', 'Tab 12', choices = choices2)
  ),
  tabPanel(
    title = 'Tab 2',
    selectInput('tab21', 'Tab 22', choices = choices1),
    selectInput('tab12', 'Tab 12', choices = choices2)
  ),
  tabPanel(
    title = 'Tab 3',
    selectInput('tab31', 'Tab 31', choices = choices1),
    selectInput('tab32', 'Tab 32', choices = choices2)
  )
)

server <- function(input, output, session) {
  # 手动编写的版本可以正常运行，以下是注释的原手动代码
  # observeEvent(input$tab11, {
  #   updateSelectInput(inputId = 'tab21', selected = input$tab11)
  #   updateSelectInput(inputId = 'tab31', selected = input$tab11)
  # })
  # 
  # observeEvent(input$tab21, {
  #   updateSelectInput(inputId = 'tab11', selected = input$tab21)
  #   updateSelectInput(inputId = 'tab31', selected = input$tab21)
  # })
  # 
  # observeEvent(input$tab31, {
  #   updateSelectInput(inputId = 'tab11', selected = input$tab31)
  #   updateSelectInput(inputId = 'tab21', selected = input$tab31)
  # })

  # 错误的批量实现版本
  # 如果删除handler.quoted = TRUE，shiny应用可运行但observeEvents不生效
  # pwalk(
  #   dat_inputs,
  #   ~ observeEvent(
  #     input[[.x]],
  #     updateSelectInput(inputId = input[[.y]], selected = input[[.x]]),
  #     handler.quoted = TRUE
  #   )
  # )

  ################################
  # 修正后的解决方案：
  ################################
  pwalk(
    dat_inputs,
    ~ observeEvent(
      input[[.x]],
      updateSelectInput(inputId = .y, selected = input[[.x]], session = session)
    )
  ) 
}

shinyApp(ui, server)

错误原因说明 #

• 原错误代码中updateSelectInput的inputId参数误传入了input[[.y]]，该参数要求传入输入控件的ID字符串，直接使用.y即可
• 不需要额外添加handler.quoted = TRUE参数，该参数会导致表达式解析异常
• 显式传入session参数可以保证更新逻辑准确作用于当前会话的输入控件

内容的提问来源于stack exchange，提问作者Avery Robbins