R Shiny动态DT Datatable记住过滤/排序

时间:2017-09-05 10:16:00

标签: r datatable shiny

我正在使用R Shiny包构建一个带有动态数据表的DT应用。用户可以在包含更多列的data.frame中选择两列。

当用户选择列时,数据表将更新,并且所有过滤器/排序将在datatable对象中重置为默认值。当给定列未被用户替换时,如何让应用程序记住过滤器和排序?

下面的最小工作示例:

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)

1 个答案:

答案 0 :(得分:0)

可以使用DataTables Information,特别是包含当前表顺序信息的“状态”信息(input$tableId_state)和包含过滤信息的input$tableId_search_columns完成此操作按列。如果列是固定的(即在上面的示例中,“ Dimensie 1”和“ Dimensie 2”将始终位于同一位置),则“记住”排序的顺序要简单得多(与原始示例按字母顺序排列不同)创建表后重新排序)。例如,基于上面的示例,如果您对“ A”列进行排序并将右列从“ B”更改为“ C”并返回,则以下内容将起作用:

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)