R/columnFilterSet.R

In stephLH/shiny.filter: Easily set bidirectionnal (cascading) filters to a table

#' columnFilterSetUI
#'
#' @param id \dots
#' @param cols_num \dots
#' @param button_reset \dots
#' @param inline \dots
#'
#' @export
columnFilterSetUI <- function(id, cols_num, button_reset = TRUE, inline = FALSE) {
  ns <- shiny::NS(id)

  ui <- lapply(cols_num, function(i) {
    columnFilterUI(ns(paste0("col", i)), inline)
  })

  if (length(cols_num) >= 1 & button_reset == TRUE) {
    list(shiny::actionButton(ns("clear_all_filters_button"), "Remise à zéro des filtres"),
         ui)
  } else {
    list(ui)
  }
}

#' columnFilterSet
#'
#' @param input \dots
#' @param output \dots
#' @param session \dots
#' @param df \dots
#' @param cols_num \dots
#' @param cols_name \dots
#'
#' @export
columnFilterSet <- function(input, output, session, df, cols_num, cols_name) {

  # Each column filter needs to only display the choices that are
  # permitted after all the OTHER filters have had their say. But
  # each column filter must not take its own filter into account
  # (hence we do filter[-col_num], not filter, in the reactive below).
  create_choice_filter <- function(col_num, cols_num) {
    reactive({
      filter_values <- lapply(filters[-which(cols_num == col_num)], do.call, args = list())
      Reduce(`&`, filter_values, TRUE)
    })
  }

  observeEvent(input$clear_all_filters_button, {
    filters <- lapply(cols_num, function(col_num) {
      num <-
      callModule(columnFilter, paste0("col", col_num), df = df, col_num = col_num, col_name = cols_name[which(cols_num == col_num)], create_choice_filter(col_num, cols_num), reset=T)
    })
  })

  # filters is a list of reactive expressions, each of which is a
  # logical vector of rows to be selected.
  filters <- lapply(cols_num, function(col_num) {
    callModule(columnFilter, paste0("col", col_num), df = df, col_num = col_num, col_name = cols_name[which(cols_num == col_num)], create_choice_filter(col_num, cols_num))
  })

  reactive({
    # Unpack the list of reactive expressions to a list of logical vectors
    filter_values <- lapply(filters, do.call, args = list())
    # Combine all the logical vectors using & operator
    selected_rows <- Reduce(`&`, filter_values, TRUE)
    # Return the data frame, filtered by the selected rows
    df()[selected_rows,]
  })
}