R Under development (unstable) (2024-04-23 r86473 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > attach(asNamespace("epigrowthfit")) > library(methods) > library(tools) > options(warn = 2L, error = if (interactive()) recover) > > o.1 <- egf_cache("egf-1.rds") > o.2 <- egf_cache("egf-2.rds") > > > ## egf_has_random ###################################################### > > e <- new.env() > e[["data"]] <- list() > o <- list(tmb_out = list(env = e)) > class(o) <- "egf" > > e[["data"]][["Z"]] <- matrix(0, 3L, 3L) > stopifnot( egf_has_random(o)) > > e[["data"]][["Z"]] <- matrix(0, 3L, 0L) > stopifnot(!egf_has_random(o)) > > > ## egf_has_converged ################################################### > > o <- list(optimizer_out = list(convergence = 0L), + value = 100, + gradient = runif(10L, -0.5, 0.5), + hessian = TRUE) > class(o) <- c("egf", "list") # "list" only for dispatch to within.list > > stopifnot(exprs = { + egf_has_converged(o) + !egf_has_converged(within(o, optimizer_out[["convergence"]] <- 1L)) + !egf_has_converged(within(o, value <- NaN)) + !egf_has_converged(within(o, gradient[1L] <- 10)) + !egf_has_converged(within(o, hessian <- FALSE)) + is.na(egf_has_converged(within(o, hessian <- NA))) + }) > > > ## egf_par_expand #################################################### > ## egf_par_condense #################################################### > > t.2 <- o.2[["tmb_out"]] > p.2 <- t.2[["env"]][["last.par.best"]] > > p.2e <- egf_par_expand(t.2, p.2) > p.2ec <- egf_par_condense(t.2, p.2e) > > len <- c(table(factor(names(p.2), levels = c("beta", "theta", "b")))) > > stopifnot(exprs = { + all.equal(p.2e, structure(c(p.2[1:4], theta = 0, p.2[-(1:4)]), + len = len + c(0L, 1L, 0L), names = NULL)) + all.equal(p.2ec, structure(p.2, len = len, names = NULL)) + }) > > > ## egf_report ######################################################## > ## egf_adreport ######################################################## > > identical. <- + function(x, y, ...) { + x[["env"]] <- y[["env"]] <- NULL + identical(x, y, ...) + } > > r.1 <- o.1[["tmb_out"]][["env"]][[".__egf__."]][["report"]] > r.1. <- egf_report(o.1) > stopifnot(identical.(r.1., r.1)) > > o.1[["tmb_out"]][["env"]][[".__egf__."]][["report"]] <- NULL > r.1. <- egf_report(o.1) > stopifnot(identical.(r.1., r.1)) > > r.1 <- o.1[["tmb_out"]][["env"]][[".__egf__."]][["adreport"]] > r.1. <- egf_adreport(o.1) > stopifnot(identical.(r.1., r.1)) > > o.1[["tmb_out"]][["env"]][[".__egf__."]][["adreport"]] <- NULL > assertCondition(r.1. <- egf_adreport(o.1), "message") computing a Hessian matrix ... > stopifnot(identical.(r.1., r.1)) > > > ## egf_cache ########################################################### > > ## see example("egf_cache") > > proc.time() user system elapsed 1.93 0.25 2.15