在 R Shiny 中使用两个依赖 selectInput 过滤 dataframe

Question

G'day awesome community

I am trying to make a dashboard of a dataframe that allows one to filter the dataframe by the levels within a column selected. This means a first pickerInput where the user selects the column, and then a second child pickerInput where the options are generated based on the column selected. I have figured out one way to make the pickerInput s dependent on each other, but for some reason when I try to apply the filtering, my dataframe has zero values and I cant see why?

Please see the reprex created with the mtcars dataset

library(shiny)
library(shinyWidgets)
library(dplyr)
library(DT)
data(mtcars)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(uiOutput('select_filter'),
                 uiOutput('filter')),
  mainPanel(
    dataTableOutput('table')
  ),
  
))

server <- function(input, output, session) {
  data<-mtcars
  categories<-c('cyl','vs','am','gear','carb')
  
  output$select_filter <- renderUI({
    
    pickerInput("select_filter", "Select flexi filter", 
                choices = levels(as.factor(categories))
    )})
  
  output$filter <- renderUI({
    
    pickerInput("filter", "Flexi filter", 
                choices = unique(data[,input$select_filter]),
                options = list('actions-box'=TRUE), multiple= TRUE,
                selected = unique(data[,input$select_filter]))
    
    
  })
  
  filtered_data<- 
    #
    reactive ({data %>% filter(input$select_filter %in% input$filter)
      
    })
  
  output$table<-renderDataTable(filtered_data())
  
}

shinyApp(ui, server)

Any help will be greatly appreciated. If any further information is required please let me know. Cheers

Answer 1

In filter , use .data to get the column value using select_filter variable. Also included req so that it doesn't error out at the start when the input$select_filter is NULL .

  filtered_data <- 
    reactive ({
      req(input$select_filter)
      data %>% filter(.data[[input$select_filter]] %in% input$filter)
      
    })

Complete app code -

library(shiny)
library(shinyWidgets)
library(dplyr)
library(DT)

data(mtcars)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(uiOutput('select_filter'),
                 uiOutput('filter')),
    mainPanel(
      dataTableOutput('table')
    ),
    
  ))

server <- function(input, output, session) {
  data<-mtcars
  categories<-c('cyl','vs','am','gear','carb')
  
  output$select_filter <- renderUI({
    
    pickerInput("select_filter", "Select flexi filter", 
                choices = levels(as.factor(categories))
    )})
  
  output$filter <- renderUI({
    
    pickerInput("filter", "Flexi filter", 
                choices = unique(data[,input$select_filter]),
                options = list('actions-box'=TRUE), multiple= TRUE,
                selected = unique(data[,input$select_filter]))
    
    
  })
  
  filtered_data<- 
    #
    reactive ({
      req(input$select_filter)
      data %>% filter(.data[[input$select_filter]] %in% input$filter)
      
    })
  
  output$table<-renderDataTable(filtered_data())
  
}

shinyApp(ui, server)