R Under development (unstable) (2023-11-03 r85470 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2023 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.

> stopifnot(suppressPackageStartupMessages(require(lme4)))
> 
> ## Using simple generated data -- fully balanced here, unbalanced later
> set.seed(1)
> dat <- within(data.frame(lagoon = factor(rep(1:4, each = 25)),
+                          habitat = factor(rep(1:20, each = 5))),
+           {   ## a simple  lagoon effect but no random effect
+               y <- round(10*rnorm(100, m = 10*as.numeric(lagoon)))
+               ## Here, *with* an RE, sigma_a = 100
+               RE <- rep(round(rnorm(nlevels(habitat), sd = 100)), each = 5)
+               y2 <- y + RE
+           })
> 
> ## FIXME:   want  lmer(* , sparseX = TRUE )  {as in lme4a}
> if (FALSE) {                            # need to adapt to new structure
+ 
+ ##' <description>
+ ##'
+ ##' <details>
+ ##' @title Comparing the different versions of lmer() for same data & model
+ ##' @param form
+ ##' @param data
+ ##' @param verbose
+ ##' @return
+ chkLmers <- function(form, data, verbose = FALSE,
+                      tol = 200e-7) # had tol = 7e-7 working ..
+ {
+ #    m   <- lmer1(form, data = data)  # ok, and more clear
+ #    m.  <- lmer1(form, data = data, sparseX = TRUE, verbose = verbose)
+     m2  <- lmer (form, data = data, verbose = verbose) # lmem-dense
+     m2. <- lmer (form, data = data, sparseX = TRUE, verbose = verbose)
+     ##
+     Eq <- function(x,y) all.equal(x,y, tolerance = tol)
+     stopifnot(## Compare  sparse & dense of the new class results
+               identical(slotNames(m2), slotNames(m2.))
+               ,
+               identical(slotNames(m2@fe), slotNames(m2.@fe))
+               ,
+               Eq(m2@resp, m2.@resp)
+               ,
+               Eq(m2@re, m2.@re)
+               ,
+               Eq(m2@fe@coef, m2.@fe@coef)
+               ,
+               ## and now compare with the "old" (class 'mer')
+ #              Eq(unname(fixef(m)), m2@fe@beta)
+ #              ,
+ #              Eq(unname(fixef(m.)), m2.@fe@beta)
+ #              ,
+               ## to do
+               ## all.equal(ranef(m)), m2@re)
+               ## all.equal(ranef(m.)), m2.@re)
+               TRUE)
+     invisible(list(#m=m, m.=m.,
+                    m2 = m2, m2. = m2.))
+ }
+ 
+ chk1 <- chkLmers(y  ~ 0+lagoon + (1|habitat), data = dat, verbose = TRUE)
+ chk2 <- chkLmers(y2 ~ 0+lagoon + (1|habitat), data = dat, verbose = TRUE)
+ chk1$m2  ## show( lmer() ) -- sigma_a == 0
+ chk2$m2. ## show( lmer( <sparseX>) ) --
+ 
+ n <- nrow(dat)
+ for(i in 1:20) {
+     iOut <- sort(sample(n, 1+rpois(1, 3), replace=FALSE))
+     cat(i,":  w/o ", paste(iOut, collapse=", ")," ")
+     chkLmers(y  ~ 0+lagoon + (1|habitat), data = dat[- iOut,])
+     chkLmers(y2 ~   lagoon + (1|habitat), data = dat[- iOut,])
+     cat("\n")
+ }
+ 
+ ## One (rare) example where the default tolerance is not sufficient:
+ dat. <- dat[- c(14, 34, 66, 67, 71, 88),]
+ try( chkLmers(y ~ 0+lagoon + (1|habitat), data = dat.) )
+ ## Error: Eq(unname(fixef(m)), m2@fe@beta) is not TRUE
+ ##
+ ## but higher tolerance works:
+ chkLmers(y ~ 0+lagoon + (1|habitat), data = dat., tol = 2e-4, verbose=TRUE)
+ 
+ }
> proc.time()
   user  system elapsed 
   1.12    0.17    1.29 
> sessionInfo()
R Under development (unstable) (2023-11-03 r85470 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows Server 2022 x64 (build 20348)

Matrix products: default


locale:
[1] LC_COLLATE=C                 LC_CTYPE=German_Germany.utf8
[3] LC_MONETARY=C                LC_NUMERIC=C                
[5] LC_TIME=C                   

time zone: Europe/Berlin
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] lme4_1.1-35.1  Matrix_1.6-1.1

loaded via a namespace (and not attached):
 [1] minqa_1.2.6    MASS_7.3-60.1  compiler_4.4.0 Rcpp_1.0.11    splines_4.4.0 
 [6] nlme_3.1-163   grid_4.4.0     nloptr_2.0.3   boot_1.3-28.1  lattice_0.22-5
> 
> proc.time()
   user  system elapsed 
   1.14    0.17    1.31