如何在Shiny的DT中让可编辑单元格默认显示为输入框

问题背景 #

开发了一款搭载DataTable的Shiny应用，支持查看产品利润（Margin），并允许编辑买入价（Buying Price）和卖出价（Selling Price）以重新计算利润。当前可编辑列需双击才进入编辑状态，希望这些列在应用启动时直接显示输入框样式，明确告知用户可编辑：

• 期望效果：启动后"Buying Price"和"Selling Price"列直接显示输入框，可直接输入修改
• 当前效果：所有单元格默认显示普通文本，需双击触发编辑

实现方案 #

通过DT的自定义渲染功能，将目标列直接渲染为<input>元素，同时适配键盘快捷键逻辑，确保输入框的编辑、导航功能正常运行。

修改后的完整代码 #

# 加载依赖库
library(shiny)
library(bslib)
library(tidyverse)
library(DT)
library(shinyjs)

# 键盘快捷键适配JS：支持输入框箭头导航、回车确认
js <- c(
  "table.on('keydown', function(e){",
  "  var keys = [9,13,37,38,39,40];",
  "  if(e.target.localName === 'input'){",
  "    if(e.keyCode === 13){",
  "      $(e.target).trigger('blur');",
  "    } else if([37,38,39,40].indexOf(e.keyCode) > -1){",
  "      e.preventDefault();",
  "      var cell = table.cell(e.target.parentElement);",
  "      var dir = '';",
  "      switch(e.keyCode){",
  "        case 37: dir = 'left'; break;",
  "        case 38: dir = 'up'; break;",
  "        case 39: dir = 'right'; break;",
  "        case 40: dir = 'down'; break;",
  "      }",
  "      var nextCell = cell[dir]();",
  "      if(nextCell.length){",
  "        nextCell.node().querySelector('input').focus();",
  "        nextCell.node().querySelector('input').select();",
  "      }",
  "    }",
  "  }",
  "});",
  # 初始化自动聚焦第一个输入框（可选）
  "table.on('init', function(){",
  "  table.cell(0, 2).node().querySelector('input').focus();",
  "});"
)

modServ_EdiTable <- function(id, data_initialisation) {
  moduleServer(id, function(input, output, session) {
    # 初始化响应式数据对象
    data <- reactiveVal()
    observe(data(data_initialisation()))
    
    # 渲染自定义输入框样式的DataTable
    output$dummyDT <- renderDT({
      datatable(
        data(),
        selection = 'none', 
        editable = FALSE, # 关闭默认双击编辑，避免冲突
        callback = JS(js),
        extensions = 'KeyTable',
        options = list(
          keys = TRUE,
          columnDefs = list(
            # 针对第2、3列（Buying Price、Selling Price）渲染输入框
            list(
              targets = c(2,3),
              render = JS(
                "function(data, type, row){",
                "  if(type === 'display'){",
                "    return '<input type=\"number\" step=\"0.1\" value=\"' + data + '\" class=\"editable-input\">';",
                "  }",
                "  return data;",
                "}"
              )
            )
          )
        )
      )
    }, server = FALSE) # 必须设置为客户端渲染，否则无法捕获输入框事件
    
    # 首次加载后监听输入框变化
    observeEvent(input$dummyDT_cell_clicked, {
      session$sendCustomMessage("listenInputChanges", list(id = session$ns("dummyDT")))
    }, once = TRUE)
    
    # 接收前端输入变化，更新数据并重新计算Margin
    observeEvent(input$inputChanged, {
      new_data <- data()
      row_idx <- input$inputChanged$row + 1 # DT行索引从0开始，R从1开始
      col_name <- if(input$inputChanged$col == 2) "Buying Price" else "Selling Price"
      new_data[row_idx, col_name] <- as.numeric(input$inputChanged$value)
      # 重新计算利润
      new_data <- new_data %>% mutate(Margin = round(`Selling Price` - `Buying Price`, 2))
      data(new_data)
    })
  })
}

server <- function(input, output, session) {
  # 生成示例数据
  dummyData <- reactive({
    tibble(
      Material = c("Lead", "Tin", "Iron", "Copper", "Mercury", "Silver", "Gold"),
      `Buying Price` = c(12.2, 10.3, 8, 5.6, 7.5, 22.9, 50),
      `Selling Price` = c(18, 15, 12, 10, 11, 40, 100),
      Margin = round(`Selling Price` - `Buying Price`, 2)
    )
  })
  
  # 调用数据表模块
  modServ_EdiTable("dummyId", data_initialisation = dummyData)
  
  # 注册自定义消息，监听输入框的change/blur事件
  session$onMessage("listenInputChanges", function(message) {
    runjs(paste0(
      "$('#", message$id, " .editable-input').on('change blur', function(){",
      "  var cell = $('#", message$id, "').DataTable().cell($(this).parent());",
      "  Shiny.setInputValue('", session$ns("inputChanged"), "', {",
      "    row: cell.index().row,",
      "    col: cell.index().column,",
      "    value: $(this).val()",
      "  });",
      "});"
    ))
  })
  
  session$onSessionEnded(function() {stopApp()})
}

modUI_EdiTable <- function(id) {
  ns <- NS(id)
  card(DTOutput(ns("dummyDT")))
}

ui <- page_navbar(
  nav_panel(title = "dummyPanel", modUI_EdiTable(id = "dummyId")),
  useShinyjs() # 加载shinyjs支持自定义JS执行
)

shinyApp(ui, server)

核心修改说明 #

1. 自定义单元格渲染：通过columnDefs的render函数，将目标列渲染为数值输入框，设置step="0.1"保证输入精度。
2. 关闭默认编辑机制：将editable设为FALSE，避免默认双击编辑与自定义输入框冲突。
3. 适配键盘操作：重写JS逻辑，支持输入框间通过箭头键切换、回车确认输入，保持操作流畅性。
4. 实时数据更新：通过shinyjs监听输入框的change和blur事件，实时同步输入值到后台数据，并重新计算利润。

内容的提问来源于stack exchange，提问作者EnisKarra