Question

下面的新代码示例，我试图在所有三个选项卡中链接selectInput。在下面的示例中，前两个选项卡selectInputs已链接，但我正在尝试将所有三个选项卡链接起来。有没有办法让所有三个联系起来？

{{1}}

Answer 1

需要注意的一些事项：

您的inputId必须是唯一的。您不能在两个不同的标签上进行两次selectInput次inputId次呼叫。它不会产生错误，但您的应用程序将无法按您希望的方式运行。
您需要在服务器功能中包含session参数。
在两个不同的选项卡上执行相同任务的控件有点多余。您可能需要考虑是否有侧边栏（sidebarLayout）对您有利。

在任何情况下，以下代码都可用于更新年份选择。

a <- list("2016", "MALE", "25", "50")
b <- list("2017", "FEMALE", "5", "100")
c <- list("2017", "MALE", "15", "75")
d <- list("2016", "MALE", "10", "35")
e <- list("2017", "FEMALE","55", "20")

data <- rbind(a,b,c,d,e)

#``````````````````````````````````````
## UI

library(shiny)

if(interactive()){

  ui = fluidPage(

    navbarPage("",

               #``````````````````````````````````````
               ## SHOES TAB

               tabPanel("SHOES", 

                        fluidRow(

                          column(2, "",
                                 selectInput("shoes_year", "YEAR", choices = c("2017", "2016")),
                                 selectInput("dataset", "CHOOSE POPULATION", choices = c("MALE", "FEMALE"))),

                          column(9, "SHOES"))),


               #``````````````````````````````````````
               ## HATS

               tabPanel("HATS",

                        fluidRow(

                          column(2, "",
                                 selectInput("hats_year", "YEAR", choices = c("2017", "2016")),
                                 selectInput("dataset", "CHOOSE POPULATION", choices     =c("MALE","FEMALE"))),

                          column(9, "HATS"))

               )))

  #``````````````````````````````````````

  server = function(input, output, session) {

    observeEvent(input[["shoes_year"]],
                 {
                   updateSelectInput(session = session,
                                     inputId = "hats_year",
                                     selected = input[["shoes_year"]])
                 })

    observeEvent(input[["hats_year"]],
                 {
                   updateSelectInput(session = session,
                                     inputId = "shoes_year",
                                     selected = input[["hats_year"]])
                 })

  }

  #``````````````````````````````````````


  shinyApp(ui, server)
}

#``````````````````````````````````````

附加功能（技术术语）

根据您在三个或更多标签上执行此操作的评论，我强烈建议您停止正在执行的操作。可以通过一些聪明的lapply来实现这一点，例如

observeEvent(input$coat_year,
             {
               lapply(c("shoes_year", "hats_year"),
                      function(x) updateSelectInput(session = session,
                                                    inputId = x,
                                                    selected = input$coat_year))
             }
)

这将最大限度地减少您必须编写的代码量，但您仍然需要为每个选项卡中的一个块，并且您必须手动维护向量进入lapply以确保它包含所有适当的控制。然后，您需要再次为数据集执行此操作。还有其他选择，但我不确定他们的工作是否少。

您正在达到一个阶段，您的应用程序非常复杂，您应该找到最小化代码工作的方法，以便更容易维护。我在下面提供了两个选项，它们仅使用shiny中提供的工具。第一个使用tabsetPanel而不是navbarPage。第二个使用navbarPage，但将其嵌入sidebarLayout。如果您浏览shinyjs，shinydashboard和shinyBS软件包，可以使用许多其他解决方案，仅举几例。

tabsetPanel

library(shiny)

shinyApp(

  ui = shinyUI(
    fluidPage(
      sidebarLayout(
        sidebarPanel(
          selectInput("year", "YEAR", choices = c("2017", "2016")),
          selectInput("dataset", "CHOOSE POPULATION", choices = c("MALE", "FEMALE"))
        ),

        mainPanel(
          tabsetPanel(
            tabPanel(title = "Shoes",
                     uiOutput("shoe_input")),
            tabPanel(title = "Hats",
                     uiOutput("hat_input"))
          )
        )
      )
    )
  ),

  server = shinyServer(function(input, output, session){

    selected_input <- 
      reactive({
        tagList(
          h3(input$year),
          h3(input$dataset)
        )
      })

    output$shoe_input <- 
      renderUI({
        selected_input()
      })

    output$hat_input <- 
      renderUI({
        selected_input()
      })

  })

)

navbarPage

library(shiny)
shinyApp(

  ui = shinyUI(
    sidebarLayout(
      sidebarPanel(
        selectInput("year", "YEAR", choices = c("2017", "2016")),
        selectInput("dataset", "CHOOSE POPULATION", choices = c("MALE", "FEMALE"))
      ),

      mainPanel(
        navbarPage(
          title = "",
          tabPanel(title = "Shoes",
                   uiOutput("shoe_input")),
          tabPanel(title = "Hats",
                   uiOutput("hat_input"))
        )
      )
    )
  ),

  server = shinyServer(function(input, output, session){

    selected_input <- 
      reactive({
        tagList(
          h3(input$year),
          h3(input$dataset)
        )
      })

    output$shoe_input <- 
      renderUI({
        selected_input()
      })

    output$hat_input <- 
      renderUI({
        selected_input()
      })

  })

)

R中的SelectInputUpdate？ SelectInput在两个相关的选项卡中

1 个答案:

附加功能（技术术语）

tabsetPanel

navbarPage