How to change the color of a cell in DT shiny if input matches a data frame?

Question

I am creating a companion app in Shiny for a language course I am participating in. I have included a wordlist via the DT package, a word cloud as a fun visualization, and a tab where one can generate a vocab quiz with both English and German words in the respective columns. The DT table is editable, and I would like it ti automatically check the user input, and turn the text to green if the input is correct (= if it matches the word in the other column in the appropriate row in the original data frame) and to red if the input is not correct. How would I go about achieving this, if it is possible at all?

Answer 1

I have a way using the JavaScript library CellEdit.

Download the file dataTables.cellEdit.js.

By default, the interface is not very stylish. To style it, copy the CSS code below and put it in a file dataTables.cellEdit.css, in the same folder as 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;
}

Now, here is the R code. Don't forget to change the path variable, and replace the JavaScript variable words with the list of your words to be matched.

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