filter data in shiny app but keeping values in selectInput when updating table

Question

I have an shiny app that ask the user to upload a file (a tabulated file with data), then it renders this file into a table and the user can filter some values based on numericInput, selectInput, and textAreaInput. The user has to select the filters and then press a button in order to filter the table.

There is no sequential filtering, i.e, the user can fill all the filters or just one. Every time the user choose a filter the value of the other filters get updated (selectInput inputs) and this is the behaviour I want. However, once the Filter button is pressed, I can't see the previous selection and also I can't reset the filters.

What I would like to achieve is to maintain the actual behaviour when updating the filters, i.e, once I choose a filter and press the filter button the other selectInput choices are automatically updated, BUT I want to keep track of the filters choices, so the user can see the filters he/she has selected. That was what I was expecting but everytime I press the button Filter it seems that the filter tab is rendered again.

Here is my app,

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)


header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,

  sidebarMenu(id="tabs", 
    menuItem("Filtros", tabName="filtros", icon = icon("bar-chart-o")),
      uiOutput("filtros")

  )
)

body <- dashboardBody(

  tabItems(
    tabItem(tabName="filtros",
          fluidRow(
          column(12,dataTableOutput("tabla_julio") %>% withSpinner(color="#0dc5c1"))
        )
    )  
   )
 )

ui <- dashboardPagePlus(enable_preloader = TRUE, sidebar_fullCollapse = TRUE, header, sidebar, body)

server = function(input, output, session) {

    #Create the choices for sample input
    vals <- reactiveValues(data=NULL)
    vals$data <- iris



  output$filtros <- renderUI({

    datos <- vals$data
      conditionalPanel("input.tabs == 'filtros'",
        tagList(        
            div(style="display: inline-block;vertical-align:top; width: 221px;",numericInput(inputId="Sepal.Length", label="Sepal.Length", value=NA, min = NA, max = NA, step = NA)),                      
            div(
              div(style="display: inline-block;vertical-align:top; width: 224px;", selectInput(inputId = "Species", label = "Species", width = "220",  choices=unique(datos$Species), 
              selected = NULL, multiple = TRUE, selectize = TRUE, size = NULL))
              )
            ),
            actionButton("filtrar", "Filter")
          )
    })

# create reactiveValues

  vals <- reactiveValues(data=NULL)
  vals$data <- iris


# Filter data

observeEvent(input$filtrar, {

      tib <- vals$data

      if (!is.na(input$Sepal.Length)){
        tib <- tib %>% dplyr::filter(!Sepal.Length >= input$Sepal.Length)
        print(head(tib))
      } else { tib <- tib }

      # Filter
      if (!is.null(input$Species)){
        toMatch <- paste0("\\b", input$Species, "\\b")
        matches <- unique(grep(paste(toMatch,collapse="|"), tib$Species, value=TRUE))
        tib <- tib %>% dplyr::filter(Species %in% matches)
      } else { tib <- tib}

      tib -> vals$data
      print(head(tib, n=15))

    })


  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable({        
      DT::datatable(vals$data) 
    })

}

shinyApp(ui, server)

Answer 1

Another Update:

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)

header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,
                            sidebarMenu(id = "tabs",
                                        menuItem(
                                          "Filtros",
                                          tabName = "filtros",
                                          icon = icon("bar-chart-o")
                                        ),
                                        uiOutput("filtros")
                            ))

body <- dashboardBody(tabItems(tabItem(tabName = "filtros",
                                       fluidRow(
                                         column(12,
                                                DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
                                         )
                                       ))))

ui <-
  dashboardPagePlus(
    enable_preloader = FALSE,
    sidebar_fullCollapse = TRUE,
    header,
    sidebar,
    body
  )

server = function(input, output, session) {

  # Create the choices for sample input
  vals <- reactiveValues(data = iris, filtered_data = iris)

  output$filtros <- renderUI({
    datos <- isolate(vals$data)
    conditionalPanel(
      "input.tabs == 'filtros'",
      tagList(
        div(
          style = "display: inline-block;vertical-align:top; width: 221px;",
          numericInput(
            inputId = "SepalLength",
            label = "Sepal.Length",
            value = NA,
            min = NA,
            max = NA,
            step = NA
          )
        ),
        div(
          div(
            style = "display: inline-block;vertical-align:top; width: 224px;",
            selectInput(
              inputId = "Species",
              label = "Species",
              width = "220",
              choices = unique(isolate(datos$Species)),
              selected = NULL,
              multiple = TRUE,
              selectize = TRUE,
              size = NULL
            )
          )
        )
      ),
      actionButton("filtrar", "Filter", style = "width: 100px;"),
      actionButton("reset", "Reset", style = "width: 100px;")
    )
  })


  # Filter data
  observeEvent(input$filtrar, {
    tib <- vals$data

    if (!is.na(input$SepalLength)) {
      tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
      print(head(tib))
    } else {
      tib
    }

    # Filter
    if (!is.null(input$Species)) {
      tib <- tib %>% dplyr::filter(Species %in% input$Species)
    } else {
      tib
    }

    print(head(tib, n = 15))

    vals$filtered_data <- tib

    updateSelectInput(session, inputId = "Species", selected = input$Species, choices = unique(vals$filtered_data$Species))

  })

  observeEvent(input$reset, {
    updateNumericInput(session, inputId = "SepalLength", value = NA)
    updateSelectInput(session, inputId = "Species", selected = "")
  })

  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable({
    DT::datatable(vals$filtered_data)
  }, server = FALSE)

}

shinyApp(ui, server)

---

Update: Here is what I think you are after. The most important step is to isolate the inputs in renderUI so they aren't re-rendered on every input change.

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)

header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,
                            sidebarMenu(id = "tabs",
                                        menuItem(
                                          "Filtros",
                                          tabName = "filtros",
                                          icon = icon("bar-chart-o")
                                        ),
                                        uiOutput("filtros")
                            ))

body <- dashboardBody(tabItems(tabItem(tabName = "filtros",
                                       fluidRow(
                                         column(12,
                                                DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
                                         )
                                       ))))

ui <-
  dashboardPagePlus(
    enable_preloader = FALSE,
    sidebar_fullCollapse = TRUE,
    header,
    sidebar,
    body
  )

server = function(input, output, session) {

  # Create the choices for sample input
  vals <- reactiveValues(data = iris, filtered_data = iris)

  output$filtros <- renderUI({
    datos <- isolate(vals$data)
    conditionalPanel(
      "input.tabs == 'filtros'",
      tagList(
        div(
          style = "display: inline-block;vertical-align:top; width: 221px;",
          numericInput(
            inputId = "SepalLength",
            label = "Sepal.Length",
            value = NA,
            min = NA,
            max = NA,
            step = NA
          )
        ),
        div(
          div(
            style = "display: inline-block;vertical-align:top; width: 224px;",
            selectInput(
              inputId = "Species",
              label = "Species",
              width = "220",
              choices = unique(isolate(datos$Species)),
              selected = NULL,
              multiple = TRUE,
              selectize = TRUE,
              size = NULL
            )
          )
        )
      ),
      actionButton("filtrar", "Filter", style = "width: 100px;"),
      actionButton("reset", "Reset", style = "width: 100px;")
    )
  })


  # Filter data
  observeEvent(input$filtrar, {
    tib <- vals$data

    if (!is.na(input$SepalLength)) {
      tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
      print(head(tib))
    } else {
      tib
    }

    # Filter
    if (!is.null(input$Species)) {
      tib <- tib %>% dplyr::filter(Species %in% input$Species)
    } else {
      tib
    }

    print(head(tib, n = 15))

    vals$filtered_data <- tib

  })

  observeEvent(input$reset, {
    updateNumericInput(session, inputId = "SepalLength", value = NA)
    updateSelectInput(session, inputId = "Species", selected = "")
  })

  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable({
    DT::datatable(vals$filtered_data)
  }, server = FALSE)

}

shinyApp(ui, server)

---

Initial answer:

I'd recommend using the selectizeGroup-module from library(shinyWidgets).

It creates a

Group of mutually dependent selectizeInput for filtering data.frame's columns (like in Excel).

Besides the fact, that it only uses selectizeInput it seems to meet your requirements and saves us from a lot of typing.

Here is an example using the iris dataset:

library(shiny)
library(DT)
library(shinyWidgets)
library(datasets)

DF <- iris
names(DF) <- gsub("\\.", "", names(DF))

ui <- fluidPage(
  fluidRow(
    column(width = 10, offset = 1, tags$h3("Filter data with selectize group")),
    column(width = 3, offset = 1, 
           selectizeGroupUI(
             id = "my-filters",
             params = list(
               SepalLength = list(inputId = "SepalLength", title = "SepalLength:"),
               SepalWidth = list(inputId = "SepalWidth", title = "SepalWidth:"),
               PetalLength = list(inputId = "PetalLength", title = "PetalLength:"),
               PetalWidth = list(inputId = "PetalWidth", title = "PetalWidth:"),
               species = list(inputId = "Species", title = "Species:")
             ),
             inline = FALSE
           )),
    column(
      width = 10, offset = 1,DT::dataTableOutput(outputId = "table")
    )
  )
)

server <- function(input, output, session) {
  filtered_table <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = DF,
    vars = names(DF)
  )
  output$table <- DT::renderDataTable(filtered_table())
}

shinyApp(ui, server)

Answer 2

If i understand your question correctly, you are almost at your goal. In this case, you are overwriting your data at run-time. This causes the filter to be invalid, and the reactive UI seems to check this at every click.

A simple solution is to store the original and filtered datasets separately. An alternativ is to store the filters in a reactive-value and re-render the DataTable at run-time, using the filters on the original table. Here I'll go for the first example.

Below I've changed the following:

1. Added data_print and filters as reactive values for printing and filters
2. Changed the filtering method for filtrar, making use of data_print, and added some formatting and changed a few lines of code, as an example of code that might be easier to adapt to a given user-input
3. removed some unnecesary code (renderDataTable changed input to DT automatically)

server = function(input, output, session) {
  #Create the choices for sample input
  vals <- reactiveValues(
                         #raw data
                         data = iris,
                         #Exists only in order to print.
                         data_print = iris,
                         #for filtering data
                         filters = list(Species = c(), 
                                        Sepal.Length = c()
                                        )
                         )
  #in case of many filters, or filters expanding depending on input data, it might be worth adding this to reactiveValues
  ## Unchanged
  output$filtros <- renderUI({
    datos <- vals$data
    conditionalPanel("input.tabs == 'filtros'",
                     tagList(        
                       div(style="display: inline-block;vertical-align:top; width: 221px;",
                           numericInput(inputId="Sepal.Length", label="Sepal.Length", 
                                        value=NA, min = NA, max = NA, step = NA)),                      
                       div(
                         div(style="display: inline-block;vertical-align:top; width: 224px;", 
                             selectInput(inputId = "Species", label = "Species", width = "220",  
                                         choices=unique(datos$Species),  
                                         selected = NULL, multiple = TRUE, selectize = TRUE, size = NULL))
                       )
                     ),
                     actionButton("filtrar", "Filter")
    )
  })

  # Filter data
  observeEvent(input$filtrar, {
    nm <- names(vals$filters)
    for(i in nm){
      if(is.na(input[[i]]) || is.null(input[[i]]))
        vals$filters[[i]] <- unique(vals$data[[i]]) #If unfiltered use all values
      else
        vals$filters[[i]] <- input[[i]] #if filtered choose the filtered value
    }
    #Overwrite data_print instead of data. Creds to https://stackoverflow.com/a/47171513/10782538 
    vals$data_print <- vals$data %>% dplyr::filter((!!as.symbol(nm[1])) %in% vals$filters[[1]], 
                                         (!!as.symbol(nm[2]) %in% vals$filters[[2]]))

  })

  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable(        
    vals$data_print #<====renderDataTable changes to data.
  )
}