2

下面的新代码示例，我试图在所有三个选项卡中链接 selectInput。在下面的示例中，前两个选项卡 selectInputs 已链接，但我试图将所有三个选项卡链接。有什么办法可以把这三个联系起来吗？

#``````````````````````````````````````
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", "2015", "2014"))),


                      column(9, "SHOES"))),


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

           tabPanel("HATS",

                    fluidRow(

                      column(2, "",
                             selectInput("hats_year", "YEAR", choices = c("2017", "2016", "2015", "2014"))),

                      column(9, "HATS"))),

  #``````````````````````````````````````
  ## COATS

  tabPanel("COATS",
           fluidRow(
             column(2, "",
                    selectInput("coats_year", "YEAR", choices = c("2017",     "2016", "2015", "2014"))),

         column(9, "COATS")))

))

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

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

#``````````````````````````````````````
4

1 回答 1

3

需要注意的一些事项：

  1. 你inputId的 s 必须是唯一的。您不能在两个不同的选项卡上进行两次selectInput相同的通话。inputId它不会产生错误，但您的应用程序不会按您想要的方式运行。
  2. 您需要session在服务器函数中包含参数。
  3. 让控件在两个不同的选项卡上执行相同的任务有点多余。您可能需要考虑使用侧边栏 ( 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. 第一个使用tabsetPanels 而不是navbarPage. 第二个使用 ，navbarPage但将其嵌入到sidebarLayout. 如果您探索 、 和 包，您可以使用许多其他解决方案shinyjs，shinydashboard仅举shinyBS几例。

选项卡组面板

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

  })

)

导航栏页面

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

  })

)
于 2017-03-28T16:59:21.847 回答