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)
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)