R/plot_temporal.R

In DUToolkit: Visualizing and Quantifying Decision Uncertainty

#' Generate temporal probability density plots
#'
#' @description The probability density of the peak (or lowest if the
#' threshold is a minimum) projected outcome across simulation runs is
#' plotted in the center of the graph for a given policy alternative.
#' Above and below, the probability density of the outcome at specified time
#' points relative to the time of the peak (or lowest) project outcome
#' is plotted to visually illustrate how uncertainty, and therefore risk,
#' changes over time. The decision threshold is shown directly on the plot as
#' a vertical line to provide a clear reference point for interpreting the
#' outputs.
#'
#' @param relative_values A list generated by [get_relative_values()].
#' @param D A single threshold value.
#'
#' @return A list of ggplots, one for each policy alternative.
#' @export
#'
#' @examples
#' tmin <- "2021-01-01"
#' tmax <- "2021-04-10"
#' D <- 750
#' t_s <- 30
#' 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
#' )
#'
#' peak_temporal_plots <- plot_temporal(
#'   peak_temporal_list,
#'   D
#' )
plot_temporal <- function(relative_values, D) {
  if (inherits(relative_values[[1]], "list")) {
    plot <- lapply(relative_values, plot_temporal_1, D)
    if (!is.null(names(plot)) && all(names(plot) != "")) {
      plot <- stats::setNames(
        lapply(names(plot), function(name) {
          plot[[name]] + ggplot2::ggtitle(name)
        }),
        names(plot)
      )
    } else {
      # Assign sequential names if unnamed
      plot_names <- paste0("Plot_", seq_along(plot))
      plot <- stats::setNames(
        lapply(seq_along(plot), function(i) {
          plot[[i]] + ggplot2::ggtitle(plot_names[i])
        }),
        plot_names
      )
    }
  } else if (inherits(relative_values[[1]], "data.frame")) {
    plot <- plot_temporal_1(relative_values, D)
  } else {
    rlang::abort("The first argument is not a data.frame or list of data.frames",
      class = "data_type"
    )
  }
  return(plot)
}


#' Generate temporal plot for a single scenario
#'
#' @inheritParams plot_temporal
#' @noRd
#' @return ggplot temporal plot
plot_temporal_1 <- function(relative_values, D) {
  p <- ggplot2::ggplot(
    data = relative_values[[1]],
    ggplot2::aes(
      x = factor(!!rlang::sym("time"),
        levels = relative_values[[2]]
      ),
      y = !!rlang::sym("outcome")
    )
  ) +
    ggdist::stat_halfeye(
      justification = 0, width = 1,
      point_interval = NULL,
      # set slab interval to 95% data range
      # .width = 0,
      # point_color="black",point_size=1,point_interval = "median_qi",
      scale = 0.9,
      slab_color = "black", slab_linewidth = 0.3,
      slab_fill = "#9386A6FF"
    ) +
    ggdist::stat_pointinterval(
      point_color = "black", point_size = 1, width = 1,
      interval_size = 1, .width = c(0.25, 0.75)
    ) +
    ggplot2::geom_hline(yintercept = D, color = "red", linetype = "dashed", linewidth = 0.75) +
    ggplot2::theme_classic() +
    ggplot2::labs(y = "Outcome") +
    ggplot2::theme(legend.position = "none", axis.title.y = ggplot2::element_blank()) +
    ggplot2::coord_flip()

  p <- gen_stand_descr(p, link = 'Temporal probability density plots')
  return(p)
}