在 R Shiny 中，如何从运行反应函数中消除“警告：if 中的错误：参数长度为 0”？

Question

在运行以下 MWE 代码时，在 R Studio 控制台框中，我收到警告“如果：参数长度为 0 时出错”，尽管应用程序实际上继续正常运行。我究竟做错了什么？如何消除这种情况？

这是应用程序的工作原理。如下图第一张所示，用户可以改变滑块中的周期 Y 和侧边栏面板中显示的输入框中的基值级别 Z。基值源自 MWE 中的 matrix1...。如图 2 所示，用户可以对变量 Y 和 Z 进行进一步的更改，包括更改 Z 值曲线形状，方法是单击“显示”操作按钮并更改弹出的矩阵输入网格。第二个矩阵网格源自matrix2，如您所见，这两个矩阵与matrix2 链接，取代matrix1。 （注意：先对右列进行任何矩阵输入更改，然后对左列进行更改；这是由于 shinyMatrix 中的一个小错误，我需要下载修复程序）。

MWE 代码：

library(shiny)
library(shinyMatrix)
library(shinyjs)
    
matrix1Input <- function(x){
  matrixInput(x, 
              value = matrix(c(0.2), 1, 1, dimnames = list(c("Z"),NULL)),
              rows = list(extend = FALSE, names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

matrix2Input <- function(x,y,z){ # x = label, y = period, z = value in period y
  matrixInput(x,
              value = matrix(c(y,z),1,2,dimnames=list(NULL,c("Y","Z"))),
              rows = list(extend = TRUE,  names = FALSE),
              cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
              class = "numeric")}  

matrixLink <- function(x,y){
  observeEvent(input$periods|input$base_input,{
    updateMatrixInput(session,x,value=matrix(c(input$periods,y),1,2,dimnames=list(NULL, c("y","z"))))
  })} # close observe event and function

matrixValidate <- function(x,y){ # x = time period x, y = matrix inputs
  a <- y                                
  a[,1][a[,1]>x] <- x                   
  b <- diff(a[,1,drop=FALSE])           
  b[b<=0] <- NA                         
  b <- c(1,b)                           
  a <- cbind(a,b)                       
  a <- na.omit(a)                       
  a <- a[,-c(3),drop=FALSE]             
  return(a)}

# --- Spreads matrix1 input across even time horizon of periods x --- #
vectorBase <- function(x,y){ # x = periods, y = value to spread over periods x
  a <- rep(y,x)                         
  b <- seq(1:x)                         
  c <- data.frame(x = b, y = a)         
  return(c)}

# --- Interpolates & spreads matrix2 input across even time horizon --- #
vectorMulti <- function(x,y,z){ # x = total periods, y = period, z = value to apply in period y                                            
  a <- rep(NA, x)                                                     
  a[y] <- z                                                           
  a[seq_len(min(y)-1)] <- a[min(y)]                                   
  if(max(y) < x){a[seq(max(y)+1, x, 1)] <- 0}                         
  a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y    
  b <- seq(1:x)                                                       
  c <- data.frame(x=b,z=a)                                            
  return(c)}

# --- Runs vectorMulti raw inputs through matrixValidate to output clean vector data --- #
vectorMultiFinal <- function(x,y){ # x = periods, y = matrix input
  vectorMulti(x,matrixValidate(x,y)[,1],matrixValidate(x,y)[,2])}

vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z)}

ui <- pageWithSidebar(
  headerPanel("Model..."),
  sidebarPanel(uiOutput("Panels")), 
  mainPanel(
    tabsetPanel(
      tabPanel("Balances", value=2,
                 fluidRow(
                   radioButtons(
                     inputId = 'Tab2',
                     label = h5(strong(helpText("View:"))),
                     choices = c('Vector plot'),
                     selected = 'Vector plot',
                     inline = TRUE
                   ) # close radio buttons
                 ), # close fluid row
                 conditionalPanel(condition="input.Tab2=='Vector plot'",plotOutput("graph1")),
      ),  # close tab panel
      id = "tabselected"
    ) # close tabset panel
  ) # close main panel
) # close page with sidebar

server <- function(input,output,session)({
  
  periods      <- reactive(input$periods)
  base_input   <- reactive(input$base_input)
  yield_input  <- reactive(input$yield_input)
  showResults  <- reactiveValues()

  vectorVariable <- function(x,y){
    if(input$showVectorBtn == 0) vectorBase(input$periods,x)
    else vectorMultiFinal(input$periods,matrixValidate(input$periods,y))}  
  
  yield <- function(){vectorVariable(input$base_input[1,1],yield_input())}

  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==2",
        sliderInput('periods','Periods Y:',min=1,max=30,value=15),
        helpText(strong('Change variable Z below:')),
        matrix1Input("base_input"),
        useShinyjs(),
        helpText(strong('Add curve to variable Z:')),
        actionButton('showVectorBtn','Show'), 
        actionButton('hideVectorBtn','Hide'),
        actionButton('resetVectorBtn','Reset'),
        hidden(uiOutput("Vectors"))
      ), # close conditional panel
    ) # close tagList
  }) # close renderUI
  
  renderUI({matrixLink("yield_input",input$base_input[1,1])}) 
  
  vectorsAll <- reactive({cbind(Period = 1:periods(),Yld_Rate = yield()[,2])})
  
  observeEvent(input$showVectorBtn,{shinyjs::show("Vectors")})
  observeEvent(input$hideVectorBtn,{shinyjs::hide("Vectors")})
  observeEvent(input$showVectorPlotBtn,{showResults$showme <- plotOutput("graph1")},ignoreNULL = FALSE)
  
  output$Vectors <- renderUI({
    input$resetVectorBtn
    matrix2Input("yield_input",input$periods,input$base_input[1,1])
  }) # close render UI
  
  output$graph1 <-renderPlot(vectorPlot(yield(),"","Period","Rate"))
  
  output$showResults <- renderUI({showResults$showme})
  
}) # close server

shinyApp(ui, server)

Answer 1

通过查看类似的帖子In R Shiny App, how to render a default table when first invoking the App? 和mnist 的解释解决：vectorVariable() 发生错误，因为当应用程序启动时，此函数在创建input$showVectorBtn 之前评估，因此此值为 NULL。我插入了以下默认值以帮助在第一次调用应用程序时渲染绘图：matrix2Default <- vectorBase(15,0.2)，并将原始 MWE 中的 yield <- 函数替换为以下测试，以了解用户输入的情况：

 yield <- function(){
if(!isTruthy(input$base_input)){matrix2Default} else {
  if(!isTruthy(input$showVectorBtn)){vectorBase(input$periods,input$base_input[1,1])} else{
    vectorVariable(yield_input())
    } # close second else
  } # closes first else
} # close function

正如 mnist 所说，代码和函数非常复杂。原始 MWE 中有一些不相关的代码片段，代表了该 MWE 被剥离的原始代码的痕迹。我将努力简化这段代码！

以下是解决问题的完整工作 MWE。请注意，自定义函数在下面不再重复，因为它们与原始帖子中的相同，除了不要忘记包含新的 matrix2Default 函数！！

ui <- pageWithSidebar(
  headerPanel("Model..."),
  sidebarPanel(uiOutput("Panels")), 
  mainPanel(
    tabsetPanel(
      tabPanel("Balances", value=2,
               fluidRow(
                 radioButtons(
                   inputId = 'Tab2',
                   label = h5(strong(helpText("View:"))),
                   choices = c('Vector plot'),
                   selected = 'Vector plot',
                   inline = TRUE
                 ) # close radio buttons
               ), # close fluid row
               conditionalPanel(condition="input.Tab2=='Vector plot'",plotOutput("graph1")),
      ),  # close tab panel
      id = "tabselected"
    ) # close tabset panel
  ) # close main panel
) # close page with sidebar

server <- function(input,output,session)({
  
  periods      <- reactive(input$periods)
  base_input   <- reactive(input$base_input)
  yield_input  <- reactive(input$yield_input)

  vectorVariable <- function(y){vectorMultiFinal(input$periods,matrixValidate(input$periods,y))}
  
  yield <- function(){
    if(!isTruthy(input$base_input)){matrix2Default} else {
      if(!isTruthy(input$showVectorBtn)){vectorBase(input$periods,input$base_input[1,1])} else{
        vectorVariable(yield_input())
        } # close second else
      } # closes first else
    } # close function
  
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==2",
        useShinyjs(),
        sliderInput('periods','Periods X:',min=1,max=30,value=15),
        helpText(strong('Change variable Y below:')),
        matrix1Input("base_input"),
        helpText(strong('Add curve to variable Y:')),
        actionButton('showVectorBtn','Show matrix below'), 
        actionButton('hideVectorBtn','Hide below matrix'),
        actionButton('resetVectorBtn','Reset below inputs'),
        hidden(uiOutput("Vectors"))
      ), # close conditional panel
    ) # close tagList
  }) # close renderUI
  
  observeEvent(input$showVectorBtn,{shinyjs::show("Vectors")})
  observeEvent(input$hideVectorBtn,{shinyjs::hide("Vectors")})

  output$Vectors <- renderUI({
    input$resetVectorBtn
    matrix2Input("yield_input",input$periods,input$base_input[1,1])
  }) # close render UI
  
  output$graph1 <- renderPlot({vectorPlot(yield(),"","Period","Rate")})
  
}) # close server

Answer 2

错误发生在vectorVariable()。当应用程序启动时，在创建 input$showVectorBtn 之前评估该函数，因此该值为 NULL 并显示错误。在conditionalPanel() 运行后，测试工作。

你可以通过在你的renderPlot() 中包含一些req() 来避免这个问题，如果它的输入不是真的，它会停止评估（参见？shiny::req）。但是，此解决方案可能存在一些逻辑缺陷，因此请务必仔细测试您的应用程序。

  output$graph1 <-renderPlot({
    req(input$showVectorBtn)
    vectorPlot(yield(),"","Period","Rate")
    })

一些补充说明

您的代码有点复杂且容易出错。尽量不要编写使用来自其父环境的对象的函数，而是通过函数参数提供所有内容。