R/financial.R

In abresler/asbtools: Alex Bresler's random tools

.munge_inflation_data <-
  function(data, index_year = NULL) {
    data <-
      data %>%
      mutate_if(is.character, readr::parse_number) %>%
      mutate(pct_change = pct_change / 100)


    if (length(index_year) == 0) {
      index_year <- data %>% filter(year == max(year)) %>% pull(year)
    }

    df_index <-
      data %>% filter(year == index_year)

    current <-
      df_index %>% pull(index)

    index_year <-
      df_index$year

    ratio <- glue("ratio_{index_year}_dollars") %>% as.character()


    data <-
      data %>%
      mutate(UQ(ratio) := current / index,
             year_index = index_year) %>%
      dplyr::select(year_index,
                    year,
                    index,
                    all_of(ratio),
                    everything())

    data
  }

.parse_inflation_data <-
  function(page,
           index_year = NULL,
           year_base = 1913) {
    data <-
      page %>%
      html_table(fill = F) %>%
      flatten_df() %>%
      dplyr::as_tibble() %>%
      purrr::set_names(c("year", "index", "pct_change"))

    data %>%
      .munge_inflation_data(index_year = index_year) %>%
      mutate(year_base = year_base) %>%
      select(year_base, everything())
  }

.get_1913_inflation <-
  function(index_year = NULL) {
    page <-
      "https://minneapolisfed.org/community/financial-and-economic-education/cpi-calculator-information/consumer-price-index-and-inflation-rates-1913" %>% read_html()

    data <-
      .parse_inflation_data(page = page,
                            year_base = 1913,
                            index_year = index_year)

    data

  }

.get_1800_inflation <-
  function() {
    page <-
      "https://minneapolisfed.org/community/financial-and-economic-education/cpi-calculator-information/consumer-price-index-1800" %>% read_html()

    data <-
      .parse_inflation_data(page = page, year_base = 1800)

    data

  }


# dictionary --------------------------------------------------------------


#' US Inflation Adjustment Table
#'
#' Gets a table to adjust prices to current dollars
#'
#'
#' @return a \code{tibble}
#' @export
#' @import rvest xml2 dplyr readr purrr
#' @examples
#' us_inflation_index(index_year = NULL)
#' us_inflation_index(index_year = 1983)
us_inflation_index <-
  memoise::memoise(function(index_year = NULL) {
    "Getting US inflation data from 1913" %>% cat(fill = T)
    data <- .get_1913_inflation(index_year = index_year)
    data
  })



# adjust ------------------------------------------------------------------


.tbl_inflation_adjust_amount <-
  function(data,
           date_column = NULL,
           amount_column = NULL,
           index_year = NULL,
           return_message = T) {
    if (length(date_column) == 0) {
      "Enter date column" %>% message()
      return(data)
    }

    if (length(amount_column) == 0) {
      "Enter amount column" %>% message()
      return(data)
    }

    tbl_inflation <- us_inflation_index(index_year = index_year)

    idx_year <- tbl_inflation %>% distinct(year_index) %>% pull()

    amount_new <- glue("{amount_column}_{idx_year}_dollars")

    if (return_message) {
      glue(
        "Adjusting {crayon::green(amount_column)} to {crayon::red(idx_year)} dollars using {crayon::blue(date_column)}"
      ) %>% cat(fill = T)
    }

    tbl_dates <-
      data %>%
      select(all_of(date_column)) %>%
      distinct()

    is_date <-
      tbl_dates %>% pull(date_column) %>% class() %>% str_detect("Date")

    is_numeric <-
      tbl_dates %>% pull(date_column) %>% class() %>% str_detect("numeric")

    if (is_date) {
      tbl_dates <-
        tbl_dates %>%
        mutate(year = !!sym(date_column) %>% lubridate::year()) %>%
        arrange(year)
    }

    if (is_numeric) {
      tbl_dates <- tbl_dates %>%
        mutate(year := !!sym(date_column))
    }

    tbl_year_ratio <-
      tbl_inflation %>%
      select(year, matches("^ratio"))

    ratio_column <-
      tbl_year_ratio %>% select(matches("ratio")) %>% names()

    tbl_dates <-
      tbl_dates %>%
      left_join(tbl_year_ratio, by = "year") %>%
      select(-year) %>%
      mutate_at(ratio_column, list(function(x) {
        x %>% coalesce(1L)
      }))

    data <-
      data %>%
      left_join(tbl_dates, by  = date_column)

    data <- data %>%
      mutate(UQ(amount_new) := !!sym(ratio_column) * !!sym(amount_column)) %>%
      select(-all_of(ratio_column))

    data

  }

#' Inflation Adjust Amount Variables
#'
#' Adjust amounts to specified index year dollars using data from the Minneapolis Federal Reserve to adjust.
#'
#' @param data a `tibble`
#' @param date_column character vector of the date column
#' @param amount_columns vector of amount columns to adjust
#' @param index_year if not `NULL` year to use as index adjustor, if `NULL` uses most recent year from Minneapolis Federal Reserve
#' @param return_message if `TRUE` returns a message
#'
#' @return
#' @export
#'
#' @examples
tbl_inflation_adjust_variables <-
  function(data,
           date_column = NULL,
           amount_columns = NULL,
           index_year = NULL,
           return_message = T) {
    .tbl_inflation_adjust_amount_safe <-
      possibly(.tbl_inflation_adjust_amount, tibble())
    data <-
      amount_columns %>%
      map_dfr(function(amount_column) {
        .tbl_inflation_adjust_amount_safe(
          data = data,
          amount_column = amount_column,
          date_column = date_column,
          index_year = index_year,
          return_message = return_message
        )
      })

    data
  }