如何将Shiny中关联的矩阵对象移入模态对话框并保留原有功能

仅需调整两处代码即可实现需求，所有原有矩阵联动、图表响应式更新逻辑完全保留：

1. 删除UI侧边栏中原有的矩阵2输入控件定义
2. 将矩阵2输入控件整体移入点击按钮触发的模态对话框内部

完整可运行代码 #

library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)

sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      matrixInput("matrix1",
                  label ="矩阵1（场景1）:",
                  value = matrix(c(60,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
                  rows = list(extend = TRUE, delete = TRUE),
                  class = "numeric"),
      actionButton(inputId = "showMat2", "新增场景"),br(),br()
    ),
    mainPanel(plotOutput("plot"))
  )
)

server <- function(input, output, session){
  
  observeEvent(input$matrix1, {
    a <- apply(input$matrix2,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
    b <- apply(input$matrix1,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
    c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
    d <- ncol(input$matrix2)
    tmpMat2 <- matrix(c(c), ncol = d)
    colnames(tmpMat2) <- paste("场景",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))

    if(any(rownames(input$matrix1) == "")){
      tmpMat1 <- input$matrix1
      rownames(tmpMat1) <- paste("行", seq_len(nrow(input$matrix1)))
      updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
      }
    updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
  })
  
  observeEvent(input$matrix2, {
    if(any(colnames(input$matrix2) == "")){
      tmpMat2 <- input$matrix2
      colnames(tmpMat2) <- paste("场景",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
      updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
      }
    if(any(rownames(input$matrix2) == "")){
      tmpMat2 <- input$matrix2
      rownames(tmpMat2) <- paste("行", seq_len(nrow(input$matrix2)))
      updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
      }
    input$matrix2
  })
  
  observeEvent(input$showMat2,{
    showModal(
      modalDialog(
        h5("可直接在下方矩阵中输入新增场景参数，矩阵1的修改会自动同步到矩阵2最左侧两列作为场景1"),
        matrixInput("matrix2",
                    label = "矩阵2:",
                    value = matrix(c(60,5), ncol = 2, dimnames = list(NULL, rep("场景1", 2))),
                    rows = list(extend = TRUE, delete = TRUE),
                    cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
                    class = "numeric"),
        footer = tagList(modalButton("关闭"))
      ))
  })
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix2)/2), 
             function(i){
               tibble(
                 Scenario= colnames(input$matrix2)[i*2-1],X=seq_len(10),
                 Y=sumMat(input$matrix2[,(i*2-1):(i*2), drop = FALSE])
               )
             }) %>% bind_rows(),
      error = function(e) NULL
    )
  })
  
  output$plot <- renderPlot({
    req(plotData())
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
      theme(legend.title=element_blank())
  })
}

shinyApp(ui, server)

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