R -shiny- DT：如何更新 col 过滤器

Question

我想使用 DT 来允许用户修改数据集。 但是，当因子 cols 更改（通过添加或删除因子级别）时，相应的表过滤器保持不变。 在以下示例中：如果我更改了一个 Species，新的 Species 不会出现在过滤器下拉列表中。 有解决方法吗？ 非常感谢！

library(shiny)
library(DT)

library(dplyr)

iris2=iris %>% group_by(Species)  %>% filter(Petal.Length==max(Petal.Length))

  

ui <- fluidPage(
  fluidRow(column(12, DTOutput("table"))
  )
)

server <- function(input, output, session) {
  output$table <- renderDT({
    
    DT::datatable(iris2, filter = "top", editable=T)
  })
}

shinyApp(ui, server)

Answer 1

您必须将更改反馈到 DT 数据中才能更新过滤器。 我通过创建一个 DT 读取的可变响应值来做到这一点。 下一步是监视表的更改并将这些更改推送到 reactiveVal。 对于一个因子来说有点棘手，因为您可能必须向列中添加一个新的因子级别。 另一个问题是编辑后的值可能与原来的 class 不一致，所以可以强制匹配。

library(shiny)
library(DT)
library(dplyr)

iris2=iris %>% group_by(Species)  %>% filter(Petal.Length==max(Petal.Length))

ui <- fluidPage(
  fluidRow(column(12, DTOutput("table")))
)

server <- function(input, output, session) {
  
  iris_rv <- reactiveVal(iris2)         # keep live iris2 table in this reactiveVal
  
  output$table <- renderDT({
    DT::datatable(iris_rv(), filter = "top", editable=T)
  })
  
  observeEvent(input$table_cell_edit, { # watch for edits
    req(input$table_cell_edit)
    
    iris_tmp <- iris_rv()               # transfer to simple variable for easier access
    old_val <- iris_tmp[input$table_cell_edit$row,input$table_cell_edit$col] %>% unlist()
    new_val <- input$table_cell_edit$value
    
    if (class(old_val) == "factor") {   # deal with new factor levels
      old_col <- iris_tmp %>% pull(input$table_cell_edit$col)
      new_col <- factor(old_col, levels = union(levels(old_col), new_val))
      iris_tmp[,input$table_cell_edit$col] <- new_col
    } else {                            # otherwise simply force new value to correct class
      class(new_val) <- class(old_val)
    }
    
    iris_tmp[input$table_cell_edit$row,input$table_cell_edit$col] <- new_val
    iris_rv(iris_tmp)                   # overwrite iris_rv with updated values
  })
}

shinyApp(ui, server)

Answer 2

使用reactiveValues让DT在更改时更新，我使用 validate 来确保正确提供数字， clean是魔法发生的地方，它检查列是否是一个factor ，如果是，检查值是否是一个级别，如果不是添加它。

library(DT)

iris2 = iris %>% group_by(Species)  %>% filter(Petal.Length==max(Petal.Length))
# get the classes of the columns
types <- sapply(iris2, class)

ui <- fluidPage(
  fluidRow(column(12, DTOutput("table"))
  )
)
types <- sapply(iris2, class)
server <- function(input, output, session) {
  proxy <- DT::dataTableProxy('table')
  RV <- reactiveValues(data = iris2)

  output$table = DT::renderDT({
    RV$data
  }, filter = "top", editable=T)

  observeEvent(input$table_cell_edit, {
    validate(
      need(check_coercibility(input$table_cell_edit$value, types[input$table_cell_edit$col]), "Please enter valid data")
    )
    RV$data <- clean(RV$data, input$table_cell_edit$value, input$table_cell_edit$row, input$table_cell_edit$col)
  }, ignoreInit = TRUE)

}
check_coercibility <- function(x, type){
    if(type == "numeric") {
        suppressWarnings(!is.na(as.numeric(x)))
    } else T
}
clean <- function(df, x, nrow, ncol, type=types[[ncol]]){
    col <- df[[ncol]]
    df[nrow, ncol] <- if(type=="factor"){
        if(! x %in% levels(col)) df[[ncol]] <- factor( col, levels=c(levels(col), x))
        x
    } else if(type=="numeric"){
        as.numeric(x)
    } else if(type=="logical"){
        as.logical(x)
    } else x
    df
}
shinyApp(ui, server)