为什么是“a”；下标越界“；光泽错误，但不是R？
我最近在闪亮的谷歌集团发布了类似的查询，但没有找到解决方案。我们正在开发一款闪亮的应用程序，正如主题所示，在运行该应用程序时，我们会收到一条“错误：下标超出范围”的消息。但是，当我们隔离有问题的代码并在RStudio中独立运行它时，就没有错误了 这让我想知道是否有一个bug在闪闪发光本身，或者如果我们错过了什么 请参阅下面的说明以及产生错误的小示例。我们使用的是闪亮版本0.8.0和RStudio 0.98.501 谢谢你的帮助为什么是“a”；下标越界“；光泽错误，但不是R？,r,shiny,R,Shiny,我最近在闪亮的谷歌集团发布了类似的查询，但没有找到解决方案。我们正在开发一款闪亮的应用程序，正如主题所示，在运行该应用程序时，我们会收到一条“错误：下标超出范围”的消息。但是，当我们隔离有问题的代码并在RStudio中独立运行它时，就没有错误了 这让我想知道是否有一个bug在闪闪发光本身，或者如果我们错过了什么 请参阅下面的说明以及产生错误的小示例。我们使用的是闪亮版本0.8.0和RStudio 0.98.501 谢谢你的帮助 要运行应用程序，请将ui.R和server.R（请参见下文）放在文
要运行应用程序，请将ui.R和server.R（请参见下文）放在文件夹中，然后运行
library(shiny)
runApp("<folder path>")
#####################
## 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")
)
))
#####################
##服务器.R
#####################
图书馆（rms）
图书馆（飞跃）
图书馆（闪亮）
图书馆（数据集）
图书馆（stringr）
图书馆（ttutils）
图书馆（plyr）
图书馆（utils）
图书馆（GG2）
#对象是一个regsubsets对象
#newdata是数据集中的一行或一组行的形式
#id指定模型中的术语数，因为RegSubset对象
#包括尺寸为1且不超过指定数量的型号
predict.regsubsets=函数（对象、新数据、id等）{
form=as.formula（对象$call[[2]]）
mat=模型矩阵（表格，新数据）
材料尺寸=尺寸（材料）
coefi=coef（对象，id=id）
xvars=名称（coefi）
#因为mat只有与newdata关联的分类变量类别，
#xvars（其变量由大小为i的“最佳”模型定义）可能
#具有不在mat中的类别
diff=setdiff（xvars、colnames（mat））
ndiffs=长度（差值）
如果（ndiffs>0）{
#为不在mat中的xvars中的每个变量添加0列
mat=cbind（mat，矩阵（0，mat.dims[1]，NDIFF））
#对于最后的“NDIFF”列，请使用适当的名称
colnames（材料）[（材料尺寸[2]+1]：（材料尺寸[2]+NDIFS）]=差异
mat[，xvars]%*%coefi
}
否则{
mat[，xvars]%*%coefi
}
}
#定义汇总和查看所选数据集所需的服务器逻辑
shinyServer（功能（输入、输出）{
mainTable1这三行代码只有在全局环境中执行时才起作用。如果您将该代码段放在local（{…}）
块中运行，您将看到相同的错误
错误来自于predict.regsubsets
的第一行，您可以在这里查看object$call[[2]]
。object$call
根据它是否在全局环境中执行而不同；它是在leaps:：regsubsets.formula
中通过调用sys.call（sys.parent（））创建的
。也许这需要是sys.call（sys.parent（0））
（只是一个猜测）？感谢约翰·哈里森的回答。他试图通过闪亮的谷歌群回复，但系统删除了他的答案，以及我稍后发布他的解决方案的尝试。在这里
约翰·哈里森说：
问题在于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
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
}
}
>test_env with（test_env，{show=data.frame（ps=c（4，-1,0,1），ns=c（0,1,0,0），ts=c（4584215653521656））
+best.fit1=regsubset（ts~ps+ns，data=show，nvmax=1）
+#pred1=predict.regsubset（best.fit1，show，id=1）
+#pred1
+贝斯特（fit1}）
子集选择对象
调用：eval（expr、envir、enclose）
2个变量（和截距）
被迫进入被迫离开
ps假假假
假假假
每种尺寸的1个子集，最多1个
选择算法：穷举
您可以在以下位置看到它获取与环境相关的调用：输出：
> 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>
>getAnywhere（regsubset.formula）
找到与“regsubsets.formula”匹配的单个对象
它被发现在以下地方
命名空间跳跃中regsubset的注册S3方法
名称空间：跳跃
有价值
函数（x，数据，权重=NULL，nbest=1，nvmax=8，force.in=NULL，
force.out=NULL，intercept=TRUE，method=c（“穷举”，
“向后”，“向前”，“seqrep”），真的。大=假，
...)
{
Joe，谢谢你的回复。你正确地识别了问题。谷歌集团的人能够帮助我们。再次感谢。
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
}
}