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)