SelectInputUpdate in R? SelectInput in two tabs that are related

让人想犯罪 __ 提交于 2020-01-07 05:36:04

问题


New code example below where I'm trying to link selectInput in all three tabs. In the example below, the first two tabs selectInputs are linked but I'm trying to get all three linked. Is there any way to have all three linked?

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

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

回答1:


Some things to take note of:

  1. Your inputIds must be unique. You can't have two selectInput calls with the same inputId on two different tabs. It won't cast an error, but your app won't work the way you want.
  2. You will need to include the session argument in your server function.
  3. Having controls that perform the same task on two different tabs is somewhat redundant. You may want to consider if having a sidebar (sidebarLayout) would work to your advantage.

In any case, the code below works for updating the year selections.

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

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

ADDITIONAL STUFF (technical term)

Based on your comment of doing this on three or more tabs, I'm going to strongly recommend you stop what you're doing. It's possible to do this through some clever lapplying, such as

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

Which will minimize the amount of code you have to write, but you still need one of those blocks for each tab, and you will have to manually maintain the vector going into lapply to make sure it consists of all of appropriate controls. Then you need to do it again for the data set. There are other options, but I'm not sure they are any less work.

You're reaching a phase where your application is of sufficient complexity that you really ought to find ways to minimize the code work to make it easier to maintain. I present two options below which use only the tools made available in shiny. The first uses tabsetPanels instead of the navbarPage. The second uses the navbarPage but embeds it in a sidebarLayout. There are many other solutions you could use if you explore the shinyjs, shinydashboard, and shinyBS packages, just to name a few.

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

  })

)


来源:https://stackoverflow.com/questions/43075333/selectinputupdate-in-r-selectinput-in-two-tabs-that-are-related

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!