如何为 R Shiny 中的可扩展矩阵自动生成顺序列标题？

Question

下面的 MWE 代码在模式对话框内的 R Shiny 中生成一个可扩展矩阵（输入网格），用于用户输入。操作按钮“修改”拉出用户可以修改的默认输入网格（更改默认值，添加/删除列等），“显示”和“隐藏”显示/隐藏最近更新的输入网格，以及“重置” " 将输入网格值返回为默认值。以上都很好用。

但是，当矩阵可扩展时，例如在这个矩阵函数中，是否可以自动生成矩阵列标题？例如，我有第一个默认列标记为“系列 1”。我想要添加的任何第二列自动标记为“系列 2”，第三列标记为“系列 3”等；用户可以选择逐列覆盖，因为它当前在 shinyMatrix 中设置。

您将在下面看到代码行colnames(default_mat) <- paste0("Series ", 1:ncol(default_mat))，它用于为第一个默认列生成列标题。我一直在尝试将其用于代码的反应部分，以便自动为其他列生成标题，但还没有运气。用户应该能够覆盖这个默认的自动标题。

MWE 代码：

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

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

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") # close matrix input
} # close function

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

server <- function(input, output, session){
  
  rv <- reactiveValues(mat = matrix3Input("matrix", default_mat), 
                       input = default_mat,
                       name = colnames(default_mat)
        ) # close reactive values
  
  hide("table2")
  
  observeEvent(input$modify,{
    showModal(modalDialog(
      rv$mat,
      tableOutput("table1"))
    )
    hide("table2")
  })
  
  output$table1 <- renderTable({
    rv$mat <- matrix3Input("matrix", input$matrix)
    rv$input <- input$matrix
    input$matrix
  }, rownames = 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)
  }) # close observe event
  
  output$table2 <- renderTable({
    rv$input
  }, rownames = TRUE)
  
} # close server

shinyApp(ui, server)

Answer 1

解决如下：

1. 在服务器部分为输入“矩阵”添加了一个反应函数
2. 在服务器部分，使用observe 函数观察输入矩阵的变化
3. 在observe函数内部，改变input$matrix给出的输入矩阵的colnames
4. 使用updateMatrixInput 将更新后的矩阵发送回 UI。使用isolate 函数来避免无休止的更改和刷新循环

修改后的 MWE 反映了解决方案，对原始 MWE 的更改如下所示，标有 # << ADDED...、# << DELETED... 和类似符号：

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

default_mat <- matrix(c(1,24,0,1),4,1,dimnames=list(c("A","B","C","D"),c(1))) # << ADDED c(1)
# colnames(default_mat)... << DELETED this function that appeared in original MWE

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") # close matrix input
}

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){
  
  matrix  <- reactive(input$matrix) # << ADDED REACTIVE FOR "matrix"
  rv      <- reactiveValues(mat = matrix3Input("matrix", default_mat), input = default_mat) 
  
  hide("table2")
  
  observeEvent(input$modify,{
    showModal(modalDialog(
      rv$mat,
      tableOutput("table1"))
    )
    hide("table2")
  })
  
  # ADDED BELOW "OBSERVE", LINKs TO MATRIX INPUT >>
    observe({
      req(matrix())
      mm <- input$matrix
      colnames(mm) <- 1:ncol(mm)
      isolate(updateMatrixInput(session, "matrix", mm))
    })
  
  output$table1 <- renderTable({
    rv$mat <- matrix3Input("matrix", input$matrix)
    rv$input <- input$matrix
    input$matrix
  }, rownames = 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)

感谢 Jan 于 2021 年 9 月 29 日发布了对类似且简化的 CuriousJorge 问题的回答，这让我走上了这个解决方案的道路！