使用 purrr::pwalk 从 tibble 创建多个闪亮的 observeEvents
use purrr::pwalk to create multiple shiny observeEvents from tibble
我想做什么
我想遍历 tibble 并创建多个 observeEvents。我在下面有一个可重现的例子。注释掉的代码有效,但我想用 pwalk 以编程方式创建 observeEvents。
基本上我正在尝试完成与此类似的事情 post:。
(虽然目标不同。我的目标是在更改一个 selectInput 时跨选项卡更新 selectInputs。)
代表
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)
好吧,三件事,你正在使用 input=input[[.y]]
而不仅仅是 input=.y
;当您使用这样的表达式时,它实际上并没有被引用;你需要传递 session=
。尝试
pwalk(
dat_inputs,
~ observeEvent(
input[[.x]],
updateSelectInput(inputId = .y, selected = input[[.x]], session=session)
)
)
我想做什么
我想遍历 tibble 并创建多个 observeEvents。我在下面有一个可重现的例子。注释掉的代码有效,但我想用 pwalk 以编程方式创建 observeEvents。
基本上我正在尝试完成与此类似的事情 post:
代表
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)
好吧,三件事,你正在使用 input=input[[.y]]
而不仅仅是 input=.y
;当您使用这样的表达式时,它实际上并没有被引用;你需要传递 session=
。尝试
pwalk(
dat_inputs,
~ observeEvent(
input[[.x]],
updateSelectInput(inputId = .y, selected = input[[.x]], session=session)
)
)