如何在R Shiny仪表盘的数据表每行添加可追踪文本框？

要实现DT数据表每行文本框的输入追踪，核心是给每个文本框绑定触发事件，把输入内容和对应行的标识一起传递给Shiny服务器。以下是修改后的完整代码：

library(shiny)
library(DT)

shinyApp(
    ui <- fluidPage(
        DT::dataTableOutput("data"),
        textOutput('textInputStatus')
    ),
    
    server <- function(input, output) {
        # 存储每行文本框的输入内容
        textInputs <- reactiveValues(data = list())
        
        shinyInput <- function(FUN, len, id, ...) {
            inputs <- character(len)
            for (i in seq_len(len)) {
                if(FUN == textInput){
                    # 给文本框添加oninput事件，传递ID和输入值
                    inputs[i] <- as.character(FUN(paste0(id, i), ..., 
                        oninput = 'Shiny.onInputChange("text_input", {id: this.id, value: this.value})'))
                } else {
                    inputs[i] <- as.character(FUN(paste0(id, i), ...))
                }
            }
            inputs
        }
        
        df <- reactiveValues(data = data.frame(
            Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
            Motivation = c(62, 73, 3, 99, 52),
            Actions = shinyInput(actionButton, 5, 'button_', label = "Fire", 
                onclick = 'Shiny.onInputChange("select_button",  this.id)' ),
            TextInput = shinyInput(textInput, 5, 'text_', label = "", value = "" ),
            stringsAsFactors = FALSE,
            row.names = 1:5
        ))
        
        output$data <- DT::renderDataTable(
            df$data, server = FALSE, escape = FALSE, selection = 'none',
            # 调整列宽，避免文本框被挤压
            options = list(columnDefs = list(list(width = '150px', targets = 3)))
        )
        
        # 监听按钮点击（保留原有功能）
        observeEvent(input$select_button, {
            selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
            showNotification(paste("已触发对", df$data[selectedRow, 1], "的操作"))
        })
        
        # 监听文本框输入
        observeEvent(input$text_input, {
            # 解析行号
            rowNum <- as.numeric(strsplit(input$text_input$id, "_")[[1]][2])
            # 存储对应行的输入内容
            textInputs$data[[rowNum]] <- input$text_input$value
            # 也可以直接更新数据表中的值（可选）
            # df$data[rowNum, "TextInputValue"] <- input$text_input$value
        })
        
        # 展示文本框输入状态
        output$textInputStatus <- renderText({
            inputRows <- names(textInputs$data)
            if(length(inputRows) == 0){
                "暂无文本输入"
            } else {
                paste0("已输入内容的行：", 
                    paste(sapply(inputRows, function(row){
                        paste(df$data[row, 1], "：", textInputs$data[[row]])
                    }), collapse = "；"))
            }
        })
    }
)

关键改动说明： #

• 给文本框添加oninput事件：在生成textInput时，通过oninput属性调用Shiny.onInputChange，将文本框的ID和当前输入值以对象形式传递给服务器端的input$text_input
• 解析行号和输入值：在observeEvent(input$text_input)中，通过拆分文本框ID获取对应行号，同时提取输入值
• 存储输入内容：用reactiveValues存储每行的输入值，方便后续在其他模块中调用；也可以直接更新数据表的对应列
• 优化显示：调整DT列宽避免文本框被挤压，同时添加文本输出展示输入状态

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