- using R Under development (unstable) (2025-01-26 r87642 ucrt)
- using platform: x86_64-w64-mingw32
- R was compiled by
gcc.exe (GCC) 13.3.0
GNU Fortran (GCC) 13.3.0
- running under: Windows Server 2022 x64 (build 20348)
- using session charset: UTF-8
- checking for file 'epigrowthfit/DESCRIPTION' ... OK
- this is package 'epigrowthfit' version '0.15.3'
- package encoding: UTF-8
- checking package namespace information ... OK
- checking package dependencies ... OK
- checking if this is a source package ... OK
- checking if there is a namespace ... OK
- checking for hidden files and directories ... OK
- checking for portable file names ... OK
- checking whether package 'epigrowthfit' can be installed ... OK
See the install log for details.
- used C++ compiler: 'g++.exe (GCC) 13.3.0'
- checking installed package size ... INFO
installed size is 14.2Mb
sub-directories of 1Mb or more:
libs 13.6Mb
- checking package directory ... OK
- checking DESCRIPTION meta-information ... OK
- checking top-level files ... OK
- checking for left-over files ... OK
- checking index information ... OK
- checking package subdirectories ... OK
- checking code files for non-ASCII characters ... OK
- checking R files for syntax errors ... OK
- checking whether the package can be loaded ... [2s] OK
- checking whether the package can be loaded with stated dependencies ... [2s] OK
- checking whether the package can be unloaded cleanly ... [2s] OK
- checking whether the namespace can be loaded with stated dependencies ... [2s] OK
- checking whether the namespace can be unloaded cleanly ... [2s] OK
- checking loading without being on the library search path ... [2s] OK
- checking whether startup messages can be suppressed ... [2s] OK
- checking use of S3 registration ... OK
- checking dependencies in R code ... OK
- checking S3 generic/method consistency ... OK
- checking replacement functions ... OK
- checking foreign function calls ... OK
- checking R code for possible problems ... [14s] OK
- checking Rd files ... [1s] OK
- checking Rd metadata ... OK
- checking Rd cross-references ... OK
- checking for missing documentation entries ... OK
- checking for code/documentation mismatches ... OK
- checking Rd \usage sections ... OK
- checking Rd contents ... OK
- checking for unstated dependencies in examples ... OK
- checking contents of 'data' directory ... OK
- checking data for non-ASCII characters ... [0s] OK
- checking LazyData ... OK
- checking data for ASCII and uncompressed saves ... OK
- checking line endings in C/C++/Fortran sources/headers ... OK
- checking line endings in Makefiles ... OK
- checking compilation flags in Makevars ... OK
- checking for GNU extensions in Makefiles ... OK
- checking for portable use of $(BLAS_LIBS) and $(LAPACK_LIBS) ... OK
- checking use of PKG_*FLAGS in Makefiles ... OK
- checking pragmas in C/C++ headers and code ... OK
- checking compiled code ... OK
- checking examples ... [34s] OK
- checking for unstated dependencies in 'tests' ... OK
- checking tests ... [273s] ERROR
Running 'coef.R' [5s]
Running 'confint.R' [54s]
Running 'datetime.R' [1s]
Running 'egf.R' [5s]
Running 'egf_enum.R' [2s]
Running 'egf_eval.R' [2s]
Running 'egf_examples_day_of_week.R' [2s]
Running 'egf_examples_excess.R' [2s]
Running 'egf_examples_fixed.R' [2s]
Running 'egf_examples_random.R' [10s]
Running 'egf_link.R' [2s]
Running 'egf_misc.R' [6s]
Running 'egf_options.R' [2s]
Running 'egf_utils.R' [6s]
Running 'epidemic.R' [2s]
Running 'extract.R' [6s]
Running 'fitted.R' [5s]
Running 'gi.R' [2s]
Running 'include.R' [104s]
Running 'language.R' [2s]
Running 'prior.R' [2s]
Running 'profile.R' [37s]
Running 'summary.R' [5s]
Running 'utils.R' [2s]
Running 'validity.R' [2s]
Running 'zzz.R' [2s]
Running the tests in 'tests/egf_examples_random.R' failed.
Complete output:
> library(epigrowthfit)
> options(warn = 2L, error = if (interactive()) recover, egf.cores = 2L)
>
>
> ## exponential #########################################################
>
> r <- log(2) / 20
> c0 <- 100
> s <- 0.2
>
> mu <- log(c(r, c0))
> Sigma <- diag(rep.int(s^2, length(mu)))
>
> zz <- simulate(egf_model(curve = "exponential", family = "pois"),
+ nsim = 20L,
+ seed = 775494L,
+ mu = mu,
+ Sigma = Sigma,
+ cstart = 10)
> mm <- egf(zz,
+ formula_priors = list(Sigma ~ LKJ(eta = 2)))
>
> p1 <- as.list(coef(zz))
> p2 <- as.list(coef(mm))
>
> stopifnot(exprs = {
+ max(abs(mm[["gradient"]])) < 5e-05
+ all.equal(p1[["beta"]], p2[["beta"]], tolerance = 5e-02)
+ all.equal(theta2cov(p1[["theta"]]), theta2cov(p2[["theta"]]), tolerance = 5e-02)
+ })
>
>
> ## subexponential ######################################################
>
> alpha <- log(2) / 20
> c0 <- 100
> p <- 0.95
> s <- 0.2
>
> mu <- c(log(alpha), log(c0), qlogis(p))
> Sigma <- diag(rep.int(s^2, length(mu)))
>
> zz <- simulate(egf_model(curve = "subexponential", family = "pois"),
+ nsim = 20L,
+ seed = 653927L,
+ mu = mu,
+ Sigma = Sigma,
+ cstart = 10)
> mm <- egf(zz,
+ formula_priors = list(beta[3L] ~ Normal(mu = qlogis(p), sigma = 0.05),
+ theta[3L] ~ Normal(mu = log(s), sigma = 0.25),
+ Sigma ~ LKJ(eta = 2)))
Error in nlminb(start = par, objective = fn, gradient = gr, control = control, :
(converted from warning) NA/NaN function evaluation
Calls: egf ... <Anonymous> -> egf.egf_model -> do.call -> <Anonymous> -> nlminb
Execution halted
Running the tests in 'tests/egf_utils.R' failed.
Complete output:
> attach(asNamespace("epigrowthfit"))
> library(methods)
> library(tools)
> options(warn = 2L, error = if (interactive()) recover)
> example("egf", package = "epigrowthfit"); o.1 <- m1; o.2 <- m2
egf> ## Simulate 'N' incidence time series exhibiting exponential growth
egf> set.seed(180149L)
egf> N <- 10L
egf> f <- function(time, r, c0) {
egf+ lambda <- diff(exp(log(c0) + r * time))
egf+ c(NA, rpois(lambda, lambda))
egf+ }
egf> time <- seq.int(0, 40, 1)
egf> r <- rlnorm(N, -3.2, 0.2)
egf> c0 <- rlnorm(N, 6, 0.2)
egf> data_ts <-
egf+ data.frame(country = gl(N, length(time), labels = LETTERS[1:N]),
egf+ time = rep.int(time, N),
egf+ x = unlist(Map(f, time = list(time), r = r, c0 = c0)))
egf> rm(f, time)
egf> ## Define fitting windows (here, two per time series)
egf> data_windows <-
egf+ data.frame(country = gl(N, 1L, 2L * N, labels = LETTERS[1:N]),
egf+ wave = gl(2L, 10L),
egf+ start = c(sample(seq.int(0, 5, 1), N, TRUE),
egf+ sample(seq.int(20, 25, 1), N, TRUE)),
egf+ end = c(sample(seq.int(15, 20, 1), N, TRUE),
egf+ sample(seq.int(35, 40, 1), N, TRUE)))
egf> ## Estimate the generative model
egf> m1 <-
egf+ egf(model = egf_model(curve = "exponential", family = "pois"),
egf+ formula_ts = cbind(time, x) ~ country,
egf+ formula_windows = cbind(start, end) ~ country,
egf+ formula_parameters = ~(1 | country:wave),
egf+ data_ts = data_ts,
egf+ data_windows = data_windows,
egf+ se = TRUE)
computing a Hessian matrix ...
egf> ## Re-estimate the generative model with:
egf> ## * Gaussian prior on beta[1L]
egf> ## * LKJ prior on all random effect covariance matrices
egf> ## (here there happens to be just one)
egf> ## * initial value of 'theta' set explicitly
egf> ## * theta[3L] fixed at initial value
egf> m2 <-
egf+ update(m1,
egf+ formula_priors = list(beta[1L] ~ Normal(mu = -3, sigma = 1),
egf+ Sigma ~ LKJ(eta = 2)),
egf+ init = list(theta = c(log(0.5), log(0.5), 0)),
egf+ map = list(theta = 3L))
computing a Hessian matrix ...
>
>
> ## egf_sanitize_formula_ts ########################################
> ## egf_sanitize_formula_windows ########################################
>
> l1 <- list(cbind(x, y) ~ 1,
+ cbind(x, y) ~ g,
+ cbind(x, y) ~ 1 + g,
+ cbind(x, y) ~ (g),
+ cbind(x, y) ~ g:h,
+ cbind(x, y) ~ I(g + h),
+ cbind(x, y) ~ I(g * h),
+ cbind(x - 1, cumsum(y)) ~ g)
> l2 <- list(~g,
+ cbind(x, y) ~ g + h,
+ cbind(x, y) ~ g * h,
+ cbind(x, y) ~ 0 + g,
+ cbind(x, y) ~ g - 1,
+ cbind(x, y) ~ offset(h) + g,
+ (cbind(x, y)) ~ g,
+ cbind(x) ~ g,
+ cbind(x, y, z) ~ g,
+ rbind(x, y) ~ g) # i.e., anything other than 'cbind'
>
> stopifnot(identical(lapply(l1, egf_sanitize_formula_ts),
+ l1[c(1L, 2L, 2L, 2L, 5:8)]))
> for (formula in l2)
+ assertError(egf_sanitize_formula_ts(formula))
>
>
> ## egf_sanitize_formula_parameters #####################################
>
> model <- egf_model(curve = "exponential", family = "pois")
> top <- egf_top(model)
>
> s <-
+ function(formula)
+ egf_sanitize_formula_parameters(formula, top, check = TRUE)
>
> fp1 <- ~x * y + (z | g) + (zz | g/h)
> l1 <- rep.int(expr(simplify_terms(fp1)), 2L)
> names(l1) <- c("log(r)", "log(c0)")
>
> fp2 <- expr(replace(fp1, 2:3, expr(quote(log(r)), fp1[[2L]])))
> l2 <- replace(l1, "log(c0)", expr(~1))
>
> fp3 <- c(fp2, expr(log(c0) ~ x))
> l3 <- replace(l2, "log(c0)", expr(~x))
>
> stopifnot(exprs = {
+ identical(s(fp1), l1)
+ identical(s(fp2), l2)
+ identical(s(fp3), l3)
+ })
> assertWarning(s(~0 + x))
>
>
> ## egf_sanitize_formula_priors #########################################
>
> p1 <- Normal(mu = 0, sigma = 1)
> p2 <- Normal(mu = 1, sigma = c(0.5, 1))
> p3 <- Normal(mu = -1, sigma = 2)
> p4 <- LKJ(eta = 1)
>
> fp. <- list(foo(bar) ~ p1,
+ baz ~ p1,
+ beta ~ p1,
+ theta[[1L]] ~ p1,
+ theta[2:3] ~ p2,
+ theta[-(1:5)] ~ p3,
+ theta[replace(logical(6L), 4L, TRUE)] ~ p1,
+ Sigma ~ p4)
>
> ip. <- list(
+ top = list(names = c("foo(bar)", "baz"), family = "norm"),
+ bottom = list(
+ beta = list(length = 4L, family = "norm"),
+ theta = list(length = 6L, family = "norm"),
+ Sigma = list(length = 1L, family = c("lkj", "wishart", "invwishart"),
+ rows = 4L)))
>
> priors <- egf_sanitize_formula_priors(formula = fp., info = ip.)
>
> p2.elt <-
+ function(i) {
+ p2[["parameters"]][["sigma"]] <- p2[["parameters"]][["sigma"]][[i]]
+ p2
+ }
>
> stopifnot(exprs = {
+ is.list(priors)
+ length(priors) == 2L
+ identical(names(priors), c("top", "bottom"))
+
+ identical(priors[["top"]],
+ `names<-`(list(p1, p1), ip.[["top"]][["names"]]))
+ identical(priors[["bottom"]],
+ list(beta = list(p1, p1, p1, p1),
+ theta = list(p1, p2.elt(1L), p2.elt(2L), p1, NULL, p3),
+ Sigma = list(p4)))
+ })
>
>
> ## egf_make_frame ######################################################
>
> model <- egf_model(curve = "exponential", family = "pois")
>
> formula_ts <- cbind(day, count) ~ country
> formula_windows <- cbind(left, right) ~ country
> formula_parameters <- list(`log(r)` = ~x1 + (1 | g1) + (1 | g1:g2),
+ `log(c0)` = ~(1 | g3))
>
> data_ts <- data.frame(country = gl(6L, 11L),
+ day = seq.int(0, 10, by = 1),
+ count = rpois(11L, 100 * exp(0.04 * 0:10)))
> data_windows <- data.frame(country = gl(3L, 2L),
+ left = rep.int(c(0, 5), 3L),
+ right = rep.int(c(5, 10), 3L),
+ x1 = c(5.00, 8.34, -0.57, -7.19, -9.71, 1.25),
+ x2 = rnorm(6L),
+ x3 = rnorm(6L),
+ g1 = c("a", "b", "b", "b", "b", "a"),
+ g2 = c("c", "d", "d", "d", "c", "c"),
+ g3 = c("f", "f", "e", "e", "e", "f"))
>
> subset_ts <- quote(day > 0)
> subset_windows <- quote(x1 < 0)
> select_windows <- quote(.)
>
> na_action_ts <- "pass"
> na_action_windows <- "omit"
>
> frame <- egf_make_frame(model = model,
+ formula_ts = formula_ts,
+ formula_windows = formula_windows,
+ formula_parameters = formula_parameters,
+ data_ts = data_ts,
+ data_windows = data_windows,
+ subset_ts = subset_ts,
+ subset_windows = subset_windows,
+ select_windows = select_windows,
+ na_action_ts = na_action_ts,
+ na_action_windows = na_action_windows)
>
> stopifnot(exprs = {
+ is.list(frame)
+ length(frame) == 4L
+ identical(names(frame), c("ts", "windows", "parameters", "extra"))
+ })
>
> l1 <- frame[["ts"]]
> l1.e <- data.frame(ts = gl(2L, 10L, labels = 2:3),
+ window = factor(rep.int(c(NA, 1, 2, NA, 3, NA),
+ c(1L, 4L, 5L, 1L, 4L, 5L)),
+ labels = sprintf("window_%d", 1:3)),
+ time = rep.int(seq.int(1, 10, by = 1), 2L),
+ x = data_ts[["count"]][c(NA, 14:22, NA, 25:33)])
> attr(l1.e, "first") <- c(1L, 5L, 11L)
> attr(l1.e, "last") <- c(5L, 10L, 15L)
> stopifnot(identical(l1, l1.e))
>
> l2 <- frame[["windows"]]
> l2.e <- data.frame(ts = factor(c(2, 2, 3)),
+ window = gl(3L, 1L, labels = sprintf("window_%d", 1:3)),
+ start = c(1, 5, 1),
+ end = c(5, 10, 5))
> stopifnot(identical(l2, l2.e))
Error: identical(l2, l2.e) is not TRUE
Execution halted
- checking PDF version of manual ... [27s] OK
- checking HTML version of manual ... [12s] OK
- DONE
Status: 1 ERROR