charts.R

#' Format df
#'
#' Uses libraries: dplyr, tidyr, data.table, stringr
#'
#' @param input_df df
#' @param group string; group var
#' @param desc string; long title
#'
#' @return df, formatted
format_df <- function(input_df, group, desc) {
  
  set <- input_df %>%
    select(date, contains(group)) %>%
    pivot_longer(-date, names_sep = 5, names_to = c("pre", "suff")) %>%
    mutate(
      title = case_when(
        str_detect(suff, "aa") == TRUE ~ "AA",
        str_detect(suff, "bb") == TRUE ~ "BB",
        str_detect(suff, "cc") == TRUE ~ "CC",
        str_detect(suff, "dd") == TRUE ~ "DD",
        str_detect(suff, "ee") == TRUE ~ "EE"
      ),
      group = group,
      desc = desc
    ) %>%
    select(group, desc, date, current = value)
  
  dt <- as.data.table(set)
  
  lag_vals <- dt[, lag := shift(current, 1, fill = NA, type = "lag"),
                    by = c("desc", "group")]
  
  chg_vals <- lag_vals[, chg := sum(current, -lag, na.rm = FALSE),
                       by = seq_len(nrow(lag_vals))]
  
  return_set <- chg_vals %>%
    as.data.frame() %>%
    relocate(desc, group)
  
  return(return_set)
  
}


#' Plot stacked bar
#'
#' Dependencies: dplyr, tidyr, data.table, ggplot2, stringr
#'
#' Plot colors: https://www.r-bloggers.com/2020/03/how-to-standardize-group-colors-in-data-visualizations-in-r/
#'
#' @param df data frame, formatted
#' @param date_start earliest date of chart, formatted "yyyymmdd"
#' @param date_end latest date of chart, formatted "yyyymmdd", optional
#' @param include boolean; 
#' @param freq boolean; 
#' @param labelsize size of chart labels, set in params
#' @param titlesize size of chart title, set in params
#'
#' @return stacked bar chart
plot_stacked_bar <- function(df, date_start, date_end,
                            include = FALSE,
                            freq = FALSE,
                            labelsize = params$label_size,
                            titlesize = params$title_size) {
  
  id_pal <- RColorBrewer::brewer.pal(n = 3, name = "Blues")
  
  id_colors <- c(
    "a" = id_pal[1],
    "b" = id_pal[2],
    "c" = id_pal[3]
  )
  
  id_labs <- c(
    "a" = "a",
    "b" = "b",
    "c" = "c"
  )
  
  if (missing(include)) {
    id_include <- "(a|b|c)"
    id_colors <- id_colors
    id_labs <- id_labs
  } else if (isTRUE(include)) {
    id_include <- "(a|b)"
    id_colors <- id_colors[2:3]
    id_labs <- id_labs[2:3]
  } else {
    id_include <- "(a|b|c)"
    id_colors <- id_colors
    id_labs <- id_labs
  }
  
  dt_start <- as.Date(date_start, format = "%Y%m%d")
  dt_end <- if (!missing(date_end)) as.Date(date_end, format = "%Y%m%d") else Sys.Date()
  
  chart_vars <- c("id", "desc", "date", "chg")
  
  if (missing(freq)) {
    
    long <- df %>%
      filter(
        str_detect(id, id_include) == TRUE
      ) %>%
      select(all_of(chart_vars)) %>%
      mutate(
        date_chart = as.Date(paste(year(date), month(date), "01", sep = "-"),
                             format = "%Y-%m-%d")
      ) %>%
      filter(date_chart >= dt_start & date_chart <= dt_end) %>%
      select(-date) %>%
      rename(date = date_chart)
    
  } else if (isTRUE(freq)) {
    
    long <- df %>%
      filter(
        str_detect(id, id_include) == TRUE
      ) %>%
      select(all_of(chart_vars)) %>%
      filter(date >= dt_start & date <= dt_end)
    
  } else {
    
    long <- df %>%
      filter(
        str_detect(id, id_include) == TRUE
      ) %>%
      select(all_of(chart_vars)) %>%
      mutate(
        date_chart = as.Date(paste(year(date), month(date), "01", sep = "-"),
                             format = "%Y-%m-%d")
      ) %>%
      filter(date_chart >= dt_start & date_chart <= dt_end) %>%
      select(-date) %>%
      rename(date = date_chart)
    
  }
  
  plot <- ggplot2::ggplot(long) +
    geom_col(aes(fill = bg,
                 x = date,
                 y = chg / 1000),
             color = "black", linewidth = 0.15) +
    geom_hline(yintercept = 0, color = "black", linewidth = 0.5) +
    scale_colour_manual(values = "black") +
    scale_fill_manual(name = "Group",
                      labels = id_labs,
                      values = id_colors) +
    theme_bw() +
    labs(x = "Date",
         y = "units",
         fill = "",
         title = paste0("Changes in ",
                        long$desc,
                        ", ",
                        format(min(long$date), "%B %Y"),
                        " to ",
                        format(max(long$date), "%B %Y")
         )) +
    scale_y_continuous(labels = scales::dollar_format()) +
    scale_x_date(date_labels = "%b", date_breaks = "1 month") +
    theme(legend.position = "bottom",
          legend.title = element_blank(),
          legend.text = element_text(size = labelsize)) +
    theme(axis.title.x = element_text(size = labelsize),
          axis.title.y = element_text(size = labelsize),
          axis.text.x = element_text(size = labelsize),
          axis.text.y = element_text(size = labelsize)) +
    theme(plot.title = element_text(size = titlesize))
  
  plot
  
}