shinyDataFilter - create new table with details on data filtered at each step

Question

I discovered the shinyDataFilter package and it is fantastic - does a lot of what I already want to do.

I am trying to create a new table that shows the variable and values selected at each filter. The current table I have created (data_summary2 in reprex below) is a summary of the dataset at the end of the application of all filters. What I am trying to achieve is a summary of filters at each step.

I would appreciate any help.

Thanks, JJ

library(shiny)
library(ggplot2)
library(magrittr)
library(shinyDataFilter)

`%nin%` <- Negate(`%in%`)

cell_type <- sample( 
  c("BCell", "TCell", "Marcophage", "Monocyte"),
  100, replace = TRUE) %>% as.factor
sex <- sample( 
  c("Male", "Female"),
  100, replace = TRUE) %>% as.factor
disease <- sample( 
  c("adenocarcinoma", "copd", "nsclc", "sclc"),
  100, replace = TRUE) %>% as.factor
tumor <- sample( 
  c("tumor", "normal", "early"),
  100, replace = TRUE) %>% as.factor
exp = sample(
  c(1:2000), replace = FALSE
)

df <- data.frame( cell_type, sex, disease, tumor, exp )

ui <- fluidPage(
  titlePanel("Filter Data Example"),
  fluidRow(
    column(8,
           dataTableOutput("data_summary"),
           dataTableOutput("data_summary2"),
           verbatimTextOutput("data_filter_code")),
    column(4, shiny_data_filter_ui("data_filter"))))

server <- function(input, output, session) {
  filtered_data <- callModule(
    shiny_data_filter,
    "data_filter",
    data = df,
    #choices = c("height", "mass", "is_droid"),
    choices = names(df),
    verbose = FALSE
  )
  
  output$data_filter_code <- renderPrint({
    cat(gsub("%>%", "%>% \n ",
             gsub("\\s{2,}", " ",
                  paste0(
                    capture.output(attr(filtered_data(), "code")),
                    collapse = " "))
    ))
  })
  
  cnames <- names(starwars2)[sapply(starwars2,is.factor)]
  
  sel_summ <- function( df) {
    cnames <- names(df)[sapply(df,is.factor)]
    f_data_sum <- do.call( 
      rbind, 
      lapply( cnames, 
              function(x) {
                tmp = table( df[[x]], useNA = "always" ) %>% 
                  as.data.frame() %>%
                  dplyr::mutate( Variable = x) %>%
                  dplyr::select( Variable, Value = Var1, selected = Freq)
                return(tmp)
              }
      )
    )
    return(f_data_sum)
  }
  
  sel_summ2 <- function(df1,df2){
    dplyr::left_join(df1,df2, by =c("Variable", "Value")) %>%
      dplyr::select(Variable, Value, Before = selected.x, After = selected.y ) %>%
      dplyr::mutate( Filter = ifelse( Before == After, 0, 1))
  }
  
  output$data_summary <- renderDataTable({
    filtered_data()
  },
  options = list(
    scrollX = TRUE,
    pageLength = 5
  ))
  
  output$data_summary2 <- renderDataTable({
    sel_summ(filtered_data())
  },
  options = list(
    scrollX = TRUE,
    pageLength = 5
  ))
  
}

shinyApp(ui = ui, server = server)

shinyDataFilter - create new table with details on data filtered at each step

0 Answers0