SelectInput filter based on a selection from another selectInput in R

2.1k views Asked by At

I have three selectInputs, and I would like the selection in the first one (Continent) to change the possible selections in the second one (Country) and third one (State). So, for example, if someone choose "B" in the first input box, then can choose only "A" in the second box and "BB" in the last box.

And at the moment it is possible to select all the names for the box State.

enter image description here

code:

library(shiny)
library(readxl)
library(shinydashboard)
library(dplyr)
library(DT)

df <-  data.frame(Continent = c("A","A","B","C"),
                    Country = rep("A",4),
                    State = c("AA","AA","BB","BB"),
                    Population = round(rnorm(4,100,2)),stringsAsFactors = FALSE)

is.not.null <- function(x) !is.null(x)

ui <- fluidPage(
  
  titlePanel("TEST"),
  sidebarLayout(
    sidebarPanel( width = 3,
                  uiOutput("continent"),
                  uiOutput("country"),
                  uiOutput("state")
                  
    ),
    mainPanel(
        tabsetPanel(type = "tabs",
                  tabPanel("Table", DT::dataTableOutput("table_subset"))
      )
      
    )
  )
)

ui = dashboardPage(
  header,
  sidebar,
  body
)

################################################

server = shinyServer(function(input,output){
  
  data <- df
  
  output$table <- DT::renderDataTable({
    if(is.null(data)){return()}
    DT::datatable(data, options = list(scrollX = T))
  })
  
  output$continent <- renderUI({
    selectInput(inputId = "Continent", "Select Continent",choices = var_continent(), multiple = F)
  })
  output$country <- renderUI({
    selectInput(inputId = "Country", "Select Country",choices = var_country(), multiple = T)
  })
  output$state <- renderUI({
    selectInput(inputId = "State", "Select State",choices = var_state(), multiple = T)
  })
  
  var_continent <- reactive({
    file1 <- data
    if(is.null(data)){return()}
    as.list(unique(file1$Continent))
  })
  
  continent_function <- reactive({
    file1 <- data
    continent <- input$Continent
    continent <<- input$Continent
    if (is.null(continent)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(Continent %in% continent)
      return (file2)
    }
    
  })
  
  var_country <- reactive({
    file1 <- continent_function()
    continent <- input$Continent
    file2 <- data
    
    if(is.null(continent)){
      as.list(unique(file2$Country))
    } else {
      as.list(unique(file1$Country))
    }
  })
  
  country_function <- reactive({
    file1 <- data
    country <- input$Country
    country <<- input$Country
    if (is.null(country)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(Country %in% country)
      return (file2)
    }
    
  })
  
  var_state <- reactive({
    file1 <- country_function()
    country <- input$Country
    file2 <- data
    
    if(is.null(country)){
      as.list(unique(file2$State))
    } else {
      as.list(unique(file1$State))
    }
  })
  
  state_function <- reactive({
    file1 <- data
    state <- input$State
    state <<- input$State
    if (is.null(state)){
      return(file1)
    } else {
      file2 <- file1 %>%
        filter(State %in% state)
      return (file2)
    }
    
  })
  
  df <- reactive({
    
    file1 <- data
    continent <- input$Continent
    country <- input$Country
    state <- input$State
    
    if (is.null(continent) & is.not.null(country) & is.not.null(state)){
      file2 <- file1 %>%
        filter(Country %in% country, State %in% state)
    } else if (is.null(country) & is.not.null(continent) & is.not.null(state)){
      file2 <- file1 %>%
        filter(State %in% state, Continent %in% continent)
    } else if (is.null(state) & is.not.null(country) & is.not.null(continent)){
      file2 <- file1 %>%
        filter(Country %in% country, Continent %in% continent)
    } else if (is.null(continent) & is.null(country) & is.not.null(state)){
      file2 <- file1 %>%
        filter(State %in% state)
    } else if (is.null(continent) & is.null(state) & is.not.null(country)){
      file2 <- file1 %>%
        filter(Country %in% country)
    } else if (is.null(country) & is.null(state) & is.not.null(continent)){
      file2 <- file1 %>%
        filter(Continent %in% continent)
    } else {
      file2 <- file1 %>%
        filter(Country %in% country, State %in% state, Continent %in% continent)
    }
    file2
  })
  
  output$table_subset <- DT::renderDataTable({
    DT::datatable(df(), options = list(scrollX = T))
    
  })
  
})

shinyApp(ui, server)

1

There are 1 answers

0
stefan On BEST ANSWER

Maybe this is what you are looking for. In my opinion your approach is overly complicated. Therefore I reduced the code considerably. Besides the outputs there are now basically three parts in the server:

  1. A reactive which filters the dataset
  2. Three reactives to get the selected values
  3. Three reactives to get the availabe choices depending on the other inputs. The available choices for Country is the list of countries after filtering for continent, the avialbel choices for States the list of states after filtering by Continent and Country

Reproducible code:

library(shiny)
library(shinydashboard)
library(dplyr)
library(DT)

df <-  data.frame(Continent = c("A","A","B","C"),
                  Country = rep("A",4),
                  State = c("AA","AA","BB","BB"),
                  Population = round(rnorm(4,100,2)),stringsAsFactors = FALSE)

is.not.null <- function(x) !is.null(x)

ui <- fluidPage(
  
  titlePanel("TEST"),
  sidebarLayout(
    sidebarPanel( width = 3,
                  uiOutput("continent"),
                  uiOutput("country"),
                  uiOutput("state")
                  
    ),
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Table", DT::dataTableOutput("table_subset"))
      )
      
    )
  )
)

# ui = dashboardPage(
#   header,
#   sidebar,
#   body
# )

################################################

server = shinyServer(function(input,output){
  
  data <- df
  
  output$table <- DT::renderDataTable({
    if(is.null(data)){return()}
    DT::datatable(data, options = list(scrollX = T))
  })
  
  output$continent <- renderUI({
    selectInput(inputId = "Continent", "Select Continent",choices = var_continent(), multiple = F)
  })
  output$country <- renderUI({
    selectInput(inputId = "Country", "Select Country",choices = var_country(), multiple = T)
  })
  output$state <- renderUI({
    selectInput(inputId = "State", "Select State",choices = var_state(), multiple = T)
  })
    
  # Filtered data
  data_filtered <- reactive({
    filter(df, Continent %in% continent(), Country %in% country(), State %in% state())
  })
  
  # Get filters from inputs
  continent <- reactive({
    if (is.null(input$Continent)) unique(df$Continent) else input$Continent
  })
  
  country <- reactive({
    if (is.null(input$Country)) unique(df$Country) else input$Country
  })
  
  state <- reactive({
    if (is.null(input$State)) unique(df$State) else input$State
  })
  
  # Get available categories
  var_continent <- reactive({
    file1 <- data
    if(is.null(data)){return()}
    as.list(unique(file1$Continent))
  })
  
  var_country <- reactive({
    filter(data, Continent %in% continent()) %>% 
      pull(Country) %>% 
      unique()
  })
  
  var_state <- reactive({
    filter(data, Continent %in% continent(), Country %in% country()) %>% 
      pull(State) %>% 
      unique()
  })

  output$table_subset <- DT::renderDataTable({
    DT::datatable(data_filtered(), options = list(scrollX = T))
  })
  
})

shinyApp(ui, server)