使用 R shiny 中的 Cell Edit 访问更新数据表编辑

Question

我使用 CellEdit callback 在我闪亮的 DataTable 中创建了下拉选择器。到目前为止，我无法通过使事件 table_cell_edit 起作用来检索更新的值。我已经花了几个小时没有成功，有人可以帮忙吗？我对javascript不是很熟悉，也不知道问题出在哪里

这是我使用的代码：

之前ui/server

callback = JS(
  "function onUpdate(updatedCell, updatedRow, oldValue){}",
  "table.MakeCellsEditable({",
  "  onUpdate: onUpdate,",
  "  inputCss: 'my-input-class',",
  "  columns : [0,1,2,3],",
  "  confirmationButton: {",
  "    confirmCss: 'my-confirm-class',",
  "    cancelCss: 'my-cancel-class'",
  "  },",
  "  inputTypes: [",
  "    {",
  "      column: 0,",
  "      type: 'list',",
  "      options: [",
  "        {value: ' ', display: ' '},",
  "        {value: 'yes',      display: 'yes'},",
  "        {value: 'no',    display: 'no'}",
  "      ]",
  "    },",
  "    {",
  "      column: 2,",
  "      type: 'list',",
  "      options: [",
  "        {value: ' ', display: ' '},",
  "        {value: 'yes',      display: 'yes'},",
  "        {value: 'no',    display: 'no'}",
  "      ]",
  "    }",
  "  ]",
  "});")

path <- file.path("./src/app/") # folder containing the files dataTables.cellEdit.js
# and dataTables.cellEdit.css
dep <- htmltools::htmlDependency(
  "CellEdit", "1.0.19", path, 
  script = "dataTables.cellEdit.js", stylesheet = "dataTables.cellEdit.css")

服务器：

output$table <- DT::renderDT({
  dtable <- DT::datatable(
    reactivedf(),
    container = sketch,
    filter="top",
    extensions = c("Buttons","FixedHeader","Scroller"),
    rownames=FALSE,
    options = list(#dom = 'Bfrtip',
      pageLength = nrow(reactivedf()),
      columnDefs = list(
        list(targets = "_all", className = "dt-center")),
      scroller=TRUE,
      scrollX=TRUE,
      scrollY="500px"
    ),
    editable = list(target = 'cell', disable = list(columns = c(4:31))),
    callback = JS(callback), 
    selection='none'
  )

  dtable$dependencies <- c(dtable$dependencies, list(dep))

  dtable
}, server=F)


observeEvent(input$table_cell_edit, {
  print("let's try")
  new_df <- reactivedf()
  row <- input$table_cell_edit$row
  col <- input$table_cell_edit$col
  value <- as.numeric(input$table_cell_edit$value)
  new_df[row, col] <- value
  reactivedf(new_df)
})

Answer 1

你必须使用回调函数onUpdate。

首先，获取数据表的id：

  "var tbl = $(table.table().node());",
  "var id = tbl.closest('.datatables').attr('id');",

然后：

  "function onUpdate(updatedCell, updatedRow, oldValue) {",
  "  var cellinfo = [{",
  "    row: updatedCell.index().row + 1,",
  "    col: updatedCell.index().column + 1,",
  "    value: updatedCell.data()",
  "  }];",
  "  Shiny.setInputValue(id + '_cell_edit:DT.cellInfo', cellinfo);",
  "}",

这是一个完整的最小示例：

library(shiny)
library(DT)

callback <- c(
  "var tbl = $(table.table().node());",
  "var id = tbl.closest('.datatables').attr('id');",
  "function onUpdate(updatedCell, updatedRow, oldValue) {",
  "  var cellinfo = [{",
  "    row: updatedCell.index().row + 1,",
  "    col: updatedCell.index().column + 1,",
  "    value: updatedCell.data()",
  "  }];",
  "  Shiny.setInputValue(id + '_cell_edit:DT.cellInfo', cellinfo);",
  "}",
  "table.MakeCellsEditable({",
  "  onUpdate: onUpdate,",
  "  inputCss: 'my-input-class',",
  "  confirmationButton: {",
  "    confirmCss: 'my-confirm-class',",
  "    cancelCss: 'my-cancel-class'",
  "  },",
  "  inputTypes: [",
  "    {",
  "      column: 0,",
  "      type: 'list',",
  "      options: [",
  "        {value: 'Keep data', display: 'Keep data'},",
  "        {value: 'Pass', display: 'Pass'},",
  "        {value: 'Delete', display: 'Delete'}",
  "      ]",
  "    }",
  "  ]",
  "});"
)

ui <- fluidPage(
  br(),
  DTOutput("dt"),
  br(),
  verbatimTextOutput("editedCell")
)

server <- function(input, output, session){
  
  dat <- data.frame(
    Action = c("Keep data", "Pass", "Delete"),
    X = c(1, 2, 3),
    Y = c("a", "b", "c")
  )
  
  output[["dt"]] <- renderDT({
    dtable <- datatable(dat, 
                        rownames = FALSE,
                        selection = "none",
                        callback = JS(callback)
    )
    path <- path.expand("www") # folder containing the files dataTables.cellEdit.js
                               # and dataTables.cellEdit.css
    dep <- htmltools::htmlDependency(
      "CellEdit", "1.0.19", path, 
      script = "dataTables.cellEdit.js", stylesheet = "dataTables.cellEdit.css", 
      all_files = FALSE)
    dtable$dependencies <- c(dtable$dependencies, list(dep))
    dtable
  }, server = FALSE)
  
  output[["editedCell"]] <- renderPrint({
    input[["dt_cell_edit"]]
  })  
}

shinyApp(ui, server)

使用 R shiny 中的 Cell Edit 访问更新数据表编辑

Access updated DataTable edited with CellEdit in R shiny

javascript

r

shiny

dropdown

dt