R/bcat_plt_ts.R

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

#' Time series plot utility
#'
#' Create a time series visualization with UC styling. Supports decomposition
#' into trend/seasonal/remainder, ACF/PACF display, and recession shading.
#'
#' @param df A data frame with date and value columns.
#' @param x Date column.
#' @param y Value column.
#' @param color Variable for color aesthetic.
#' @param decompose Logical. Show 4-panel decomposition? Default is FALSE.
#' @param acf Logical. Show ACF/PACF side-by-side? Default is FALSE.
#' @param recession_bars Data frame with \code{start} and \code{end} date columns. Default is NULL.
#' @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 color_scale \code{scale_color_} function.
#' @param layer_points Logical. Show points on line? Default is FALSE.
#' @param x_highlight_min Date(s) at which to start highlight region(s).
#' @param x_highlight_max Date(s) at which to end highlight region(s).
#' @param y_refline Horizontal reference line(s).
#' @return A ggplot or patchwork object.
#' @author Saannidhya Rawat
#' @family plots
#' @export
#'
#' @examples
#' library(ggplot2)
#' library(scales)
#'
#' bcat_plt_ts(economics, x = date, y = unemploy,
#'             y_scale = scale_y_continuous(labels = comma_format()))
bcat_plt_ts <- function(df,
                        x = NULL,
                        y = NULL,
                        color = NULL,
                        decompose = FALSE,
                        acf = FALSE,
                        recession_bars = NULL,
                        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,
                        color_scale = scale_colour_UC(),
                        layer_points = FALSE,
                        x_highlight_min = NULL,
                        x_highlight_max = NULL,
                        y_refline = NULL) {

  if (decompose) return(.plt_ts_decompose(df, x = {{ x }}, y = {{ y }}))
  if (acf) return(.plt_ts_acf(df, x = {{ x }}, y = {{ y }}))

  p <- ggplot2::ggplot(data = df,
                       mapping = ggplot2::aes(x = {{ x }}, y = {{ y }},
                                              color = {{ color }}))

  # Recession bars
  if (!is.null(recession_bars)) {
    p <- p + ggplot2::geom_rect(
      data = recession_bars,
      ggplot2::aes(xmin = start, xmax = end, ymin = -Inf, ymax = Inf),
      fill = .uc_ribbon_fill(0.55),
      alpha = 0.4, inherit.aes = FALSE
    )
  }

  # Highlight regions
  if (!is.null(x_highlight_min) && !is.null(x_highlight_max)) {
    p <- p + ggplot2::annotate("rect",
                               xmin = x_highlight_min, xmax = x_highlight_max,
                               ymin = -Inf, ymax = Inf,
                               alpha = 0.40, fill = .uc_highlight_fill())
  }

  p <- p + ggplot2::geom_line()
  if (layer_points) p <- p + ggplot2::geom_point(size = 1.5, alpha = 0.7)
  p <- p + x_scale + y_scale + color_scale

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

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

  p + theme_UC(legend_position = legend_position, legend_hide = legend_hide)
}

#' @noRd
.plt_ts_decompose <- function(df, x, y) {
  y_vals <- dplyr::pull(df, {{ y }})
  x_vals <- dplyr::pull(df, {{ x }})

  n <- length(x_vals)
  date_range <- as.numeric(difftime(max(x_vals), min(x_vals), units = "days"))
  freq <- max(round(n / (date_range / 365.25)), 2)

  ts_obj <- stats::ts(y_vals, frequency = freq)
  decomp <- stats::stl(ts_obj, s.window = "periodic")

  decomp_df <- data.frame(
    date = x_vals,
    observed = y_vals,
    trend = as.numeric(decomp$time.series[, "trend"]),
    seasonal = as.numeric(decomp$time.series[, "seasonal"]),
    remainder = as.numeric(decomp$time.series[, "remainder"])
  )

  .make_panel <- function(data, val_col, panel_title) {
    ggplot2::ggplot(data, ggplot2::aes(x = .data[["date"]], y = .data[[val_col]])) +
      ggplot2::geom_line(color = .uc_color("UC Red")) +
      ggplot2::labs(x = NULL, y = panel_title) +
      theme_UC_hgrid()
  }

  p1 <- .make_panel(decomp_df, "observed", "Observed")
  p2 <- .make_panel(decomp_df, "trend", "Trend")
  p3 <- .make_panel(decomp_df, "seasonal", "Seasonal")
  p4 <- .make_panel(decomp_df, "remainder", "Remainder")

  patchwork::wrap_plots(p1, p2, p3, p4, ncol = 1)
}

#' @noRd
.plt_ts_acf <- function(df, x, y) {
  y_vals <- dplyr::pull(df, {{ y }})

  acf_data <- stats::acf(y_vals, plot = FALSE)
  pacf_data <- stats::pacf(y_vals, plot = FALSE)

  acf_df <- data.frame(lag = as.numeric(acf_data$lag[-1]),
                        acf = as.numeric(acf_data$acf[-1]))
  pacf_df <- data.frame(lag = as.numeric(pacf_data$lag),
                         pacf = as.numeric(pacf_data$acf))

  ci <- stats::qnorm(0.975) / sqrt(length(y_vals))

  p_acf <- ggplot2::ggplot(acf_df, ggplot2::aes(x = lag, y = acf)) +
    ggplot2::geom_hline(yintercept = 0, color = .uc_reference_color()) +
    ggplot2::geom_hline(yintercept = c(-ci, ci), linetype = "dashed",
                        color = .uc_color("UC Red")) +
    ggplot2::geom_segment(ggplot2::aes(xend = lag, yend = 0),
                          color = .uc_color("Bearcats Black"), linewidth = 0.8) +
    ggplot2::labs(x = "Lag", y = "ACF", title = "Autocorrelation") +
    theme_UC_hgrid()

  p_pacf <- ggplot2::ggplot(pacf_df, ggplot2::aes(x = lag, y = pacf)) +
    ggplot2::geom_hline(yintercept = 0, color = .uc_reference_color()) +
    ggplot2::geom_hline(yintercept = c(-ci, ci), linetype = "dashed",
                        color = .uc_color("UC Red")) +
    ggplot2::geom_segment(ggplot2::aes(xend = lag, yend = 0),
                          color = .uc_color("Bearcats Black"), linewidth = 0.8) +
    ggplot2::labs(x = "Lag", y = "PACF", title = "Partial Autocorrelation") +
    theme_UC_hgrid()

  patchwork::wrap_plots(p_acf, p_pacf, ncol = 2)
}