Last updated on 2020-02-19 10:49:13 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 1.4.1 | 6.62 | 163.10 | 169.72 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 1.4.1 | 4.88 | 113.75 | 118.63 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 1.4.1 | 202.47 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 1.4.1 | 186.22 | ERROR | |||
| r-devel-windows-ix86+x86_64 | 1.4.1 | 11.00 | 253.00 | 264.00 | OK | |
| r-devel-windows-ix86+x86_64-gcc8 | 1.4.1 | 14.00 | 175.00 | 189.00 | OK | |
| r-patched-linux-x86_64 | 1.4.1 | 4.36 | 158.29 | 162.65 | OK | |
| r-patched-solaris-x86 | 1.4.1 | 232.00 | OK | |||
| r-release-linux-x86_64 | 1.4.1 | 4.75 | 158.59 | 163.34 | OK | |
| r-release-windows-ix86+x86_64 | 1.4.1 | 10.00 | 190.00 | 200.00 | OK | |
| r-release-osx-x86_64 | 1.4.1 | OK | ||||
| r-oldrel-windows-ix86+x86_64 | 1.4.1 | 8.00 | 178.00 | 186.00 | OK | |
| r-oldrel-osx-x86_64 | 1.4.1 | OK |
Version: 1.4.1
Check: tests
Result: ERROR
Running 'test_code.R' [40s/48s]
Running the tests in 'tests/test_code.R' failed.
Complete output:
> library(tscount)
>
> begin <- Sys.time()
>
> checkfit <- function(seed, n=50, model, param, xreg=NULL, distr="poisson", distrcoefs=NULL, link="identity", startestims=FALSE, extended=FALSE, interv=FALSE, ...){
+ if(missing(seed)) seed <- 1945
+ set.seed(seed)
+ #Simulate a time series from the given model:
+ timser <- tsglm.sim(n=n, param=param, model=model, xreg=xreg, link=link, distr=distr, distrcoefs=distrcoefs)$ts
+ print(unlist(param))
+ #Fit the given model to the time series:
+ print(fit <- tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, ...))
+ if(startestims){ #Try the different methods for start estimation:
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="iid"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="GLM"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="CSS"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="MM"), final.control=NULL)
+ }
+ if(extended){ #Apply the standard methods for the fitted model:
+ summary(fit)
+ residuals(fit, type="pearson")
+ residuals(fit, type="anscombe")
+ par(mfrow=c(3,2))
+ plot(fit, ask=FALSE)
+ fitted(fit)
+ coef(fit)
+ predict(fit, n.ahead=4)
+ #logLik(fit) #already included in summary-method
+ vcov(fit)
+ #AIC(fit) #already included in summary-method
+ #BIC(fit) #already included in summary-method
+ se(fit, B=3)
+ #pit(fit) #already included in plot-method
+ #marcal(fit) #already included in plot-method
+ scoring(fit)
+ }
+ if(interv){
+ interv_test(fit, tau=floor(n/2), delta=0.8, external=FALSE, est_interv=TRUE, ...)
+ interv_detect(fit, taus=floor(0.45*n):ceiling(0.55*n), delta=0.8, B=3, ...)
+ interv_multiple(fit, taus=floor(0.45*n):ceiling(0.55*n), deltas=c(0,1), B=3, final.control_bootstrap=NULL, ...)
+ }
+ return(TRUE)
+ }
>
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
4.36248 0.47076 0.02301
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4)), xreg=matrix(rexp(1*50, rate=3), ncol=1), startestims=TRUE, extended=TRUE) #one covariate
intercept past_obs past_mean xreg
2.0 0.4 0.3 4.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1
2.66696 0.04534 0.48532 9.85239
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4,2)), xreg=matrix(rexp(2*50, rate=3), ncol=2), startestims=TRUE, extended=TRUE) #two covariates
intercept past_obs past_mean xreg1 xreg2
2.0 0.4 0.3 4.0 2.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1 eta_2
0.9103 0.3786 0.4741 0.9416 2.0897
[1] TRUE
> checkfit(model=list(past_obs=1), param=list(intercept=2, past_obs=0.4))
intercept past_obs
2.0 0.4
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1
2.6873 0.3656
[1] TRUE
> checkfit(model=list(), param=list(intercept=2))
intercept
2
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept)
2.42
[1] TRUE
> checkfit(model=list(past_obs=1:2, past_mean=1:2), param=list(intercept=2, past_obs=c(0.3,0.2), past_mean=c(0.2,0.1)))
intercept past_obs1 past_obs2 past_mean1 past_mean2
2.0 0.3 0.2 0.2 0.1
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 beta_2 alpha_1 alpha_2
1.097e+01 8.592e-12 1.299e-01 2.234e-03 2.014e-03
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, start.control=list(use=20))
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
start.control = ..1)
Coefficients:
(Intercept) beta_1 alpha_1
2.8027 0.5440 0.1208
Overdispersion coefficient 'sigmasq' was estimated to be 0.3211238.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, init.drop=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
init.drop = TRUE)
Coefficients:
(Intercept) beta_1 alpha_1
2.7022 0.5488 0.1313
Overdispersion coefficient 'sigmasq' was estimated to be 0.3292575.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
2.4338 0.3250 -0.5352
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", distr="nbinom", distrcoefs=c(size=2), extended=TRUE, interv=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
0.6058 0.4157 0.2108
Overdispersion coefficient 'sigmasq' was estimated to be 0.4746927.
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
tscount
--- call from context ---
invertinfo(G_11, ...)
--- call from argument ---
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
} else {
result$vcov <- vcov
}
--- R stacktrace ---
where 1: invertinfo(G_11, ...)
where 2: scoretest(Score = loglik$score, G = loglik$info, G1 = infomat_corrected,
r = 1, stopOnError = stopOnError, silent = TRUE)
where 3: (function (model, ts, xreg, link, distr, fit_H0 = NULL, taus,
delta, external, est_interv = FALSE, stopOnError = FALSE,
...)
{
n <- length(ts)
if (all(ts == 0))
return(list(error_message = "Time series is constantly zero"))
if (is.null(fit_H0)) {
op <- options(show.error.messages = FALSE)
fit_H0 <- try(tsglm(ts = ts, model = model, xreg = xreg,
link = link, distr = distr, score = FALSE, info = "none",
...))
options(op)
if ("try-error" %in% class(fit_H0))
return(list(error_message = fit_H0[[1]]))
}
param_H0_extended <- c(fit_H0$coefficients, 0)
model_extended <- model
xreg_extended <- xreg
xreg_extended <- cbind(xreg, numeric(n))
model_extended$external <- c(model$external, external)
condmean_H0 <- tsglm.condmean(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
derivatives = ifelse(info == "hessian", "second", "first"))
test_statistic_tau <- as.numeric(rep(NA, length(taus)))
names(test_statistic_tau) <- taus
for (j in seq(along = taus)) {
xreg_extended <- cbind(xreg, interv_covariate(n = n,
tau = taus[j], delta = delta))
loglik <- tsglm.loglik(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
score = TRUE, info = info, condmean = condmean_H0,
from = taus[j])
infomat_corrected <- apply((1/loglik$nu + fit$sigmasq) *
loglik$outerscoreprod, c(2, 3), sum)
test_statistic_temp <- scoretest(Score = loglik$score,
G = loglik$info, G1 = infomat_corrected, r = 1, stopOnError = stopOnError,
silent = TRUE)
if (!is.null(test_statistic_temp$error_message)) {
return(list(error_message = test_statistic_temp$error_message))
}
test_statistic_tau[j] <- test_statistic_temp$test_statistic
}
index_tau_max <- which.max(test_statistic_tau)
tau_max <- taus[index_tau_max]
test_statistic <- test_statistic_tau[index_tau_max]
covariate <- interv_covariate(n = n, tau = tau_max, delta = delta)
xreg_extended <- cbind(xreg, covariate)
colnames(xreg_extended) <- c(colnames(xreg), colnames(covariate))
result <- list(test_statistic = test_statistic, test_statistic_tau = test_statistic_tau,
tau_max = tau_max, fit_H0 = fit_H0)
if (est_interv) {
fit_interv <- try(tsglm(ts = ts, model = model_extended,
xreg = xreg_extended, link = link, distr = distr,
score = FALSE, info = "none", ...))
result <- c(result, list(fit_interv = fit_interv))
}
result <- c(result, list(model_interv = model_extended, xreg_interv = xreg_extended))
return(result)
})(model = list(past_obs = 1, past_mean = 1, external = logical(0)),
ts = c(5, 1, 0, 3, 3, 0, 3, 17, 5, 11, 5, 2, 7, 3, 5, 3,
6, 1, 0, 1, 2, 0, 1, 1, 2, 4, 3, 3, 1, 2, 2, 6, 7, 1, 6,
10, 3, 11, 6, 18, 8, 5, 1, 10, 3, 12, 14, 7, 6, 1), xreg = numeric(0),
link = "log", distr = "nbinom", fit_H0 = NULL, taus = 22:28,
delta = 0.8, external = FALSE, est_interv = TRUE, start.control = list(),
final.control = list(), inter.control = list())
where 4: do.call(compute_test_statistic, args = c(list(model = model,
ts = ts.bootstrap, xreg = xreg, link = link, distr = distr,
fit_H0 = fit_H0.bootstrap, taus = taus, delta = delta, external = external,
est_interv = TRUE, start.control = start.control_bootstrap,
final.control = final.control_bootstrap, inter.control = inter.control_bootstrap),
dotdotdot))
where 5: FUN(X[[i]], ...)
where 6: lapply(X = X, FUN = FUN, ...)
where 7: sapply(X = X, FUN = FUN, ..., simplify = FALSE)
where 8: Sapply(seeds, bootstrap, fit_H0 = fit, n = fit$n_obs, model = fit$model,
xreg = fit$xreg, link = fit$link, distr = fit$distr, taus = taus,
delta = delta, external = external, ...)
where 9: interv_detect.tsglm(fit, taus = floor(0.45 * n):ceiling(0.55 *
n), delta = 0.8, B = 3, ...)
where 10: interv_detect(fit, taus = floor(0.45 * n):ceiling(0.55 * n),
delta = 0.8, B = 3, ...)
where 11: checkfit(model = list(past_obs = 1, past_mean = 1), param = list(intercept = 0.5,
past_obs = 0.4, past_mean = 0.3), link = "log", distr = "nbinom",
distrcoefs = c(size = 2), extended = TRUE, interv = TRUE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (mat, silent = TRUE, stopOnError = FALSE)
{
if (stopOnError) {
result <- list(vcov = chol2inv(chol(mat)), error_message = NULL)
}
else {
result <- list(vcov = matrix(NA, ncol = ncol(mat)), error_message = NULL)
vcov <- try(chol2inv(chol(mat)), silent = silent)
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
}
else {
result$vcov <- vcov
}
}
dimnames(result$vcov) <- dimnames(mat)
return(result)
}
<bytecode: 0x39328f0>
<environment: namespace:tscount>
--- function search by body ---
Function invertinfo in namespace tscount has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(vcov) == "try-error") { : the condition has length > 1
Calls: checkfit ... FUN -> do.call -> <Anonymous> -> scoretest -> invertinfo
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 1.4.1
Check: tests
Result: ERROR
Running ‘test_code.R’ [27s/41s]
Running the tests in ‘tests/test_code.R’ failed.
Complete output:
> library(tscount)
>
> begin <- Sys.time()
>
> checkfit <- function(seed, n=50, model, param, xreg=NULL, distr="poisson", distrcoefs=NULL, link="identity", startestims=FALSE, extended=FALSE, interv=FALSE, ...){
+ if(missing(seed)) seed <- 1945
+ set.seed(seed)
+ #Simulate a time series from the given model:
+ timser <- tsglm.sim(n=n, param=param, model=model, xreg=xreg, link=link, distr=distr, distrcoefs=distrcoefs)$ts
+ print(unlist(param))
+ #Fit the given model to the time series:
+ print(fit <- tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, ...))
+ if(startestims){ #Try the different methods for start estimation:
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="iid"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="GLM"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="CSS"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="MM"), final.control=NULL)
+ }
+ if(extended){ #Apply the standard methods for the fitted model:
+ summary(fit)
+ residuals(fit, type="pearson")
+ residuals(fit, type="anscombe")
+ par(mfrow=c(3,2))
+ plot(fit, ask=FALSE)
+ fitted(fit)
+ coef(fit)
+ predict(fit, n.ahead=4)
+ #logLik(fit) #already included in summary-method
+ vcov(fit)
+ #AIC(fit) #already included in summary-method
+ #BIC(fit) #already included in summary-method
+ se(fit, B=3)
+ #pit(fit) #already included in plot-method
+ #marcal(fit) #already included in plot-method
+ scoring(fit)
+ }
+ if(interv){
+ interv_test(fit, tau=floor(n/2), delta=0.8, external=FALSE, est_interv=TRUE, ...)
+ interv_detect(fit, taus=floor(0.45*n):ceiling(0.55*n), delta=0.8, B=3, ...)
+ interv_multiple(fit, taus=floor(0.45*n):ceiling(0.55*n), deltas=c(0,1), B=3, final.control_bootstrap=NULL, ...)
+ }
+ return(TRUE)
+ }
>
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
4.36248 0.47076 0.02301
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4)), xreg=matrix(rexp(1*50, rate=3), ncol=1), startestims=TRUE, extended=TRUE) #one covariate
intercept past_obs past_mean xreg
2.0 0.4 0.3 4.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1
2.66696 0.04534 0.48532 9.85239
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4,2)), xreg=matrix(rexp(2*50, rate=3), ncol=2), startestims=TRUE, extended=TRUE) #two covariates
intercept past_obs past_mean xreg1 xreg2
2.0 0.4 0.3 4.0 2.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1 eta_2
0.9103 0.3786 0.4741 0.9416 2.0897
[1] TRUE
> checkfit(model=list(past_obs=1), param=list(intercept=2, past_obs=0.4))
intercept past_obs
2.0 0.4
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1
2.6873 0.3656
[1] TRUE
> checkfit(model=list(), param=list(intercept=2))
intercept
2
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept)
2.42
[1] TRUE
> checkfit(model=list(past_obs=1:2, past_mean=1:2), param=list(intercept=2, past_obs=c(0.3,0.2), past_mean=c(0.2,0.1)))
intercept past_obs1 past_obs2 past_mean1 past_mean2
2.0 0.3 0.2 0.2 0.1
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 beta_2 alpha_1 alpha_2
1.097e+01 8.592e-12 1.299e-01 2.234e-03 2.014e-03
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, start.control=list(use=20))
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
start.control = ..1)
Coefficients:
(Intercept) beta_1 alpha_1
2.8027 0.5440 0.1208
Overdispersion coefficient 'sigmasq' was estimated to be 0.3211238.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, init.drop=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
init.drop = TRUE)
Coefficients:
(Intercept) beta_1 alpha_1
2.7022 0.5488 0.1313
Overdispersion coefficient 'sigmasq' was estimated to be 0.3292575.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
2.4338 0.3250 -0.5352
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", distr="nbinom", distrcoefs=c(size=2), extended=TRUE, interv=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
0.6058 0.4157 0.2108
Overdispersion coefficient 'sigmasq' was estimated to be 0.4746927.
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
tscount
--- call from context ---
invertinfo(G_11, ...)
--- call from argument ---
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
} else {
result$vcov <- vcov
}
--- R stacktrace ---
where 1: invertinfo(G_11, ...)
where 2: scoretest(Score = loglik$score, G = loglik$info, G1 = infomat_corrected,
r = 1, stopOnError = stopOnError, silent = TRUE)
where 3: (function (model, ts, xreg, link, distr, fit_H0 = NULL, taus,
delta, external, est_interv = FALSE, stopOnError = FALSE,
...)
{
n <- length(ts)
if (all(ts == 0))
return(list(error_message = "Time series is constantly zero"))
if (is.null(fit_H0)) {
op <- options(show.error.messages = FALSE)
fit_H0 <- try(tsglm(ts = ts, model = model, xreg = xreg,
link = link, distr = distr, score = FALSE, info = "none",
...))
options(op)
if ("try-error" %in% class(fit_H0))
return(list(error_message = fit_H0[[1]]))
}
param_H0_extended <- c(fit_H0$coefficients, 0)
model_extended <- model
xreg_extended <- xreg
xreg_extended <- cbind(xreg, numeric(n))
model_extended$external <- c(model$external, external)
condmean_H0 <- tsglm.condmean(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
derivatives = ifelse(info == "hessian", "second", "first"))
test_statistic_tau <- as.numeric(rep(NA, length(taus)))
names(test_statistic_tau) <- taus
for (j in seq(along = taus)) {
xreg_extended <- cbind(xreg, interv_covariate(n = n,
tau = taus[j], delta = delta))
loglik <- tsglm.loglik(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
score = TRUE, info = info, condmean = condmean_H0,
from = taus[j])
infomat_corrected <- apply((1/loglik$nu + fit$sigmasq) *
loglik$outerscoreprod, c(2, 3), sum)
test_statistic_temp <- scoretest(Score = loglik$score,
G = loglik$info, G1 = infomat_corrected, r = 1, stopOnError = stopOnError,
silent = TRUE)
if (!is.null(test_statistic_temp$error_message)) {
return(list(error_message = test_statistic_temp$error_message))
}
test_statistic_tau[j] <- test_statistic_temp$test_statistic
}
index_tau_max <- which.max(test_statistic_tau)
tau_max <- taus[index_tau_max]
test_statistic <- test_statistic_tau[index_tau_max]
covariate <- interv_covariate(n = n, tau = tau_max, delta = delta)
xreg_extended <- cbind(xreg, covariate)
colnames(xreg_extended) <- c(colnames(xreg), colnames(covariate))
result <- list(test_statistic = test_statistic, test_statistic_tau = test_statistic_tau,
tau_max = tau_max, fit_H0 = fit_H0)
if (est_interv) {
fit_interv <- try(tsglm(ts = ts, model = model_extended,
xreg = xreg_extended, link = link, distr = distr,
score = FALSE, info = "none", ...))
result <- c(result, list(fit_interv = fit_interv))
}
result <- c(result, list(model_interv = model_extended, xreg_interv = xreg_extended))
return(result)
})(model = list(past_obs = 1, past_mean = 1, external = logical(0)),
ts = c(5, 1, 0, 3, 3, 0, 3, 17, 5, 11, 5, 2, 7, 3, 5, 3,
6, 1, 0, 1, 2, 0, 1, 1, 2, 4, 3, 3, 1, 2, 2, 6, 7, 1, 6,
10, 3, 11, 6, 18, 8, 5, 1, 10, 3, 12, 14, 7, 6, 1), xreg = numeric(0),
link = "log", distr = "nbinom", fit_H0 = NULL, taus = 22:28,
delta = 0.8, external = FALSE, est_interv = TRUE, start.control = list(),
final.control = list(), inter.control = list())
where 4: do.call(compute_test_statistic, args = c(list(model = model,
ts = ts.bootstrap, xreg = xreg, link = link, distr = distr,
fit_H0 = fit_H0.bootstrap, taus = taus, delta = delta, external = external,
est_interv = TRUE, start.control = start.control_bootstrap,
final.control = final.control_bootstrap, inter.control = inter.control_bootstrap),
dotdotdot))
where 5: FUN(X[[i]], ...)
where 6: lapply(X = X, FUN = FUN, ...)
where 7: sapply(X = X, FUN = FUN, ..., simplify = FALSE)
where 8: Sapply(seeds, bootstrap, fit_H0 = fit, n = fit$n_obs, model = fit$model,
xreg = fit$xreg, link = fit$link, distr = fit$distr, taus = taus,
delta = delta, external = external, ...)
where 9: interv_detect.tsglm(fit, taus = floor(0.45 * n):ceiling(0.55 *
n), delta = 0.8, B = 3, ...)
where 10: interv_detect(fit, taus = floor(0.45 * n):ceiling(0.55 * n),
delta = 0.8, B = 3, ...)
where 11: checkfit(model = list(past_obs = 1, past_mean = 1), param = list(intercept = 0.5,
past_obs = 0.4, past_mean = 0.3), link = "log", distr = "nbinom",
distrcoefs = c(size = 2), extended = TRUE, interv = TRUE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (mat, silent = TRUE, stopOnError = FALSE)
{
if (stopOnError) {
result <- list(vcov = chol2inv(chol(mat)), error_message = NULL)
}
else {
result <- list(vcov = matrix(NA, ncol = ncol(mat)), error_message = NULL)
vcov <- try(chol2inv(chol(mat)), silent = silent)
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
}
else {
result$vcov <- vcov
}
}
dimnames(result$vcov) <- dimnames(mat)
return(result)
}
<bytecode: 0x56528f693178>
<environment: namespace:tscount>
--- function search by body ---
Function invertinfo in namespace tscount has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(vcov) == "try-error") { : the condition has length > 1
Calls: checkfit ... FUN -> do.call -> <Anonymous> -> scoretest -> invertinfo
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 1.4.1
Check: tests
Result: ERROR
Running ‘test_code.R’ [47s/120s]
Running the tests in ‘tests/test_code.R’ failed.
Complete output:
> library(tscount)
>
> begin <- Sys.time()
>
> checkfit <- function(seed, n=50, model, param, xreg=NULL, distr="poisson", distrcoefs=NULL, link="identity", startestims=FALSE, extended=FALSE, interv=FALSE, ...){
+ if(missing(seed)) seed <- 1945
+ set.seed(seed)
+ #Simulate a time series from the given model:
+ timser <- tsglm.sim(n=n, param=param, model=model, xreg=xreg, link=link, distr=distr, distrcoefs=distrcoefs)$ts
+ print(unlist(param))
+ #Fit the given model to the time series:
+ print(fit <- tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, ...))
+ if(startestims){ #Try the different methods for start estimation:
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="iid"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="GLM"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="CSS"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="MM"), final.control=NULL)
+ }
+ if(extended){ #Apply the standard methods for the fitted model:
+ summary(fit)
+ residuals(fit, type="pearson")
+ residuals(fit, type="anscombe")
+ par(mfrow=c(3,2))
+ plot(fit, ask=FALSE)
+ fitted(fit)
+ coef(fit)
+ predict(fit, n.ahead=4)
+ #logLik(fit) #already included in summary-method
+ vcov(fit)
+ #AIC(fit) #already included in summary-method
+ #BIC(fit) #already included in summary-method
+ se(fit, B=3)
+ #pit(fit) #already included in plot-method
+ #marcal(fit) #already included in plot-method
+ scoring(fit)
+ }
+ if(interv){
+ interv_test(fit, tau=floor(n/2), delta=0.8, external=FALSE, est_interv=TRUE, ...)
+ interv_detect(fit, taus=floor(0.45*n):ceiling(0.55*n), delta=0.8, B=3, ...)
+ interv_multiple(fit, taus=floor(0.45*n):ceiling(0.55*n), deltas=c(0,1), B=3, final.control_bootstrap=NULL, ...)
+ }
+ return(TRUE)
+ }
>
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
4.36248 0.47076 0.02301
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4)), xreg=matrix(rexp(1*50, rate=3), ncol=1), startestims=TRUE, extended=TRUE) #one covariate
intercept past_obs past_mean xreg
2.0 0.4 0.3 4.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1
2.66696 0.04534 0.48532 9.85239
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4,2)), xreg=matrix(rexp(2*50, rate=3), ncol=2), startestims=TRUE, extended=TRUE) #two covariates
intercept past_obs past_mean xreg1 xreg2
2.0 0.4 0.3 4.0 2.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1 eta_2
0.9103 0.3786 0.4741 0.9416 2.0897
[1] TRUE
> checkfit(model=list(past_obs=1), param=list(intercept=2, past_obs=0.4))
intercept past_obs
2.0 0.4
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1
2.6873 0.3656
[1] TRUE
> checkfit(model=list(), param=list(intercept=2))
intercept
2
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept)
2.42
[1] TRUE
> checkfit(model=list(past_obs=1:2, past_mean=1:2), param=list(intercept=2, past_obs=c(0.3,0.2), past_mean=c(0.2,0.1)))
intercept past_obs1 past_obs2 past_mean1 past_mean2
2.0 0.3 0.2 0.2 0.1
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 beta_2 alpha_1 alpha_2
1.097e+01 8.592e-12 1.299e-01 2.234e-03 2.014e-03
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, start.control=list(use=20))
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
start.control = ..1)
Coefficients:
(Intercept) beta_1 alpha_1
2.8027 0.5440 0.1208
Overdispersion coefficient 'sigmasq' was estimated to be 0.3211238.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, init.drop=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
init.drop = TRUE)
Coefficients:
(Intercept) beta_1 alpha_1
2.7022 0.5488 0.1313
Overdispersion coefficient 'sigmasq' was estimated to be 0.3292575.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
2.4338 0.3250 -0.5352
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", distr="nbinom", distrcoefs=c(size=2), extended=TRUE, interv=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
0.6058 0.4157 0.2108
Overdispersion coefficient 'sigmasq' was estimated to be 0.4746927.
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
tscount
--- call from context ---
invertinfo(G_11, ...)
--- call from argument ---
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
} else {
result$vcov <- vcov
}
--- R stacktrace ---
where 1: invertinfo(G_11, ...)
where 2: scoretest(Score = loglik$score, G = loglik$info, G1 = infomat_corrected,
r = 1, stopOnError = stopOnError, silent = TRUE)
where 3: (function (model, ts, xreg, link, distr, fit_H0 = NULL, taus,
delta, external, est_interv = FALSE, stopOnError = FALSE,
...)
{
n <- length(ts)
if (all(ts == 0))
return(list(error_message = "Time series is constantly zero"))
if (is.null(fit_H0)) {
op <- options(show.error.messages = FALSE)
fit_H0 <- try(tsglm(ts = ts, model = model, xreg = xreg,
link = link, distr = distr, score = FALSE, info = "none",
...))
options(op)
if ("try-error" %in% class(fit_H0))
return(list(error_message = fit_H0[[1]]))
}
param_H0_extended <- c(fit_H0$coefficients, 0)
model_extended <- model
xreg_extended <- xreg
xreg_extended <- cbind(xreg, numeric(n))
model_extended$external <- c(model$external, external)
condmean_H0 <- tsglm.condmean(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
derivatives = ifelse(info == "hessian", "second", "first"))
test_statistic_tau <- as.numeric(rep(NA, length(taus)))
names(test_statistic_tau) <- taus
for (j in seq(along = taus)) {
xreg_extended <- cbind(xreg, interv_covariate(n = n,
tau = taus[j], delta = delta))
loglik <- tsglm.loglik(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
score = TRUE, info = info, condmean = condmean_H0,
from = taus[j])
infomat_corrected <- apply((1/loglik$nu + fit$sigmasq) *
loglik$outerscoreprod, c(2, 3), sum)
test_statistic_temp <- scoretest(Score = loglik$score,
G = loglik$info, G1 = infomat_corrected, r = 1, stopOnError = stopOnError,
silent = TRUE)
if (!is.null(test_statistic_temp$error_message)) {
return(list(error_message = test_statistic_temp$error_message))
}
test_statistic_tau[j] <- test_statistic_temp$test_statistic
}
index_tau_max <- which.max(test_statistic_tau)
tau_max <- taus[index_tau_max]
test_statistic <- test_statistic_tau[index_tau_max]
covariate <- interv_covariate(n = n, tau = tau_max, delta = delta)
xreg_extended <- cbind(xreg, covariate)
colnames(xreg_extended) <- c(colnames(xreg), colnames(covariate))
result <- list(test_statistic = test_statistic, test_statistic_tau = test_statistic_tau,
tau_max = tau_max, fit_H0 = fit_H0)
if (est_interv) {
fit_interv <- try(tsglm(ts = ts, model = model_extended,
xreg = xreg_extended, link = link, distr = distr,
score = FALSE, info = "none", ...))
result <- c(result, list(fit_interv = fit_interv))
}
result <- c(result, list(model_interv = model_extended, xreg_interv = xreg_extended))
return(result)
})(model = list(past_obs = 1, past_mean = 1, external = logical(0)),
ts = c(5, 1, 0, 3, 3, 0, 3, 17, 5, 11, 5, 2, 7, 3, 5, 3,
6, 1, 0, 1, 2, 0, 1, 1, 2, 4, 3, 3, 1, 2, 2, 6, 7, 1, 6,
10, 3, 11, 6, 18, 8, 5, 1, 10, 3, 12, 14, 7, 6, 1), xreg = numeric(0),
link = "log", distr = "nbinom", fit_H0 = NULL, taus = 22:28,
delta = 0.8, external = FALSE, est_interv = TRUE, start.control = list(),
final.control = list(), inter.control = list())
where 4: do.call(compute_test_statistic, args = c(list(model = model,
ts = ts.bootstrap, xreg = xreg, link = link, distr = distr,
fit_H0 = fit_H0.bootstrap, taus = taus, delta = delta, external = external,
est_interv = TRUE, start.control = start.control_bootstrap,
final.control = final.control_bootstrap, inter.control = inter.control_bootstrap),
dotdotdot))
where 5: FUN(X[[i]], ...)
where 6: lapply(X = X, FUN = FUN, ...)
where 7: sapply(X = X, FUN = FUN, ..., simplify = FALSE)
where 8: Sapply(seeds, bootstrap, fit_H0 = fit, n = fit$n_obs, model = fit$model,
xreg = fit$xreg, link = fit$link, distr = fit$distr, taus = taus,
delta = delta, external = external, ...)
where 9: interv_detect.tsglm(fit, taus = floor(0.45 * n):ceiling(0.55 *
n), delta = 0.8, B = 3, ...)
where 10: interv_detect(fit, taus = floor(0.45 * n):ceiling(0.55 * n),
delta = 0.8, B = 3, ...)
where 11: checkfit(model = list(past_obs = 1, past_mean = 1), param = list(intercept = 0.5,
past_obs = 0.4, past_mean = 0.3), link = "log", distr = "nbinom",
distrcoefs = c(size = 2), extended = TRUE, interv = TRUE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (mat, silent = TRUE, stopOnError = FALSE)
{
if (stopOnError) {
result <- list(vcov = chol2inv(chol(mat)), error_message = NULL)
}
else {
result <- list(vcov = matrix(NA, ncol = ncol(mat)), error_message = NULL)
vcov <- try(chol2inv(chol(mat)), silent = silent)
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
}
else {
result$vcov <- vcov
}
}
dimnames(result$vcov) <- dimnames(mat)
return(result)
}
<bytecode: 0x39c49e8>
<environment: namespace:tscount>
--- function search by body ---
Function invertinfo in namespace tscount has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(vcov) == "try-error") { : the condition has length > 1
Calls: checkfit ... FUN -> do.call -> <Anonymous> -> scoretest -> invertinfo
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 1.4.1
Check: tests
Result: ERROR
Running ‘test_code.R’ [42s/47s]
Running the tests in ‘tests/test_code.R’ failed.
Complete output:
> library(tscount)
>
> begin <- Sys.time()
>
> checkfit <- function(seed, n=50, model, param, xreg=NULL, distr="poisson", distrcoefs=NULL, link="identity", startestims=FALSE, extended=FALSE, interv=FALSE, ...){
+ if(missing(seed)) seed <- 1945
+ set.seed(seed)
+ #Simulate a time series from the given model:
+ timser <- tsglm.sim(n=n, param=param, model=model, xreg=xreg, link=link, distr=distr, distrcoefs=distrcoefs)$ts
+ print(unlist(param))
+ #Fit the given model to the time series:
+ print(fit <- tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, ...))
+ if(startestims){ #Try the different methods for start estimation:
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="iid"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="GLM"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="CSS"), final.control=NULL)
+ tsglm(ts=timser, model=model, xreg=xreg, link=link, distr=distr, start.control=list(method="MM"), final.control=NULL)
+ }
+ if(extended){ #Apply the standard methods for the fitted model:
+ summary(fit)
+ residuals(fit, type="pearson")
+ residuals(fit, type="anscombe")
+ par(mfrow=c(3,2))
+ plot(fit, ask=FALSE)
+ fitted(fit)
+ coef(fit)
+ predict(fit, n.ahead=4)
+ #logLik(fit) #already included in summary-method
+ vcov(fit)
+ #AIC(fit) #already included in summary-method
+ #BIC(fit) #already included in summary-method
+ se(fit, B=3)
+ #pit(fit) #already included in plot-method
+ #marcal(fit) #already included in plot-method
+ scoring(fit)
+ }
+ if(interv){
+ interv_test(fit, tau=floor(n/2), delta=0.8, external=FALSE, est_interv=TRUE, ...)
+ interv_detect(fit, taus=floor(0.45*n):ceiling(0.55*n), delta=0.8, B=3, ...)
+ interv_multiple(fit, taus=floor(0.45*n):ceiling(0.55*n), deltas=c(0,1), B=3, final.control_bootstrap=NULL, ...)
+ }
+ return(TRUE)
+ }
>
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
4.36248 0.47076 0.02301
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4)), xreg=matrix(rexp(1*50, rate=3), ncol=1), startestims=TRUE, extended=TRUE) #one covariate
intercept past_obs past_mean xreg
2.0 0.4 0.3 4.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1
2.66696 0.04534 0.48532 9.85239
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3, xreg=c(4,2)), xreg=matrix(rexp(2*50, rate=3), ncol=2), startestims=TRUE, extended=TRUE) #two covariates
intercept past_obs past_mean xreg1 xreg2
2.0 0.4 0.3 4.0 2.0
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1 eta_1 eta_2
0.9103 0.3786 0.4741 0.9416 2.0897
[1] TRUE
> checkfit(model=list(past_obs=1), param=list(intercept=2, past_obs=0.4))
intercept past_obs
2.0 0.4
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1
2.6873 0.3656
[1] TRUE
> checkfit(model=list(), param=list(intercept=2))
intercept
2
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept)
2.42
[1] TRUE
> checkfit(model=list(past_obs=1:2, past_mean=1:2), param=list(intercept=2, past_obs=c(0.3,0.2), past_mean=c(0.2,0.1)))
intercept past_obs1 past_obs2 past_mean1 past_mean2
2.0 0.3 0.2 0.2 0.1
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 beta_2 alpha_1 alpha_2
1.097e+01 8.592e-12 1.299e-01 2.234e-03 2.014e-03
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, start.control=list(use=20))
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
start.control = ..1)
Coefficients:
(Intercept) beta_1 alpha_1
2.8027 0.5440 0.1208
Overdispersion coefficient 'sigmasq' was estimated to be 0.3211238.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=2, past_obs=0.4, past_mean=0.3), distr="nbinom", distrcoefs=c(size=2), extended=TRUE, init.drop=TRUE)
intercept past_obs past_mean
2.0 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr,
init.drop = TRUE)
Coefficients:
(Intercept) beta_1 alpha_1
2.7022 0.5488 0.1313
Overdispersion coefficient 'sigmasq' was estimated to be 0.3292575.
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", startestims=TRUE, extended=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
2.4338 0.3250 -0.5352
[1] TRUE
> checkfit(model=list(past_obs=1, past_mean=1), param=list(intercept=0.5, past_obs=0.4, past_mean=0.3), link="log", distr="nbinom", distrcoefs=c(size=2), extended=TRUE, interv=TRUE)
intercept past_obs past_mean
0.5 0.4 0.3
Call:
tsglm(ts = timser, model = model, xreg = xreg, link = link, distr = distr)
Coefficients:
(Intercept) beta_1 alpha_1
0.6058 0.4157 0.2108
Overdispersion coefficient 'sigmasq' was estimated to be 0.4746927.
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
tscount
--- call from context ---
invertinfo(G_11, ...)
--- call from argument ---
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
} else {
result$vcov <- vcov
}
--- R stacktrace ---
where 1: invertinfo(G_11, ...)
where 2: scoretest(Score = loglik$score, G = loglik$info, G1 = infomat_corrected,
r = 1, stopOnError = stopOnError, silent = TRUE)
where 3: (function (model, ts, xreg, link, distr, fit_H0 = NULL, taus,
delta, external, est_interv = FALSE, stopOnError = FALSE,
...)
{
n <- length(ts)
if (all(ts == 0))
return(list(error_message = "Time series is constantly zero"))
if (is.null(fit_H0)) {
op <- options(show.error.messages = FALSE)
fit_H0 <- try(tsglm(ts = ts, model = model, xreg = xreg,
link = link, distr = distr, score = FALSE, info = "none",
...))
options(op)
if ("try-error" %in% class(fit_H0))
return(list(error_message = fit_H0[[1]]))
}
param_H0_extended <- c(fit_H0$coefficients, 0)
model_extended <- model
xreg_extended <- xreg
xreg_extended <- cbind(xreg, numeric(n))
model_extended$external <- c(model$external, external)
condmean_H0 <- tsglm.condmean(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
derivatives = ifelse(info == "hessian", "second", "first"))
test_statistic_tau <- as.numeric(rep(NA, length(taus)))
names(test_statistic_tau) <- taus
for (j in seq(along = taus)) {
xreg_extended <- cbind(xreg, interv_covariate(n = n,
tau = taus[j], delta = delta))
loglik <- tsglm.loglik(link = link, paramvec = param_H0_extended,
model = model_extended, ts = ts, xreg = xreg_extended,
score = TRUE, info = info, condmean = condmean_H0,
from = taus[j])
infomat_corrected <- apply((1/loglik$nu + fit$sigmasq) *
loglik$outerscoreprod, c(2, 3), sum)
test_statistic_temp <- scoretest(Score = loglik$score,
G = loglik$info, G1 = infomat_corrected, r = 1, stopOnError = stopOnError,
silent = TRUE)
if (!is.null(test_statistic_temp$error_message)) {
return(list(error_message = test_statistic_temp$error_message))
}
test_statistic_tau[j] <- test_statistic_temp$test_statistic
}
index_tau_max <- which.max(test_statistic_tau)
tau_max <- taus[index_tau_max]
test_statistic <- test_statistic_tau[index_tau_max]
covariate <- interv_covariate(n = n, tau = tau_max, delta = delta)
xreg_extended <- cbind(xreg, covariate)
colnames(xreg_extended) <- c(colnames(xreg), colnames(covariate))
result <- list(test_statistic = test_statistic, test_statistic_tau = test_statistic_tau,
tau_max = tau_max, fit_H0 = fit_H0)
if (est_interv) {
fit_interv <- try(tsglm(ts = ts, model = model_extended,
xreg = xreg_extended, link = link, distr = distr,
score = FALSE, info = "none", ...))
result <- c(result, list(fit_interv = fit_interv))
}
result <- c(result, list(model_interv = model_extended, xreg_interv = xreg_extended))
return(result)
})(model = list(past_obs = 1, past_mean = 1, external = logical(0)),
ts = c(5, 1, 0, 3, 3, 0, 3, 17, 5, 11, 5, 2, 7, 3, 5, 3,
6, 1, 0, 1, 2, 0, 1, 1, 2, 4, 3, 3, 1, 2, 2, 6, 7, 1, 6,
10, 3, 11, 6, 18, 8, 5, 1, 10, 3, 12, 14, 7, 6, 1), xreg = numeric(0),
link = "log", distr = "nbinom", fit_H0 = NULL, taus = 22:28,
delta = 0.8, external = FALSE, est_interv = TRUE, start.control = list(),
final.control = list(), inter.control = list())
where 4: do.call(compute_test_statistic, args = c(list(model = model,
ts = ts.bootstrap, xreg = xreg, link = link, distr = distr,
fit_H0 = fit_H0.bootstrap, taus = taus, delta = delta, external = external,
est_interv = TRUE, start.control = start.control_bootstrap,
final.control = final.control_bootstrap, inter.control = inter.control_bootstrap),
dotdotdot))
where 5: FUN(X[[i]], ...)
where 6: lapply(X = X, FUN = FUN, ...)
where 7: sapply(X = X, FUN = FUN, ..., simplify = FALSE)
where 8: Sapply(seeds, bootstrap, fit_H0 = fit, n = fit$n_obs, model = fit$model,
xreg = fit$xreg, link = fit$link, distr = fit$distr, taus = taus,
delta = delta, external = external, ...)
where 9: interv_detect.tsglm(fit, taus = floor(0.45 * n):ceiling(0.55 *
n), delta = 0.8, B = 3, ...)
where 10: interv_detect(fit, taus = floor(0.45 * n):ceiling(0.55 * n),
delta = 0.8, B = 3, ...)
where 11: checkfit(model = list(past_obs = 1, past_mean = 1), param = list(intercept = 0.5,
past_obs = 0.4, past_mean = 0.3), link = "log", distr = "nbinom",
distrcoefs = c(size = 2), extended = TRUE, interv = TRUE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (mat, silent = TRUE, stopOnError = FALSE)
{
if (stopOnError) {
result <- list(vcov = chol2inv(chol(mat)), error_message = NULL)
}
else {
result <- list(vcov = matrix(NA, ncol = ncol(mat)), error_message = NULL)
vcov <- try(chol2inv(chol(mat)), silent = silent)
if (class(vcov) == "try-error") {
result$error_message <- paste("Error in invertinfo(mat) : \n",
vcov[[1]], sep = "")
result$vcov <- matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
}
else {
result$vcov <- vcov
}
}
dimnames(result$vcov) <- dimnames(mat)
return(result)
}
<bytecode: 0x4a636d8>
<environment: namespace:tscount>
--- function search by body ---
Function invertinfo in namespace tscount has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(vcov) == "try-error") { : the condition has length > 1
Calls: checkfit ... FUN -> do.call -> <Anonymous> -> scoretest -> invertinfo
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc