I have strange problem with my app below. Everything works fine but when I select None from my pickerInput(). the table remains as it is while it should be empty.
library(shiny)
library(shinydashboard)
#>
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#>
#> box
library(shinyWidgets)
# Load necessary libraries
library(DT)
#>
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#>
#> dataTableOutput, renderDataTable
# Creating a sample dataframe
set.seed(123)
dates <- seq(as.Date("2023-01-01"), as.Date("2023-12-31"), by = "days")
numeric_values <- sample(1:100, length(dates), replace = TRUE)
names <- rep(c("Alice", "Bob", "Charlie"), length.out = length(dates))
df <- data.frame(Date = dates, Numeric = numeric_values, Name = names)
# Define UI
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput("namePicker", "Select Name:", choices = unique(df$Name), selected = unique(df$Name)[1], multiple = TRUE,
options = list(
`actions-box` = TRUE,
`deselect-all-text` = "None...",
`select-all-text` = "Yeah, all !",
`none-selected-text` = "zero"
)),
uiOutput("inputs")
),
mainPanel(
DTOutput("table")
)
)
)
# Define server logic
server <- function(input, output, session) {
# Filter data based on selected names
filtered_data <- eventReactive(input$namePicker, {
df_subset <- df[df$Name %in% input$namePicker, ]
df_subset
})
# Render numeric range inputs dynamically
output$inputs <- renderUI({
tagList(
numericInput(
"minNumeric",
"Min Numeric Value:",
value = min(filtered_data()$Numeric),
min = min(filtered_data()$Numeric),
max = max(filtered_data()$Numeric)
),
numericInput(
"maxNumeric",
"Max Numeric Value:",
value = max(filtered_data()$Numeric),
min = min(filtered_data()$Numeric),
max = max(filtered_data()$Numeric)
),
dateInput(
"minDate",
"Min Date:",
min = min(filtered_data()$Date),
max = max(filtered_data()$Date),
value = min(filtered_data()$Date)
),
dateInput(
"maxDate",
"Max Date:",
min = min(filtered_data()$Date),
max = max(filtered_data()$Date),
value = max(filtered_data()$Date)
)
)
})
filtered_data_full <- eventReactive(
list(input$minNumeric, input$maxNumeric, input$minDate, input$maxDate),
{
validate(need(input$minDate <= input$maxDate, "min Date has to be smaller or equal than max Date"))
validate(need(input$minNumeric <= input$maxNumeric, "min Numeric has to be smaller or equal than max Numeric"))
df_subset <- subset(filtered_data(), Numeric >= input$minNumeric & Numeric <= input$maxNumeric & Date >= input$minDate & Date <= input$maxDate)
df_subset
},
ignoreInit = TRUE
)
observe({
if (NROW(filtered_data_full())) {
updateNumericInput(
session,
"maxNumeric",
"Max Numeric Value:",
value = max(filtered_data_full()$Numeric),
min = min(filtered_data_full()$Numeric),
max = max(filtered_data_full()$Numeric)
)
updateNumericInput(
session,
"minNumeric",
"Min Numeric Value:",
min = min(filtered_data_full()$Numeric),
max = max(filtered_data_full()$Numeric),
value = min(filtered_data_full()$Numeric)
)
updateDateInput(
session,
"minDate",
"Min Date:",
min = min(filtered_data_full()$Date),
max = max(filtered_data_full()$Date),
value = min(filtered_data_full()$Date)
)
updateDateInput(
session,
"maxDate",
"Max Date:",
min = min(filtered_data_full()$Date),
max = max(filtered_data_full()$Date),
value = max(filtered_data_full()$Date)
)
}
})
output$table <- renderDT({
datatable(filtered_data_full(), options = list(pageLength = 10))
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4962
The issue is that when no option is selected, input$namePicker
is NULL
which does not trigger the eventReactive
and hence filtered_data
is not updated. Instead you could simply use a reactive
instead of an eventReactive
to filter your data:
# Filter data based on selected names
filtered_data <- reactive({
df_subset <- df[df$Name %in% input$namePicker, ]
df_subset
})