r - 在 R Shiny 中，如何从运行反应函数中消除“警告：if 中的错误：参数长度为 0”？
问题描述
在运行以下 MWE 代码时，在 R Studio 控制台框中，我收到警告“如果：参数长度为 0 时出错”，尽管应用程序实际上继续正常运行。我究竟做错了什么？我该如何消除这个？
这是该应用程序的工作原理。如下图第一张所示，用户可以改变滑块中的周期 Y 和侧边栏面板中显示的输入框中的基值级别 Z。来自matrix1...MWE 的基础值。如图 2 所示，用户可以对变量 Y 和 Z 进行进一步的更改，包括更改 Z 值曲线形状，方法是单击“显示”操作按钮并对弹出的矩阵输入网格进行更改。这第二个矩阵网格源自matrix2并且如您所见，这两个矩阵与matrix2superseding链接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)
解决方案
通过查看类似的帖子解决了 In R Shiny App, how to render a default table when first invoking the App? 并且与mnist的解释：错误发生在vectorVariable()因为当应用程序启动时，这个函数在input$showVectorBtn创建之前被评估，因此这个值为NULL。我插入了以下默认值以帮助在第一次调用 App: 时渲染绘图matrix2Default <- vectorBase(15,0.2)，并且我用yield <-以下测试替换了原始 MWE 中的函数，以测试用户输入的情况：
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
推荐阅读
- python - 将单词分成音节python
- c# - 后续 if 语句
- linux - 如何在k8s yaml文件中获取名称选项的文本值
- reactjs - 如何在反应中获取位置信息（纬度，经度）？
- powerbi - PowerBI - x 轴月份标签排序
- bash - Shell/Bash - 字符串之间的相等性检查在匹配时返回 1
- wordpress - 账单地址替换 WooCommerce 中的收货地址
- react-native - 如何将 Facebook 登录添加到 React Native 应用程序
- format - 从 zsh 名称中的 vcs_info 提示中删除 VCS 以使用 ZSH_THEME_GIT_PROMPT_DIRTY
- c++ - 用双 C++ 表达