Interactive datatable: keep column filters after rerendering the table

Question

First time poster here. I'm usually able to get all my answers without posting but this one really stumps me. I'm an intermediate R user with NO javascript experience whatsoever. Here's what I'm trying to do:

I have a datatable that uses both interactive shiny filters via action buttons which subset my data, and also the built in datatable filters. The action buttons perform bulk filtering by subsetting the dataframe. The problem I'm having is that whenever one of these bulk filters is applied, the datatable is re-rendered and all the individual column filters are cleared. I'd like to be able to keep the individual column filters active whenever the data is subsetted and the table re-rendered.

I've managed to find that I can output and isolate this information from the datatable using input$mytable_search_columns but I have no idea how to write that javascript that will apply this criteria upon re-rendering the table.

library(shinyBS)
library(DT)

server <- function(input, output, session) {

  df <- reactive({iris})

  df.sub <- reactive({
    if(input$buttonfilter == 0){
      df.sub <- df()
    }
    if(input$buttonfilter == 1){
      df.sub <- subset(df(), subset = Species == 'setosa')
    }
    df.sub
  })

  output$mytable <- DT::renderDataTable(df.sub(),
                                        filter = 'top')
  output$filters <- renderText({input$mytable_search_columns})
}
ui <- fluidPage(
  h3('Button Toggle Filter'),
  bsButton("buttonfilter","Show only Setosa", type = 'toggle'),
  br(),
  br(),
  h3('Current filters'),
  textOutput('filters'),
  br(),
  br(),
  DT::dataTableOutput('mytable')



)

shinyApp(ui = ui, server = server)

Thanks so much.

EDIT:

OK I've made it so that it should be reproducible (requires shinyBS and DT packages).

What I'm trying to do is find a way to maintain the current DT filters when the table is re-rendered based on the subset initiated by the action button. In this example you can see the filters are cleared once the table is re-rendered.

Thank you!

Answer 1

I found a way without using JavaScript. I am actually surprised it worked. I never had to deal with the package DT but I think this is what you want:

library(shinyBS)
library(DT)

server <- function(input, output, session) {

  df <- reactive({
    if(input$buttonfilter %% 2 == 0){
      df.sub <- iris
    } else {
      df.sub <- subset(iris, subset = Species == 'setosa')
    }
    df.sub
  })


  output$mytable <- DT::renderDataTable(isolate(df()), filter = 'top')
  proxy <- dataTableProxy('mytable')

  observe({
    replaceData(proxy, df(), resetPaging = FALSE)
  })  
}

ui <- fluidPage(h3('Button Toggle Filter'),
                bsButton("buttonfilter","Show only Setosa", type = 'toggle'),
                br(),br(),
                DT::dataTableOutput('mytable')
)

shiny::shinyApp(ui=ui,server=server)

We basically create a proxy for our table and just replace the data for the rendered table. For details check the very bottom of this page: https://rstudio.github.io/DT/shiny.html

I did not find the example mentioned there on my computer but you can go to GitHub and copy and paste it: https://github.com/rstudio/DT/blob/master/inst/examples/DT-reload/app.R

Hope this helps.

Answer 2

Here is another solution. This solution has the advantage that the filters are kept even if the displayed columns change. In order to realize this a dataframe is created that saves the filter values and the currently displayed columns.

    library(shiny)           #  Shiny web app
    library(shinydashboard)  #  Dashboard framework for Shiny
    library(plotly)          #  Plotly interactive plots
    library(DT)

    # default global search value
    if (!exists("default_search")) default_search <- ""

    # ---- ui ----

    ui <- dashboardPage(
      dashboardHeader(),
      dashboardSidebar(
        sidebarMenu(
          menuItem(
            "select species",
            tabName = "selectspecies",
            selectizeInput(
              "select_species",
              '',
              choices = sort(iris$Species),
              selected = "versicolor",
              multiple =T)
          ),
          menuItem(
            "select Columns",
            tabName = "selectcols",
            selectizeInput(
              "select_cols",
              '',
              choices = sort(names(iris)),
              selected = names(iris),
              multiple =T )
          )
        )),
      dashboardBody(
        fluidRow(column(12, DTOutput("table"))
        )
      )
    )

    # ---- server ----


    server <- function(input, output, session) {

      # initialize help table
      transition <- reactiveValues()
      transition$table <- data.frame("colnames" = sort(names(iris)),
          "filter" = c("","","","",""), "active" = c(T,T,T,T,T) )

      # Update table if sidebar input is changed (lacy)
      fileData <- reactive({
        iris2 <- iris[iris$Species == input$select_species,]
        iris3 <- iris2[input$select_cols]
      })

      # before table is updated save all filter settings in transition$table
      observeEvent( c(input$select_cols,input$select_species ),{

        # Set type
        transition$table[,"filter"] <- as.character(transition$table[,"filter"])

        # check if it is the inital start
        if(length(input$table_search_columns )!=0){
          # save filter settings in currently displayed columns 
          transition$table[transition$table[,"active"]==T, "filter"] <- input$table_search_columns
        }
        # save new column state after changing
        transition$table[,"active"] <- transition$table[,"colnames"] %in% input$select_cols

      })

      observeEvent( fileData(),{

        # update global search and column search strings
        default_search <- input$table_search

        # set column settings
        default_search_columns <- c("",
             transition$table[transition$table[,"active"]==T, "filter"])


        # update the search terms on the proxy table (see below)
        proxy %>% updateSearch(keywords =
                                 list(global = default_search, columns = default_search_columns))


      })

      output$table <- renderDT({

        # reorder columns 
        fileData <- fileData()[,sort(names(fileData()))]

        DT::datatable(fileData, filter = "top", 
                      options = list(stateSave = F
                      )
        )
      })
      # initialize proxy to transfer settings
      proxy <- dataTableProxy("table")


    }

    shinyApp(ui,server)