訪問在 R shiny 中使用 CellEdit 編輯的更新數據表

Question

我使用 CellEdit回調在 shiny 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

您必須使用回調 function 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)