theme argument of check_model() has no effect. (#426)

Fixes easystats/performance#851

Author: strengejacke

DESCRIPTION

@@ -127,3 +127,4 @@ Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
+Remotes: easystats/performance

NEWS.md

@@ -4,6 +4,10 @@
 
 * Daniel Lüdecke is now the main maintainer of the package.
 
+* Several `plot()` methods gain a `theme` argument, to control the visual
+  themes for plots. This is in particular useful for plots that consist of
+  several single plots, like the one returned by `check_model()`.
+
 ## Changes
 
 * `plot()` for `check_model()` now limits the number of data points for models

R/plot.binned_residuals.R

@@ -8,9 +8,18 @@ plot.see_binned_residuals <- function(
   base_size = 10,
   colors = social_colors(c("blue", "red", "green")),
   show_smooth = FALSE,
-  style = theme_lucid,
+  theme = NULL,
   ...
 ) {
+  theme <- .set_default_theme(
+    x,
+    theme,
+    base_size,
+    size_axis_title,
+    size_title,
+    default_theme = ggplot2::theme_grey()
+  )
+
   x$se.lo <- -x$se
   if (length(unique(x$group)) > 1L) {
     ltitle <- "Within error bounds"
@@ -27,12 +36,6 @@ plot.see_binned_residuals <- function(
     show_dots <- isTRUE(dots[["show_dots"]])
   }
 
-  if (missing(style) && !is.null(attr(x, "theme"))) {
-    theme_style <- unlist(strsplit(attr(x, "theme"), "::", fixed = TRUE))
-    style <- get(theme_style[2], asNamespace(theme_style[1]))
-  }
-  theme_style <- style
-
   if (is.null(colors) || length(colors) != 3) {
     colors <- social_colors(c("blue", "red", "green"))
   }
@@ -124,16 +127,7 @@ plot.see_binned_residuals <- function(
       )
   }
 
-  if (isTRUE(dots[["check_model"]])) {
-    p <- p +
-      theme_style(
-        base_size = base_size,
-        plot.title.space = 3,
-        axis.title.space = 5,
-        axis.title.size = size_axis_title,
-        plot.title.size = size_title
-      )
-  }
+  p <- p + theme
 
   if (isTRUE(dots[["adjust_legend"]])) {
     p <- p +

R/plot.check_collinearity.R

@@ -4,6 +4,7 @@
 #'
 #' @inheritParams data_plot
 #' @inheritParams plot.see_check_normality
+#' @inheritParams print.see_performance_pp_check
 #'
 #' @return A ggplot2-object.
 #'
@@ -18,6 +19,7 @@
 plot.see_check_collinearity <- function(
   x,
   data = NULL,
+  theme = NULL,
   colors = c("#3aaf85", "#1b6ca8", "#cd201f"),
   size_point = 3.5,
   linewidth = 0.8,
@@ -56,6 +58,7 @@ plot.see_check_collinearity <- function(
     size_title = size_title,
     size_axis_title = size_axis_title,
     base_size = base_size,
+    theme = theme,
     colors = colors,
     ci_data = attributes(x)$CI,
     is_check_model = FALSE
@@ -67,14 +70,22 @@ plot.see_check_collinearity <- function(
   x,
   size_point,
   linewidth,
-  theme_style = theme_lucid,
+  theme = NULL,
   size_title = 12,
   size_axis_title = 10,
   base_size = 10,
   colors = unname(social_colors(c("green", "blue", "red"))),
   ci_data = NULL,
   is_check_model = FALSE
 ) {
+  theme <- .set_default_theme(
+    x,
+    theme,
+    base_size,
+    size_axis_title,
+    size_title
+  )
+
   ylim <- ceiling(max(x$y, na.rm = TRUE))
   xlim <- nrow(x)
   if (ylim < 10) {
@@ -178,13 +189,7 @@ plot.see_check_collinearity <- function(
       aesthetics = c("color", "fill"),
       guide = ggplot2::guide_legend(title = NULL)
     ) +
-    theme_style(
-      base_size = base_size,
-      plot.title.space = 3,
-      axis.title.space = 5,
-      plot.title.size = size_title,
-      axis.title.size = size_axis_title
-    ) +
+    theme +
     ggplot2::scale_y_continuous(
       limits = c(1, ylim * 1.15),
       oob = scales::oob_squish,

R/plot.check_distribution.R

@@ -46,39 +46,39 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) {
   # default legend-position
   lp <- ifelse(isTRUE(panel), "right", "bottom")
 
-  p1 <- ggplot(
+  p1 <- ggplot2::ggplot(
     dat,
-    aes(
+    ggplot2::aes(
       y = .data$x,
       x = .data$y,
       colour = .data$group
     )
   ) +
-    geom_linerange(
-      aes(xmin = 0, xmax = .data$y),
-      position = position_dodge(0.4),
+    ggplot2::geom_linerange(
+      ggplot2::aes(xmin = 0, xmax = .data$y),
+      position = ggplot2::position_dodge(0.4),
       linewidth = 0.8,
       na.rm = TRUE
     ) +
-    geom_point(
+    ggplot2::geom_point(
       size = size_point,
-      position = position_dodge(0.4),
+      position = ggplot2::position_dodge(0.4),
       na.rm = TRUE
     ) +
-    labs(
+    ggplot2::labs(
       y = NULL,
       x = NULL,
       fill = NULL,
       colour = NULL,
       title = "Predicted Distribution of Residuals and Response"
     ) +
-    scale_x_continuous(
+    ggplot2::scale_x_continuous(
       labels = .percents,
       expand = c(0, 0),
       limits = c(0, max_y)
     ) +
     scale_color_material_d(reverse = TRUE) +
-    guides(colour = guide_legend(reverse = TRUE)) +
+    ggplot2::guides(colour = ggplot2::guide_legend(reverse = TRUE)) +
     theme_lucid(legend.position = lp)
 
   dat1 <- as.data.frame(stats::density(stats::residuals(model)))
@@ -90,9 +90,9 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) {
     dat2$x <- round(dat2$x)
   }
 
-  p2 <- ggplot(dat1, aes(x = .data$x, y = .data$y)) +
-    geom_line(colour = "#2196F3") +
-    labs(x = NULL, y = NULL, title = "Density of Residuals") +
+  p2 <- ggplot2::ggplot(dat1, ggplot2::aes(x = .data$x, y = .data$y)) +
+    ggplot2::geom_line(colour = "#2196F3") +
+    ggplot2::labs(x = NULL, y = NULL, title = "Density of Residuals") +
     theme_lucid()
 
   # usually, we have an outline for the bars in the same color as the
@@ -106,14 +106,14 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) {
     bar_color <- theme_lucid()$panel.background$fill
   }
 
-  p3 <- ggplot(dat2, aes(x = .data$x)) +
-    geom_histogram(
+  p3 <- ggplot2::ggplot(dat2, ggplot2::aes(x = .data$x)) +
+    ggplot2::geom_histogram(
       fill = "#f44336",
       colour = bar_color,
       binwidth = sqrt(length(vars(.data$x))),
       na.rm = TRUE
     ) +
-    labs(x = NULL, y = NULL, title = "Distribution of Response") +
+    ggplot2::labs(x = NULL, y = NULL, title = "Distribution of Response") +
     theme_lucid()
 
   if (panel) {
@@ -150,26 +150,26 @@ plot.see_check_distribution_numeric <- function(
   # default legend-position
   lp <- ifelse(isTRUE(panel), "right", "bottom")
 
-  p1 <- ggplot(dat, aes(y = .data$x, x = .data$y)) +
-    geom_linerange(
-      aes(xmin = 0, xmax = .data$y),
-      position = position_dodge(0.4),
+  p1 <- ggplot2::ggplot(dat, ggplot2::aes(y = .data$x, x = .data$y)) +
+    ggplot2::geom_linerange(
+      ggplot2::aes(xmin = 0, xmax = .data$y),
+      position = ggplot2::position_dodge(0.4),
       linewidth = 0.8,
       na.rm = TRUE
     ) +
-    geom_point(
+    ggplot2::geom_point(
       size = size_point,
-      position = position_dodge(0.4),
+      position = ggplot2::position_dodge(0.4),
       na.rm = TRUE
     ) +
-    labs(
+    ggplot2::labs(
       y = NULL,
       x = NULL,
       fill = NULL,
       colour = NULL,
       title = "Predicted Distribution of Vector"
     ) +
-    scale_x_continuous(
+    ggplot2::scale_x_continuous(
       labels = .percents,
       expand = c(0, 0),
       limits = c(0, max_y)
@@ -179,18 +179,18 @@ plot.see_check_distribution_numeric <- function(
   dat1 <- as.data.frame(stats::density(vec))
   dat2 <- data.frame(x = vec, stringsAsFactors = FALSE)
 
-  p2 <- ggplot(dat1, aes(x = .data$x, y = .data$y)) +
-    geom_line() +
-    labs(x = NULL, y = NULL, title = "Density of Vector") +
+  p2 <- ggplot2::ggplot(dat1, ggplot2::aes(x = .data$x, y = .data$y)) +
+    ggplot2::geom_line() +
+    ggplot2::labs(x = NULL, y = NULL, title = "Density of Vector") +
     theme_lucid()
 
-  p3 <- ggplot(dat2, aes(x = .data$x)) +
-    geom_histogram(
+  p3 <- ggplot2::ggplot(dat2, ggplot2::aes(x = .data$x)) +
+    ggplot2::geom_histogram(
       colour = theme_lucid()$panel.background$fill,
       binwidth = sqrt(length(vars(.data$x))),
       na.rm = TRUE
     ) +
-    labs(x = NULL, y = NULL, title = "Distribution of Vector") +
+    ggplot2::labs(x = NULL, y = NULL, title = "Distribution of Vector") +
     theme_lucid()
 
   if (panel) {

R/plot.check_heteroscedasticity.R

@@ -5,6 +5,7 @@
 #'
 #' @inheritParams data_plot
 #' @inheritParams plot.see_check_normality
+#' @inheritParams print.see_performance_pp_check
 #'
 #' @return A ggplot2-object.
 #'
@@ -24,6 +25,7 @@ plot.see_check_heteroscedasticity <- function(
   size_title = 12,
   size_axis_title = base_size,
   base_size = 10,
+  theme = NULL,
   ...
 ) {
   if (is.null(data)) {
@@ -85,6 +87,7 @@ plot.see_check_heteroscedasticity <- function(
     base_size = base_size,
     size_title = size_title,
     size_axis_title = size_axis_title,
+    theme = theme,
     ...
   )
 }

R/plot.check_homogeneity.R

@@ -149,7 +149,7 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) {
   size_point,
   linewidth,
   alpha_level = 0.2,
-  theme_style = theme_lucid,
+  theme = NULL,
   size_title = 12,
   size_axis_title = 10,
   base_size = 10,
@@ -159,6 +159,15 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) {
   maximum_dots = 2000,
   ...
 ) {
+  theme <- .set_default_theme(
+    x,
+    theme,
+    base_size,
+    size_axis_title,
+    size_title,
+    default_theme = ggplot2::theme_grey()
+  )
+
   # Sample data if too large for performance (issue #420)
   x <- .sample_for_plot(x, maximum_dots = maximum_dots, ...)
 
@@ -188,11 +197,5 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) {
       y = expression(sqrt("|Std. residuals|")),
       x = "Fitted values"
     ) +
-    theme_style(
-      base_size = base_size,
-      plot.title.space = 3,
-      axis.title.space = 5,
-      plot.title.size = size_title,
-      axis.title.size = size_axis_title
-    )
+    theme
 }