R/sum_stats_temporal.R

In DUToolkit: Visualizing and Quantifying Decision Uncertainty

#' Calculates summary statistics at specified time points relative to the
#' peak (or minimum)
#'
#' @description For each policy alternative, this function calculates
#' summary statistics (n, mean, median, and IQR) for the model output values at
#' the specified time points relative to the peak (or minimum) value.
#'
#' @param relative_values A list generated by [get_relative_values()].
#'
#' @return A list of data.frames of summary statistics.
#' @export
#'
#' @examples
#' tmin <- "2021-01-01"
#' tmax <- "2021-04-10"
#' D <- 750
#' t_s <- 20
#' t_ss <- 10
#'
#' peak_values_list <- get_max_min_values(
#'   psa_data,
#'   tmin = tmin,
#'   tmax = tmax,
#'   Dt_max = TRUE
#' )
#'
#' peak_temporal_list <- get_relative_values(
#'   psa_data,
#'   peak_values_list,
#'   t_s = t_s,
#'   t_ss = t_ss
#' )
#'
#' stats_peak_temporal <- sum_stats_temporal(peak_temporal_list)
sum_stats_temporal <- function(relative_values) {
  if (inherits(relative_values[[1]], "list")) {
    stats <- lapply(relative_values, sum_stats_temporal_1)
  } else if (inherits(relative_values[[1]], "data.frame")) {
    stats <- sum_stats_temporal_1(relative_values)
  } else {
    rlang::abort("The first argument is not a data.frame or list of data.frames",
      class = "data_type"
    )
  }
  return(stats)
}

#' Calculates summary statistics for a single scenario
#'
#' @inheritParams sum_stats_temporal
#' @noRd
#' @return A data.frame of summary statistics
sum_stats_temporal_1 <- function(relative_values) {
  df <- relative_values[[1]]
  time_levels <- relative_values[[2]]

  # Ensure time is a factor with the specified levels
  df$time_step <- factor(df$time, levels = time_levels)

  # Calculate summary statistics manually using base R
  summary_stats <- stats::aggregate(outcome ~ time_step, data = df, function(x) {
    c(
      n = sum(!is.na(x)),
      q1 = round(stats::quantile(x, 0.25, na.rm = TRUE), 2),
      median = round(stats::median(x, na.rm = TRUE), 2),
      mean = round(mean(x, na.rm = TRUE), 2),
      q3 = round(stats::quantile(x, 0.75, na.rm = TRUE), 2)
    )
  })

  # Convert matrix columns into separate data frame columns
  summary_stats <- do.call(data.frame, summary_stats)

  # Rename columns
  colnames(summary_stats) <- c("time_step", "n", "q1", "median", "mean", "q3")

  # Convert back to a data frame
  summary_stats <- as.data.frame(summary_stats)

  return(summary_stats)
}