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

Question

下面的 MWE 代码在模态对话框内的 R Shiny 中生成一个可扩展矩阵（输入网格），供用户输入。操作按钮“修改”拉出用户可以修改的默认输入网格（更改默认值，add/delete 列等），“显示”和“隐藏”show/hide 最近更新的输入网格和“重置”returns 输入网格值到默认值。以上都很好。

但是，是否可以在矩阵可扩展的情况下自动生成矩阵列headers，比如在这个矩阵函数中？因此，例如，我有第一个默认列标记为“Series 1”。我希望添加的任何第二列自动标记为“系列 2”，第三列标记为“系列 3”等；用户可以选择 over-write 在 column-by-column 的基础上，因为它当前在 shinyMatrix 中设置。

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

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

解决如下：

在服务器部分添加了输入“矩阵”的反应函数
在服务器部分，使用observe函数观察输入矩阵的变化
在 observe 函数内，更改 input$matrix

colnames

用 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 问题的回答，这让我走上了这个解决方案的道路！

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

How to automatically generate sequential column headers for an expandable matrix in R Shiny?

r

shiny

shiny-reactivity

shinyjs