US Unemployment from 1869 to present

################################################################################
### US Unemployment, 1869 to present - /u/MetricT
################################################################################
###
### The following data sources are used in this graph:
###
###  * UNRATE (https://fred.stlouisfed.org/series/UNRATE)
###    (1948 - present)
###
###  * M0892BUSM156SNBR (https://fred.stlouisfed.org/series/M0892BUSM156SNBR)
###    (1940 - 1946)
###
###  * M0892AUSM156SNBR (https://fred.stlouisfed.org/series/M0892AUSM156SNBR)
###    (1929 - 1942)
###
###  * Romer, "Spurious Volatility in Historical Unemployment Data"
###    PDF:  https://eml.berkeley.edu/~cromer/Reprints/Spurious%20Volatility.pdf
###    (1890 - 1930)
###
###  * Vernon, "Unemployment Rates in Postbellum America: 1869 - 1899"
###    PDF:  https://delong.typepad.com/1-s2.0-0164070494900086-main.pdf
###    (1869 - 1889)


################################################################################
### Load necessary R packages
################################################################################

### We need the following packages
packages <- c("tidyverse", "fredr", "scales")

### Install packages if needed, then load them quietly
new_packages <- packages[!(packages %in% installed.packages()[, "Package"])]
if (length(new_packages)) install.packages(new_packages, quiet = TRUE)
invisible(lapply(packages, "library", quietly = TRUE,
                 character.only = TRUE, warn.conflicts = FALSE))

### Set my 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 ggplot graphs
################################################################################

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 sources
################################################################################

### Data from 1869 - 1930 from Vernon and Romer
unemployment_before_1930 <- 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")),

  value = c(

    0.0397, 0.0352, 0.0366, 0.0400,
    0.0399, 0.0553, 0.0583, 0.0700,
    0.0777, 0.0825, 0.0659, 0.0448,
    0.0412, 0.0329, 0.0348, 0.0401,
    0.0462, 0.0472, 0.0430, 0.0508,
    0.0427,

    0.0397, 0.0477, 0.0372, 0.0809,
    0.1233, 0.1111, 0.1196, 0.1243,
    0.1162, 0.0866, 0.0500, 0.0459,
    0.0430, 0.0435, 0.0508, 0.0462,
    0.0329, 0.0357, 0.0617, 0.0513,
    0.0586, 0.0627, 0.0525, 0.0493,
    0.0663, 0.0718, 0.0563, 0.0523,
    0.0338, 0.0295, 0.0516, 0.0873,
    0.0693, 0.0480, 0.0580, 0.0492,
    0.0402, 0.0457, 0.0502, 0.0461,
    0.0894)
)
data0 <- unemployment_before_1930 %>%
         mutate(value = value * 100) %>%
         filter(date <= as.Date("1929-01-01"))

### M0892AUSM156SNBR (1929 - 1942)
data1 <-
  fredr(series_id = "M0892AUSM156SNBR", frequency = "m") %>%
  select(date, value) %>%
  filter(date < as.Date("1940-01-01")) %>%
  as_tibble()

### M0892BUSM156SNBR (1940-1946)
data2 <-
  fredr(series_id = "M0892BUSM156SNBR", frequency = "m") %>%
  select(date, value) %>%
  as_tibble()

### UNRATE (1948 - Present)
data3 <-
  fredr(series_id = "UNRATE", frequency = "m") %>%
  select(date, value) %>%
  as_tibble()

### Combine them into one dataset
data <-
  bind_rows(data0, data1, data2, data3) %>%
  filter(!is.na(value))

last_us_date <- data$date %>% tail(n = 1) %>% format("%b %Y")

### Plot the combined data
p_unemploy <-
  ggplot(data = data) +
  theme_classic() +
  theme(legend.position = "none") +
  geom_line(aes(x = as.Date(date), y = value / 100),
            color = "black", alpha = 0.8) +
  geom_hline(yintercept = tail(data$value, n = 1) / 100,
             linetype = "dotted", color = "firebrick2") +
  geom_recession_bars(min(data$date), max(data$date)) +

  annotate("text", size = 4, color = "darkred", vjust = -0.2,
           label = paste(last_us_date, "\n",
                         tail(data$value, n = 1), "%", sep = ""),
            x = max(data$date), y = tail(data$value, n = 1) / 100) +

  annotate("text", size = 5, color = "dodgerblue4", angle = "90",
           label = "Great Recession", x = as.Date("2011-01-01"), y = 0.04) +

  annotate("text", size = 5, color = "dodgerblue4", angle = "90",
           label = "Great Depression", x = as.Date("1936-01-01"), y = 0.05) +

  annotate("text", size = 5, color = "dodgerblue4", angle = "90",
           label = "Panic of 1893", x = as.Date("1896-01-01"), y = 0.05) +

  scale_y_continuous(labels = scales::percent,
                     breaks = c(0, 0.05, 0.10, 0.15, 0.20, 0.25)) +

  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 = "US Unemployment Rate, 1869 - Present", x = "", y = "")
print(p_unemploy)