chg_table.R

#' Get change between dates
#'
#' Finds simple diff bt dates in df
#'
#' Dependencies: dplyr, data.table, lubridate, dtplyr, stringr
#'
#' @param df df; df to analyze
#' formatted date, series_a, series_b, series_c
#' @param date_start earliest date, format "20241101"
#' @param date_end final date, format "20241201"
get_change_bt_dates <- function(df = dfs$relevant_df,
                                date_start,
                                date_end) {

  comp_data <- df %>%
    pivot_longer(-date, names_to = c("series")) %>%
    filter(date == as.Date(date_end, format = "%Y%m%d") |
             date == as.Date(date_start, format = "%Y%m%d")) %>%
    select(series, date, val = value) %>%
    arrange(series, date)

  agg_vals <- data.table::as.data.table(comp_data)

  lag_vals <- agg_vals[, lag := shift(val, 1, fill = NA, type = "lag"),
                       by = c("series")]

  chg_vals <- lag_vals[, chg := sum(val, -lag, na.rm = FALSE),
                       by = seq_len(nrow(lag_vals))]

  date_cut <- chg_vals[date >= as.Date(date_end, format = "%Y%m%d"), ]

  table_output <- as.data.frame(date_cut)

  output <- table_output %>%
    mutate(series2 = paste0("id_", series)) %>%
    select(series, series2, date, lag, current = val, chg)

  output
}


#' Creates chg table
#'
#' Dependencies: dplyr, data.table, lubridate, dtplyr, openxlsx
#'
#' @param df_list list; list of dataframes
#' @param file_name string; output Excel sheet name, including xlsx
#' @param file_loc string; file output
#' @param include boolean; whether to include x cat
#' @param descs df; metadata lookup with descs
#' @param date_start earliest date to compare (usually previous week), format "20241101"
#' @param date_end final date to compare (usually current week), format "20241201"
#' @param output_time string; file output timestamp
#'
#' @export
create_weekly_change_table <- function(
    df_list = c("pub1", "pub2"),
    file_name = "chg_pub1_pub2.xlsx",
    file_loc = "reports/",
    include = FALSE,
    descs = meta,
    date_start,
    date_end,
    output_time = Sys.time()) {
  
  message(paste0("Create ", file_loc, file_name))
  
  order <- c(
    "1",
    "2"
  )
  
  long_desc <- descs %>%
    filter(as.character(series) %in% order) %>%
    select(bcnum, long_desc)
  
  sets <- list()

  for (d in df_list) {
    sets[[d]] <- get_change_bt_dates(df = series[[d]],
                                     date_start = date_start,
                                     date_end = date_end)
  }

  if (isTRUE(include)) {

    output <- sets %>%
      purrr::map(~ .x %>% select(series, chg)) %>%
      purrr::map(~ .x %>% pivot_wider(names_from = "series", values_from = "chg")) %>%
      purrr::map(~ .x %>% filter(series %in% order)) %>%
      reduce(full_join, by = "series") %>%
      left_join(long_desc, by = "series") %>%
      arrange(order(order)) %>%
      select(long_desc, starts_with("n")) %>%
      mutate(across(where(is.numeric), ~ round(.x / 1000, 1))) %>%
      mutate(row_order = seq_along(long_desc))
    
  } else {
    
    output <- sets %>%
      purrr::map(~ .x %>% select(series, chg)) %>%
      purrr::map(~ .x %>% filter(!(series == "3"))) %>%
      purrr::map(~ .x %>% pivot_wider(names_from = "series", values_from = "chg")) %>%
      purrr::map(~ .x %>% filter(series %in% order)) %>%
      reduce(full_join, by = "series") %>%
      left_join(long_desc, by = "series") %>%
      arrange(order(order)) %>%
      select(long_desc, starts_with("n")) %>%
      mutate(across(where(is.numeric), ~ round(.x / 1000, 1))) %>%
      mutate(row_order = seq_along(long_desc))

  }

  old <- names(output)

  names_df <- data.frame(old = names(output)) %>%
    mutate(
      g = dplyr::case_when(
        stringr::str_detect(old, "long") == TRUE ~ "Description",
        stringr::str_detect(old, "aa") == TRUE ~ "aa",
        stringr::str_detect(old, "bb") == TRUE ~ "bb",
        stringr::str_detect(old, "cc") == TRUE ~ "cc",
        stringr::str_detect(old, "dd") == TRUE ~ "dd",
        stringr::str_detect(old, "ee") == TRUE ~ "ee"),
      freq = dplyr::case_when(
        stringr::str_detect(old, "(d$|b$)") == TRUE ~ "($a)",
        stringr::str_detect(old, "(a$|c$)") == TRUE & old != "long_desc" ~ "($b)",
        stringr::str_detect(old, "(a$|c$)") == TRUE & old == "long_desc" ~ "Description"),
      name_change = dplyr::if_else(
        old == "long_desc",
        "Description",
        paste(g, freq, sep = " "))
    )
  
  names(output) <- names_df$name_change
  
  tab_name <- paste0("Time ", format(output_time, "%Y-%m-%d %H%M"))
  
  t_style <- openxlsx::createStyle(textDecoration = "Bold")
  
  chg_tbl_wb <- openxlsx::createWorkbook()
  
  openxlsx::addWorksheet(chg_tbl_wb,
                         tab_name)
  
  openxlsx::writeDataTable(chg_tbl_wb,
                           1,
                           output,
                           startRow = 1, startCol = 1,
                           tableStyle = "TableStyleMedium2")
  
  openxlsx::conditionalFormatting(chg_tbl_wb, tab_name,
                                  cols = 1,
                                  rows = 1:30,
                                  type = "contains",
                                  rule = ("Total"),
                                  style = t_style)

  openxlsx::saveWorkbook(chg_tbl_wb,
                         paste0(file_loc, file_name),
                         overwrite = TRUE)

  system(paste0("chmod g+rw ", file_loc, file_name))
  system(paste0("chmod o+r ", file_loc, file_name))

  message(paste0("Table output to ", file_loc, file_name))

}