plot.n_factors: Add % of variance to plot

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.8.1
+Version: 0.8.1.1
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -1,3 +1,10 @@
+# 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.
+
 # see 0.8.1
 
 ## Major Changes

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
 }

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

@@ -112,60 +112,70 @@
 #'   geom_from_list(list(geom = "ggside::scale_xsidey_continuous", breaks = NULL))
 #'
 #' @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 @@
   }
 
   # Default for violin
   if (x$geom == "violin") {
     stat <- "ydensity"
     position <- "dodge"
   } else if (x$geom == "boxplot") {
@@ -212,7 +222,7 @@
 
   # 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 = 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 @@
   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
@@ -119,33 +119,31 @@
       color = NA,
       alpha = 0.15
     ) +
-    {
-      if (!is.null(ci_data)) {
-        list(
-          ggplot2::geom_linerange(
-            linewidth = size_line,
-            na.rm = TRUE
+    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")
           ),
-          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
-          )
+          show.legend = FALSE
         )
-      }
+      )
     } +
     geom_point2(
       size = size_point,
       na.rm = TRUE
     ) +

R/plot.check_heteroscedasticity.R

@@ -7,7 +7,7 @@
 #'
 #' @return A ggplot2-object.
 #'
 #' @seealso See also the vignette about [`check_model()`](https://easystats.github.io/performance/articles/check_model.html).
 #'
 #' @examplesIf require("performance")
 #' m <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars)
@@ -24,21 +24,19 @@
 
   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) {
       NULL