Velocity of M2 Money Stock, 1869 - Present

################################################################################
### Velocity of M2 Money Stock, 1869 to present
###    by /u/MetricT
################################################################################

library("tidyverse")
library("fredr")

### Set your FRED API key to access the FRED database.
### You may request an API key at:
### https://research.stlouisfed.org/useraccount/apikeys
api_key_fred <- "PUT_YOUR_FRED_API_KEY_HERE"
fredr_set_key(api_key_fred)

################################################################################
### Add recession bars to our graph using NBER dates
################################################################################
geom_recession_bars <- function(date_start, date_end, fill = "darkgray") {

  date_start <- as.Date(date_start, origin = "1970-01-01")
  date_end   <- as.Date(date_end,   origin = "1970-01-01")

  recessions_tibble <- tibble(

    peak = as.Date(
      c("1857-06-01", "1860-10-01", "1865-04-01", "1869-06-01",
        "1873-10-01", "1882-03-01", "1887-03-01", "1890-07-01",
        "1893-01-01", "1895-12-01", "1899-06-01", "1902-09-01",
        "1907-05-01", "1910-01-01", "1913-01-01", "1918-08-01",
        "1920-01-01", "1923-05-01", "1926-10-01", "1929-08-01",
        "1937-05-01", "1945-02-01", "1948-11-01", "1953-07-01",
        "1957-08-01", "1960-04-01", "1969-12-01", "1973-11-01",
        "1980-01-01", "1981-07-01", "1990-07-01", "2001-03-01",
        "2007-12-01")),

    trough = as.Date(
      c("1858-12-01", "1861-06-01", "1867-12-01", "1870-12-01",
        "1879-03-01", "1885-05-01", "1888-04-01", "1891-05-01",
        "1894-06-01", "1897-06-01", "1900-12-01", "1904-08-01",
        "1908-06-01", "1912-01-01", "1914-12-01", "1919-03-01",
        "1921-07-01", "1924-07-01", "1927-11-01", "1933-03-01",
        "1938-06-01", "1945-10-01", "1949-10-01", "1954-05-01",
        "1958-04-01", "1961-02-01", "1970-11-01", "1975-03-01",
        "1980-07-01", "1982-11-01", "1991-03-01", "2001-11-01",
        "2009-06-01")
    )
  )

  recessions_trim <- recessions_tibble %>%
    filter(peak   >= min(date_start) &
             trough <= max(date_end))

  if (nrow(recessions_trim) > 0) {

    recession_bars <- geom_rect(data        = recessions_trim,
                                inherit.aes = F,
                                fill        = fill,
                                alpha       = 0.25,
                              aes(xmin = as.Date(peak,   origin = "1970-01-01"),
                                  xmax = as.Date(trough, origin = "1970-01-01"),
                                  ymin = -Inf, ymax = +Inf))
  } else {

    recession_bars <- geom_blank()
  }

}

################################################################################
### Data from 1869 to 1960 is from Friedman & Schwartz
### "A Monetary History of the United States, 1867-1960", table A-5
################################################################################

money_velocity_before_1960 <- tibble(

  date = as.Date(c(

    "1869-01-01", "1870-01-01", "1871-01-01", "1872-01-01",
    "1873-01-01", "1874-01-01", "1875-01-01", "1876-01-01",
    "1877-01-01", "1878-01-01", "1879-01-01", "1880-01-01",
    "1881-01-01", "1882-01-01", "1883-01-01", "1884-01-01",
    "1885-01-01", "1886-01-01", "1887-01-01", "1888-01-01",
    "1889-01-01", "1890-01-01", "1891-01-01", "1892-01-01",
    "1893-01-01", "1894-01-01", "1895-01-01", "1896-01-01",
    "1897-01-01", "1898-01-01", "1899-01-01", "1900-01-01",
    "1901-01-01", "1902-01-01", "1903-01-01", "1904-01-01",
    "1905-01-01", "1906-01-01", "1907-01-01", "1908-01-01",
    "1909-01-01", "1910-01-01", "1911-01-01", "1912-01-01",
    "1913-01-01", "1914-01-01", "1915-01-01", "1916-01-01",
    "1917-01-01", "1918-01-01", "1919-01-01", "1920-01-01",
    "1921-01-01", "1922-01-01", "1923-01-01", "1924-01-01",
    "1925-01-01", "1926-01-01", "1927-01-01", "1928-01-01",
    "1929-01-01", "1930-01-01", "1931-01-01", "1932-01-01",
    "1933-01-01", "1934-01-01", "1935-01-01", "1936-01-01",
    "1937-01-01", "1938-01-01", "1939-01-01", "1940-01-01",
    "1941-01-01", "1942-01-01", "1943-01-01", "1944-01-01",
    "1945-01-01", "1946-01-01", "1947-01-01", "1948-01-01",
    "1949-01-01", "1950-01-01", "1951-01-01", "1952-01-01",
    "1953-01-01", "1954-01-01", "1955-01-01", "1956-01-01",
    "1957-01-01", "1958-01-01", "1959-01-01", "1960-01-01")),

  value = c(
    4.57, 4.12, 3.91, 4.34,
    4.35, 4.23, 3.99, 4.19,
    4.48, 4.70, 4.67, 4.97,
    4.10, 4.16, 3.76, 3.75,
    3.43, 3.30, 3.22, 3.10,
    3.06, 2.93, 2.94, 2.81,
    2.87, 2.55, 2.71, 2.67,
    2.81, 2.55, 2.48, 2.53,
    2.47, 2.35, 2.34, 2.21,
    2.18, 2.32, 2.30, 2.08,
    2.23, 2.20, 2.09, 2.15,
    2.17, 1.91, 1.90, 2.12,
    2.18, 2.51, 2.28, 2.20,
    1.90, 1.88, 2.04, 1.97,
    1.88, 1.95, 1.87, 1.84,
    1.95, 1.70, 1.47, 1.28,
    1.38, 1.52, 1.52, 1.60,
    1.67, 1.53, 1.52, 1.51,
    1.61, 1.84, 1.77, 1.61,
    1.37, 1.16, 1.23, 1.31,
    1.27, 1.43, 1.53, 1.50,
    1.51, 1.49, 1.58, 1.61,
    1.63, 1.56, 1.63, 1.69)

)

################################################################################
### Add/combine our data
################################################################################

### Add data from 1859 - 1960 from the tibble above
data0 <- money_velocity_before_1960

### Fetch data for 1959 - present from FRED
data1 <-
  fredr(series_id = "M2V", frequency = "q") %>%
  select(date, value) %>%
  as_tibble()

### Exclude data from Friedman when we have Fed data to go on
data0 <- data0 %>% filter(date < (min(data1$date)))

### Combine the two data sets
data <- bind_rows(data0, data1) %>% filter(!is.na(value))

################################################################################
### Graph:  Velocity of M2 Money Stock, 1869 - present
################################################################################
p_m2_velocity <-
  ggplot(data = data) +
  theme_classic() +
  theme(legend.position = "none") +
  geom_line(aes(x = as.Date(date), y = value),
            color = "black", alpha = 0.8) +
  geom_recession_bars(min(data$date), max(data$date)) +

  scale_x_date(breaks = as.Date(c("1870-01-01", "1880-01-01", "1890-01-01",
                                  "1900-01-01", "1910-01-01", "1920-01-01",
                                  "1930-01-01", "1940-01-01", "1950-01-01",
                                  "1960-01-01", "1970-01-01", "1980-01-01",
                                  "1990-01-01", "2000-01-01", "2010-01-01",
                                  "2020-01-01")),
               date_labels = "%Y") +
  labs(title = "Velocity of M2 Money Stock, 1869 - Present", x = "", y = "")
print(p_m2_velocity)