R/plot.check_homogeneity.R

In easystats/see: Model Visualisation Toolbox for 'easystats' and 'ggplot2'

#' Plot method for homogeneity of variances checks
#'
#' The `plot()` method for the `performance::check_homogeneity()`
#' function.
#'
#' @inheritParams data_plot
#'
#' @return A ggplot2-object.
#'
#' @examples
#' library(performance)
#'
#' model <<- lm(len ~ supp + dose, data = ToothGrowth)
#' result <- check_homogeneity(model)
#' result
#' plot(result)
#'
#' @export
plot.see_check_homogeneity <- function(x, data = NULL, ...) {
  if (is.null(data)) {
    model <- .retrieve_data(x)
  } else {
    model <- data
  }

  method <- paste0("Homogeneity of Variance (", attr(x, "method"), ")")

  dat <- insight::get_data(model)
  resp <- insight::get_response(model)
  pred <- insight::find_predictors(model, flatten = TRUE)

  if (length(pred) > 1L) {
    l <- lapply(dat[, pred], as.character)
    for (i in pred[1:(length(pred) - 1)]) {
      l[[i]] <- sprintf("%s \u00D7 ", l[[i]])
    }
    x <- do.call(c, l)
    group_labels <- do.call(paste0, l)
    group <- rep(group_labels, each = length(pred))
    resp <- rep(resp, length(pred))
  } else {
    x <- as.character(as.vector(dat[, pred, drop = TRUE]))
    group <- 1
  }

  dat <- data.frame(
    x = x,
    y = resp,
    group = group,
    stringsAsFactors = FALSE
  )

  if (length(pred) > 1L) {
    # group-mean-center response
    dat$y <- dat$y -
      stats::ave(
        dat[["y"]],
        dat[["group"]],
        FUN = mean,
        na.rm = TRUE
      )
    p <- ggplot(
      data = dat,
      aes(x = .data$group, y = .data$y, fill = .data$group)
    ) +
      geom_violin() +
      if (requireNamespace("ggrepel", quietly = TRUE)) {
        ggrepel::geom_label_repel(
          aes(label = .data$group),
          y = 0,
          fill = "white",
          data = data.frame(
            group = unique(dat$group),
            stringsAsFactors = FALSE
          ),
          direction = "y",
          segment.colour = NA,
          max.overlaps = Inf
        )
      } else {
        geom_label(
          aes(label = .data$group),
          y = 0,
          fill = "white",
          data = data.frame(
            group = unique(dat$group),
            stringsAsFactors = FALSE
          )
        )
      }
  } else {
    # group-mean-center response
    dat$y <- dat$y -
      stats::ave(
        dat[["y"]],
        dat[["x"]],
        FUN = mean,
        na.rm = TRUE
      )
    p <- ggplot(data = dat, aes(x = .data$x, y = .data$y, fill = .data$x)) +
      geom_violin() +
      if (requireNamespace("ggrepel", quietly = TRUE)) {
        ggrepel::geom_label_repel(
          aes(label = .data$x),
          y = 0,
          fill = "white",
          data = data.frame(
            x = unique(dat$x),
            stringsAsFactors = FALSE
          ),
          direction = "y",
          segment.colour = NA,
          max.overlaps = Inf
        )
      } else {
        geom_label(
          aes(label = .data$x),
          y = 0,
          fill = "white",
          data = data.frame(
            x = unique(dat$x),
            stringsAsFactors = FALSE
          )
        )
      }
  }

  p +
    scale_fill_flat_d() +
    scale_x_discrete(labels = NULL) +
    theme_modern(
      base_size = 12,
      plot.title.space = 3,
      axis.title.space = 5
    ) +
    guides(fill = "none") +
    labs(
      x = NULL,
      y = paste0(insight::find_response(model), "\n(group mean-centered)"),
      title = method,
      subtitle = "Groups should be evenly spread"
    ) +
    theme(plot.title.position = "plot")
}


.plot_diag_homogeneity <- function(
  x,
  size_point,
  linewidth,
  alpha_level = 0.2,
  theme_style = theme_lucid,
  size_title = 12,
  size_axis_title = 10,
  base_size = 10,
  colors = unname(social_colors(c("green", "blue", "red"))),
  alpha_dot = 0.8,
  show_dots = TRUE
) {
  p <- ggplot2::ggplot(x, ggplot2::aes(x = .data$x, .data$y))

  if (isTRUE(show_dots)) {
    p <- p +
      geom_point2(
        colour = colors[2],
        size = size_point,
        alpha = alpha_dot
      )
  }

  p +
    ggplot2::stat_smooth(
      method = "loess",
      se = TRUE,
      alpha = alpha_level,
      formula = y ~ x,
      linewidth = linewidth,
      colour = colors[1]
    ) +
    ggplot2::labs(
      title = "Homogeneity of Variance",
      subtitle = "Reference line should be flat and horizontal",
      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
    )
}