更改单个模块中的输入时如何更改多个 Shiny 模块的输入?

How to change inputs across several Shiny modules when changing the inputs in a single module?

我正在使用具有多个模块的相当大的 Shiny 应用程序。应用程序中的每个选项卡都是其自己的模块。一些选项卡有一些共享的输入,以及它们自己的选项卡的不同输入。

这就是我需要的:当用户更改其中一个闪亮模块中的输入时,跨模块相同的输入也需要更改。这样一来,当用户已经更改了一个选项卡中的输入时,他们不需要继续跨选项卡更改输入。此外,理想情况下,在用户导航到选项卡之前,代码不会执行。

一些给我灵感的资源如下:

下面我写了一些我正在尝试做的示例代码。任何帮助深表感谢。我希望闪亮的大师能找到这个 post。到目前为止,我一直没有成功。

library(shiny)

common_inputs_UI <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(
      ns('common1'),
      'Common 1',
      c('A', 'B', 'C', 'D')
    ),
    selectInput(
      ns('common2'),
      'Common 2',
      c('A2', 'B2', 'C2', 'D2')
    )
  )
}

common_inputs <- function(input, output, session) {
  
  return(
    list(
      common1 = reactive({ input$common1 }),
      common2 = reactive({ input$common2 })
    )
  )
}

test_one_UI <- function(id) {
  ns <- NS(id)
  tagList(
    common_inputs_UI('test1'),
    selectInput(
      'test1_select',
      'Test 1 Select',
      c('Fee 1', 'Fi 1', 'Fo 1', 'Fum 1')
    )
  )
}

test_one <- function(input, output, session, default_inputs) {
  
  ns <- session$ns
  
  observe({
    
    updateSelectInput(
      session,
      'common1',
      selected = default_inputs$common1()
    )
    
    updateSelectInput(
      session,
      'common2',
      selected = default_inputs$common2()
    )
    
  })
}

test_two_UI <- function(id) {
  ns <- NS(id)
  tagList(
    common_inputs_UI('test2'),
    selectInput(
      'test2_select',
      'Test 2 Select',
      c('Fee 2', 'Fi 2', 'Fo 2', 'Fum 2')
    )
  )
}

test_two <- function(input, output, session, default_inputs) {
  
  ns <- session$ns
  
  observe({
    
    updateSelectInput(
      session,
      'common1',
      selected = default_inputs$common1()
    )
    
    updateSelectInput(
      session,
      'common2',
      selected = default_inputs$common2()
    )
    
  })
}

test_three_UI <- function(id) {
  ns <- NS(id)
  tagList(
    common_inputs_UI('test3'),
    selectInput(
      'test3_select',
      'Test 3 Select',
      c('Fee 3', 'Fi 3', 'Fo 3', 'Fum 3')
    )
  )
}

test_three <- function(input, output, session, default_inputs) {
  
  ns <- session$ns
  
  observe({
    
    updateSelectInput(
      session,
      'common1',
      selected = default_inputs$common1()
    )
    
    updateSelectInput(
      session,
      'common2',
      selected = default_inputs$common2()
    )
  
  })
}


ui <- fluidPage(
  tabsetPanel(
    type = 'tabs',
    tabPanel(
      'Test One',
      test_one_UI('test1')
    ),
    tabPanel(
      'Test Two',
      test_two_UI('test2')
    ),
    tabPanel(
      'Test Three',
      test_three_UI('test3')
    )
  )
)

server <- function(input, output, session) {
  
  common_inputs_mod1 <- callModule(common_inputs, 'test1')
  common_inputs_mod2 <- callModule(common_inputs, 'test2')
  common_inputs_mod3 <- callModule(common_inputs, 'test3')
  
  t1 <- callModule(test_one, 'test1', common_inputs_mod1)
  t2 <- callModule(test_two, 'test2', common_inputs_mod2)
  t3 <- callModule(test_three, 'test3', common_inputs_mod3)
  
}

shinyApp(ui, server)

要在所有选项卡中显示相同的公共输入,您需要在对不同模块的调用中使用相同的 common_inputs(@Limey 在评论中也建议)。要使用 tab1 中的一个公共输入并自由选择其他选项卡中的其他输入,您可以在所有三个调用中使用 common_inputs_mod1。在 MRE 中,您可以使用三个 observeEvents 来提供来自任何选项卡的通用输入。试试这个

server <- function(input, output, session) {
  
  common_inputs_mod1 <- callModule(common_inputs, 'test1')
  common_inputs_mod2 <- callModule(common_inputs, 'test2')
  common_inputs_mod3 <- callModule(common_inputs, 'test3')
  
  observeEvent(common_inputs_mod1, {
    t1 <- callModule(test_one, 'test1', common_inputs_mod1)
    t2 <- callModule(test_two, 'test2', common_inputs_mod1)
    t3 <- callModule(test_three, 'test3', common_inputs_mod1)
  })
  
  observeEvent(common_inputs_mod2, {
    t1 <- callModule(test_one, 'test1', common_inputs_mod2)
    t2 <- callModule(test_two, 'test2', common_inputs_mod2)
    t3 <- callModule(test_three, 'test3', common_inputs_mod2)
  })
  
  observeEvent(common_inputs_mod3, {
    t1 <- callModule(test_one, 'test1', common_inputs_mod3)
    t2 <- callModule(test_two, 'test2', common_inputs_mod3)
    t3 <- callModule(test_three, 'test3', common_inputs_mod3)
  })
}