rshinyshinywidgets

The 'None' choice from shinywidgets ::pickerInput() seems not to work


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

Solution

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

    enter image description here