Search code examples
rdplyrshinypurrr

Filter dataset based on dynamic number of user inputs from user file upload


I am making a shiny app where the user should be able to upload a file then filter the dataset based on the unique values (levels) of all character columns in the uploaded file. I am able to dynamically generate the correct pickerInput (selectInput) elements, but am having trouble executing the filtering. I used the link below as a guide but am having trouble figuring out how to get the selected values (I think input[[paste0("level", .y)]] is where my problem is).

Filter the input of another input with unknown length in R Shiny

Input CSV file

structure(list(factorGroup1 = c("A", "A", "A", "A", "B", "B", 
"B", "B", "C", "C", "C", "C"), factorGroup2 = c("D", "D", "E", 
"E", "D", "D", "E", "E", "D", "D", "E", "E"), factorGroup3 = c("F", 
"G", "F", "G", "F", "G", "F", "G", "F", "G", "F", "G"), numVar = c(5L, 
8L, 1L, 6L, 3L, 4L, 9L, 5L, 8L, 7L, 5L, 3L)), class = "data.frame", row.names = c(NA, 
-12L))

App code

library(shiny)
library(data.table)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
  
  headerPanel("Dynamic number of plots"),
  
  sidebarPanel(
    fileInput("fileIn", 
              "Load input file",
              multiple = F)
  ),
  
  mainPanel(
    uiOutput("generateFilters"),
    tableOutput("dataOut")
  )
)

server <- function(input, output) {
  
  getData <- reactive({
    req(input$fileIn)
    dataIn <- as.data.frame(fread(input$fileIn$datapath))
    return(dataIn)
  })
  
  output$generateFilters <- renderUI({
    lapply(names(Filter(is.character, getData())), function(i) {
      
      filterLevels <- unique(getData()[,i])
      shinyWidgets::pickerInput(inputId = paste(i),
                                label = paste(i),
                                choices = filterLevels,
                                multiple = T,
                                options = list(`actions-box` = T),
                                selected = filterLevels)
    })
  })
  
  dataFxn <- reactive({
    purrr::reduce(seq_along(input$generateFilters), 
                  ~ filter(.x, .data[[ input$generateFilters[[.y]] ]] %in% 
                             input[[paste0("level", .y)]]), 
                  .init = getData())
  })
  
  output$dataOut <- renderTable({
    dataFxn()
  })
  
  }

shinyApp(ui, server)

Solution

  • The example in the post you referenced had a slightly different logic and used some bad notation, i.e. there was both an input named var and an output named var. To make the solution from the answer work for your case requires some adjustments, i.e. for reduce we have to loop over names(Filter(is.character, getData())) as in lapply and inside the function we have to do filter(.x, .data[[ .y ]] %in% input[[.y]]) to filter the data.

    library(shiny)
    library(purrr)
    library(dplyr)
    
    ui <- fluidPage(
      headerPanel("Dynamic number of plots"),
      sidebarPanel(
        fileInput("fileIn",
          "Load input file",
          multiple = F
        )
      ),
      mainPanel(
        uiOutput("generateFilters"),
        tableOutput("dataOut")
      )
    )
    
    server <- function(input, output) {
      getData <- reactive({
       dataIn
      })
    
      output$generateFilters <- renderUI({
        lapply(names(Filter(is.character, getData())), function(i) {
          filterLevels <- unique(getData()[, i])
          shinyWidgets::pickerInput(
            inputId = paste(i),
            label = paste(i),
            choices = filterLevels,
            multiple = T,
            options = list(`actions-box` = T),
            selected = filterLevels
          )
        })
      })
    
      dataFxn <- reactive({
        purrr::reduce(names(Filter(is.character, getData())), function(.x, .y) {
          filter(.x, .data[[ .y ]] %in% input[[.y]])  
        },
          .init = getData()
        )
      })
    
      output$dataOut <- renderTable({
        dataFxn()
      })
    }
    
    shinyApp(ui, server)
    

    enter image description here