在 R Shiny 中，如何从 运行 反应函数中消除 "Warning: Error in if: argument is of length 0"？
In R Shiny, how to eliminate "Warning: Error in if: argument is of length 0" from running reactive function?
在 运行 下面的 MWE 代码中，在 R studio 控制台框中我收到警告“如果错误：参数长度为 0”，尽管应用程序实际上继续 运行 正常。我究竟做错了什么？我该如何消除它？
应用程序的工作原理如下。如下图所示，用户可以改变滑块中的周期 Y 和出现在侧边栏面板中的输入框中的基值级别 Z。 MWE 中从 matrix1... 派生的基值。如第二张图片所示，用户可以通过单击“显示”操作按钮并更改弹出的矩阵输入网格来进一步更改变量 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)
错误发生在vectorVariable()。当应用程序启动时，在创建 input$showVectorBtn 之前评估函数，因此此值为 NULL 并显示错误。在 conditionalPanel() 是 运行 之后，测试有效。
你可以通过在你的 renderPlot() 中包含一些 req() 来避免这个问题，如果它的输入不真实则停止评估（参见 ?shiny::req）。但是，此解决方案可能存在一些逻辑缺陷，因此请务必仔细测试您的应用程序。
output$graph1 <-renderPlot({
req(input$showVectorBtn)
vectorPlot(yield(),"","Period","Rate")
})
一些补充说明
您的代码有点复杂且容易出错。尽量不要编写使用其父环境中的对象但通过函数参数提供所有内容的函数。
通过查看类似 post 和 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。请注意，自定义函数不会在下面重复，因为它们与原始 post 中的相同，除了不要忘记包含新的 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
在 运行 下面的 MWE 代码中，在 R studio 控制台框中我收到警告“如果错误：参数长度为 0”，尽管应用程序实际上继续 运行 正常。我究竟做错了什么？我该如何消除它？
应用程序的工作原理如下。如下图所示，用户可以改变滑块中的周期 Y 和出现在侧边栏面板中的输入框中的基值级别 Z。 MWE 中从 matrix1... 派生的基值。如第二张图片所示，用户可以通过单击“显示”操作按钮并更改弹出的矩阵输入网格来进一步更改变量 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)
错误发生在vectorVariable()。当应用程序启动时，在创建 input$showVectorBtn 之前评估函数，因此此值为 NULL 并显示错误。在 conditionalPanel() 是 运行 之后，测试有效。
你可以通过在你的 renderPlot() 中包含一些 req() 来避免这个问题，如果它的输入不真实则停止评估（参见 ?shiny::req）。但是，此解决方案可能存在一些逻辑缺陷，因此请务必仔细测试您的应用程序。
output$graph1 <-renderPlot({
req(input$showVectorBtn)
vectorPlot(yield(),"","Period","Rate")
})
一些补充说明
您的代码有点复杂且容易出错。尽量不要编写使用其父环境中的对象但通过函数参数提供所有内容的函数。
通过查看类似 post 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。请注意，自定义函数不会在下面重复，因为它们与原始 post 中的相同，除了不要忘记包含新的 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