1

私は、いくつかのモジュールを備えたかなり大きな Shiny アプリを使用しています。アプリの各タブは独自のモジュールです。一部のタブには、独自のタブへの個別の入力とともに、いくつかの共有入力があります。

これが私が必要としているものです: ユーザーが光沢のあるモジュールの 1 つで入力を変更すると、モジュール間で同じ入力も変更する必要があります。これは、ユーザーが 1 つのタブで入力を既に変更している場合に、タブ間で入力を変更し続ける必要がないようにするためです。また、理想的には、ユーザーがタブに移動するまでコードは実行されません。

私にアイデアを与えてくれたいくつかのリソースは次のとおりです。

以下に、私がやろうとしていることのサンプルコードをいくつか書きました。どんな助けでも大歓迎です。輝くマスターがこの投稿を見つけてくれることを願っています。これまでのところ、私は成功していません。

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

1 に答える 1