R/bcat_plt_box.R

In Rbearcat: University of Cincinnati Themes and Utilities for Econometrics and Data Science

#' Box plot / violin plot utility
#'
#' Create a box plot or violin plot with UC styling. Includes optional
#' jittered point overlay and outlier highlighting.
#'
#' @param df The data to be displayed.
#' @param x Categorical variable for the x-axis.
#' @param y Numeric variable for the y-axis.
#' @param fill Variable to map to fill aesthetic. If NULL, uses x for coloring.
#' @param facet Facetting variable(s). Wrap in \code{vars()}.
#' @param violin Logical. Use violin plot instead of box plot? Default is FALSE.
#' @param jitter Logical. Overlay jittered points? Default is TRUE.
#' @param jitter_width Jitter width. Default is 0.2.
#' @param notch Logical. Add notches? Default is FALSE.
#' @param order Logical. Reorder x by median of y? Default is FALSE.
#' @param coord_flip Logical. Flip coordinates? Default is FALSE.
#' @param alpha Point transparency. Default is 0.3.
#' @param x_lab Label for x-axis.
#' @param y_lab Label for y-axis.
#' @param title Plot title.
#' @param subtitle Plot subtitle.
#' @param caption Plot caption.
#' @param legend_lab Legend title.
#' @param legend_position Legend position.
#' @param legend_hide Logical. Hide legend?
#' @param x_scale \code{scale_x_} function.
#' @param y_scale \code{scale_y_} function.
#' @param fill_scale \code{scale_fill_} function.
#' @param facet_scale Facet scales.
#' @param nrow Number of facet rows.
#' @param ncol Number of facet columns.
#' @param x_refline Vertical reference lines.
#' @param y_refline Horizontal reference lines.
#' @return A ggplot object.
#' @author Saannidhya Rawat
#' @family plots
#' @export
#'
#' @examples
#' library(ggplot2)
#'
#' # Basic box plot
#' bcat_plt_box(mtcars, x = factor(cyl), y = mpg)
#'
#' # Violin plot
#' bcat_plt_box(mtcars, x = factor(cyl), y = mpg, violin = TRUE)
#'
#' # Ordered and flipped
#' bcat_plt_box(mtcars, x = factor(cyl), y = mpg, order = TRUE, coord_flip = TRUE)
bcat_plt_box <- function(df,
                         x,
                         y,
                         fill = NULL,
                         facet = NULL,
                         violin = FALSE,
                         jitter = TRUE,
                         jitter_width = 0.2,
                         notch = FALSE,
                         order = FALSE,
                         coord_flip = FALSE,
                         alpha = 0.3,
                         x_lab = ggplot2::waiver(),
                         y_lab = ggplot2::waiver(),
                         title = ggplot2::waiver(),
                         subtitle = ggplot2::waiver(),
                         caption = ggplot2::waiver(),
                         legend_lab = ggplot2::waiver(),
                         legend_position = "bottom",
                         legend_hide = FALSE,
                         x_scale = NULL,
                         y_scale = NULL,
                         fill_scale = scale_fill_UC(),
                         facet_scale = c("fixed", "free_y", "free_x", "free"),
                         nrow = NULL,
                         ncol = NULL,
                         x_refline = NULL,
                         y_refline = NULL) {

  facet_scale <- match.arg(facet_scale)

  # Check if fill was provided
  fill_quo <- rlang::enquo(fill)
  has_fill <- !rlang::quo_is_null(fill_quo)

  # Build x mapping with optional reorder
  if (order) {
    if (coord_flip) {
      x_aes <- ggplot2::aes(x = forcats::fct_reorder({{ x }}, {{ y }}, stats::median))
    } else {
      x_aes <- ggplot2::aes(x = forcats::fct_reorder({{ x }}, {{ y }},
                                                       function(v) -stats::median(v)))
    }
  } else {
    x_aes <- ggplot2::aes(x = {{ x }})
  }

  # Base plot
  if (has_fill) {
    p <- ggplot2::ggplot(data = df, mapping = ggplot2::aes(y = {{ y }}, fill = {{ fill }}))
  } else {
    p <- ggplot2::ggplot(data = df, mapping = ggplot2::aes(y = {{ y }}, fill = {{ x }}))
  }
  p <- p + x_aes

  # Box or violin
  if (violin) {
    p <- p + ggplot2::geom_violin(alpha = 0.7, color = .uc_reference_color())
  } else {
    p <- p + ggplot2::geom_boxplot(notch = notch, alpha = 0.7,
                                   outlier.shape = 21,
                                   outlier.fill = .uc_color("UC Red"),
                                   outlier.color = .uc_color("UC Red"))
  }

  # Jittered points
  if (jitter) {
    p <- p + ggplot2::geom_jitter(width = jitter_width, alpha = alpha,
                                  size = 1, color = .uc_text_color())
  }

  p <- p + x_scale + y_scale + fill_scale

  if (!is.null(facet)) {
    p <- p + ggplot2::facet_wrap(facets = facet, nrow = nrow, ncol = ncol,
                                 scales = facet_scale)
  }

  p <- p + ggplot2::labs(x = x_lab, y = y_lab, title = title,
                         subtitle = subtitle, caption = caption,
                         fill = legend_lab)

  if (!is.null(x_refline)) p <- p + ggplot2::geom_vline(xintercept = x_refline)
  if (!is.null(y_refline)) p <- p + ggplot2::geom_hline(yintercept = y_refline)

  if (coord_flip) {
    p + theme_UC_vgrid(legend_position = legend_position,
                       legend_hide = legend_hide) +
      ggplot2::coord_flip()
  } else {
    p + theme_UC_hgrid(legend_position = legend_position,
                       legend_hide = legend_hide)
  }
}