简体   繁体   中英

R update selection boxes in Shiny

I have a problem at work. I am building a Shiny app and trying to subset data based on the value of three selection boxes. My data has three variables, Commissioner, Neighbourhood and Practice. What I need is that no matter which box the user chooses first to filter the data on, the other two update to only show relevant choices. The default on loading is to show all choices in all boxes.

I've made a start but getting no where fast. The code below shows all the choices in Commissioner on loading but nothing for the other two. When a choice is selected in the Commissioner box the Neighbourhood box updates and then when selecting a neighbourhood the Practice box updates.

library(shiny)

ui <- fluidPage(
  fluidRow(
    div(style="display: inline-block;vertical-align:top;",
        uiOutput("Box1"),
        uiOutput("Box2"),
        uiOutput("Box3")
    )
  )
)

server <- function(input, output) {
  data <- data.frame(Commissioner = c(rep("CommA", 6), rep("CommB", 6)),
                     Neighbourhood = c(rep("Nhood1", 2), 
                                       rep("Nhood2", 2),
                                       rep("Nhood3", 2),
                                       rep("Nhood4", 2),
                                       rep("Nhood5", 2),
                                       rep("Nhood6",2)),
                     Practice = c("Prac1", "Prac2", "Prac3", "Prac4", "Prac5", 
                                  "Prac6", "Prac7", "Prac8", "Prac9", "Prac10", 
                                  "Prac11", "Prac12")
                     )

  output$Box1 = renderUI(
    selectInput("commissioner",
                  "Select a Commissioner",
                  c("All",as.character(unique(data$Commissioner))),
                  "selectcommissioner")
  )


  output$Box2 = renderUI(
    selectInput("neighbourhood",
                "Select a Neighbourhood",
                c("All",     as.character(unique(data$Neighbourhood[which(data$Commissioner ==     input$commissioner)]))),
                "selectnhood")
    )

  output$Box3 = renderUI(
    selectInput("practice", 
                "Select a Practice", 
                c("All", as.character(unique(data$Practice[which(data$Neighbourhood == input$neighbourhood)]))), 
                "selectpractice")
    )


}

shinyApp(ui = ui, server = server)

I have modified your server code to achieve what you want.

server <- function(input, output) {
  data <- data.frame(Commissioner = c(rep("CommA", 6), rep("CommB", 6)),
                     Neighbourhood = c(rep("Nhood1", 2), 
                                       rep("Nhood2", 2),
                                       rep("Nhood3", 2),
                                       rep("Nhood4", 2),
                                       rep("Nhood5", 2),
                                       rep("Nhood6",2)),
                     Practice = c("Prac1", "Prac2", "Prac3", "Prac4", "Prac5", 
                                  "Prac6", "Prac7", "Prac8", "Prac9", "Prac10", 
                                  "Prac11", "Prac12")
  )

  output$Box1 = renderUI(
    selectInput("commissioner",
                "Select a Commissioner",
                c("All",as.character(unique(data$Commissioner))),
                "selectcommissioner")
  )


  output$Box2 = renderUI({

    if(!is.null(input$commissioner))
    {
      if(input$commissioner == "All"){
        opts1 <- c("All", as.character(unique(data$Neighbourhood)))
      }else{
        opts1 <-  c("All",as.character(unique(data$Neighbourhood[which(data$Commissioner==input$commissioner)])))
      }
    }
    selectInput("neighbourhood",
                "Select a Neighbourhood",
                opts1,
                "selectnhood")
  })

  output$Box3 = renderUI({


    if(!is.null(input$neighbourhood))
    {
      if(input$neighbourhood == "All"){
        opts2 <- c("All", as.character(unique(data$Practice)))
      }else{
        opts2 <- c("All", as.character(unique(data$Practice[which(data$Neighbourhood == input$neighbourhood)])))
      }
    }
    selectInput("practice", 
                "Select a Practice", 
               opts2, 
                "selectpractice")

  })


}

Hope it helps!

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM