如何在R Shiny中通过Observe Event等响应式函数修改表格列标题

解决方法 #

你要的效果只需要修改renderTable返回矩阵前的处理逻辑即可，核心是在输出表格前，给当前的矩阵动态设置列名，和你在R控制台写的修改逻辑完全一致，直接放到响应式表达式里就能生效。

需要修改的核心代码段是output$table1的定义，修改后如下：

output$table1 <- renderTable({
  req(input$matrix)
  # 取当前输入的矩阵
  current_mat <- input$matrix
  # 按列数动态生成列名
  colnames(current_mat) <- paste0("Series ", seq_len(ncol(current_mat)))
  # 同步更新响应式变量，保证其他用到rv$input的地方也同步列名
  rv$mat <- matrix3Input("matrix", input$matrix)
  rv$input <- current_mat
  # 返回修改完列名的矩阵用于渲染表格
  current_mat
}, rownames = TRUE, colnames = TRUE)

如果需要保留用户手动修改矩阵组件的列名，只需要调整逻辑判断是否使用自定义列名即可，按你现在需要自动生成顺序Series X的需求，上述代码直接替换即可生效。

完整可运行的修改后代码如下：

library(shiny)
library(shinyMatrix)
library(shinyjs)

default_mat <- matrix(c(1,24,0,1),4,1,dimnames=list(c("A","B","C","D"),paste0("Series ", 1:1)))

colnames(default_mat) <- paste0("Series ", 1:ncol(default_mat))

matrix3Input <- function(x, default_mat){
  matrixInput(x, 
              label = 'Series terms:',
              value = default_mat, 
              rows = list(extend = FALSE,names = TRUE), 
              cols = list(extend = TRUE,names = TRUE,editableNames = TRUE,delete = TRUE),
              class = "numeric") 
} 

ui <- fluidPage(
  useShinyjs(),
  titlePanel("Inputs"),
  fluidRow(actionButton("modify","Modify"),
           actionButton("show","Show"),
           actionButton("hide","Hide"),
           actionButton("reset","Reset"),
           tableOutput("table2")
  ) 
) 

server <- function(input, output, session){
  
  rv <- reactiveValues(mat = matrix3Input("matrix", default_mat), 
                       input = default_mat,
                       colHeader = colnames(input)
  ) 
  
  hide("table2")
  
  observeEvent(input$modify,{
    showModal(modalDialog(
      rv$mat,
      tableOutput("table1"))
    ) 
    hide("table2")
  }) 
  
  # 修改后的table1渲染逻辑
  output$table1 <- renderTable({
    req(input$matrix)
    current_mat <- input$matrix
    colnames(current_mat) <- paste0("Series ", seq_len(ncol(current_mat)))
    rv$mat <- matrix3Input("matrix", input$matrix)
    rv$input <- current_mat
    current_mat
  }, rownames = TRUE, colnames = TRUE)
  
  observeEvent(input$show,{show("table2")})
  
  observeEvent(input$hide, hide("table2"))
  
  observeEvent(input$reset,{
    hide("table2")
    rv$input <- default_mat
    rv$mat <- matrix3Input("matrix", default_mat)
  }) 
  
  output$table2 <- renderTable({
    rv$input
  }, rownames = TRUE)
  
} 

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Curious Jorge - user9788072