R/plt-ts-median-excess.R

In healthyR: Hospital Data Analysis Workflow Tools

#' Create a plot showing the excess of the median value
#'
#' @family Plotting Functions
#'
#' @description
#' Plot out the excess +/- of the median value grouped by certain time parameters.
#'
#' @param .data The data that is being analyzed, data must be a tibble/data.frame.
#' @param .date_col The column of the tibble that holds the date.
#' @param .value_col The column that holds the value of interest.
#' @param .x_axis What is the be the x-axis, day, week, etc.
#' @param .ggplot_group_var The variable to group the ggplot on.
#' @param .years_back How many yeas back do you want to go in order to compute
#' the median value.
#'
#' @details
#' - Supply data that you want to view and you will see the excess +/- of the median values
#'   over a specified time series tibble.
#'
#' @examples
#'
#' suppressPackageStartupMessages(library(timetk))
#'
#' ts_signature_tbl(
#'   .data       = m4_daily
#'   , .date_col = date
#' ) %>%
#' ts_median_excess_plt(
#'   .date_col           = date
#'   , .value_col        = value
#'   , .x_axis           = month
#'   , .ggplot_group_var = year
#'   , .years_back       = 1
#' )
#'
#' @return
#' A `ggplot2` plot
#'
#' @export
#'

ts_median_excess_plt <- function(
    .data
    , .date_col
    , .value_col
    , .x_axis
    , .ggplot_group_var
    , .years_back
) {

    # * Tidayeval ----
    date_var_expr         <- rlang::enquo(.date_col)

    value_var_expr        <- rlang::enquo(.value_col)
    value_var_name        <- rlang::quo_name(value_var_expr)

    x_axis_var_expr       <- rlang::enquo(.x_axis)
    x_axis_var_name       <- rlang::quo_name(x_axis_var_expr)

    ggplot_group_expr     <- rlang::enquo(.ggplot_group_var)

    years_back_expr       <- rlang::enquo(.years_back)

    # * Checks ----
    if(!is.data.frame(.data)) {
        stop(call. = FALSE, "(data) is not a data-frame or tibble. Please supply.")
    }

    if (rlang::quo_is_missing(date_var_expr)) {
        stop(call. = FALSE, "(date_var_expr) is missing. Please supply.")
    }

    if (rlang::quo_is_missing(value_var_expr)) {
        stop(call. = FALSE, "(value_var_expr) is missing. Please supply.")
    }

    if (rlang::quo_is_missing(x_axis_var_expr)) {
        stop(call. = FALSE, "(x_axis_var_expr) is missing. Please supply.")
    }

    if (rlang::quo_is_missing(years_back_expr)) {
        stop(call. = FALSE, "(years_back_expr) is missing. Please supply.")
    }

    # Get .end_date
    .end_date   <- .data %>%
        dplyr::select({{date_var_expr}}) %>%
        dplyr::pull({{date_var_expr}}) %>%
        base::max()

    # * Manipulate ----
    df_grp_tbl <- tibble::as_tibble(.data) %>%
        dplyr::filter(lubridate::year({{date_var_expr}}) >= lubridate::year(.end_date) - {{years_back_expr}}) %>%
        dplyr::filter(lubridate::year({{date_var_expr}}) <= lubridate::year(.end_date) - 1) %>%
        dplyr::select(- {{date_var_expr}} ) %>%
        dplyr::group_by( {{ggplot_group_expr}}, {{x_axis_var_expr}} ) %>%
        dplyr::summarise(value = sum({{value_var_expr}})) %>%
        dplyr::ungroup() %>%
        dplyr::group_by({{x_axis_var_expr}}) %>%
        dplyr::summarise(median_value = stats::median(value)) %>%
        dplyr::ungroup()

    df_excess_tbl <- tibble::as_tibble(.data) %>%
        dplyr::select(- {{date_var_expr}} ) %>%
        dplyr::group_by( {{ggplot_group_expr}}, {{x_axis_var_expr}} ) %>%
        dplyr::summarise(value = sum( {{value_var_expr}} )) %>%
        dplyr::ungroup() %>%
        dplyr::group_by( {{x_axis_var_expr}} ) %>%
        dplyr::left_join(df_grp_tbl) %>%
        dplyr::mutate(excess = value - median_value) %>%
        dplyr::ungroup() %>%
        dplyr::select(-value, -median_value)

    # * Plot ----
    g <- df_excess_tbl %>%
        dplyr::mutate(last_flag = (df_excess_tbl[[1]] == max(df_excess_tbl[[1]]))) %>%
        ggplot2::ggplot(
            mapping = ggplot2::aes(
                x = df_excess_tbl[[2]]
                , y = excess
                , group = df_excess_tbl[[1]]
            )
        ) +
        ggplot2::geom_hline(yintercept = 0, col='gray') +
        ggplot2::geom_line(ggplot2::aes(col=last_flag, y = excess)) +
        ggplot2::scale_color_manual(values = c("FALSE"='gray',"TRUE"='red')) +
        ggplot2::guides(col = "none") +
        ggplot2::theme_minimal() +
        ggplot2::labs(
            x = "",
            y = "Excess +/- of Median Value",
            title = "Excess +/- of Median Value Over Time"
        )

    # * Return ----
    return(g)

}