在Shiny应用的DT::datatable中实现行添加、删除与编辑功能

问题说明 #

你当前编辑功能未生效的核心原因是：编辑逻辑修改的是rv$df变量，但表格渲染依赖的是独立的data()响应式值，两个数据源没有同步。

修改后完整代码 #

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(tibble)
library(purrr) # 新增，用于walk2遍历赋值

Input <- structure(list(`Security Type` = c("Stock", "Stock", "Load Fund"), Ticker = c("XOM", "NFLX", "AMCPX"), `Purchase Date` = structure(c(
  16070,
  17084, 17084
), class = "Date"), `Sale Date` = structure(c(
  18627,
  NA, 18545
), class = "Date"), `Amount Invested` = c(
  "$10,000",
  "$8,000", "$10,000"
)), class = c(
  "spec_tbl_df", "tbl_df", "tbl",
  "data.frame"
), row.names = c(NA, -3L))

shinyApp(
  ui = tags$body(class = "skin-blue sidebar-mini control-sidebar-open", dashboardPage(
    options = list(sidebarExpandOnHover = TRUE),
    header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading", titleWidth = 450),
    sidebar = dashboardSidebar(
      minified = F, collapsed = F,
      selectInput(
        "sectype", "Security Type",
        c(unique(Input$`Security Type`))
      ),
      selectInput(
        "sectick", "Ticker",
        c(unique(Input$Ticker))
      ),
      dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
      dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
      selectInput(
        "aminv", "Amount Invested",
        c(unique(Input$`Amount Invested`))
      ),
      actionButton("add", "Add"),
      actionButton("edit", "Edit"),
      actionButton("deleteRows", "Delete Rows")
    ),
    body = dashboardBody(
      h3("Results"),
      tabsetPanel(
        id = "tabs",
        tabPanel(
          "InsiderTraining",
          dataTableOutput("TBL1")
        )
      )
    ),
    controlbar = dashboardControlbar(width = 300),
    title = "DashboardPage"
  )),
  server = function(input, output, session) { # 新增session参数，用于更新输入控件
    # 统一用data存储表格数据，删除冗余的rv变量
    data <- reactiveVal(Input)
    
    # 新增：选中行时自动将行数据填充到左侧输入控件
    observeEvent(input$TBL1_rows_selected, {
      selected_row <- input$TBL1_rows_selected
      if (!is.null(selected_row)) {
        current_data <- data()
        updateSelectInput(session, "sectype", selected = current_data[["Security Type"]][selected_row])
        updateSelectInput(session, "sectick", selected = current_data$Ticker[selected_row])
        updateDateInput(session, "PurDate", value = current_data[["Purchase Date"]][selected_row])
        updateDateInput(session, "selDate", value = current_data[["Sale Date"]][selected_row])
        updateSelectInput(session, "aminv", selected = current_data[["Amount Invested"]][selected_row])
      }
    })
    
    observeEvent(input$add, {
      data() %>%
        add_row(
          `Security Type` = isolate(input$sectype),
          Ticker = isolate(input$sectick),
          `Purchase Date` = isolate(input$PurDate),
          `Sale Date` = isolate(input$selDate),
          `Amount Invested` = isolate(input$aminv)
        ) %>%
        data()
    })
    
    observeEvent(input$deleteRows, {
      if (!is.null(input$TBL1_rows_selected)) {
        data(data()[-as.numeric(input$TBL1_rows_selected), ])
      }
    })
    
    # 重写Edit按钮逻辑，直接更新统一数据源data
    observeEvent(input$edit, {
      selected_row <- input$TBL1_rows_selected
      if (!is.null(selected_row)) {
        current_data <- data()
        cols_input <- c('sectype', 'sectick', 'PurDate', 'selDate', 'aminv')
        cols_table <- c('Security Type', 'Ticker', 'Purchase Date', 'Sale Date', 'Amount Invested')
        
        walk2(cols_input, cols_table, ~{
          current_data[selected_row, .y] <- input[[.x]]
        })
        data(current_data)
      }
    })
    
    output$TBL1 <- renderDataTable(
      data(),
      selection = "single",
      rownames = FALSE
    )
  }
)

功能验证 #

• 选中表格任意行，左侧输入控件会自动填充该行的对应值
• 修改左侧控件取值后点击Edit按钮，选中行的对应列数据会同步更新
• 原有Add、Delete功能可正常使用

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