R Shiny 动态 DT 数据表记住过滤器/排序

Question

I'm building a R Shiny app with a dynamic datatable, using the DT package. Users are able to select two columns within a data.frame that contains more columns.

When users select a column, the datatable is updated and all filters/sorting are reset to default within the datatable object. How can I let the application remember filters and sorting when the given column is not replaced by the user?

Minimal working example below:

library(shiny)
library(DT)
library(data.table)


server <- function(input, output) {

  df <- data.frame(
    name = rep('a',20),
    dimA = 1:20,
    dimB = 21:40,
    dimC = 41:60
  )

  observe({
    columns <- c('name', input$dim1ID, input$dim2ID)
    dfDt <- df[names(df) %in% columns]

    output$dtDataTable = DT::renderDataTable(
      server = FALSE,

      expr = datatable(
        dfDt,
        filter = 'top',
        rownames = FALSE,
        selection = 'none',
        options = list(sDom  = '<"top">rt<"bottom">ip')
      )
    )
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      ## Dimension 1
      selectInput(
        inputId = "dim1ID",
        label = "Dimensie 1",
        choices = c('dimA', 'dimB', 'dimC'),
        selected = 'dimA'
      ),
      ## Dimension 2      
      selectInput(
        inputId = "dim2ID",
        label = "Dimensie 2",
        choices = c('dimA', 'dimB', 'dimC'),
        selected = 'dimB'
      )
    ),
    mainPanel(DT::dataTableOutput('dtDataTable'))
  )
)

shinyApp(ui = ui, server = server)

Answer 1

This can be done using the DataTables Information , in particular the "state" information ( input$tableId_state ) which contains the order information of the current table, and input$tableId_search_columns which contains the filtering information by columns. If the columns are fixed (ie in the example above "Dimensie 1" and "Dimensie 2" would always be at the same place), it is much simpler to "remember" which one was ordered (unlike the original example where they are alphabetically reordered when the table is created). For instance based on the above example, the following will work if you sort the "A" column and change the right column from "B" to "C" and back:

library(shiny)
library(DT)
library(data.table)


server <- function(input, output) {
    
    df <- data.frame(
        name = rep('a',20),
        dimA = 1:20,
        dimB = 21:40,
        dimC = 41:60
    )
    
    values <- reactiveValues(
        prevDim1 = "",
        prevDim2 = "",
        options = list(sDom  = '<"top">rt<"bottom">ip',
                       stateSave = TRUE,
                       order = list())
    )
    
    observeEvent(input$dtDataTable_state$order, {
        values$options$order <- input$dtDataTable_state$order
    })
    
    observeEvent({
        input$dim1ID
        input$dim2ID
    },{
        columns <- c('name', input$dim1ID, input$dim2ID)
        dfDt <- df[names(df) %in% columns]
        
        if(length(values$options$order) != 0 && ((values$prevDim1 != input$dim1ID && values$options$order[[1]][[1]] == 1) | (values$prevDim2 != input$dim2ID && values$options$order[[1]][[1]] == 2)) ){
            values$options$order = list()
        }
        
        values$prevDim1 <- input$dim1ID
        values$prevDim2 <- input$dim2ID
        
        output$dtDataTable = DT::renderDataTable(
            server = FALSE,
            
            expr = datatable(
                dfDt,
                filter = 'top',
                rownames = FALSE,
                selection = 'none',
                options = values$options
            )
        )
    })
}

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            ## Dimension 1
            selectInput(
                inputId = "dim1ID",
                label = "Dimensie 1",
                choices = c('dimA', 'dimB', 'dimC'),
                selected = 'dimA'
            ),
            ## Dimension 2      
            selectInput(
                inputId = "dim2ID",
                label = "Dimensie 2",
                choices = c('dimA', 'dimB', 'dimC'),
                selected = 'dimB'
            )
        ),
        mainPanel(DT::dataTableOutput('dtDataTable'))
    )
)

shinyApp(ui = ui, server = server)