R Under development (unstable) (2024-06-30 r86854 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.

> ## -- Test utils & settings
> source("test_util.R")
> .run_test <- identical(Sys.getenv("NOT_CRAN"), "true")
> oldopt <- options(digits = 4)
> set.seed(100)
> 
> library("tramME")
Loading required package: tram
Loading required package: mlt
Loading required package: basefun
Loading required package: variables
Loading required package: mvtnorm
> 
> ## -- Model setup with initpar
> ip <- list(beta = c(1.5, 0.08, 0.2))
> mod <- LmME(dist ~ speed, data = cars, initpar = ip, nofit = TRUE)
> ## NOTE: initpars are not set as actual model parameters...
> chkeq(ip$beta, coef(mod, with_baseline = TRUE), check.attributes = FALSE,
+       tol = 0.1, scale = 1, chkdiff = TRUE)
> ## ... but the tramTMB object is set up with using them
> chkeq(ip$beta, mod$tmb_obj$env$par_checked, check.attributes = FALSE)
> 
> ## -- Data can come from the gobal environment
> data("sleepstudy", package = "lme4")
> fit_lm1 <- LmME(Reaction ~ Days + (Days || Subject), data = sleepstudy)
> attach(sleepstudy)
> fit_lm2 <- LmME(Reaction ~ Days + (Days || Subject))
> chkeq(logLik(fit_lm1), logLik(fit_lm2))
> 
> ## -- Check .th2vc and .vc2th helper functions
> library("survival")
> mod <- CoxphME(
+   Surv(tstart, tstop, status) ~ treat + age + weight + height + (age + weight + height |id),
+   data = cgd, log_first = TRUE, order = 5, nofit = TRUE)
> pr <- mod$tmb_obj$env$last.par
> th <- runif(sum(names(pr) == "theta"))
> pr[names(pr) == "theta"] <- th
> vc1 <- mod$tmb_obj$report(pr) ## NOTE: using REPORT from TMB
> vc1 <- diag(vc1$sd_rep[[1]]) %*% vc1$corr_rep[[1]] %*% diag(vc1$sd_rep[[1]])
> rs <- attr(mod$param, "re")
> vc2 <- tramME:::.th2vc(th, rs$blocksize)
> chkeq(vc1, vc2[[1]])
> th2 <- tramME:::.vc2th(vc2, rs$blocksize) ## NOTE: check back-transformation
> chkeq(th, th2, check.attributes = FALSE)
> 
> ## -- Setting up models flexibly: TODO: extend a little bit with simulated data
> m1 <- BoxCoxME(dist ~ s(speed), data = cars)
> m2a <- BoxCox(dist ~ 1, data = cars, model_only = TRUE)
> m2 <- tramME(ctm = m2a, formula = ~ s(speed), data = cars)
> chkeq(logLik(m1), logLik(m2))
> 
> ## -- Call models from within lapply, when some inputs are defined in the function
> ## both for LmME and tramME
> chkid({
+   lapply(1, function(i) {
+     dat <- cars
+     inherits(LmME(dist ~ speed, data = dat), "LmME")
+   })[[1]]}, TRUE)
> 
> chkid({
+   lapply(1, function(i) {
+     dat <- cars
+     m1 <- BoxCox(dist ~ 1, data = dat, model_only = TRUE)
+     m2 <- tramME(ctm = m1, formula = ~ s(speed), data = dat)
+     inherits(m2, "tramME")
+   })[[1]]}, TRUE)
> 
> chkid({
+ lapply(1, function(i) {
+   supp <- c(4, 24)
+   m <- LmME(dist ~ speed, data = cars, support = supp)
+   inherits(m, "tramME")
+ })[[1]]}, TRUE)
> 
> 
> ## bugfix: model names after call with tramME::
> m3 <- tramME::CoxphME(dist ~ s(speed), data = cars, nofit = TRUE)
> pm <- suppressWarnings(capture.output(m3)) ## FIXME: don't try to calculate anything when the model is not fitted
> chkid(isTRUE(grepl("Cox", pm[2L], fixed = TRUE)), TRUE)
> 
> summarize_tests()
==========================
Number of failed tests: 0
==========================
> 
> options(oldopt)
> 
> proc.time()
   user  system elapsed 
   2.68    0.20    2.87