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

Question

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


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 来做到这一点。下一步是观察 table 的变化并将这些变化推送到 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 在更改时更新，我使用验证来确保正确提供数字，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)

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

R -shiny- DT: how to update col filters

r

shiny

dt