3

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.

4
  • 3
    To change the selected value of a pickerInput based on the selected value of another, you need to use updatePickerInput inside a reactive (observeEvent, say) that responds to a change in the defining pickerInput. There's no need to use uiOutput/renderUI.
    – Limey
    Jul 10, 2020 at 5:30
  • 1
    You also have to make sure that the logic doesn't interlock : if the user deselects everything there might be no way back because mtcars.reactive() will be empty and as a consequence all the unique(...) selection possibilities will also become empty
    – Waldi
    Jul 10, 2020 at 17:16
  • Thank you both for your comments. I could work out the first one and it like to provide an answer later. However the second comment from @Waldi regarding the interlock not. What would you suggest to work around that problem of an empty mtcars from deselecting all?
    – Joschi
    Jul 10, 2020 at 19:51
  • 1
    You'll perhaps need to keep a hierarchy between pickerInputs : first one fully free, second one depending on first one and third one depending on first one and second one. Not as open as your initial wish but easier to understand / handle
    – Waldi
    Jul 11, 2020 at 14:56

1 Answer 1

2

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)

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.