1

问题：我有以下带有两个选项卡的应用程序。这些选项卡中的每一个都包含在一个模块 ( first_module, second_module) 中。在每个选项卡中都会selectizeInput显示一个，我可以在其中选择各种选项。

目标：如果我在选项卡 1 上选择例如亚马逊并切换到选项卡 2，我想实现这一点，亚马逊也将在选项卡 2 中被选中。

有关如何修改此示例应用程序的任何想法？非常感谢！！


first_module_ui <- function(id){
  
  ns <- NS(id)
  
  mainPanel(width = 12,
            fluidRow(
              column(4, uiOutput(ns("filter_clients")))
            )
  )
}


first_module_server <- function(input, output, session, context){

  output$filter_clients <- renderUI({

    selectizeInput(inputId = session$ns("select_clients"),
                   label = "Client",
                   choices = c("All", "Google", "Amazon", "Facebook"),
                   selected = "All",
                   multiple = TRUE,
                   width = "100%")
  })
  
  observeEvent(context(), {
    print(context())
    updateSelectizeInput(session, 
                         inputId = session$ns("select_clients"),
                         label = "Client", 
                         choices = c("All", "Google", "Amazon", "Facebook"),
                         selected = context(),
                         server = TRUE)
  })
  
  return(reactive({input$select_clients}))
  
}

second_module_ui <- function(id){
  
  ns <- NS(id)
  
  mainPanel(width = 12,
            fluidRow(
              column(4, uiOutput(ns("filter_clients")))
            )
  )
}


second_module_server <- function(input, output, session, context){
  
  output$filter_clients <- renderUI({
    
    selectizeInput(inputId = session$ns("select_clients"),
                   label = "Client",
                   choices = c("All", "Google", "Amazon", "Facebook"),
                   selected = "All",
                   multiple = TRUE,
                   width = "100%")
  })
  
  observeEvent(context(), {
    print(context())
    updateSelectizeInput(session, 
                         inputId = session$ns("select_clients"),
                         label = "Client", 
                         choices = c("All", "Google", "Amazon", "Facebook"),
                         selected = context(),
                         server = TRUE)
  })
  
  return(reactive({input$select_clients}))

}


ui <- fluidPage(
  tabsetPanel(
    tabPanel("First Module",
             first_module_ui("first_ui")
             ),
    tabPanel("Second Module",
             second_module_ui("second_ui")
    )
  )
)

server <- function(input, output) {
  
  context <- callModule(first_module_server,
             "first_ui",
             context)
  
  context <- callModule(second_module_server,
             "second_ui",
             context)
}

shinyApp(ui = ui, server = server)
4

1 回答 1

0

为了使您的示例正常工作，我更改了以下内容：

  • 将模块的结果存储在不同的变量中，context_1以及context_2
  • in updateSelectizeInput,inputId不能包含ns()
  • 在 中observeEvent，仅当来自另一个选项卡的新值与当前选择的值不同时才会更新输入，否则会创建一个无限循环
  • 在第二个选项卡中，selectizeInput使用第一个选项卡中的选定值进行初始化（否则第一次切换到选项卡 2 时它不起作用，我认为这是因为第二个选项卡只有在第一个选项卡切换到它时才会呈现时间）
library(shiny)

first_module_ui <- function(id){
  
  ns <- NS(id)
  
  mainPanel(width = 12,
            fluidRow(
              column(4, uiOutput(ns("filter_clients")))
            )
  )
}


first_module_server <- function(input, output, session, context){
  
  output$filter_clients <- renderUI({
    
    selectizeInput(inputId = session$ns("select_clients"),
                   label = "Client",
                   choices = c("All", "Google", "Amazon", "Facebook"),
                   selected = "All",
                   multiple = TRUE,
                   width = "100%")
  })
  
  observeEvent(context(), {
    print("first module")
    print(context())
    if (!isTRUE(all.equal(input$select_clients, context()))) {
      updateSelectizeInput(session, 
                           inputId = "select_clients",
                           label = "Client", 
                           choices = c("All", "Google", "Amazon", "Facebook"),
                           selected = context(),
                           server = TRUE)
    }
  })
  
  return(reactive({input$select_clients}))
  
}

second_module_ui <- function(id){
  
  ns <- NS(id)
  
  mainPanel(width = 12,
            fluidRow(
              column(4, uiOutput(ns("filter_clients")))
            )
  )
}


second_module_server <- function(input, output, session, context){
  
  output$filter_clients <- renderUI({
    
    selectizeInput(inputId = session$ns("select_clients"),
                   label = "Client",
                   choices = c("All", "Google", "Amazon", "Facebook"),
                   selected = context(),
                   multiple = TRUE,
                   width = "100%")
  })
  
  observeEvent(context(), {
    print("second module")
    print(context())
    print(input$select_clients)
    if (!isTRUE(all.equal(input$select_clients, context()))) {
      updateSelectizeInput(session, 
                           inputId = "select_clients",
                           label = "Client", 
                           choices = c("All", "Google", "Amazon", "Facebook"),
                           selected = context(),
                           server = TRUE)
    }
  })
  
  return(reactive({input$select_clients}))
  
}


ui <- fluidPage(
  tabsetPanel(
    tabPanel("First Module",
             first_module_ui("first_ui")
    ),
    tabPanel("Second Module",
             second_module_ui("second_ui")
    )
  )
)

server <- function(input, output) {
  
  context_1 <- callModule(first_module_server,
                        "first_ui",
                        context_2)
  
  context_2 <- callModule(second_module_server,
                        "second_ui",
                        context_1)
}

shinyApp(ui = ui, server = server)
于 2020-07-20T12:17:26.457 回答