Почему в Shiny есть ошибка "подписи за пределами", а не R?
Недавно я опубликовал аналогичный запрос в блестящей группе Google, но не нашел решения. Мы разрабатываем приложение Shiny, и, как показывает тема, мы получаем сообщение "error: subscript out of bounds" при запуске приложения. Однако когда мы изолируем код, вызывающий сбой, и запускаем его самостоятельно в RStudio, ошибки не возникает.
Это заставляет меня задуматься, есть ли ошибка в самом Shiny, или мы что-то упустили.
Пожалуйста, смотрите инструкции ниже вместе с небольшим примером, который приводит к ошибке. Мы используем Shiny версии 0.8.0 и RStudio 0.98.501.
Спасибо за вашу помощь!
Чтобы запустить приложение, поместите ui.R и server.R (см. Ниже) в папку и запустите
library(shiny)
runApp("<folder path>")
Он должен создать пользовательский интерфейс с кнопкой слева, но справа вы увидите "ошибка: индекс за пределами".
Однако, если просто запустить следующие три строки кода (примерно строки 57-59 в server.R)
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 (нужно включить функцию "Предсказание.regsubsets" - указывается в начале 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")
)
))
2 ответа
Эти три строки работают только при выполнении в глобальной среде. Если вы возьмете этот фрагмент и запустите его внутри local({...}) Блок вы увидите ту же ошибку.
Ошибка исходит от первой строки predict.regsubsetsгде вы смотрите на object$call[[2]], Это object$call это сильно отличается в зависимости от того, выполняется оно в глобальной среде или нет; он создан в leaps:::regsubsets.formula позвонив sys.call(sys.parent()), Возможно, это должно быть sys.call(sys.parent(0)) (просто предположение)?
Спасибо Джону Харрисону за этот ответ. Он попытался ответить через блестящую группу Google, но система удалила его ответы, а также мою попытку позже опубликовать его решение. Вот.
Джон Харрисон говорит:
Проблема связана с функцией 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
Вы можете видеть, что он получает его. Call: output относительно среды, в которой он находится:
> 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]]),