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)

@bretauv, I have made the example shorter – user2380782 Mar 13 '20 at 11:01 — user2380782, Mar 13 '20 at 11:01
@SeGa, I have updated the example with the iris dataset – user2380782 Mar 17 '20 at 17:48 — user2380782, Mar 17 '20 at 17:48

ismirsehregal · Accepted Answer · 2022-09-13T07:33:36.557

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),
    inline = FALSE
  )
  output$table <- DT::renderDataTable(filtered_table())
}

shinyApp(ui, server)

thanks @ismirsehregal, but in my real data I have `selectInputs` and `numericInputs` that need to be filtered with values higher and smaller than the numericIpunt. I thought also about using `selectizeGroup` but doesn't meet my requirements in my real data — user2380782, Mar 18 '20 at 15:52
Ok that's reasonable - I'll leave the answer here, as it might fit to other's usecases. Have you thought about using DT's [column filters](https://rstudio.github.io/DT/)? — ismirsehregal, Mar 18 '20 at 16:01
Yep, that was another approach, the problem is that the users sometimes want to do negative filtering and they are looking for something more intuitive. I am struggling a bit because I am able to update the filtering based on the different choices but everytime I do that (triggering a button) the filters are refreshed and user can't go back — user2380782, Mar 18 '20 at 16:05
yep that is what I was looking for, the only functionality I have lost is that once you select the filters the choices in the selectInput not reflect the real values, i.e, it you filter using setosa only setosa should display, but I think this is because `isolate` and if doesn't have easy solution I would go with your option. Many thanks — user2380782, Mar 19 '20 at 17:04
Hi @ismirsehregal, sorry for bothering you with so many questions, I think I didn't explain myself properly. Let me try with an example: application starts, then then I filter by `Sepan.Length` with value of `4.5` the table displays only 4 rows, and the only `Species` is setosa, so the behaviour I would like to obtain is that in `selectInput` only setosa species should show up. My real app, have several selectInputs some of them with several choices, the idea is that choices get reduce once the user applies some filters (not sequentially). — user2380782, Mar 20 '20 at 12:09
Sorry I ran out of characters in my last comment @ismirsehregal, if my last question is too much, I can go with your second update. Thanks a lot!!! and thanks a lot to take time to help me, very much appreciated. — user2380782, Mar 20 '20 at 12:10
Ok - that makes more sense. I edited `Another Update` in place. Sorry for the misunderstanding. — ismirsehregal, Mar 20 '20 at 15:50
could I send you in private my app because there is really strange behaviour and my app is really big to post here, and I can't find a good example to post since I think the problem is when populating the reactiveValues from an upload file — user2380782, Apr 30 '20 at 19:10

score 3 · Answer 2 · answered Mar 17 '20 at 20:01

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:

Added data_print and filters as reactive values for printing and filters
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
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.
  )
}

Thanks a lot @Oliver, my real data has 12 filters, between numericInput and selectInput, could you post an example of your second solution? thanks — user2380782, Mar 17 '20 at 20:33
Thanks @Oliver, the behaviour is almost there but the `selectInput` choices are not updated when you choose the previous filter. For example if you choose 5.1 in `Sepal.Length` and then filter, the only options in the species `selectInput` should be **setosa** and **versicolor** — user2380782, Mar 18 '20 at 14:52

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

2 Answers2

Linked