是否可以限制Shiny中可编辑数据表中可以使用的值？

Question

我在 Shiny 中有一个可编辑的数据表。表中有一列包含用户可以编辑的数值。这工作正常，我发现了很多关于如何限制可以编辑哪些行/列的信息（在下面的示例中未使用）。

我遇到的问题是我需要一种方法来限制用户可以输入可编辑单元格的值。例如，当表的数据最初上传时，第一列中的所有值都是 10^x 的某个值（即 1、10、100、1000 等）。我需要能够限制单元格的值，以便当用户单击可编辑单元格中的向上或向下箭头时，它会保持该限制。在下面的示例中，当第 1 列中的原始值为 10 时，如果我单击箭头上或下，数字将分别更改为 11 或 9。显然，这是预期的，但我需要一种方法来强制将值更改为 1 或 100。

这可能吗？我无法找到有关此主题的任何问题或示例。预先感谢。

闪亮应用程序示例：

library(shiny)
library(DT)
ui <- fluidPage(
  basicPage(
    DT::dataTableOutput("table")
  )
)
server <- function(input, output, session) {
  
  df <- data.frame(val1 = c(10,100,1000),
                   val2 = c(4,5,6))
  
  output$table <- DT::renderDT(
    df,
    rownames = FALSE,
    editable = list(target = "cell"),
  )
}
shinyApp(ui, server)

Answer 1

正如我在评论中所说，内置数字编辑不可能做到这一点。但是有一个使用 Javascript 插件CellEdit的解决方案。我假设您希望允许有限数量的选择，例如 1、10、100、1000、10000。然后使用 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;
}

现在，这是应用程序的代码：

library(shiny)
library(DT)

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

callback = JS(
  "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: 1,     display: '1'},",
  "        {value: 10,    display: '10'},",
  "        {value: 100,   display: '100'},",
  "        {value: 1000,  display: '1000'},",
  "        {value: 10000, display: '10000'}",
  "      ]",
  "    }",
  "  ]",
  "});"
)

path <- path.expand("www") # the folder containing '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
)

# Shiny app
ui <- fluidPage(
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session) {
  
  output[["dtable"]] <- renderDT({
    dtable <- datatable(
      dat, callback = callback, rownames = FALSE, selection = "none",
      options = list(
        columnDefs = list(
          list(targets = "_all", className = "dt-center")
        )
      )
    )
    dtable$dependencies <- c(dtable$dependencies, list(dep))
    dtable
  }, server = FALSE)  
  
}

shinyApp(ui, server)