在更改单个模块中的输入时，如何更改多个 Shiny 模块的输入？

Question

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

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

给我带来想法的一些资源如下：

• 模块之间的通信 - https://shiny.rstudio.com/articles/communicate-bet-modules.html
• 更新所选输入的值 - https://shiny.rstudio.com/reference/shiny/1.3.1/updateSelectInput.html

下面我编写了一些我想要做的示例代码。非常感谢任何帮助。我希望有一位闪亮的大师能找到这篇文章。到目前为止，我还没有成功。

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)

Answer 1

要在所有选项卡中显示相同的通用输入，您需要在对不同模块的调用中使用相同的

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)
  })
}

Answer 2

此解决方案使用

moduleServer

而不是

callModule

library(shiny)
library(tidyverse)

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

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')
    )
  )
}



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(id, default_inputs) {
  moduleServer(
    id,
    function(input, output, session) {
      
      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(id, default_inputs) {
  moduleServer(
    id,
    function(input, output, session) {
      
      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(id, default_inputs) {
  moduleServer(
    id,
    function(input, output, session) {
      
      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) {
  
  module_ids <- c("test1", "test2", "test3")
  modules <- list(test_one, test_two, test_three)
  common_inputs <- map(module_ids, ~moduleServer(.x, common_inputs)) %>% setNames(module_ids)
  
  observeEvent(common_inputs$test1, {
    
    map2(modules, module_ids, ~.x(.y, default_inputs = common_inputs$test1))
    
    
  })
  
  observeEvent(common_inputs$test2, {
    
    map2(modules, module_ids, ~.x(.y, default_inputs = common_inputs$test2))
    
    
  })
  
  observeEvent(common_inputs$test3, {
    
    map2(modules, module_ids, ~.x(.y, default_inputs = common_inputs$test3))
    
    
  })
  
}

shinyApp(ui, server)