Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Controlling font size of check_model() axis labels and plot titles #318

Open
peter-bastian opened this issue Jun 25, 2021 · 3 comments
Open
Labels
3 investigators ❔❓ Need to look further into this issue Enhancement 💥 Implemented features can be improved or revised

Comments

@peter-bastian
Copy link

I am looking for a way to control (in my case, reduce) the font sizes used in the plots generated by check_model().

Is there some way to do this? I have tried passing arguments to the print() method after capturing the check_model() output in a variable, like this:
plots <- check_model(m)
print(plots, main="this is a test")

But that does not work. Seems like I could pass something via the ... in check_model() to be used by see, but that is unclear. Would another solution be to create my own custom see theme?

I have also seen reference to a "base" parameter that could work to scale the fonts.

@bwiernik
Copy link
Contributor

The current release of see doesn't make it easy to access these plots for further tweaking.

If you run the function below, you can then do:

diagnostics <- check_model(mod)
diag_plots <- plot(diagnostics, return_list = TRUE)

to get a list of the individual plots. These are regular ggplot objects, so you can add more geoms, themes, etc. to them as you like.

plot.see_check_model <- function (x, style = theme_lucid, 
                                  colors = c("#3aaf85", "#1b6ca8", "#cd201f"), 
                                  return_list = FALSE,
                                  ...) 
{
  orig_x <- x
  p <- list()
  if (isTRUE(return_list)) {
    panel <- FALSE
  } else {
    panel <- attr(x, "panel")
  }
  check <- attr(x, "check")
  size_point <- attr(x, "dot_size")
  size_line <- attr(x, "line_size")
  size_text <- attr(x, "text_size")
  alpha_level <- attr(x, "alpha")
  dot_alpha_level <- attr(x, "dot_alpha")
  detrend <- attr(x, "detrend")
  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]))
  }
  if (missing(colors)) {
    colors <- attr(x, "colors")
  }
  if (is.null(colors)) {
    colors <- c("#3aaf85", "#1b6ca8", "#cd201f")
  }
  colors <- unname(colors)
  if (is.null(alpha_level)) {
    alpha_level <- 0.2
  }
  if (is.null(dot_alpha_level)) {
    dot_alpha_level <- 0.8
  }
  if (is.null(check)) 
    check <- "all"
  if ("NCV" %in% names(x) && any(c("ncv", "linearity", "all") %in% 
                                 check)) {
    p$NCV <- see:::.plot_diag_linearity(x$NCV, size_point, size_line, 
                                  alpha_level, theme_style = style, colors = colors, 
                                  dot_alpha_level = dot_alpha_level)
  }
  if ("HOMOGENEITY" %in% names(x) && any(c("homogeneity", 
                                           "all") %in% check)) {
    p$HOMOGENEITY <- see:::.plot_diag_homogeneity(x$HOMOGENEITY, 
                                            size_point, size_line, alpha_level, theme_style = style, 
                                            colors = colors, dot_alpha_level = dot_alpha_level)
  }
  if ("VIF" %in% names(x) && any(c("vif", "all") %in% check)) {
    p$VIF <- see:::.plot_diag_vif(x$VIF, theme_style = style, 
                            colors = colors)
  }
  if ("OUTLIERS" %in% names(x) && any(c("outliers", "all") %in% 
                                      check)) {
    p$OUTLIERS <- see:::.plot_diag_outliers_new(x$INFLUENTIAL, 
                                          size_text = size_text, size_line = size_line, theme_style = style, 
                                          colors = colors, dot_alpha_level = dot_alpha_level)
  }
  if ("QQ" %in% names(x) && any(c("qq", "all") %in% check)) {
    p$QQ <- see:::.plot_diag_qq(x$QQ, size_point, size_line, alpha_level = alpha_level, 
                          detrend = detrend, theme_style = style, colors = colors, 
                          dot_alpha_level = dot_alpha_level)
  }
  if ("NORM" %in% names(x) && any(c("normality", "all") %in% 
                                  check)) {
    p$NORM <- see:::.plot_diag_norm(x$NORM, size_line, alpha_level = alpha_level, 
                              theme_style = style, colors = colors)
  }
  if ("REQQ" %in% names(x) && any(c("reqq", "all") %in% check)) {
    ps <- see:::.plot_diag_reqq(x$REQQ, size_point, size_line, 
                          alpha_level = alpha_level, theme_style = style, 
                          colors = colors, dot_alpha_level = dot_alpha_level)
    for (i in 1:length(ps)) {
      p[[length(p) + 1]] <- ps[[i]]
    }
  }
  if (panel) {
    suppressWarnings(suppressMessages(do.call(plots, p)))
  }
  else {
    suppressWarnings(suppressMessages(p))
  }
}

@strengejacke strengejacke added 3 investigators ❔❓ Need to look further into this issue Feature idea 🔥 New feature or request Enhancement 💥 Implemented features can be improved or revised and removed Feature idea 🔥 New feature or request labels Jul 14, 2021
@krassowski
Copy link
Contributor

It would be great if we could pass a named list of lists with extra ggplot layers to be applied to specific plots. In my use case I experience overplotting on the collinearity plot and would like to add scale_x_discrete(guide = guide_axis(n.dodge = 2)) to this one plot.

So maybe something like:

check_model(
    model,
    extra_layers = list(
        "collinearity"=list(scale_x_discrete(guide = guide_axis(n.dodge = 2))),
        "normality"=list(theme_bw(), labs(subtitle="my text"))
    )
)

What do you think?

@bwiernik
Copy link
Contributor

Now that see uses patchwork to combine plots, I think it makes more sense to leave this sort of tweaking to editing post-plot-creation:

library(performance)
library(see)
library(ggplot2)
m <- lm(mpg ~ factor(cyl) + disp + hp, data = mtcars)
pp <- check_model(m)

p <- plot(pp)
p

p[[3]] <- p[[3]] + labs(y = "Variance Inflation\nFactor (VIF)")
p[[6]] <- p[[6]] + xlim(c(-5, 6))
p

Created on 2021-07-26 by the reprex package (v2.0.0)

@bwiernik bwiernik reopened this Jul 26, 2021
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
3 investigators ❔❓ Need to look further into this issue Enhancement 💥 Implemented features can be improved or revised
Projects
None yet
Development

No branches or pull requests

4 participants