rshinyreactable

How to add a date picker to filter a date column in a reactable table in R Shiny?

I would like to display a reactable table in an R Shiny Dashboard where the records can be filtered by column. One of the columns is a date. I would like to use a date picker that appears when you click on the corresponding filter field for this column. Is this possible, and if so, how can it be implemented?

library(shiny)
library(reactable)
library(dplyr)

# Function to generate random letter combinations
random_name <- function(n) {
  replicate(n, paste0(sample(LETTERS, 5, replace = TRUE), collapse = ""))
}

# Generate a DataFrame with 100 sample records
set.seed(123)  # For reproducibility
df <- data.frame(
  ID = 1:100,
  Name = random_name(100),
  Date = sample(seq(as.Date('2023-01-01'), as.Date('2023-12-31'), by = "day"), 100)
)

# Add a column for the weekday
df$Weekday <- weekdays(df$Date)

# UI
ui <- fluidPage(
  titlePanel("Example Shiny Dashboard with reactable"),
  reactableOutput("table")
)

# Server
server <- function(input, output) {
  output$table <- renderReactable({
    reactable(
      df,
      filterable = TRUE,
      columns = list(
        ID = colDef(filterable = TRUE),
        Name = colDef(filterable = TRUE),
        Date = colDef(filterable = TRUE, format = colFormat(date = TRUE)),
        Weekday = colDef(filterable = TRUE)
      )
    )
  })
}

# Run Shiny App
shinyApp(ui, server)
Solution

  • The general idea here is that in colDef there is a filterInput argument which we have to set up:

    filterInput: Custom filter input or render function. Render functions can be an R function that takes the column values and column name as arguments, or a JS() function that takes a column object and table state object as arguments.

    Here you would like to have an <input type="date">, which we define by using tags$input. Please see the MDN docs for more information on the date input and the reactable docs for more information on Column Filter Inputs. It's also possible to add custom JS and CSS for more individual behavior and style of the input.

    enter image description here

    library(shiny)
library(reactable)
library(dplyr)

# Function to generate random letter combinations
random_name <- function(n) {
  replicate(n, paste0(sample(LETTERS, 5, replace = TRUE), collapse = ""))
}

# Generate a DataFrame with 100 sample records
set.seed(123)  # For reproducibility
df <- data.frame(ID = 1:100,
                 Name = random_name(100),
                 Date = sample(seq(
                   as.Date('2023-01-01'), as.Date('2023-12-31'), by = "day"
                 ), 100))

# Add a column for the weekday
df$Weekday <- weekdays(df$Date)

# UI
ui <-
  fluidPage(titlePanel("Example Shiny Dashboard with reactable"),
            reactableOutput("table"))

# Server
server <- function(input, output) {
  output$table <- renderReactable({
    table <- reactable(
      df,
      filterable = TRUE,
      columns = list(
        ID = colDef(filterable = TRUE),
        Name = colDef(filterable = TRUE),
        Date = colDef(
          filterable = TRUE,
          format = colFormat(date = TRUE),
          filterInput = function(values, name) {
            tags$input(
              # Set to undefined to clear the filter
              onchange = sprintf(
                "Reactable.setFilter('tbl', '%s', event.target.value || undefined)",
                name
              ),
              "type" = "date",
              "min" = "2023-01-01",
              "max" = "2023-12-31",
              "value" = "",
              "aria-label" = sprintf("Filter %s", name),
              style = "width: 100%; height: 28px;"
            )
          }
        ),
        Weekday = colDef(filterable = TRUE)
      ),
      elementId = "tbl"
    )
    table$elementId <- NULL
    table
  })
}

# Run Shiny App
shinyApp(ui, server)