R更新Shiny中的选择框

Question

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)

Answer 1

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!