使用模态对话框的R Shiny应用如何在启动时展示默认表格

问题根因 #

• 输入控件input$base_input定义在模态框内部，Shiny仅在模态框第一次被触发打开时才会初始化该输入变量，应用刚启动时input$base_input为NULL，执行input$base_input[1,1]取值操作会触发异常
• 未给结果展示变量showResults$showme设置初始值，应用启动后主面板没有默认渲染内容

修改后的完整可运行代码 #

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

button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}

matrix1Input <- function(x){
  matrixInput(x, 
              value = matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL)),
              rows = list(extend=FALSE,names=TRUE),
              cols = list(extend=FALSE,names=FALSE,editableNames=FALSE),
              class = "numeric")}

pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")}

vectorBase <- function(x,y){
  a <- rep(y,x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)}

vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow(helpText(h5(strong("Base Input Panel")),align="center",style="margin-top:-15px;margin-bottom:5px")),
      uiOutput("Panels") 
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("By balances", value=2),
        tabPanel("By accounts", value=3), 
        tabPanel("Liabilities module", value=4,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   button2('showVectorValueBtn','Vector values'),
                   button2('showVectorPlotBtn','Vector plots'),
                 ),
                 div(style = "margin-top: 5px"),
                 uiOutput('showResults')), 
        id = "tabselected"
      )
    )
  )

server <- function(input,output,session)({
  # 新增默认值兜底逻辑，未初始化时返回默认矩阵
  base_input  <- reactive({
    if(is.null(input$base_input)){
      matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL))
    }else{
      input$base_input
    }
  })
  # 新增初始展示配置，启动默认显示数值表格
  showResults <- reactiveValues(showme = tableOutput("table1"))
  # 调用处理过的响应式变量取值
  yield   <- function(){vectorBase(60,base_input()[1,1])}
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==4",
        actionButton('showLiabilityGrid','Input Liabilities',style='width:100%;background-color:LightGrey'),
        div(style = "margin-bottom: 10px"),
      ),
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    )
  })
  vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
  output$table1 <- renderTable({vectorsAll()})
  observeEvent(input$showVectorValueBtn,{showResults$showme <- tagList(tableOutput("table1"))},ignoreNULL = FALSE)
  output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
  observeEvent(input$showVectorPlotBtn,{showResults$showme <- plotOutput("graph1")})
  output$showResults <- renderUI({showResults$showme})
  observeEvent(input$showLiabilityGrid,{showModal(modalDialog(matrix1Input("base_input"),div(style = "margin-top: 0px"),useShinyjs()))})
})

shinyApp(ui, server)

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