我最近在闪亮的谷歌群发布了类似的调查，但没有找到解决方案。我们正在开发一个Shiny应用程序，因为主题表明我们得到了一个错误：下标超出范围＆＃34;运行应用程序时的消息。但是，当我们隔离违规代码并在RStudio中独立运行时，没有错误。
这让我想知道Shiny本身是否存在错误，或者我们是否遗漏了某些东西。
请参阅下面的说明以及产生错误的小示例。我们使用的是Shiny版本0.8.0和RStudio 0.98.501。
感谢您的帮助！
要运行该应用，请将ui.R和server.R（见下文）放在一个文件夹中并运行
library(shiny)
runApp("<folder path>")
它应该生成一个带有左边按钮的用户界面，但是在右边你会看到＆＃34;错误：下标越界＆＃34;。
但是，如果只运行以下三行代码（大约在server.R中的第57-59行）
show=data.frame(ps=c(4,-1,0,1),ns=c(0,1,0,0),ts=c(45842,15653,28535,21656))
best.fit1=regsubsets(ts~ps+ns,data=show,nvmax=1)
pred1=predict.regsubsets(best.fit1,show,id=1) # line that offends Shiny
在RStudio中（需要包含函数＆＃34; predict.regsubsets＆＃34; - 在server.R的开头给出），然后没有错误。
#####################
## server.R
#####################
library(rms)
library(leaps)
library(shiny)
library(datasets)
library(stringr)
library(ttutils)
library(plyr)
library(utils)
library(ggplot2)
# object is a regsubsets object
# newdata is of the form of a row or collection of rows in the dataset
# id specifies the number of terms in the model, since regsubsets objects
# includes models of size 1 up to a specified number
predict.regsubsets=function(object,newdata,id,...){
form=as.formula(object$call[[2]])
mat=model.matrix(form,newdata)
mat.dims=dim(mat)
coefi=coef(object,id=id)
xvars=names(coefi)
# because mat only has those categorical variable categories associated with newdata,
# it is possible that xvars (whose variables are defined by the "best" model of size i)
# has a category that is not in mat
diffs=setdiff(xvars,colnames(mat))
ndiffs=length(diffs)
if(ndiffs>0){
# add columns of 0's for each variable in xvars that is not in mat
mat=cbind(mat,matrix(0,mat.dims[1],ndiffs))
# for the last "ndiffs" columns, make appropriate names
colnames(mat)[(mat.dims[2]+1):(mat.dims[2]+ndiffs)]=diffs
mat[,xvars]%*%coefi
}
else{
mat[,xvars]%*%coefi
}
}
# Define server logic required to summarize and view the selected dataset
shinyServer(function(input, output) {
mainTable1 <- reactive({
})
output$table21 <- renderTable({
mainTable1()
})
formulamodel1 <- reactive({
#ticketsale<-dataset1Input()
show=data.frame(ps=c(4,-1,0,1),ns=c(0,1,0,0),ts=c(45842,15653,28535,21656))
best.fit1=regsubsets(ts~ps+ns,data=show,nvmax=1)
pred1=predict.regsubsets(best.fit1,show,id=1)
})
output$model1fit <- renderPrint({
formulamodel1()
})
})
######################
## end server.R
######################
######################
## ui.R
######################
library(rms)
library(leaps)
library(shiny)
library(datasets)
library(stringr)
library(ttutils)
library(plyr)
library(utils)
library(ggplot2)
shinyUI(pageWithSidebar(
headerPanel("Forecasting ticket sales for xxx"),
sidebarPanel(
p(strong("Model Fitting")),
selectInput("order1", "Sort results by:",c("a","b","c")),
submitButton("Run Model")
),
mainPanel(
h3(strong("Model fit without using ticket sales") ),
tableOutput("table21"),
verbatimTextOutput(outputId = "model1fit")
)
))
答案 0 :(得分：3)
这三行似乎只在全局环境中执行时才有效。如果您使用该代码段并在local({...})块内运行，则会看到相同的错误。
错误来自predict.regsubsets的第一行，您可以在其中查看object$call[[2]]。根据它是否在全球环境中执行，object$call是非常不同的;它是通过调用leaps:::regsubsets.formula在sys.call(sys.parent())中创建的。也许这需要sys.call(sys.parent(0))（只是一个猜测）？
答案 1 :(得分：0)
感谢John Harrison的回答。他试图通过闪亮的谷歌小组回复，但系统删除了他的答案，以及我后来尝试发布他的解决方案。在这里。
问题在于regsubsets功能：
> test_env <- new.env(parent = globalenv())
> with(test_env, {show=data.frame(ps=c(4,-1,0,1),ns=c(0,1,0,0),ts=c(45842,15653,28535,21656))
+ best.fit1=regsubsets(ts~ps+ns,data=show,nvmax=1)
+ #pred1=predict.regsubsets(best.fit1,show,id=1)
+ #pred1
+ best.fit1})
Subset selection object
Call: eval(expr, envir, enclos)
2 Variables (and intercept)
Forced in Forced out
ps FALSE FALSE
ns FALSE FALSE
1 subsets of each size up to 1
Selection Algorithm: exhaustive
你可以看到它得到它调用：输出相对于环境的输入：
> getAnywhere(regsubsets.formula)
A single object matching ‘regsubsets.formula’ was found
It was found in the following places
registered S3 method for regsubsets from namespace leaps
namespace:leaps
with value
function (x, data, weights = NULL, nbest = 1, nvmax = 8, force.in = NULL,
force.out = NULL, intercept = TRUE, method = c("exhaustive",
"backward", "forward", "seqrep"), really.big = FALSE,
...)
{
formula <- x
rm(x)
mm <- match.call()
mm$formula <- formula
mm$x <- NULL
mm$nbest <- mm$nvmax <- mm$force.in <- mm$force.out <- NULL
mm$intercept <- mm$method <- mm$really.big <- NULL
mm[[1]] <- as.name("model.frame")
mm <- eval(mm, sys.frame(sys.parent()))
x <- model.matrix(terms(formula, data = data), mm)[, -1]
y <- model.extract(mm, "response")
wt <- model.extract(mm, "weights")
if (is.null(wt))
wt <- rep(1, length(y))
else wt <- weights
a <- leaps.setup(x, y, wt = wt, nbest = nbest, nvmax = nvmax,
force.in = force.in, force.out = force.out, intercept = intercept)
rval <- switch(1 + pmatch(method[1], c("exhaustive", "backward",
"forward", "seqrep"), nomatch = 0), stop(paste("Ambiguous or unrecognised method name :",
method)), leaps.exhaustive(a, really.big), leaps.backward(a),
leaps.forward(a), leaps.seqrep(a))
rval$call <- sys.call(sys.parent())
rval
}
<environment: namespace:leaps>
rval$call <- sys.call(sys.parent())
是令人讨厌的代码行
我回答说：
我在这些R功能，环境等方面有点过头。我粗略地按照你上面的解释，但我不明白它有什么实际的想法可以解决它（或者它是否可以修复）。你能轻易指出我正确的方向吗？
约翰回答说：
您可以定义自己的regsubsets功能：
myregsubsets <- function (x, data, weights = NULL, nbest = 1, nvmax = 8, force.in = NULL,
force.out = NULL, intercept = TRUE, method = c("exhaustive",
"backward", "forward", "seqrep"), really.big = FALSE,
...){
formula <- x
rm(x)
mm <- match.call()
mm$formula <- formula
mm$x <- NULL
mm$nbest <- mm$nvmax <- mm$force.in <- mm$force.out <- NULL
mm$intercept <- mm$method <- mm$really.big <- NULL
mm[[1]] <- as.name("model.frame")
mm <- eval(mm, sys.frame(sys.parent()))
x <- model.matrix(terms(formula, data = data), mm)[, -1]
y <- model.extract(mm, "response")
wt <- model.extract(mm, "weights")
if (is.null(wt))
wt <- rep(1, length(y))
else wt <- weights
a <- leaps:::leaps.setup(x, y, wt = wt, nbest = nbest, nvmax = nvmax,
force.in = force.in, force.out = force.out, intercept = intercept)
rval <- switch(1 + pmatch(method[1], c("exhaustive", "backward",
"forward", "seqrep"), nomatch = 0), stop(paste("Ambiguous or unrecognised method name :",
method)), leaps:::leaps.exhaustive(a, really.big), leaps:::leaps.backward(a),
leaps:::leaps.forward(a), leaps:::leaps.seqrep(a))
rval$call <- sys.call(sys.parent())
rval$x <- formula
rval
}
predict.regsubsets=function(object,newdata,id,...){
form=as.formula(object$x)
mat=model.matrix(form,newdata)
mat.dims=dim(mat)
coefi=coef(object,id=id)
xvars=names(coefi)
# because mat only has those categorical variable categories associated with newdata,
# it is possible that xvars (whose variables are defined by the "best" model of size i)
# has a category that is not in mat
diffs=setdiff(xvars,colnames(mat))
ndiffs=length(diffs)
if(ndiffs>0){
# add columns of 0's for each variable in xvars that is not in mat
mat=cbind(mat,matrix(0,mat.dims[1],ndiffs))
# for the last "ndiffs" columns, make appropriate names
colnames(mat)[(mat.dims[2]+1):(mat.dims[2]+ndiffs)]=diffs
mat[,xvars]%*%coefi
}
else{
mat[,xvars]%*%coefi
}
}
后来，约翰补充道：
regsubsets函数假设用户以某种方式调用它。 myregsubsets是regsubsets.formula的替代品。在predict.regsubsets中，您可以使用as.formula(object$call[[2]])访问公式。嵌套在环境中时，这并不能满足您的需求。 myregsubsets替换使用rval$x <- formula获取公式。更改后的predict.regsubsets然后使用form=as.formula(object$x)而不是as.formula(object$call[[2]])。