R Shiny如何捕获模态框内DataTable的编辑事件并同步更新数据

问题核心原因 #

你的代码核心错误是把renderDataTable、renderPlot这类服务端渲染函数写在了模态框的UI定义逻辑里，Shiny的UI侧只能定义输出占位符，渲染逻辑必须放在server端才会生效，这就是你模态框内表格的编辑事件捕获不到的原因。

具体修改点 #

• 把模态框里的outTable渲染逻辑、图表渲染逻辑从dataModal函数中移到server主逻辑里
• 删除给数据加ns()的错误写法，ns()仅用于给输入输出ID加命名空间，不需要作用于数据对象
• 移除冗余的isolate和全局赋值符<<-，reactiveValues的属性直接在server环境下赋值即可生效
• 修正UI层多余的options参数写法

修复后完整可运行代码 #

# 加载依赖库
library(shiny)
library(DT)
library(ggplot2)

# 模拟数据
x = c(5.0, 15.0, 20.0, 25.0, 30.0)
y = c(0.2, 1.0,  1.0, 0.3, 0.1)

# UI定义
ui = fluidPage(
  fluidRow(
    column(width = 6,
      DT::dataTableOutput("tblData")
    ),
    column(width=6,
      actionButton("show", "Show", icon('chart-line'))
    )
  )
)

# 服务端逻辑
server = function(input, output, session) {
  ns <- session$ns
  # 初始化响应式数据
  myData <- data.frame(x,y)
  df <- reactiveValues(myData = myData)
  
  # 渲染主页面表格
  output$tblData <- DT::renderDataTable(df$myData,
                                        editable = TRUE,
                                        rownames = FALSE,
                                        options = list(
                                          autoWidth = TRUE,
                                          columnDefs = list(list(width = '100px', targets = "_all"))))
  
  # 模态框UI定义，仅保留占位符
  dataModal <- function(ns) {
    modalDialog(
      fluidRow(
        column(width=6,
               DT::dataTableOutput(ns("outTable"))
        ),
        column(width=6,
               plotOutput(ns("modalPlot"))
        )
      ),
      footer = tagList(
        actionButton("ok", "OK")
      ),
      title = "Graphical presentation",
      easyClose = FALSE
    )
  }
  
  # 渲染模态框内表格
  output$outTable <- DT::renderDataTable(df$myData,
                                          rownames = FALSE,
                                          editable = TRUE,
                                          options = list(
                                            autoWidth = FALSE,
                                            columnDefs = list(list(width = '100px', targets = "_all"))))
  
  # 渲染模态框内图表
  output$modalPlot <- renderPlot({
    ggplot(df$myData, aes(x=x,y=y)) + 
      geom_point(colour="red") +
      geom_line(linetype = "solid", colour="red")
  })
  
  # 点击按钮弹出模态框
  observeEvent(input$show, {
    showModal(dataModal(session$ns))
  })
  
  # 监听主页面表格编辑事件
  observeEvent(input$tblData_cell_edit, {
    info = input$tblData_cell_edit
    i = info$row
    j = info$col + 1 # 因为rownames=FALSE，列索引从0开始，要加1匹配R的列索引
    k = info$value
    df$myData[i, j] <- DT::coerceValue(k, df$myData[i, j])
  })
  
  # 监听模态框内表格编辑事件
  observeEvent(input$outTable_cell_edit, {
    info = input$outTable_cell_edit
    i = info$row
    j = info$col + 1
    k = info$value
    df$myData[i, j] <- DT::coerceValue(k, df$myData[i, j])
  })
  
  # 点击OK关闭模态框
  observeEvent(input$ok, {
    removeModal()
  })
  
}

# 运行应用
shinyApp(ui, server)

效果验证 #

修改后无论是编辑主页面表格还是模态框内的表格，都会同步更新响应式数据df$myData，两个表格和模态框内的图表都会自动同步变更。

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