R Shiny解决Warning: Error in data.frame参数行数不一致报错

错误根因 #

• 首次点击「Input Liabilities」按钮弹出模态框时，matrixInput组件的返回值input$base_input尚未完成初始化，处于空值状态
• 此时依赖该输入的响应式计算、表格/绘图渲染逻辑会立刻执行，拼接60行的周期序列和空的收益率列时，就会触发「行数不匹配」的报错，等输入初始化完成后渲染就会恢复正常，因此仅出现短暂闪错和控制台告警。

修正步骤 #

给所有依赖input$base_input的逻辑增加非空校验，确保输入就绪后再执行计算：

1. 响应式对象vectorsAll中增加req(input$base_input)校验，拦截空输入场景
2. 给绘图渲染函数补充req(vectorsAll())校验，确保数据就绪后再执行绘图逻辑
3. 给yield、vectorBase基础计算函数也增加非空校验，避免异常调用时出错

修正后完整可运行代码 #

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

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){
  req(y)
  a <- rep(y,x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)}

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(input$base_input)
  showResults <- reactiveValues()
  
  yield   <- function(){
    req(input$base_input)
    vectorBase(60,input$base_input[1,1])
  }
  
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==4",
        actionButton('showLiabilityGrid','Input Liabilities',style='width:100%;background-color:LightGrey'),
        setShadow(id='showLiabilityGrid'),
        div(style = "margin-bottom: 10px"),
      ),
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    )
  })
  
  vectorsAll <- reactive({
    if (is.null(input$showLiabilityGrid)){df <- NULL}
    else {
      if(input$showLiabilityGrid < 1){df <- cbind(Period = 1:60,Yld_Rate = pct(0.2))}
      else {
        req(input$base_input)
        df <- cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))
      }
    }
    df
  })
  
  output$table1 <- renderTable({vectorsAll()})
  
  observeEvent(input$showVectorValueBtn,
               {showResults$showme <-
                 tagList(tableOutput("table1"))
               },ignoreNULL = FALSE)
  
  output$graph1 <-renderPlot({
    req(vectorsAll())
    plot(vectorsAll()[,1],sapply(vectorsAll()[,2], function(x)gsub("%", "", x)) )
  })
  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