· 5 years ago · May 18, 2020, 06:32 PM
1################################################################################
2### US Unemployment, 1869 to present - /u/MetricT
3################################################################################
4###
5### The following data sources are used in this graph:
6###
7### * UNRATE (https://fred.stlouisfed.org/series/UNRATE)
8### (1948 - present)
9###
10### * M0892BUSM156SNBR (https://fred.stlouisfed.org/series/M0892BUSM156SNBR)
11### (1940 - 1946)
12###
13### * M0892AUSM156SNBR (https://fred.stlouisfed.org/series/M0892AUSM156SNBR)
14### (1929 - 1942)
15###
16### * Romer, "Spurious Volatility in Historical Unemployment Data"
17### PDF: https://eml.berkeley.edu/~cromer/Reprints/Spurious%20Volatility.pdf
18### (1890 - 1930)
19###
20### * Vernon, "Unemployment Rates in Postbellum America: 1869 - 1899"
21### PDF: https://delong.typepad.com/1-s2.0-0164070494900086-main.pdf
22### (1869 - 1889)
23
24
25################################################################################
26### Load necessary R packages
27################################################################################
28
29### We need the following packages
30packages <- c("tidyverse", "fredr", "scales")
31
32### Install packages if needed, then load them quietly
33new_packages <- packages[!(packages %in% installed.packages()[, "Package"])]
34if (length(new_packages)) install.packages(new_packages, quiet = TRUE)
35invisible(lapply(packages, "library", quietly = TRUE,
36 character.only = TRUE, warn.conflicts = FALSE))
37
38### Set my FRED API key to access the FRED database.
39### You may request an API key at:
40### https://research.stlouisfed.org/useraccount/apikeys
41api_key_fred <- "PUT_YOUR_FRED_API_KEY_HERE"
42fredr_set_key(api_key_fred)
43
44
45################################################################################
46### Add recession bars to ggplot graphs
47################################################################################
48
49geom_recession_bars <- function(date_start, date_end, fill = "darkgray") {
50
51 date_start <- as.Date(date_start, origin = "1970-01-01")
52 date_end <- as.Date(date_end, origin = "1970-01-01")
53
54 recessions_tibble <- tibble(
55
56 peak = as.Date(
57 c("1857-06-01", "1860-10-01", "1865-04-01", "1869-06-01",
58 "1873-10-01", "1882-03-01", "1887-03-01", "1890-07-01",
59 "1893-01-01", "1895-12-01", "1899-06-01", "1902-09-01",
60 "1907-05-01", "1910-01-01", "1913-01-01", "1918-08-01",
61 "1920-01-01", "1923-05-01", "1926-10-01", "1929-08-01",
62 "1937-05-01", "1945-02-01", "1948-11-01", "1953-07-01",
63 "1957-08-01", "1960-04-01", "1969-12-01", "1973-11-01",
64 "1980-01-01", "1981-07-01", "1990-07-01", "2001-03-01",
65 "2007-12-01")),
66
67 trough = as.Date(
68 c("1858-12-01", "1861-06-01", "1867-12-01", "1870-12-01",
69 "1879-03-01", "1885-05-01", "1888-04-01", "1891-05-01",
70 "1894-06-01", "1897-06-01", "1900-12-01", "1904-08-01",
71 "1908-06-01", "1912-01-01", "1914-12-01", "1919-03-01",
72 "1921-07-01", "1924-07-01", "1927-11-01", "1933-03-01",
73 "1938-06-01", "1945-10-01", "1949-10-01", "1954-05-01",
74 "1958-04-01", "1961-02-01", "1970-11-01", "1975-03-01",
75 "1980-07-01", "1982-11-01", "1991-03-01", "2001-11-01",
76 "2009-06-01")
77 )
78 )
79
80 recessions_trim <- recessions_tibble %>%
81 filter(peak >= min(date_start) &
82 trough <= max(date_end))
83
84 if (nrow(recessions_trim) > 0) {
85
86 recession_bars <-
87 geom_rect(data = recessions_trim,
88 inherit.aes = F,
89 fill = fill,
90 alpha = 0.25,
91 aes(xmin = as.Date(peak, origin = "1970-01-01"),
92 xmax = as.Date(trough, origin = "1970-01-01"),
93 ymin = -Inf, ymax = +Inf))
94 } else {
95
96 recession_bars <- geom_blank()
97 }
98
99}
100
101
102################################################################################
103### Data sources
104################################################################################
105
106### Data from 1869 - 1930 from Vernon and Romer
107unemployment_before_1930 <- tibble(
108
109 date = as.Date(c(
110
111 "1869-01-01", "1870-01-01", "1871-01-01", "1872-01-01",
112 "1873-01-01", "1874-01-01", "1875-01-01", "1876-01-01",
113 "1877-01-01", "1878-01-01", "1879-01-01", "1880-01-01",
114 "1881-01-01", "1882-01-01", "1883-01-01", "1884-01-01",
115 "1885-01-01", "1886-01-01", "1887-01-01", "1888-01-01",
116 "1889-01-01",
117
118 "1890-01-01", "1891-01-01", "1892-01-01", "1893-01-01",
119 "1894-01-01", "1895-01-01", "1896-01-01", "1897-01-01",
120 "1898-01-01", "1899-01-01", "1900-01-01", "1901-01-01",
121 "1902-01-01", "1903-01-01", "1904-01-01", "1905-01-01",
122 "1906-01-01", "1907-01-01", "1908-01-01", "1909-01-01",
123 "1910-01-01", "1911-01-01", "1912-01-01", "1913-01-01",
124 "1914-01-01", "1915-01-01", "1916-01-01", "1917-01-01",
125 "1918-01-01", "1919-01-01", "1920-01-01", "1921-01-01",
126 "1922-01-01", "1923-01-01", "1924-01-01", "1925-01-01",
127 "1926-01-01", "1927-01-01", "1928-01-01", "1929-01-01",
128 "1930-01-01")),
129
130 value = c(
131
132 0.0397, 0.0352, 0.0366, 0.0400,
133 0.0399, 0.0553, 0.0583, 0.0700,
134 0.0777, 0.0825, 0.0659, 0.0448,
135 0.0412, 0.0329, 0.0348, 0.0401,
136 0.0462, 0.0472, 0.0430, 0.0508,
137 0.0427,
138
139 0.0397, 0.0477, 0.0372, 0.0809,
140 0.1233, 0.1111, 0.1196, 0.1243,
141 0.1162, 0.0866, 0.0500, 0.0459,
142 0.0430, 0.0435, 0.0508, 0.0462,
143 0.0329, 0.0357, 0.0617, 0.0513,
144 0.0586, 0.0627, 0.0525, 0.0493,
145 0.0663, 0.0718, 0.0563, 0.0523,
146 0.0338, 0.0295, 0.0516, 0.0873,
147 0.0693, 0.0480, 0.0580, 0.0492,
148 0.0402, 0.0457, 0.0502, 0.0461,
149 0.0894)
150)
151data0 <- unemployment_before_1930 %>%
152 mutate(value = value * 100) %>%
153 filter(date <= as.Date("1929-01-01"))
154
155### M0892AUSM156SNBR (1929 - 1942)
156data1 <-
157 fredr(series_id = "M0892AUSM156SNBR", frequency = "m") %>%
158 select(date, value) %>%
159 filter(date < as.Date("1940-01-01")) %>%
160 as_tibble()
161
162### M0892BUSM156SNBR (1940-1946)
163data2 <-
164 fredr(series_id = "M0892BUSM156SNBR", frequency = "m") %>%
165 select(date, value) %>%
166 as_tibble()
167
168### UNRATE (1948 - Present)
169data3 <-
170 fredr(series_id = "UNRATE", frequency = "m") %>%
171 select(date, value) %>%
172 as_tibble()
173
174### Combine them into one dataset
175data <-
176 bind_rows(data0, data1, data2, data3) %>%
177 filter(!is.na(value))
178
179last_us_date <- data$date %>% tail(n = 1) %>% format("%b %Y")
180
181### Plot the combined data
182p_unemploy <-
183 ggplot(data = data) +
184 theme_classic() +
185 theme(legend.position = "none") +
186 geom_line(aes(x = as.Date(date), y = value / 100),
187 color = "black", alpha = 0.8) +
188 geom_hline(yintercept = tail(data$value, n = 1) / 100,
189 linetype = "dotted", color = "firebrick2") +
190 geom_recession_bars(min(data$date), max(data$date)) +
191
192 annotate("text", size = 4, color = "darkred", vjust = -0.2,
193 label = paste(last_us_date, "\n",
194 tail(data$value, n = 1), "%", sep = ""),
195 x = max(data$date), y = tail(data$value, n = 1) / 100) +
196
197 annotate("text", size = 5, color = "dodgerblue4", angle = "90",
198 label = "Great Recession", x = as.Date("2011-01-01"), y = 0.04) +
199
200 annotate("text", size = 5, color = "dodgerblue4", angle = "90",
201 label = "Great Depression", x = as.Date("1936-01-01"), y = 0.05) +
202
203 annotate("text", size = 5, color = "dodgerblue4", angle = "90",
204 label = "Panic of 1893", x = as.Date("1896-01-01"), y = 0.05) +
205
206 scale_y_continuous(labels = scales::percent,
207 breaks = c(0, 0.05, 0.10, 0.15, 0.20, 0.25)) +
208
209 scale_x_date(breaks = as.Date(c("1870-01-01", "1880-01-01", "1890-01-01",
210 "1900-01-01", "1910-01-01", "1920-01-01",
211 "1930-01-01", "1940-01-01", "1950-01-01",
212 "1960-01-01", "1970-01-01", "1980-01-01",
213 "1990-01-01", "2000-01-01", "2010-01-01",
214 "2020-01-01")),
215 date_labels = "%Y") +
216 labs(title = "US Unemployment Rate, 1869 - Present", x = "", y = "")
217print(p_unemploy)