如果輸入與數據框匹配，如何更改 DT 閃亮中單元格的顏色？

Question

我正在為我正在參加的語言課程在 Shiny 中創建一個配套應用程序。我通過 DT 包包含了一個詞表、一個作為有趣可視化的詞雲，以及一個可以生成英語和德語詞匯測驗的選項卡相應列中的單詞。 DT 表是可編輯的，我希望它自動檢查用戶輸入，如果輸入正確，則將文本變為綠色（= 如果它與原始數據框中相應行的另一列中的單詞匹配）如果輸入不正確，則變為紅色。 如果可能的話，我將如何實現這一目標？

Answer 1

我有一種使用 JavaScript 庫CellEdit的方法。

下載文件dataTables.cellEdit.js 。

默認情況下，界面不是很時尚。 要設置樣式，請復制下面的 CSS 代碼並將其放入文件dataTables.cellEdit.css中，與dataTables.cellEdit.js位於同一文件夾中。

.my-input-class {
  padding: 3px 6px;
  border: 1px solid #ccc;
  border-radius: 4px;
}

.my-confirm-class {
  padding: 3px 6px;
  font-size: 12px;
  color: white;
  text-align: center;
  vertical-align: middle;
  border-radius: 4px;
  background-color: #337ab7;
  text-decoration: none;
}

.my-cancel-class {
  padding: 3px 6px;
  font-size: 12px;
  color: white;
  text-align: center;
  vertical-align: middle;
  border-radius: 4px;
  background-color: #a94442;
  text-decoration: none;
}

現在，這里是 R 代碼。 不要忘記更改path變量，並將 JavaScript 變量words替換為要匹配的單詞列表。

library(DT)

dat <- data.frame(
  X = c("Edit me", "Edit me", "Edit me"),
  Y = c("a", "b", "c")
)

callback = JS(
  "var words = ['hello', 'goodbye', 'cat'];", # words to be matched
  "function onUpdate(updatedCell, updatedRow, oldValue){",
  "  var $td = $(updatedCell.node());",
  "  var text = updatedCell.data();",
  "  if(words.indexOf(text) > - 1){",
  "    $td.css('background-color', '#98FB98');",
  "  }else{",
  "    $td.css('background-color', '#FF6347');",
  "  }",
  "}",
  "table.MakeCellsEditable({",
  "  onUpdate: onUpdate,",
  "  inputCss: 'my-input-class',",
  "  confirmationButton: {",
  "    confirmCss: 'my-confirm-class',",
  "    cancelCss: 'my-cancel-class'",
  "  },",
  "  columns: [1]",
  "});")

## the datatable
dtable <- datatable(
  dat, callback = callback, rownames = TRUE, 
  options = list(
    columnDefs = list(
      list(targets = "_all", className = "dt-center")
    )
  )
)
path <- "C:/SL/R/DT" # 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"
)
dtable[["dependencies"]] <- c(dtable[["dependencies"]], list(dep))
dtable