Joschi
Joschi

Reputation: 3039

Multiple dynamic filter updates in shiny

I want to be able to have UI inputs in shiny that update themselves based on the previous choices of a user. So in the example below, the intended behavior would be that the user chooses from cyl, vsor carbwhich will then

  1. filter the dataset mtcarswhich is used to create a plot i.e. the user adjusts the plot to the filter criteria and
  2. update the remaining input choices in the other filters in order to correspond to the remaining choices based upon the filter that is already in place.

Here is what I tried:

library(shiny)
library(dplyr)
library(plotly)

data("mtcars")

# create ui
ui <- fluidPage(
  fluidRow(
    box(
      title = "Filter",
      uiOutput(outputId = "cyl_dynamic_input"),
      uiOutput(outputId = "vs_dynamic_input"),
      uiOutput(outputId = "carb_dynamic_input")
    ),
    box(
      title = "Plot of mtcars",
      plotlyOutput("carplot")
    )
  ),
)

# create server
server <- function(input, output, session) {
  # create reactive filters of the mtcars table
  mtcars.reactive <- 
    reactive({
      mtcars %>%
        filter(mpg %in% input$cyl_input_rendered &
                 vs %in% input$vs_input_rendered &
                 carb %in% input$carb_input_rendered
        )})
  ## create rendered inputs
  # for cyl
  output$cyl_dynamic_input <- renderUI({
    pickerInput(inputId = "cyl_input_rendered",
                label = "CYL",
                choices = unique(mtcars$cyl),
                multiple = T,
                selected = mtcars.reactive()$cyl,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} cyl selected"
                ))
  })
  # for vs
  output$vs_dynamic_input <- renderUI({
    pickerInput(inputId = "vs_input_rendered",
                label = "VS",
                choices = unique(mtcars$vs),
                multiple = T,
                selected = mtcars.reactive()$vs,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} vs selected"
                ))
  })
  # for carb
  output$carb_dynamic_input <- renderUI({
    pickerInput(inputId = "carb_input_rendered",
                label = "CARB",
                choices = unique(mtcars$carb),
                multiple = T,
                selected = mtcars.reactive()$carb,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} carb selected"
                ))
  })
  ## create the plot output
  # Start Barplot Emissionen here 
  output$carplot<-
    renderPlotly({
    # create plot
    plot<-ggplot(mtcars.reactive(), aes(wt, mpg))+
      geom_point()
    # convert to plotly
    ggplotly(plot)
  })
  
  
  
}

shinyApp(ui, server)

My guess is that the this cannot work because the filter for the mtcarstable references to the rendered inputs and vice versa which somehow creates an empty information loop

I already had a look in the official Shiny documentation which also provides some background information but the whole topic is not really intuitiv for a beginner. Here is a somehow similar question but it is not fully reproducible.

Upvotes: 4

Views: 2341

Answers (1)

joaoal
joaoal

Reputation: 1982

The following does what you want without a hierarchy but using pickerInput and conditional statements in an observeEvent statement. It looks complex at first but does what it should do.

library(shiny)
library(dplyr)
library(plotly)

data("mtcars")

# create ui
ui <- fluidPage(fluidRow(
  box(
    title = "Filter",
    pickerInput(
      inputId = "cyl_pickerinput",
      label = "CYL",
      choices = levels(as.factor(mtcars$cyl)),
      multiple = T,
      selected = levels(as.factor(mtcars$cyl)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} cyl selected"
      )
    ),
    pickerInput(
      inputId = "vs_pickerinput",
      label = "VS",
      choices = levels(as.factor(mtcars$vs)),
      multiple = T,
      selected = levels(as.factor(mtcars$vs)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} vs selected"
      )
    ),
    pickerInput(
      inputId = "carb_pickerinput",
      label = "CARB",
      choices = levels(as.factor(mtcars$carb)),
      multiple = T,
      selected = levels(as.factor(mtcars$carb)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} carb selected"
      )
    ),
  ),
  box(title = "Plot of mtcars",
      plotlyOutput("carplot"))
),)

# create server
server <- function(input, output, session) {
  #(1) Create PickerInput Updates
  observeEvent(
    # define pickerinputs to be observed
    c(
      input$vs_pickerinput,
      input$carb_pickerinput,
      input$cyl_pickerinput
    ),
    {
      ## filter the data based on the pickerinputs
      # include an ifelse condition first to check wheter at least one value is choosen in all of the filters.
      mtcars2 <-
        if (!is.null(input$cyl_pickerinput) &
            !is.null(input$vs_pickerinput) &
            !is.null(input$carb_pickerinput)) {
          mtcars %>%
            filter(cyl %in% input$cyl_pickerinput) %>% # filters
            filter(vs %in% input$vs_pickerinput) %>%
            filter(carb %in% input$carb_pickerinput)
        } 
      else{
           mtcars
         }

      ## update PickerInput based on a condition that requires the user to choose at least one input, else reset all filters
      # for cyl 
      if (!is.null(input$cyl_pickerinput)) {
        updatePickerInput(
          session,
          "cyl_pickerinput",
          choices = levels(factor(mtcars$cyl)),
          selected = unique(mtcars2$cyl))
      } else{
      }
      # for carb
      if (!is.null(input$carb_pickerinput)) {
        updatePickerInput(
          session,
          "carb_pickerinput",
          choices = levels(factor(mtcars$carb)),
          selected = unique(mtcars2$carb)
        )
      } 
      # for vs 
      if (!is.null(input$vs_pickerinput)) {
        updatePickerInput(
          session,
          "vs_pickerinput",
          choices = levels(factor(mtcars$vs)),
          selected  = unique(mtcars2$vs)
        )
      } 
    },
    ignoreInit = TRUE,
    ignoreNULL = F
  )
  
  # (2) Create reactive object with filtered data
  # update mtcars table based on filters
  mtcars.reactive <-
    reactive({
      if (!is.null(input$vs_pickerinput))
        # one condition should be enough.
      {
        mtcars %>% # filters
          filter(
            cyl %in% input$cyl_pickerinput &
              vs %in% input$vs_pickerinput &
              carb %in% input$carb_pickerinput
          )
      } else
      {
        mtcars
      }
    })
  
  # (3) create the plot output
  output$carplot <-
    renderPlotly({
      # create plot
      plot <- ggplot(mtcars.reactive()) +
        geom_point(aes(wt, mpg, color = factor(vs)))
      # convert to plotly
      ggplotly(plot)
    })
  
  
  
}

shinyApp(ui, server)

Upvotes: 2

Related Questions