Prepare CRAN release, try to reduce time for examples (#361)

* Prepare CRAN release, try to reduce time for examples * fix * shorten examples * skip examples * thread limit * use ribbon = "none" * add global option for joining dots * typo * skip tests on CRAN * Update DESCRIPTION
easystats · Jan 23, 2025 · 6ca6cf7 · 6ca6cf7
1 parent c6dd079
commit 6ca6cf7
Show file tree

Hide file tree

Showing 25 changed files with 94 additions and 73 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: modelbased
 Title: Estimation of Model-Based Predictions, Contrasts and Means
-Version: 0.8.9.100
+Version: 0.8.9.101
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",

diff --git a/R/estimate_contrasts.R b/R/estimate_contrasts.R
@@ -40,7 +40,7 @@
 #'
 #' @inherit estimate_slopes details
 #'
-#' @examplesIf all(insight::check_if_installed(c("lme4", "emmeans", "rstanarm"), quietly = TRUE))
+#' @examplesIf all(insight::check_if_installed(c("lme4", "marginaleffects", "rstanarm"), quietly = TRUE))
 #' \dontrun{
 #' # Basic usage
 #' model <- lm(Sepal.Width ~ Species, data = iris)

diff --git a/R/estimate_grouplevel.R b/R/estimate_grouplevel.R
@@ -18,7 +18,7 @@
 #'   indices (such as SE and CI), as these are not computable.
 #' @param ... Other arguments passed to or from other methods.
 #'
-#' @examplesIf require("lme4") && require("see")
+#' @examplesIf all(insight::check_if_installed(c("see", "lme4"), quietly = TRUE))
 #' # lme4 model
 #' data(mtcars)
 #' model <- lme4::lmer(mpg ~ hp + (1 | carb), data = mtcars)

diff --git a/R/estimate_means.R b/R/estimate_means.R
@@ -115,7 +115,7 @@
 #' Heiss, A. (2022). Marginal and conditional effects for GLMMs with
 #' {marginaleffects}. Andrew Heiss. \doi{10.59350/xwnfm-x1827}
 #'
-#' @examplesIf all(insight::check_if_installed(c("emmeans", "see", "lme4"), quietly = TRUE))
+#' @examplesIf all(insight::check_if_installed(c("marginaleffects", "see", "lme4"), quietly = TRUE))
 #' library(modelbased)
 #'
 #' # Frequentist models
@@ -136,6 +136,7 @@
 #' # `?insight::get_datagrid`.
 #' estimate_means(model, by = c("Species", "Sepal.Width = [fivenum]"))
 #'
+#' \dontrun{
 #' # same for factors: filter by specific levels
 #' estimate_means(model, by = "Species=c('versicolor', 'setosa')")
 #' estimate_means(model, by = c("Species", "Sepal.Width=0"))
@@ -156,7 +157,6 @@
 #' plot(means) # which runs visualisation_recipe()
 #' standardize(means)
 #'
-#' \donttest{
 #' data <- iris
 #' data$Petal.Length_factor <- ifelse(data$Petal.Length < 4.2, "A", "B")
 #'

diff --git a/R/estimate_slopes.R b/R/estimate_slopes.R
@@ -77,7 +77,7 @@
 #'
 #' @return A data.frame of class `estimate_slopes`.
 #'
-#' @examplesIf all(insight::check_if_installed(c("emmeans", "effectsize", "mgcv", "ggplot2", "see"), quietly = TRUE))
+#' @examplesIf all(insight::check_if_installed(c("marginaleffects", "effectsize", "mgcv", "ggplot2", "see"), quietly = TRUE))
 #' library(ggplot2)
 #' # Get an idea of the data
 #' ggplot(iris, aes(x = Petal.Length, y = Sepal.Width)) +
@@ -92,6 +92,7 @@
 #' slopes <- estimate_slopes(model, trend = "Petal.Length", by = "Species")
 #' slopes
 #'
+#' \dontrun{
 #' # Plot it
 #' plot(slopes)
 #' standardize(slopes)
@@ -108,6 +109,7 @@
 #' )
 #' summary(slopes)
 #' plot(slopes)
+#' }
 #' @export
 estimate_slopes <- function(model,
                             trend = NULL,

diff --git a/R/get_emcontrasts.R b/R/get_emcontrasts.R
@@ -4,6 +4,7 @@
 #' model <- lm(Sepal.Width ~ Species, data = iris)
 #' get_emcontrasts(model)
 #'
+#' \dontrun{
 #' # Dealing with interactions
 #' model <- lm(Sepal.Width ~ Species * Petal.Width, data = iris)
 #' # By default: selects first factor
@@ -16,6 +17,7 @@
 #' estimate_contrasts(model, contrast = c("Species", "Petal.Width=c(1, 2)"))
 #' # Or modulate it
 #' get_emcontrasts(model, by = "Petal.Width", length = 4)
+#' }
 #' @export
 get_emcontrasts <- function(model,
                             contrast = NULL,

diff --git a/R/get_emmeans.R b/R/get_emmeans.R
@@ -19,6 +19,7 @@
 #' # By default, 'by' is set to "Species"
 #' get_emmeans(model)
 #'
+#' \dontrun{
 #' # Overall mean (close to 'mean(iris$Sepal.Length)')
 #' get_emmeans(model, by = NULL)
 #'
@@ -31,6 +32,7 @@
 #' get_emmeans(model)
 #' get_emmeans(model, by = c("Species", "Petal.Length"), length = 2)
 #' get_emmeans(model, by = c("Species", "Petal.Length = c(1, 3, 5)"), length = 2)
+#' }
 #' @export
 get_emmeans <- function(model,
                         by = "auto",

diff --git a/R/get_emtrends.R b/R/get_emtrends.R
@@ -1,11 +1,13 @@
 #' @rdname get_emmeans
 #' @examplesIf insight::check_if_installed("emmeans", quietly = TRUE)
+#' \dontrun{
 #' model <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
 #'
 #' get_emtrends(model)
 #' get_emtrends(model, by = "Species")
 #' get_emtrends(model, by = "Petal.Length")
 #' get_emtrends(model, by = c("Species", "Petal.Length"))
+#' }
 #'
 #' model <- lm(Petal.Length ~ poly(Sepal.Width, 4), data = iris)
 #' get_emtrends(model)

diff --git a/R/get_marginalmeans.R b/R/get_marginalmeans.R
@@ -9,6 +9,7 @@
 #' # Overall mean (close to 'mean(iris$Sepal.Length)')
 #' get_marginalmeans(model, by = NULL)
 #'
+#' \dontrun{
 #' # One can estimate marginal means at several values of a 'modulate' variable
 #' get_marginalmeans(model, by = "Petal.Width", length = 3)
 #'
@@ -18,6 +19,7 @@
 #' get_marginalmeans(model)
 #' get_marginalmeans(model, by = c("Species", "Petal.Length"), length = 2)
 #' get_marginalmeans(model, by = c("Species", "Petal.Length = c(1, 3, 5)"), length = 2)
+#' }
 #' @export
 get_marginalmeans <- function(model,
                               by = "auto",

diff --git a/R/table_footer.R b/R/table_footer.R
@@ -84,7 +84,7 @@
     predict <- switch(predict,
       none = "link",
       prediction = ,
-      expectations = ,
+      expectation = ,
       `invlink(link)` = "response",
       predict
     )

diff --git a/R/visualisation_recipe.R b/R/visualisation_recipe.R
@@ -17,16 +17,23 @@
 #' @param x A modelbased object.
 #' @param show_data Logical, if `TRUE`, display the "raw" data as a background
 #'   to the model-based estimation.
-#' @param show_ci Logical, if `TRUE`, show error bars or uncertainty bands.
 #' @param join_dots Logical, if `TRUE` and for categorical focal terms in `by`,
 #' dots (estimates) are connected by lines, i.e. plots will be a combination of
 #' dots with error bars and connecting lines. If `FALSE`, only dots and error
-#' bars are shown.
+#' bars are shown. It is possible to set a global default value using `options()`,
+#' e.g. `options("modelbased_join_dots" = FALSE)`.
 #' @param point,line,pointrange,ribbon,facet,grid Additional
 #' aesthetics and parameters for the geoms (see customization example).
 #' @param ... Not used.
 #'
-#' @examplesIf require("ggplot2") && require("emmeans") && require("see") && getRversion() >= "4.1.0"
+#' @details There are two options to remove the confidence bands or errors bars
+#' from the plot. To remove error bars, simply set the `pointrange` geom to
+#' `point`, e.g. `plot(..., pointrange = list(geom = "point"))`. To remove the
+#' confidence bands from line geoms, use `ribbon = "none"`.
+#'
+#' @examplesIf all(insight::check_if_installed(c("marginaleffects", "see", "ggplot2"), quietly = TRUE)) && getRversion() >= "4.1.0"
+#' library(ggplot2)
+#' library(see)
 #' # ==============================================
 #' # estimate_relation, estimate_expectation, ...
 #' # ==============================================
@@ -39,6 +46,7 @@
 #' # visualization_recipe() is called implicitly when you call plot()
 #' plot(estimate_relation(lm(mpg ~ qsec, data = mtcars)))
 #'
+#' \dontrun{
 #' # And can be used in a pipe workflow
 #' lm(mpg ~ qsec, data = mtcars) |>
 #'   estimate_relation(ci = c(0.5, 0.8, 0.9)) |>
@@ -54,7 +62,6 @@
 #'   theme_minimal() +
 #'   labs(title = "Relationship between MPG and WT")
 #'
-#'
 #' # Customize raw data -------------
 #'
 #' plot(x, point = list(geom = "density_2d_filled"), line = list(color = "white")) +
@@ -107,22 +114,21 @@
 #' data <- data.frame(vs = mtcars$vs, cyl = as.factor(mtcars$cyl))
 #' x <- estimate_means(glm(vs ~ cyl, data = data, family = "binomial"), by = c("cyl"))
 #' plot(x)
+#' }
 #' @export
 visualisation_recipe.estimate_predicted <- function(x,
                                                     show_data = FALSE,
-                                                    show_ci = TRUE,
                                                     point = NULL,
                                                     line = NULL,
                                                     pointrange = NULL,
                                                     ribbon = NULL,
                                                     facet = NULL,
                                                     grid = NULL,
-                                                    join_dots = TRUE,
+                                                    join_dots = getOption("modelbased_join_dots", TRUE),
                                                     ...) {
   .visualization_recipe(
     x,
     show_data = show_data,
-    show_ci = show_ci,
     point = point,
     line = line,
     pointrange = pointrange,
@@ -141,7 +147,7 @@ visualisation_recipe.estimate_means <- visualisation_recipe.estimate_predicted
 
 #' @rdname visualisation_recipe.estimate_predicted
 #'
-#' @examplesIf require("ggplot2") && require("emmeans") && require("see")
+#' @examplesIf all(insight::check_if_installed(c("marginaleffects", "see", "ggplot2"), quietly = TRUE))
 #' # ==============================================
 #' # estimate_slopes
 #' # ==============================================
@@ -152,6 +158,7 @@ visualisation_recipe.estimate_means <- visualisation_recipe.estimate_predicted
 #' layers
 #' plot(layers)
 #'
+#' \dontrun{
 #' # Customize aesthetics and add horizontal line and theme
 #' layers <- visualisation_recipe(x, pointrange = list(size = 2, linewidth = 2))
 #' plot(layers) +
@@ -166,9 +173,9 @@ visualisation_recipe.estimate_means <- visualisation_recipe.estimate_predicted
 #' model <- lm(Petal.Length ~ Species * poly(Sepal.Width, 3), data = iris)
 #' x <- estimate_slopes(model, trend = "Sepal.Width", by = c("Sepal.Width", "Species"))
 #' plot(visualisation_recipe(x))
+#' }
 #' @export
 visualisation_recipe.estimate_slopes <- function(x,
-                                                 show_ci = TRUE,
                                                  line = NULL,
                                                  pointrange = NULL,
                                                  ribbon = NULL,
@@ -178,7 +185,6 @@ visualisation_recipe.estimate_slopes <- function(x,
   .visualization_recipe(
     x,
     show_data = FALSE,
-    show_ci = show_ci,
     line = line,
     pointrange = pointrange,
     ribbon = ribbon,
@@ -191,10 +197,11 @@ visualisation_recipe.estimate_slopes <- function(x,
 
 #' @rdname visualisation_recipe.estimate_predicted
 #'
-#' @examplesIf require("see") && require("lme4") && require("emmeans")
+#' @examplesIf all(insight::check_if_installed(c("ggplot2", "marginaleffects", "see", "lme4"), quietly = TRUE))
 #' # ==============================================
 #' # estimate_grouplevel
 #' # ==============================================
+#' \dontrun{
 #' data <- lme4::sleepstudy
 #' data <- rbind(data, data)
 #' data$Newfactor <- rep(c("A", "B", "C", "D"))
@@ -217,9 +224,9 @@ visualisation_recipe.estimate_slopes <- function(x,
 #' model <- lme4::lmer(Reaction ~ Days + (1 + Days | Subject) + (1 | Newfactor), data = data)
 #' x <- estimate_grouplevel(model)
 #' plot(x)
+#' }
 #' @export
 visualisation_recipe.estimate_grouplevel <- function(x,
-                                                     show_ci = TRUE,
                                                      line = NULL,
                                                      pointrange = NULL,
                                                      ribbon = NULL,
@@ -235,7 +242,6 @@ visualisation_recipe.estimate_grouplevel <- function(x,
   .visualization_recipe(
     x,
     show_data = FALSE,
-    show_ci = show_ci,
     line = line,
     pointrange = pointrange,
     ribbon = ribbon,

diff --git a/R/visualisation_recipe_internal.R b/R/visualisation_recipe_internal.R
@@ -2,7 +2,7 @@
 
 
 #' @keywords internal
-.find_aes <- function(x, show_ci = TRUE) {
+.find_aes <- function(x) {
   data <- as.data.frame(x)
   data$.group <- 1
 
@@ -56,10 +56,8 @@
     # If x is a not-numeric, make pointrange
     if (is.numeric(data[[by[1]]])) {
       aes$type <- "ribbon"
-    } else if (isTRUE(show_ci)) {
-      aes$type <- "pointrange"
     } else {
-      aes$type <- "point"
+      aes$type <- "pointrange"
     }
   }
   if (length(by) > 1) {
@@ -86,9 +84,7 @@
   }
 
   # CI
-  if (isTRUE(show_ci)) {
-    aes <- .find_aes_ci(aes, data)
-  }
+  aes <- .find_aes_ci(aes, data)
 
   # axis and legend labels
   if (!is.null(model_data) && !is.null(model_response)) {
@@ -138,7 +134,6 @@
 #' @keywords internal
 .visualization_recipe <- function(x,
                                   show_data = TRUE,
-                                  show_ci = TRUE,
                                   point = NULL,
                                   line = NULL,
                                   pointrange = NULL,
@@ -148,7 +143,7 @@
                                   join_dots = TRUE,
                                   ...) {
   response_scale <- attributes(x)$predict
-  aes <- .find_aes(x, show_ci)
+  aes <- .find_aes(x)
   data <- aes$data
   aes <- aes$aes
   layers <- list()
@@ -161,7 +156,7 @@
   }
 
   # Don't plot raw data if `predict` is not on the response scale
-  if (!is.null(response_scale) && !response_scale %in% c("prediction", "response", "expectations", "invlink(link)")) {
+  if (!is.null(response_scale) && !response_scale %in% c("prediction", "response", "expectation", "invlink(link)")) {
     show_data <- FALSE
   }
 
@@ -174,7 +169,7 @@
   }
 
   # Uncertainty -----------------------------------
-  if (isTRUE(show_ci) && aes$type == "ribbon" && is.null(aes$alpha)) {
+  if (!identical(ribbon, "none") && aes$type == "ribbon" && is.null(aes$alpha)) {
     for (i in seq_len(length(aes$ymin))) {
       layers[[paste0("l", l)]] <- list(
         geom = "ribbon",
@@ -217,7 +212,7 @@
     l <- l + 1
   }
 
-  # points with error bars - when show_ci = TRUE
+  # points with error bars
   if (aes$type %in% c("pointrange", "grouplevel")) {
     layers[[paste0("l", l)]] <- list(
       geom = "pointrange",
@@ -244,26 +239,6 @@
     l <- l + 1
   }
 
-  # only points, no error bars - when show_ci = FALSE
-  if (aes$type == "point") {
-    layers[[paste0("l", l)]] <- list(
-      geom = "point",
-      data = data,
-      aes = list(
-        y = aes$y,
-        x = aes$x,
-        color = aes$color,
-        group = aes$group,
-        alpha = aes$alpha
-      )
-    )
-    if (!is.null(aes$color)) {
-      layers[[paste0("l", l)]]$position <- "dodge"
-      layers[[paste0("l", l)]]$width <- 0.2
-    }
-    if (!is.null(point)) layers[[paste0("l", l)]] <- utils::modifyList(layers[[paste0("l", l)]], point)
-    l <- l + 1
-  }
 
   # grids and facets ----------------------------------
   if (!is.null(aes$facet)) {

diff --git a/R/zzz.R b/R/zzz.R
@@ -0,0 +1,4 @@
+.onLoad <- function(libname, pkgname) {
+  # CRAN OMP THREAD LIMIT
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+}