Merge pull request #432 from easystats/strengejacke/issue430

CRAN update before  2025-03-24

Author: DominiqueMakowski

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: modelbased
 Title: Estimation of Model-Based Predictions, Contrasts and Means
-Version: 0.9.0.42
+Version: 0.10.0
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",
@@ -102,4 +102,3 @@ Roxygen: list(markdown = TRUE)
 Config/Needs/check: stan-dev/cmdstanr
 Config/Needs/website: easystats/easystatstemplate
 LazyData: true
-Remotes: easystats/see, easystats/parameters, easystats/insight

NEWS.md

@@ -1,4 +1,4 @@
-# modelbased (devel)
+# modelbased 0.10.0
 
 ## Breaking Changes
 
@@ -39,6 +39,10 @@
 * The `print()` method is now explicitly documented and gets some new options
   to customize the output for tables.
 
+* `estimate_grouplevel()` gets a new option, `type = "total"`, to return the
+  sum of fixed and random effects (similar to what `coef()` returns for (Bayesian)
+  mixed models).
+
 * New option `"esarey"` for the `p_adjust` argument. The `"esarey"` option is
   specifically for the case of Johnson-Neyman intervals, i.e. when calling
   `estimate_slopes()` with two numeric predictors in an interaction term.
@@ -74,6 +78,8 @@
 
 * Fixed issues in `estimate_contrasts()` when filtering numeric values in `by`.
 
+* Fixed issues in `estimate_grouplevel()`.
+
 * Fixed issue in `estimate_slopes()` for models from package *lme4*.
 
 # modelbased 0.9.0

R/describe_nonlinear.R

@@ -41,7 +41,7 @@ describe_nonlinear.estimate_predicted <- function(data,
 #' @export
 describe_nonlinear.numeric <- function(data, x = NULL, ...) {
   if (is.null(x)) {
-    x <- seq_len(length(data))
+    x <- seq_along(data)
   }
 
   describe_nonlinear(data.frame(x = x, y = data), x = "x", y = "y")

R/estimate_grouplevel.R

@@ -16,8 +16,9 @@
 #'   the sum of the random effect and its corresponding fixed effects, which
 #'   internally relies on the `coef()` method (see `?coef.merMod`). Note that
 #'   `type = "total"` yet does not return uncertainty indices (such as SE and CI)
-#'   for models from *lme4* or *glmmTMB*, as these are not computable. However, for
-#'   Bayesian models, it is possible to compute them.
+#'   for models from *lme4* or *glmmTMB*, as the necessary information to
+#'   compute them is not yet available. However, for Bayesian models, it is
+#'   possible to compute them.
 #' @param ... Other arguments passed to or from other methods.
 #'
 #' @details
@@ -94,7 +95,7 @@ estimate_grouplevel <- function(model, type = "random", ...) {
     # Save brms name (just in case)
     random$Name <- random$Parameter
     # Filter out non-random effects
-    random <- random[grepl("^r_", random$Parameter), ]
+    random <- random[startsWith(random$Parameter, "r_"), ]
     # Remove Group from Level
     random$Level <- sapply(1:nrow(random), function(i) gsub(paste0("^", random$Group[i], "\\."), "", random$Level[i]))
     # Find the group name (what follows "r_" and before the first "[" or "__")

R/estimate_slopes.R

@@ -158,10 +158,7 @@ estimate_slopes <- function(model,
   info <- attributes(estimated)
 
   # Table formatting
-  table_footer <- paste("\nMarginal effects estimated for", info$trend)
-  if (!is.null(attributes(trends)$slope)) {
-    table_footer <- paste0(table_footer, "\nType of slope was ", attributes(trends)$slope)
-  }
+  table_footer <- .table_footer_slopes(trends, model = model, info = info)
   attr(trends, "table_title") <- c("Estimated Marginal Effects", "blue")
   attr(trends, "table_footer") <- c(table_footer, "yellow")
 

R/smoothing.R

@@ -41,7 +41,7 @@ smoothing.numeric <- function(x, method = "loess", strength = 0.25, ...) {
       {
         stats::predict(stats::loess(
           paste0("y ~ x"),
-          data = data.frame(y = x, x = seq_len(length(x))),
+          data = data.frame(y = x, x = seq_along(x)),
           span = strength
         ))
       },
@@ -55,7 +55,7 @@ smoothing.numeric <- function(x, method = "loess", strength = 0.25, ...) {
         )
         stats::predict(stats::loess(
           paste0("y ~ x"),
-          data = data.frame(y = x, x = seq_len(length(x))),
+          data = data.frame(y = x, x = seq_along(x)),
           span = strength
         ))
       }

R/standardize_methods.R

@@ -10,7 +10,7 @@ standardize.estimate_predicted <- function(x, include_response = TRUE, ...) {
   x[names(data)] <- datawizard::standardize(as.data.frame(x)[names(data)], reference = data, ...)
 
   # Standardize response
-  if (include_response == TRUE && insight::model_info(attributes(x)$model)$is_linear) {
+  if (include_response && insight::model_info(attributes(x)$model)$is_linear) {
     resp <- insight::get_response(attributes(x)$model)
     disp <- attributes(datawizard::standardize(resp, ...))$scale
 

R/table_footer.R

@@ -141,3 +141,29 @@
 
   c(paste0(table_footer, "\n"), "yellow")
 }
+
+
+# Table footer slopes =========================================================
+
+
+.table_footer_slopes <- function(x, model = NULL, info = NULL) {
+  model_info <- info$model_info
+  # make sure we definitely have model information
+  if (is.null(model_info) && !is.null(model)) {
+    model_info <- insight::model_info(model)
+  }
+  transform <- info$transform
+
+  table_footer <- paste("\nMarginal effects estimated for", info$trend)
+  if (!is.null(attributes(x)$slope)) {
+    table_footer <- paste0(table_footer, "\nType of slope was ", attributes(x)$slope)
+  }
+  if (isTRUE(model_info$is_linear) && !isTRUE(transform)) {
+    # add information about response transformation
+    trans_fun <- .safe(insight::find_transformation(model))
+    if (!is.null(trans_fun) && trans_fun != "identity") {
+      table_footer <- paste0(table_footer, "\nSlopes are on the ", trans_fun, "-scale (consider `transform=TRUE`).")
+    }
+  }
+  table_footer
+}

R/visualisation_recipe_internal.R

@@ -294,7 +294,7 @@
 
   # Uncertainty -----------------------------------
   if (!identical(ribbon, "none") && aes$type == "ribbon" && is.null(aes$alpha)) {
-    for (i in seq_len(length(aes$ymin))) {
+    for (i in seq_along(aes$ymin)) {
       # base list elements
       aes_list <- list(
         y = aes$y,

R/zero_crossings.R

@@ -11,14 +11,14 @@
 #'
 #' @examples
 #' x <- sin(seq(0, 4 * pi, length.out = 100))
-#' plot(x, type = "b")
+#' # plot(x, type = "b")
 #'
-#' zero_crossings(x)
-#' find_inversions(x)
+#' modelbased::zero_crossings(x)
+#' modelbased::find_inversions(x)
 #' @export
 zero_crossings <- function(x) {
   # Estimate gradient
-  zerocrossings <- .uniroot.all(stats::approxfun(seq_len(length(x)), x), interval = range(seq_len(length(x))))
+  zerocrossings <- .uniroot.all(stats::approxfun(seq_along(x), x), interval = range(seq_along(x)))
   if (length(zerocrossings) == 0) {
     return(NA)
   }

R/zzz.R

@@ -1,4 +1,4 @@
 .onLoad <- function(libname, pkgname) {
   # CRAN OMP THREAD LIMIT
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  Sys.setenv(OMP_THREAD_LIMIT = 2)
 }

cran-comments.md

@@ -1,3 +1 @@
-## R CMD check results
-
-0 errors | 0 warnings | 0 note
+This release fixes CRAN check failures.

man/estimate_grouplevel.Rd

@@ -5,7 +5,7 @@ skip_if_not_installed("glmmTMB")
 test_that("estimate_means correct inverse link for glmmTMB", {
   data(mtcars)
   d <- mtcars
-  d$count <- rep(c(0, 0, 0, 0, 1, 2, 4), length.out = nrow(mtcars))
+  d$count <- rep_len(c(0, 0, 0, 0, 1, 2, 4), nrow(mtcars))
   m <- glmmTMB::glmmTMB(
     count ~ cyl,
     data = datawizard::data_modify(d, cyl = as.factor(cyl)),
@@ -50,7 +50,7 @@ test_that("estimate_means correct inverse link for glmer", {
   data(efc, package = "modelbased")
 
   x <- which(efc$negc7d == 1 & efc$c172code == 3)
-  efc$negc7d[x[sample(1:length(x), round(length(x) / 1.1))]] <- 0
+  efc$negc7d[x[sample.int(length(x), round(length(x) / 1.1))]] <- 0
   efc$c172code <- as.factor(efc$c172code)
   fit <- lme4::glmer(
     negc7d ~ c12hour + e42dep + c161sex + c172code + (1 | grp),

man/zero_crossings.Rd

@@ -45,7 +45,7 @@ test_that("estimate_contrast, filterin in `by` and `contrast`", {
 
   out <- estimate_contrasts(
     m,
-    c("e42dep=c('independent','slightly dependent','moderately dependent')"),
+    "e42dep=c('independent','slightly dependent','moderately dependent')",
     by = "c172code",
     estimate = "average"
   )

tests/testthat/test-backtransform_invlink.R

@@ -873,7 +873,7 @@ test_that("estimate_contrast, filterin in `by` and `contrast`", {
 
   out <- estimate_contrasts(
     m,
-    c("e42dep=c('independent','slightly dependent','moderately dependent')"),
+    "e42dep=c('independent','slightly dependent','moderately dependent')",
     by = "c172code"
   )
   expect_identical(dim(out), c(9L, 10L))

tests/testthat/test-estimate_contrasts-average.R

@@ -314,6 +314,6 @@ Let's replicate this step-by-step:
 
 # Conclusion
 
-While the current implementation in `estimate_contrasts()` already covers many common use cases for testing contrasts and pairwise comparison, there still might be the need for more sophisticated comparisons. In this case, we recommend using the [*marginaleffects*](https://marginaleffects.com/) package directly. Some further related recommended readings are the vignettes about [Comparisons](https://marginaleffects.com/vignettes/comparisons.html) or [Hypothesis Tests](https://marginaleffects.com/vignettes/hypothesis.html).
+While the current implementation in `estimate_contrasts()` already covers many common use cases for testing contrasts and pairwise comparison, there still might be the need for more sophisticated comparisons. In this case, we recommend using the [*marginaleffects*](https://marginaleffects.com/) package directly. Some further related recommended readings are the vignettes about [Comparisons](https://marginaleffects.com/chapters/comparisons.html) or [Hypothesis Tests](https://marginaleffects.com/chapters/hypothesis.html).
 
 [Go to next vignette: **Comparisons of Slopes, Floodlight and Spotlight Analysis (Johnson-Neyman Intervals)**](https://easystats.github.io/modelbased/articles/introduction_comparisons_2.html)

tests/testthat/test-estimate_contrasts.R

@@ -27,7 +27,7 @@ pkgs <- c("glmmTMB", "marginaleffects", "ggplot2", "see", "brms")
 if (!all(insight::check_if_installed(pkgs, quietly = TRUE))) {
   knitr::opts_chunk$set(eval = FALSE)
 }
-if (!getRversion() >= "4.1.0") {
+if (getRversion() < "4.1.0") {
   knitr::opts_chunk$set(eval = FALSE)
 }
 ```

vignettes/introduction_comparisons_1.Rmd

@@ -36,7 +36,7 @@ pkgs <- c(
 if (!all(insight::check_if_installed(pkgs, quietly = TRUE))) {
   knitr::opts_chunk$set(eval = FALSE)
 }
-if (!getRversion() >= "4.1.0") {
+if (getRversion() < "4.1.0") {
   knitr::opts_chunk$set(eval = FALSE)
 }
 ```

vignettes/practical_causality.Rmd

@@ -20,8 +20,7 @@ knitr::opts_chunk$set(
   collapse = TRUE,
   comment = "#>",
   warning = FALSE,
-  message = TRUE,
-  package.startup.message = FALSE
+  message = TRUE
 )
 options(knitr.kable.NA = "", digits = 2, width = 800, modelbased_join_dots = FALSE)
 pkgs <- c("ggplot2", "marginaleffects", "collapse", "Formula")