Here is an example of dynamic filtering conducted using the iris data frame.
library(dplyr)
library(shiny)
library(purrr)
make_ui <- function(x, var) {
if (is.numeric(x)) {
rng <- range(x, na.rm = TRUE)
sliderInput(var, var, min = rng[1], max = rng[2], value = rng)
} else if (is.factor(x)) {
levs <- levels(x)
selectInput(var, var, choices = levs, selected = levs, multiple = TRUE)
} else {
# Not supported
NULL
}
}
filter_var <- function(x, val) {
if (is.numeric(x)) {
!is.na(x) & x >= val[1] & x <= val[2]
} else if (is.factor(x)) {
x %in% val
} else {
# No control, so don't filter
TRUE
}
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
map(names(iris), ~ make_ui(iris[[.x]], .x))
),
mainPanel(
tableOutput("data")
)
)
)
server <- function(input, output, session) {
selected <- reactive({
each_var <- map(names(iris), ~ filter_var(iris[[.x]], input[[.x]]))
reduce(each_var, ~ .x & .y)
})
output$data <- renderTable(head(iris[selected(), ], 12))
}
shinyApp(ui, server)
How should the code be modified to have a similar output for the time in which we need to import a file, for example, a CSV file using the following code (rather than using a data frame already available):
fileInput('inputFile', 'Choose CSV/XLSX File',
multiple = FALSE,
accept = c('text/csv',
'text/comma-separated-values',
'application/vnd.ms-excel',
'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
'.csv'))
Here is a code to generate a sample CSV file:
write.csv(iris, "my_example.csv", row.names = F)
There's no need to modularise. Since you now want part of your UI (the sidebar) to respond dynamically to user input, you can't define that part of the UI in the Ui function. Instead, you need to delegate the population to the server function using uiOutput
and renderUI
.
I've added a selectInput
to the sidebar to allow you to choose either mtcars
or iris
. Obviously, you should adapt this to satisfy your real use case. This selectInput
is used to define a reactive (selectedData
) that returns the required dataset. So the other changes simply replace iris
with selectedData()
.
library(dplyr)
library(shiny)
library(purrr)
make_ui <- function(x, var) {
if (is.numeric(x)) {
rng <- range(x, na.rm = TRUE)
sliderInput(var, var, min = rng[1], max = rng[2], value = rng)
} else if (is.factor(x)) {
levs <- levels(x)
selectInput(var, var, choices = levs, selected = levs, multiple = TRUE)
} else {
# Not supported
NULL
}
}
filter_var <- function(x, val) {
if (is.numeric(x)) {
!is.na(x) & x >= val[1] & x <= val[2]
} else if (is.factor(x)) {
x %in% val
} else {
# No control, so don't filter
TRUE
}
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("sourceData", "Source data:", c("iris", "mtcars")),
uiOutput("sidebar")
),
mainPanel(
tableOutput("data")
)
)
)
server <- function(input, output, session) {
selected <- reactive({
each_var <- map(names(selectedData()), ~ filter_var(selectedData()[[.x]], input[[.x]]))
reduce(each_var, ~ .x & .y)
})
selectedData <- reactive({
if (input$sourceData == "iris") {
iris
} else {
mtcars
}
})
output$sidebar <- renderUI({
map(names(selectedData()), ~ make_ui(selectedData()[[.x]], .x))
})
output$data <- renderTable(head(selectedData()[selected(), ], 12))
}
shinyApp(ui, server)