Filter One Selectinput Based on Selection from Another Selectinput

  • Home
  • Languages
  • R
  • Filter One Selectinput Based on Selection from Another Selectinput

SelectInput filter based on a selection from another selectInput in R

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)

Filter one selectInput based on selection from another selectInput?

Here's one approach: 

library(shiny)
library(shinydashboard)
##
ui <- shinyUI({
  sidebarPanel(

    htmlOutput("brand_selector"),
    htmlOutput("candy_selector"))

})
##
server <- shinyServer(function(input, output) {
  candyData <- read.table(
    text = "Brand       Candy
    Nestle      100Grand
    Netle       Butterfinger
    Nestle      Crunch
    Hershey's   KitKat
    Hershey's   Reeses
    Hershey's   Mounds
    Mars        Snickers
    Mars        Twix
    Mars        M&Ms",
    header = TRUE,
    stringsAsFactors = FALSE)

  output$brand_selector <- renderUI({

    selectInput(
      inputId = "brand", 
      label = "Brand:",
      choices = as.character(unique(candyData$Brand)),
      selected = "Nestle")

  })

  output$candy_selector <- renderUI({

    available <- candyData[candyData$Brand == input$brand, "Candy"]

    selectInput(
      inputId = "candy", 
      label = "Candy:",
      choices = unique(available),
      selected = unique(available)[1])

  })

})
##
shinyApp(ui = ui, server = server)

Updated:

You can modify the ui definition to be 

ui <- shinyUI({
  sidebarPanel(

    htmlOutput("brand_selector"),
    htmlOutput("candy_selector"),
    valueBoxOutput("count"))

})

and add the following to server: 

output$count <- renderValueBox({

  available <- candyData[candyData$Brand == input$brand, ]

  valueBox(
    value = nrow(available),
    subtitle = sprintf("Number of %s Candy Bars", input$brand),
    icon = icon("table"))

})

selectInput that is dependent on another selectInput

You can't access inputs in the ui.R part of the app so you need to use renderUi/uiOutput to dynamically generate your selectInput.

In your ui.R you could add:

uiOutput("secondSelection")

and in your server.R:

 output$secondSelection <- renderUI({
                selectInput("User", "Date:", choices = as.character(dat5[dat5$email==input$Select,"date"]))
        })

Updating a selectInput based on previous selectInput under common server function in R shiny

Your code does not work because every time one of the inputs changes, the entire renderUI runs again, thereby resetting all your inputs since they are all created from scratch again!

So how can we work around this? You could try something like the following. Note that I stripped a lot of the unnecessary formatting so it is a bit easier to see how this works.

We create the inputs in the UI, and add some observeEvents that listen to changes in the first or second input. If the first input changes, this fires the first observeEvent and will change the choices of input$Select2. Subsequently, this will trigger the second observeEvent, thereby limiting the choices in input$Select3.

I hope this helps!

library(shiny)
library(shinydashboard)

candyData <- read.table(
  text = "
    Brand       Candy           value
    Nestle      100Grand        Choc1
    Netle       Butterfinger    Choc2
    Nestle      Crunch          Choc2
    Hershey's   KitKat          Choc4
    Hershey's   Reeses          Choc3
    Hershey's   Mounds          Choc2
    Mars        Snickers        Choc5
    Nestle      100Grand        Choc3
    Nestle      Crunch          Choc4
    Hershey's   KitKat          Choc5
    Hershey's   Reeses          Choc2
    Hershey's   Mounds          Choc1
    Mars        Twix            Choc3
    Mars        Vaid            Choc2",
  header = TRUE,
  stringsAsFactors = FALSE)

ui <- fluidPage(
  selectInput("Select1","select1",unique(candyData$Brand)),
  selectInput("Select2","select2",choices = NULL),
  selectInput("Select3","select3",choices=NULL ))

server <- function(input, output,session) {
 observeEvent(input$Select1,{
   updateSelectInput(session,'Select2',
           choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
 }) 
  observeEvent(input$Select2,{
    updateSelectInput(session,'Select3',
           choices=unique(candyData$value[candyData$Brand==input$Select1 & candyData$Candy==input$Select2]))
  }) 

}

shinyApp(ui = ui, server = server)

Shiny: selectInput based on previous selectInput resetting the selected value

That's because your observer is inside the renderPlot. It has nothing to do here.

server <- function(input, output, session) {

  # Make drop-down choice of sel_2 dependent upon user input of sel_1
  observeEvent(input$sel_1, {
    updateSelectInput(session,
                      "sel_2",
                      choices = sort(unique(mtcars[[input$sel_1]]))
    )
  })
  
  output$plot_out <- renderPlot({
    
    # Assign inputs
    sel_1 <- input$sel_1
    sel_2 <- input$sel_2
    
    # Data to plot
    my_data <- mtcars %>% 
      filter(.data[[sel_1]] == sel_2)
    
    # Plot
    ggplot(my_data, aes(x = factor(.data[[sel_1]]), y = hp)) + geom_point()

  })
}

Here the observeEvent instead of observe is not necessary, since input$sel_1 is the only reactive value inside the observer, but I find that observeEvent is more readable.

Also, avoid to load tidyverse. That loads a ton of packages you don't need. Here dplyr and ggplot2 are enough

Dynamically update two selectInput boxes based on the others selection in R Shiny

You can achieve this by using each input to filter choices in other input:

library(shiny)
my_vars <- c("A", "B", "C", "D", "E", "F", "G", "H")

ui <- fluidPage(
  selectInput("v1", label = "Select Variable 1", choices = my_vars, multiple = TRUE),
  selectInput("v2", label = "Select Variable 2", choices = my_vars, multiple = TRUE)
  
)

server <- function(input, output, session){
  observe({
    if(!is.null(input$v2))
      updateSelectInput(session, "v1", 
                        choices = my_vars[!(my_vars %in% input$v2)], 
                        selected = isolate(input$v1) )
  })
  
  observe({
    if(!is.null(input$v1))
      updateSelectInput(session, "v2", 
                        choices = my_vars[!(my_vars %in% input$v1)], 
                        selected = isolate(input$v2) )
  })
}

shinyApp(ui = ui, server = server)

Note the use of isolate to avoid closing the list between choices

In case you don't want multiple selection, initialise each input with different selections:

ui <- fluidPage(
  selectInput("v1", label = "Select Variable 1", choices = my_vars, selected = "A"),
  selectInput("v2", label = "Select Variable 2", choices = my_vars, selected = "B")
)

From two selectInputs in the server, how to make one dependent on another?

I have modified some of your code and added some JS functionality from shinyjs, which you may or may not find useful

  • You don't really need to create objects all the time if you only going to update the list, so we are going to use updateSelectInput to update the sliders
  • I used hidden functionality to hide the elements initially so they are invisible to begin with
  • I created dependency on input$dataset within observeEvent so we can update the sliders and hide and show both the sliders we dont want and the output we dont want
  • Also if your datasets are static, like mtcars and iris its best to take them outside the server.R so you dont do extra unnecessary work
  • Finally its always a good idea to add req so you're not creating any objects if they are NULL
  • Your original error was due to the fact that you were passing the dataframe and not the list or vector to the slider, try to print out the objects if you're unsure and see their types

library(shiny)
library(shinyjs)

ui <- fluidPage(
    titlePanel("Select a dataset"),
    useShinyjs(),
    
    sidebarLayout(
        sidebarPanel(
            selectInput("dataset", "Dataset",
                        choices = c("Cars" = "Cars", "Iris" = "Iris")),
            hidden(selectInput(inputId = "options_cars", "Select one", choices = NULL)),
            hidden(selectInput(inputId = "options_iris", "Select one iris", choices = NULL))
            
        ),
        mainPanel(
            verbatimTextOutput("text_cars"),
            verbatimTextOutput("text_iris") 
        )
    )
)

cars_data <- unique(rownames(mtcars))
iris_data <-  as.character(unique(iris$Species))

server <- function(input, output, session) {
    
    observeEvent(input$dataset,{
        if(input$dataset == "Cars"){
            show('options_cars')
            hide('options_iris')
            show('text_cars')
            hide('text_iris')
            updateSelectInput(session,"options_cars", "Select one", choices = cars_data)
        }else{
            show('options_iris')
            hide('options_cars')
            show('text_iris')
            hide('text_cars')
            updateSelectInput(session,"options_iris", "Select one iris", choices = iris_data)
        }
    })
    
    output$text_cars <- renderPrint({
        req(input$options_cars)
        input$options_cars
    })
    
    output$text_iris <- renderPrint({
        req(input$options_iris)
        input$options_iris
    })
}

#Run the app
shinyApp(ui = ui, server = server)

Display options in selectInput based on user's previous selection after table processing in RShiny

Something like this will do the trick, note that I mostly used observeEvent

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600), 
                                             class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                            Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"), 
                            Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"), 
                            Code = c(601, 602, 603, 604, 605, 606, 607, 608,  609), 
                            Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320), 
                            Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974), 
                            Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79), 
                            Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))

ui <- dashboardPage(
  dashboardHeader(),

  dashboardSidebar(
    selectInput("objective", 
                "Objective:", 
                choices = c("Nothing Selected" , sort(unique(campaigns$Objective))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected"),

    selectInput("name_campaign", 
                "Campaign Name:", 
                choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected"),

    selectInput("code", 
                "Code:", 
                choices = c("Nothing Selected" , sort(unique((campaigns$Code)))), 
                width = "200px", 
                selectize = F,
                selected = "Nothing Selected")
  ), # End () dashboard Sidebar

  dashboardBody(
    DT::dataTableOutput("BigNumberTable")
  ) # End () dashboardBody
) # End () dashboardPage

server <- function(input, output,session) { # Server

  observeEvent(input$objective,{
    req(input$objective)
    if(input$objective == "Nothing Selected"){
      return()
    }
    updateSelectInput(session,"name_campaign", choices =  c("Nothing Selected",campaigns$Campaign[campaigns$Objective %in% input$objective]),selected = "Nothing Selected")
  })

  observeEvent(c(input$objective,input$name_campaign),{
    req(input$objective)
    req(input$name_campaign)
    if(input$objective == "Nothing Selected" || input$name_campaign == "Nothing Selected"){
      return()
    }
    updateSelectInput(session,"code", choices =  c("Nothing Selected",campaigns$Code[campaigns$Objective %in% input$objective & campaigns$Campaign %in% input$name_campaign]),selected = "Nothing Selected")
  })

  line_one <- reactive({ 
    req(input$name_campaign)
    req(input$code)
    total_campaign <- campaigns

    if(input$objective != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Objective == input$objective)
    }

    if(input$name_campaign != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
    }

    if(input$code != "Nothing Selected"){
      total_campaign <- subset(total_campaign, Code == input$code)
    }

    total_campaign <- total_campaign %>%
      select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
      summarise(Metric_One = sum(Metric_One),
                Metric_Two = sum(Metric_Two),
                Metric_Three = sum(Metric_Three),
                Metric_Four = sum(Metric_Four)) %>%
      mutate(Description = "") %>%
      mutate(Date = "") %>% 
      select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)

    total_campaign

  }) ## End () line_one

  line_two <- reactive({ 

    campaign_tx <- line_one()

    campaign_tx <- campaign_tx %>%
      select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
      mutate(TxMetric_One = "",
             TxMetric_Two = (Metric_Two/Metric_One)*100,
             TxMetric_Three = (Metric_Three/Metric_Two)*100,
             TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
      mutate(Date = "") %>%
      mutate(Description = "") %>%
      select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>% 
      dplyr::rename(Metric_One = TxMetric_One,
                    Metric_Two = TxMetric_Two,
                    Metric_Three = TxMetric_Three,
                    Metric_Four = TxMetric_Four)

    campaign_tx

  }) ## End () line_two

  # Table
  output$BigNumberTable <-  DT::renderDataTable({

    ## Bind the lines in one table

    all_table <- rbind(line_one(), line_two())

    datatable(all_table,
              rownames = NULL,
              colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
              filter = "none",
              options = list(dom = 't', 
                             scrollX = TRUE, 
                             ordering=F,
                             columnDefs = list(list(className = 'dt-center', targets = 0:5))))

  } # End {} renderDataTable
  ) # End () renderTable
} # End {} server function
# Run the application 
shinyApp(ui = ui, server = server)

Sample Image


Related Topics

How to Read.Jpeg in R 2.15

Update Graph/Plot with Fixed Interval of Time

How to Properly Document S4 "[" and "[<-" Methods Using Roxygen

Using Grid and Ggplot2 to Create Join Plots Using R

How to Get the Text Between Two Words in R

Switch R Script from Non-Interactive to Interactive

Extracting Off-Diagonal Slice of Large Matrix

How to Convert Mm:Ss.00 to Seconds.00

Producing a Boxplot in Ggplot2 Using Summary Statistics

Coding Variable Values into Classes Using R

Get Filename and Path of 'Source'D File

Minimal Example of Rpy2 Regression Using Pandas Data Frame

Shade Region Between Two Lines with Ggplot

Create a 24 Hour Vector with 5 Minutes Time Interval in R

How to Align a Group of Checkboxgroupinput in R Shiny

Merge/Combine Columns with Same Name But Incomplete Data

How to Find the Percentage of Nas in a Data.Frame

R Remove Parts of Column Name After Certain Characters


Leave a reply



Submit