Replace lme4 with reformulas, fixes #4

biodiverse · Sep 19, 2024 · 6048def · 6048def
1 parent dd14d5f
commit 6048def
Show file tree

Hide file tree

Showing 9 changed files with 29 additions and 29 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: unmarked
-Version: 1.4.3.9003
-Date: 2024-09-18
+Version: 1.4.3.9004
+Date: 2024-09-19
 Type: Package
 Title: Models for Data from Unmarked Animals
 Authors@R: c(
@@ -23,12 +23,12 @@ Depends: R (>= 4.0)
 Imports: 
     graphics,
     lattice,
-    lme4,
     MASS,
     Matrix,
     methods,
     parallel,
     Rcpp (>= 0.8.0),
+    reformulas,
     stats,
     TMB (>= 1.7.18),
     utils

diff --git a/R/deprecated_sim_power.R b/R/deprecated_sim_power.R
@@ -109,7 +109,7 @@ setMethod("simulate", "character",
 #replace_sigma <- function(coefs, fit){
 #  required_subs <- names(fit@estimates@estimates)
 #  formulas <- sapply(names(fit), function(x) get_formula(fit, x))
-#  rand <- lapply(formulas, lme4::findbars)
+#  rand <- lapply(formulas, reformulas::findbars)
 #  if(!all(sapply(rand, is.null))){
 #    rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars)))
 #    for (i in required_subs){
@@ -840,7 +840,7 @@ check_coefs_old <- function(coefs, fit, template=FALSE){
 
   # If there are random effects, adjust the expected coefficient names
   # to remove the b vector and add the grouping covariate name
-  rand <- lapply(formulas, lme4::findbars)
+  rand <- lapply(formulas, reformulas::findbars)
   if(!all(sapply(rand, is.null))){
     stopifnot(all(required_subs %in% names(formulas)))
     rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars)))

diff --git a/R/gdistremoval.R b/R/gdistremoval.R
@@ -201,19 +201,19 @@ setMethod("getDesign", "unmarkedFrameGDR",
 
   if(return.frames) return(list(sc=sc, ysc=ysc, oc=oc))
 
-  lam_fixed <- lme4::nobars(formula$lambdaformula)
+  lam_fixed <- reformulas::nobars(formula$lambdaformula)
   Xlam <- model.matrix(lam_fixed,
             model.frame(lam_fixed, sc, na.action=NULL))
 
-  phi_fixed <- lme4::nobars(formula$phiformula)
+  phi_fixed <- reformulas::nobars(formula$phiformula)
   Xphi <- model.matrix(phi_fixed,
             model.frame(phi_fixed, ysc, na.action=NULL))
 
-  dist_fixed <- lme4::nobars(formula$distanceformula)
+  dist_fixed <- reformulas::nobars(formula$distanceformula)
   Xdist <- model.matrix(dist_fixed,
             model.frame(dist_fixed, ysc, na.action=NULL))
 
-  rem_fixed <- lme4::nobars(formula$removalformula)
+  rem_fixed <- reformulas::nobars(formula$removalformula)
   Xrem <- model.matrix(rem_fixed,
             model.frame(rem_fixed, oc, na.action=NULL))
 

diff --git a/R/getDesign.R b/R/getDesign.R
@@ -10,8 +10,8 @@ setGeneric("handleNA", function(umf, ...) standardGeneric("handleNA"))
 setMethod("getDesign", "unmarkedFrame",
     function(umf, formula, na.rm=TRUE)
 {
-    detformula <- lme4::nobars(as.formula(formula[[2]]))
-    stateformula <- lme4::nobars(as.formula(paste("~", formula[3], sep="")))
+    detformula <- reformulas::nobars(as.formula(formula[[2]]))
+    stateformula <- reformulas::nobars(as.formula(paste("~", formula[3], sep="")))
     detVars <- all.vars(detformula)
 
     M <- numSites(umf)

diff --git a/R/mixedModelTools.R b/R/mixedModelTools.R
@@ -5,16 +5,16 @@ get_xlev <- function(data, model_frame){
 }
 
 get_reTrms <- function(formula, data, newdata=NULL){
-  fb <- lme4::findbars(formula)
-  mf <- model.frame(lme4::subbars(formula), data, na.action=stats::na.pass)
-  if(is.null(newdata)) return(lme4::mkReTrms(fb, mf))
+  fb <- reformulas::findbars(formula)
+  mf <- model.frame(reformulas::subbars(formula), data, na.action=stats::na.pass)
+  if(is.null(newdata)) return(reformulas::mkReTrms(fb, mf))
   new_mf <- model.frame(stats::terms(mf), newdata, na.action=stats::na.pass,
                         xlev=get_xlev(data, mf))
-  lme4::mkReTrms(fb, new_mf, drop.unused.levels=FALSE)
+  reformulas::mkReTrms(fb, new_mf, drop.unused.levels=FALSE)
 }
 
 get_Z <- function(formula, data, newdata=NULL){
-  if(is.null(lme4::findbars(formula))){
+  if(is.null(reformulas::findbars(formula))){
     if(is.null(newdata)){
       return(Matrix::Matrix(matrix(0, nrow=nrow(data), ncol=0),sparse=TRUE))
     } else{
@@ -28,12 +28,12 @@ get_Z <- function(formula, data, newdata=NULL){
 }
 
 get_group_vars <- function(formula){
-  rand <- lme4::findbars(formula)
+  rand <- reformulas::findbars(formula)
   ifelse(is.null(rand), 0, length(rand))
 }
 
 get_nrandom <- function(formula, data){
-  rand <- lme4::findbars(formula)
+  rand <- reformulas::findbars(formula)
   if(length(rand)==0) return(as.array(0))
 
   out <- sapply(rand, function(x){
@@ -44,7 +44,7 @@ get_nrandom <- function(formula, data){
 }
 
 has_random <- function(formula){
-  length(lme4::findbars(formula)) > 0
+  length(reformulas::findbars(formula)) > 0
 }
 
 sigma_names <- function(formula, data){
@@ -57,7 +57,7 @@ sigma_names <- function(formula, data){
 }
 
 check_formula <- function(formula, data){
-  rand <- lme4::findbars(formula)
+  rand <- reformulas::findbars(formula)
   if(is.null(rand)) return(invisible())
 
   char <- paste(formula, collapse=" ")
@@ -159,7 +159,7 @@ print_randvar_info <- function(object){
 }
 
 check_no_support <- function(formula_list){
-  has_bars <- any(sapply(formula_list, function(x) !is.null(lme4::findbars(x))))
+  has_bars <- any(sapply(formula_list, function(x) !is.null(reformulas::findbars(x))))
   if(has_bars){
     stop("This function does not support random effects", call.=FALSE)
   }

diff --git a/R/occuCOP.R b/R/occuCOP.R
@@ -79,7 +79,7 @@ setMethod(
 
     # Occupancy submodel -------------------------------------------------------
     # Retrieve the fixed-effects part of the formula
-    psiformula <- lme4::nobars(as.formula(formlist$psiformula))
+    psiformula <- reformulas::nobars(as.formula(formlist$psiformula))
     psiVars <- all.vars(psiformula)
 
     # Retrieve the site covariates
@@ -109,7 +109,7 @@ setMethod(
     # Detection submodel -------------------------------------------------------
 
     # Retrieve the fixed-effects part of the formula
-    lambdaformula <- lme4::nobars(as.formula(formlist$lambdaformula))
+    lambdaformula <- reformulas::nobars(as.formula(formlist$lambdaformula))
     lambdaVars <- all.vars(lambdaformula)
 
     # Retrieve the observation covariates

diff --git a/R/power.R b/R/power.R
@@ -99,7 +99,7 @@ get_summary_df <- function(fit, effects, nulls){
   # Remove random effects from output list
   effects <- check_coefs(effects, fit, quiet=TRUE)
   rvars <- sapply(names(fit), function(x){
-                       bars <- lme4::findbars(get_formula(fit, x))
+                       bars <- reformulas::findbars(get_formula(fit, x))
                        all.vars(bars[[1]])
                       })
 

diff --git a/R/predict.R b/R/predict.R
@@ -40,7 +40,7 @@ setMethod("predict_internal", "unmarkedFit",
       is_raster <- TRUE
       orig_raster <- newdata
       check_vars <- all.vars(orig_formula)
-      if(!is.null(re.form) && is.na(re.form)) check_vars <- all.vars(lme4::nobars(orig_formula))
+      if(!is.null(re.form) && is.na(re.form)) check_vars <- all.vars(reformulas::nobars(orig_formula))
       newdata <- newdata_from_raster(newdata, check_vars)
     }
 
@@ -68,7 +68,7 @@ setMethod("predict_internal", "unmarkedFit",
 # This function makes sure factor levels in newdata match, and that
 # any functions in the formula are handled properly (e.g. scale)
 make_mod_matrix <- function(formula, data, newdata, re.form=NULL){
-  form_nobars <- lme4::nobars(formula)
+  form_nobars <- reformulas::nobars(formula)
   mf <- model.frame(form_nobars, data, na.action=stats::na.pass)
   X.terms <- stats::terms(mf)
   fac_cols <- data[, sapply(data, is.factor), drop=FALSE]
@@ -78,7 +78,7 @@ make_mod_matrix <- function(formula, data, newdata, re.form=NULL){
   #X <- model.matrix(X.terms, newdata, xlev=xlevs)
   X <- model.matrix(form_nobars, nmf)
   offset <- model.offset(nmf)
-  if(is.null(re.form) & !is.null(lme4::findbars(formula))){
+  if(is.null(re.form) & !is.null(reformulas::findbars(formula))){
     Z <- get_Z(formula, data, newdata)
     X <- cbind(X, Z)
   }

diff --git a/R/simulate.R b/R/simulate.R
@@ -48,7 +48,7 @@ check_coefs <- function(coefs, fit, name = "coefs", quiet = FALSE){
 
   # If there are random effects, adjust the expected coefficient names
   # to remove the b vector and add the grouping covariate name
-  rand <- lapply(formulas, lme4::findbars)
+  rand <- lapply(formulas, reformulas::findbars)
   if(!all(sapply(rand, is.null))){
     stopifnot(all(required_subs %in% names(formulas)))
     rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars)))
@@ -106,7 +106,7 @@ check_coefs <- function(coefs, fit, name = "coefs", quiet = FALSE){
 generate_random_effects <- function(coefs, fit){
   required_subs <- names(fit@estimates@estimates)
   formulas <- sapply(names(fit), function(x) get_formula(fit, x))
-  rand <- lapply(formulas, lme4::findbars)
+  rand <- lapply(formulas, reformulas::findbars)
   if(!all(sapply(rand, is.null))){
     rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars)))
     for (i in required_subs){