R Shiny中如何实现模态对话框内用户输入的响应式重置

问题根因 #

• 模态框内矩阵点击重置无响应：模态框弹出时是静态渲染当前的rv$mat3对象，后续修改rv$mat3不会触发已弹出模态框的内容重绘，需要调用updateMatrixInput()直接更新已渲染的输入控件
• 主面板表格点击重置无响应：原renderTable逻辑仅依赖input$modLiabStruct、input$matrix3两个输入变量，没有监听重置操作修改的rv响应式变量，无法触发自动重绘
• 原代码存在基础错误：matrix3Default的列名赋值操作放在了变量定义之前，运行会抛出未找到对象的报错，需要调整变量定义顺序

修正后完整代码 #

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

# 调整变量定义顺序，避免报错
matrix3Headers <- function(){c('A','B','C','D')}
matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(), NULL))
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))

matrix3Input <- function(x, matrix3Default){
  matrixInput(x,label='Input series terms into below grid:',value=matrix3Default, 
              rows= list(extend=FALSE,names=TRUE),cols= list(extend=TRUE,names=TRUE,
                    editableNames=FALSE,delete=TRUE),class='numeric')}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow(helpText(h5(strong("Base Input Panel")))), 
      uiOutput("Panels") 
    ),
    
    mainPanel(
      tabsetPanel(
        tabPanel("Liabilities module", value=4,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(actionButton('showLiabStructBtn','Liabilities')),
                 div(style = "margin-top: 5px"),
                 uiOutput('showResults')), 
        id = "tabselected"
      )
    )
  )

server <- function(input,output,session)({
  
  showResults <- reactiveValues()
  rv          <- reactiveValues( 
    mat3      =  matrix3Input('matrix3',matrix3Default),
    input     =  matrix3Default,
    colHeader =  colnames(matrix3Default)
  )
  
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==4",
        actionButton('modLiabStruct','Modify Liabilities Structure'))
    )
  })
  
  # 监听矩阵输入变化，同步到响应式变量
  observeEvent(input$matrix3, {
    rv$input <- input$matrix3
  }, ignoreInit = TRUE)
  
  vectorLiabStruct <- reactive({
    df <- rv$input
    n <- dim(df)[2]
    colnames(df) <- paste("Series", 1:n)
    rownames(df) <- matrix3Headers()
    df
  })
  
  output$table3 <- renderTable({
    df <- rv$input
    n <- dim(df)[2]
    colnames(df) <- paste("Series", 1:n)
    rownames(df) <- matrix3Headers()
    df
  },rownames=TRUE, colnames=TRUE)
  
  observeEvent(input$modLiabStruct,{ 
    showModal(modalDialog( 
      rv$mat3,
      footer = tagList(
        actionButton("resetLiabStruct","Reset"), 
        modalButton("Close")
      ),
    ))
  })
  
  observeEvent(input$showLiabStructBtn,{showResults$showme<-tagList(tableOutput("table3"))},ignoreNULL=FALSE)  
  
  # 修正后的重置逻辑
  observeEvent(input$resetLiabStruct,{
    # 直接更新模态框内已渲染的矩阵输入控件
    updateMatrixInput(session, "matrix3", value = matrix3Default)
    # 更新响应式变量触发表格重绘
    rv$input <- matrix3Default
    rv$mat3  <- matrix3Input('matrix3',matrix3Default)
  },ignoreNULL = TRUE)

  output$showResults <- renderUI({showResults$showme})
})

shinyApp(ui, server)

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