我正在尝试做什么
我想迭代一个 tibble 并创建多个observeEvents。我下面有一个可重现的例子。注释掉的代码有效,但我想使用 pwalk 以编程方式创建observeEvents。
基本上我正在尝试完成与这篇文章类似的事情:使用 purrr::walk 来设置多个事件观察者 https://stackoverflow.com/questions/50564632/using-purrrwalk-to-instate-multiple-event-observers。
(虽然目标不同。我的目标是当一个 selectInput 更改时跨选项卡更新 selectInputs。)
reprex
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)
# })
# edit - commenting out the old code so that the solution takes its place
# this code does not work
# if you delete handler.quoted = TRUE the shiny app runs but the
# observeEvents don't work
# pwalk(
# dat_inputs,
# ~ observeEvent(
# input[[.x]],
# updateSelectInput(inputId = input[[.y]], selected = input[[.x]]),
# handler.quoted = TRUE
# )
# )
################################
# solution from accepted answer:
################################
pwalk(
dat_inputs,
~ observeEvent(
input[[.x]],
updateSelectInput(inputId = .y, selected = input[[.x]],
session = session)
)
)
}
shinyApp(ui, server)