Merge branch 'main' into performance_simulated_res

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.8.0.7
+Version: 0.8.2.4
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -63,15 +63,15 @@ Depends:
     R (>= 3.6),
     stats
 Imports:
-    bayestestR (>= 0.13.1),
+    bayestestR (>= 0.13.2),
     correlation (>= 0.8.4),
-    datawizard (>= 0.9.0),
+    datawizard (>= 0.9.1),
     effectsize (>= 0.8.6),
-    ggplot2 (>= 3.4.3),
-    insight (>= 0.19.5),
-    modelbased (>= 0.8.6),
-    parameters (>= 0.21.2),
-    performance (>= 0.10.5)
+    ggplot2 (>= 3.4.0),
+    insight (>= 0.19.8),
+    modelbased (>= 0.8.7),
+    parameters (>= 0.21.5),
+    performance (>= 0.10.9)
 Suggests:
     brms,
     curl,
@@ -94,7 +94,7 @@ Suggests:
     metafor,
     NbClust,
     nFactors,
-    patchwork,
+    patchwork (>= 1.2.0),
     poorman,
     psych,
     qqplotr (>= 0.0.6),
@@ -103,18 +103,18 @@ Suggests:
     rlang,
     rmarkdown,
     rstanarm,
-    scales (>= 1.2.1),
+    scales (>= 1.3.0),
     splines,
-    testthat (>= 3.1.7),
+    testthat (>= 3.2.1),
     tidygraph,
-    vdiffr (>= 1.0.6)
+    vdiffr (>= 1.0.7)
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3.9000
+RoxygenNote: 7.3.1
 Config/testthat/edition: 3
 Config/Needs/website:
     rstudio/bslib,
     r-lib/pkgdown,
     easystats/easystatstemplate
-Remotes: easystats/bayestestR
+Config/rcmdcheck/ignore-inconsequential-notes: true

NEWS.md

@@ -1,25 +1,41 @@
 # see (development version)
 
+# see 0.8.2
+
+## Minor Changes
+
+* `plot.n_factors()` now shows a dashed line over the bars, indicating the
+  cumulate explained variance by the number of factors.
+
+* `plot.check_outliers()` now dodges the x-axis labels, to avoid overlapping
+  labels.
+
+# see 0.8.1
+
 ## Major Changes
 
 * This release changes the licensing model of `{see}` to an MIT license.
 
 ## New features
 
-* There is now a `plot()` method for outputs of `datawizard::data_tabulate()` 
+* There is now a `plot()` method for outputs of `datawizard::data_tabulate()`
   (#293).
 
 ## Minor Changes
 
 * The `print()` method for `performance::check_model()` now also evaluates the
   default plot type for posterior predictive checks.
+
 * QQ/PP-plots now default to drawing simultaneous testing bands (when the
   `qqplotr` package is available). Previous behavior can be restored by setting
   `method = "pointwise"`.
-* Plot method for `performance::check_normality()` now default to a detrended 
+
+* Plot method for `performance::check_normality()` now default to a detrended
   QQ-plot. Previous behavior can be restored by setting `type = "density"`.
+
 * Plot method for `binned_residuals()` gains a `show_smooth` argument, to show
   or hide the smooth line.
+
 * Plot method for `check_predictions()` gains a `x_limits` argument, to limit
   the x-axis-range. This can be useful to "zoom in" certain parts of the plot.
 

R/data_plot.R

@@ -132,6 +132,9 @@ add_plot_attributes <- function(x) {
   if (!is.null(info$title)) {
     out[[length(out) + 1L]] <- ggplot2::labs(title = info$title)
   }
+  if (!is.null(info$subtitle)) {
+    out[[length(out) + 1L]] <- ggplot2::labs(subtitle = info$subtitle)
+  }
 
   out
 }
@@ -181,7 +184,7 @@ add_plot_attributes <- function(x) {
 
 #' @keywords internal
 .dynGet <- function(x,
-                    ifnotfound = stop(gettextf("%s not found", sQuote(x)), domain = NA),
+                    ifnotfound = stop(gettextf("%s not found", sQuote(x)), domain = NA, call. = FALSE),
                     minframe = 1L,
                     inherits = FALSE) {
   x <- insight::safe_deparse(x)

R/geom_binomdensity.R

@@ -62,7 +62,7 @@ geom_binomdensity <- function(data,
 
   # Other parameters
   data$.side <- ifelse(data[[y]] == y_levels[1], "top", "bottom")
-  data$.justification <- as.numeric(!(data[[y]] == y_levels[1]))
+  data$.justification <- as.numeric(data[[y]] != y_levels[1])
   data$.scale <- .geom_binomdensity_scale(data, x, y, scale)
 
   # ggdist geom

R/geom_from_list.R

@@ -114,58 +114,68 @@
 #' @export
 geom_from_list <- function(x, ...) {
   # Additional parameters ------------------------------------------------------
-  args <- x[!names(x) %in% c("geom", "aes", "data", "width", "height", "position", "show.legend")]
+  arguments <- x[!names(x) %in% c("geom", "aes", "data", "width", "height", "position", "show.legend")]
 
   if (is.null(x$geom)) {
     return(NULL)
   }
 
   if (inherits(x$geom, "function")) {
-    return(do.call(x$geom, args))
+    return(do.call(x$geom, args = arguments))
   }
 
   if (x$geom %in% c("density_2d", "density_2d_filled", "density_2d_polygon")) {
-    if (!"contour" %in% names(args)) args$contour <- TRUE
-    if (!"contour_var" %in% names(args)) args$contour_var <- "density"
+    if (!"contour" %in% names(arguments)) arguments$contour <- TRUE
+    if (!"contour_var" %in% names(arguments)) arguments$contour_var <- "density"
   }
 
   # If they are not geoms, return immediately
   if (x$geom == "labs") {
-    return(do.call(ggplot2::labs, args))
+    return(do.call(ggplot2::labs, args = arguments))
   }
   if (x$geom == "guides") {
-    return(do.call(ggplot2::guides, args))
+    return(do.call(ggplot2::guides, args = arguments))
   }
   if (x$geom == "coord_flip") {
-    return(do.call(ggplot2::coord_flip, args))
+    return(do.call(ggplot2::coord_flip, args = arguments))
   }
   if (x$geom == "facet_wrap") {
-    return(do.call(ggplot2::facet_wrap, args))
+    return(do.call(ggplot2::facet_wrap, args = arguments))
   }
   if (x$geom == "facet_grid") {
-    return(do.call(ggplot2::facet_grid, args))
+    return(do.call(ggplot2::facet_grid, args = arguments))
   }
   if (x$geom == "smooth") {
-    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
-    if (!"method" %in% names(args)) args$method <- "loess"
-    if (!"formula" %in% names(args)) args$formula <- "y ~ x"
-    return(do.call(ggplot2::geom_smooth, args))
+    if (!is.null(x$aes)) {
+      arguments$mapping <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
+    }
+    if (!"method" %in% names(arguments)) {
+      arguments$method <- "loess"
+    }
+    if (!"formula" %in% names(arguments)) {
+      arguments$formula <- "y ~ x"
+    }
+    return(do.call(ggplot2::geom_smooth, args = arguments))
   }
 
   if (startsWith(x$geom, "scale_") || startsWith(x$geom, "theme") || startsWith(x$geom, "see_")) {
-    return(do.call(x$geom, args))
+    return(do.call(x$geom, args = arguments))
   }
 
   if (startsWith(x$geom, "ggside::")) {
     insight::check_if_installed("ggside")
-    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
-    return(do.call(eval(parse(text = x$geom)), args))
+    if (!is.null(x$aes)) {
+      arguments$mapping <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
+    }
+    return(do.call(eval(parse(text = x$geom)), args = arguments))
   }
 
   if (startsWith(x$geom, "ggraph::")) {
     insight::check_if_installed("ggraph")
-    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
-    return(do.call(eval(parse(text = x$geom)), args))
+    if (!is.null(x$aes)) {
+      arguments$mapping <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
+    }
+    return(do.call(eval(parse(text = x$geom)), args = arguments))
   }
 
   # Default parameters
@@ -179,7 +189,7 @@ geom_from_list <- function(x, ...) {
   }
 
   # Default for violin
-  if (x$geom == "violin") {
+  if (x$geom == "violin") { # nolint
     stat <- "ydensity"
     position <- "dodge"
   } else if (x$geom == "boxplot") {
@@ -212,7 +222,7 @@ geom_from_list <- function(x, ...) {
 
   # Aesthetics
   if ("aes" %in% names(x)) {
-    aes_list <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
+    aes_list <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
   } else {
     aes_list <- NULL
   }
@@ -231,7 +241,7 @@ geom_from_list <- function(x, ...) {
     geom = x$geom,
     mapping = aes_list,
     data = x$data,
-    params = args,
+    params = arguments,
     show.legend = show.legend,
     ...
   )

R/plot.check_collinearity.R

@@ -69,11 +69,11 @@ plot.see_check_collinearity <- function(x,
   xlim <- nrow(x)
   if (ylim < 10) ylim <- 10
 
-  if (!is.null(ci_data)) {
-    x <- cbind(x, ci_data)
-  } else {
+  if (is.null(ci_data)) {
     x$VIF_CI_low <- NA_real_
     x$VIF_CI_high <- NA_real_
+  } else {
+    x <- cbind(x, ci_data)
   }
 
   # make sure legend is properly sorted
@@ -118,33 +118,33 @@ plot.see_check_collinearity <- function(x,
       fill = colors[3],
       color = NA,
       alpha = 0.15
-    ) +
-    {
-      if (!is.null(ci_data)) {
-        list(
-          ggplot2::geom_linerange(
-            linewidth = size_line,
-            na.rm = TRUE
-          ),
-          ggplot2::geom_segment(
-            data = x[x$VIF_CI_high > ylim * 1.15, ],
-            mapping = aes(
-              x = .data$x,
-              xend = .data$x,
-              y = .data$y,
-              yend = .data$VIF_CI_high
-            ),
-            lineend = "round",
-            linejoin = "round",
-            arrow = ggplot2::arrow(
-              ends = "last", type = "closed",
-              angle = 20, length = ggplot2::unit(0.03, "native")
-            ),
-            show.legend = FALSE
-          )
-        )
-      }
-    } +
+    )
+
+  if (!is.null(ci_data)) {
+    p <- p +
+      ggplot2::geom_linerange(
+        linewidth = size_line,
+        na.rm = TRUE
+      ) +
+      ggplot2::geom_segment(
+        data = x[x$VIF_CI_high > ylim * 1.15, ],
+        mapping = aes(
+          x = .data$x,
+          xend = .data$x,
+          y = .data$y,
+          yend = .data$VIF_CI_high
+        ),
+        lineend = "round",
+        linejoin = "round",
+        arrow = ggplot2::arrow(
+          ends = "last", type = "closed",
+          angle = 20, length = ggplot2::unit(0.03, "native")
+        ),
+        show.legend = FALSE
+      )
+  }
+
+  p <- p +
     geom_point2(
       size = size_point,
       na.rm = TRUE

R/plot.check_heteroscedasticity.R

@@ -24,23 +24,25 @@ plot.see_check_heteroscedasticity <- function(x, data = NULL, ...) {
 
   faminfo <- insight::model_info(model)
   r <- tryCatch(
-    {
-      if (inherits(model, "merMod")) {
-        stats::residuals(model, scaled = TRUE)
-      } else if (inherits(model, c("glmmTMB", "MixMod"))) {
-        sigma <- if (faminfo$is_mixed) {
-          sqrt(insight::get_variance_residual(model))
-        } else {
-          .sigma_glmmTMB_nonmixed(model, faminfo)
-        }
-        stats::residuals(model) / sigma
-      } else if (inherits(model, "glm")) {
-        stats::rstandard(model, type = "pearson")
+    if (inherits(model, "merMod")) {
+      stats::residuals(model, scaled = TRUE)
+    } else if (inherits(model, c("glmmTMB", "MixMod"))) {
+      sig <- if (faminfo$is_mixed) {
+        sqrt(insight::get_variance_residual(model))
       } else {
-        stats::rstandard(model)
+        .sigma_glmmTMB_nonmixed(model, faminfo)
       }
+      stats::residuals(model) / sig
+    } else if (inherits(model, "glm")) {
+      stats::rstandard(model, type = "pearson")
+    } else {
+      stats::rstandard(model)
     },
     error = function(e) {
+      # debugging
+      if (getOption("easystats_erros", FALSE)) {
+        insight::format_error(e$message)
+      }
       NULL
     }
   )

R/plot.check_model.R

@@ -39,6 +39,7 @@ plot.see_check_model <- function(x,
   model_info <- attr(x, "model_info")
   overdisp_type <- attr(x, "overdisp_type")
   plot_type <- attr(x, "type")
+  model_class <- attr(x, "model_class")
 
   if (missing(type) && !is.null(plot_type) && plot_type %in% c("density", "discrete_dots", "discrete_interval", "discrete_both")) {
     type <- plot_type
@@ -174,7 +175,8 @@ plot.see_check_model <- function(x,
       colors = colors,
       dot_alpha_level = dot_alpha_level,
       show_dots = TRUE, # qq-plots w/o dots makes no sense
-      model_info = model_info
+      model_info = model_info,
+      model_class = model_class
     )
   }
 
@@ -209,9 +211,9 @@ plot.see_check_model <- function(x,
     pw <- plots(p, n_columns = n_columns)
     .safe_print_plots(pw, ...)
     invisible(pw)
-  } else {
-    return(p)
   }
+
+  p
 }