· 6 years ago · Jan 23, 2020, 08:52 PM
1### We need the following packages for this example.
2packages <- c("lubridate", "fredr", "shape", "forecast",
3 "ggthemes", "zoo", "tidyverse", "tis", "showtext", "tsibble",
4 "tsibbledata", "feasts", "fable", "dplyr", "tsbox",
5 "here", "magick", "magrittr", "reshape2", "gtrendsR",
6 "scales")
7
8### Install packages if needed, then load them quietly
9new_packages <- packages[!(packages %in% installed.packages()[, "Package"])]
10if (length(new_packages)) install.packages(new_packages, quiet = TRUE)
11invisible(lapply(packages, "library", quietly = TRUE,
12 character.only = TRUE, warn.conflicts = FALSE))
13
14### Load API Keys
15api_key_fred <- "INSERT_YOUR_FRED_API_KEY_HERE"
16
17# I like the "Economist" ggplot theme, so use it by default.
18# theme_set(theme_economist() + scale_colour_economist())
19theme_set(theme_economist())
20
21####################################################################
22### Add recession bars to ggplot graphs
23####################################################################
24geom_recession_bars <- function (date_start, date_end) {
25
26 date_start = as.Date(date_start, origin="1970-01-01")
27 date_end = as.Date(date_end, origin="1970-01-01")
28
29 recessions_tibble <- tibble(
30
31 peak = as.Date(
32 c("1857-06-01", "1860-10-01", "1865-04-01", "1869-06-01",
33 "1873-10-01", "1882-03-01", "1887-03-01", "1890-07-01",
34 "1893-01-01", "1895-12-01", "1899-06-01", "1902-09-01",
35 "1907-05-01", "1910-01-01", "1913-01-01", "1918-08-01",
36 "1920-01-01", "1923-05-01", "1926-10-01", "1929-08-01",
37 "1937-05-01", "1945-02-01", "1948-11-01", "1953-07-01",
38 "1957-08-01", "1960-04-01", "1969-12-01", "1973-11-01",
39 "1980-01-01", "1981-07-01", "1990-07-01", "2001-03-01",
40 "2007-12-01")),
41
42 trough = as.Date(
43 c("1858-12-01", "1861-06-01", "1867-12-01", "1870-12-01",
44 "1879-03-01", "1885-05-01", "1888-04-01", "1891-05-01",
45 "1894-06-01", "1897-06-01", "1900-12-01", "1904-08-01",
46 "1908-06-01", "1912-01-01", "1914-12-01", "1919-03-01",
47 "1921-07-01", "1924-07-01", "1927-11-01", "1933-03-01",
48 "1938-06-01", "1945-10-01", "1949-10-01", "1954-05-01",
49 "1958-04-01", "1961-02-01", "1970-11-01", "1975-03-01",
50 "1980-07-01", "1982-11-01", "1991-03-01", "2001-11-01",
51 "2009-06-01")
52 )
53 )
54
55 recessions_trim <- recessions_tibble %>%
56 filter(peak >= min(date_start) &
57 trough <= max(date_end))
58
59 if (nrow(recessions_trim) > 0) {
60
61 recession_bars = geom_rect(data = recessions_trim,
62 inherit.aes = F,
63 fill = "darkgray",
64 alpha = 0.25,
65 aes(xmin = as.Date(peak, origin="1970-01-01"),
66 xmax = as.Date(trough, origin="1970-01-01"),
67 ymin = -Inf, ymax = +Inf))
68 } else {
69
70 recession_bars = geom_blank()
71 }
72
73}
74
75### Set my FRED API key to access the FRED database.
76### The actual value is in Include/API_Keys.R
77### You may request an API key at:
78### https://research.stlouisfed.org/useraccount/apikeys
79fredr_set_key(api_key_fred)
80
81### What date ranges do we want?
82date_start <- "1952-01-01"
83date_end <- "2019-04-01"
84
85### A frequency selector to automate selecting the data frequency
86#frequency <- c("m", 12, "Seasonal12") # For monthly data
87frequency <- c("q", 4, "Seasonal4") # For quarterly data
88#frequency <- c("sa", 2, "Seasonal2") # For semiannual data
89#frequency <- c("a", 1, "Seasonal1") # For annual data
90
91###########################################################################
92### Import Household Wealth from FRED
93###########################################################################
94series <- "TNWBSHNO"
95
96data <- fredr(series_id = series, frequency = frequency[1],
97 observation_start = as.Date(date_start),
98 observation_end = as.Date(date_end)) %>%
99 as_tsibble(index = "date")
100
101date <- data %>% pull("date")
102household_wealth <- data %>% pull("value")
103household_wealth_decomposed <- household_wealth %>%
104 ts(frequency = as.numeric(frequency[2])) %>%
105 mstl()
106
107household_wealth_seasonal <- household_wealth_decomposed %>% seasonal()
108household_wealth_trend <- household_wealth_decomposed %>% trendcycle()
109household_wealth_remainder <- household_wealth_decomposed %>% remainder()
110
111### You can use trend, trend + remainder, or trend + seasonal + remainder
112household_wealth <- household_wealth_trend + household_wealth_remainder
113
114###########################################################################
115### Import Nominal GDP from FRED
116###########################################################################
117series <- "GDP"
118
119data <- fredr(series_id = series, frequency = frequency[1],
120 observation_start = as.Date(date_start),
121 observation_end = as.Date(date_end)) %>%
122 as_tsibble(index = "date")
123
124nominal_gdp <- data %>% pull("value")
125nominal_gdp_decomposed <- nominal_gdp %>%
126 ts(frequency = as.numeric(frequency[2])) %>%
127 mstl()
128
129nominal_gdp_seasonal <- nominal_gdp_decomposed %>% seasonal()
130nominal_gdp_trend <- nominal_gdp_decomposed %>% trendcycle()
131nominal_gdp_remainder <- nominal_gdp_decomposed %>% remainder()
132
133### You can use trend, trend + remainder, or trend + seasonal + remainder
134nominal_gdp <- nominal_gdp_trend + nominal_gdp_remainder
135
136###########################################################################
137### Import Real GDP from FRED
138###########################################################################
139series <- "GDPC1"
140
141data <- fredr(series_id = series, frequency = frequency[1],
142 observation_start = as.Date(date_start),
143 observation_end = as.Date(date_end)) %>%
144 as_tsibble(index = "date")
145
146real_gdp <- data %>% pull("value")
147real_gdp_decomposed <- real_gdp %>%
148 ts(frequency = as.numeric(frequency[2])) %>%
149 mstl()
150
151real_gdp_seasonal <- real_gdp_decomposed %>% seasonal()
152real_gdp_trend <- real_gdp_decomposed %>% trendcycle()
153real_gdp_remainder <- real_gdp_decomposed %>% remainder()
154
155### You can use trend, trend + remainder, or trend + seasonal + remainder
156real_gdp <- real_gdp_trend + real_gdp_remainder
157
158### Graph globals
159annotationcolor <- "black"
160
161### Common caption strings to make doing the caption easier
162real_gdp_cap <- "U.S. Bureau of Economic Analysis, Real Gross Domestic Product [GDPC1]\n"
163nom_gdp_cap <- "U.S. Bureau of Economic Analysis, Gross Domestic Product [GDP]\n"
164wealth_cap <- "Board of Governors of the Federal Reserve System (US), Households and nonprofit organizations; net worth, Level [TNWBSHNO]\n"
165
166nw_cap <- paste(wealth_cap,
167 nom_gdp_cap,
168 "retrieved from FRED, Federal Reserve Bank of St. Louis")
169
170nwr_cap <- paste(wealth_cap,
171 nom_gdp_cap,
172 real_gdp_cap,
173 "retrieved from FRED, Federal Reserve Bank of St. Louis")
174
175##########################################################################
176### Graph 1: Household Wealth graphed alongside Nominal GDP
177##########################################################################
178
179### Normalize both Household Wealth and Nominal GDP with respect to
180### the start date (1952-01-01)
181norm_household_wealth <- household_wealth / household_wealth[1]
182norm_nominal_gdp <- nominal_gdp / nominal_gdp[1]
183
184### Create a dataframe for graphing
185data_df <- data.frame(date, norm_household_wealth, norm_nominal_gdp)
186
187### Create the graph
188title <- paste("Household Wealth and Nominal GDP growth relative to",
189 date_start)
190subtitle <- "Recessions marked with vertical bars"
191caption <- nw_cap
192xlab <- "Year"
193ylab <- paste("Growth relative to ", date_start)
194
195### Arrow settings for the annotations
196segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
197 x2 = as.Date("1998-01-01"), y1 = 32, y2 = 32)
198segment_df_2 <- data.frame(x1 = as.Date("2000-07-01"),
199 x2 = as.Date("2003-07-01"), y1 = 52, y2 = 52)
200segment_df_3 <- data.frame(x1 = as.Date("2012-01-01"),
201 x2 = as.Date("2015-01-01"), y1 = 82, y2 = 82)
202
203p <- ggplot(data = data_df,
204 mapping = aes(x = date, y = norm_nominal_gdp)) +
205
206 theme_economist() + scale_colour_economist() +
207 theme(legend.title = element_blank()) +
208 labs(title = title,
209 subtitle = subtitle,
210 caption = caption,
211 x = xlab,
212 y = ylab) +
213
214 geom_line(data = data_df,
215 size = 1.3,
216 aes(y = norm_nominal_gdp,
217 color = "Nominal GDP")) +
218
219 geom_line(data = data_df,
220 size = 1.3,
221 aes(y = norm_household_wealth,
222 color = "Household Wealth")) +
223
224 # Add recession bars
225 geom_recession_bars(min(date), max(date)) +
226
227 annotate("text",
228 x = as.Date("1990-01-01"),
229 y = 32,
230 label = "Dot.Com\nStock Bubble",
231 size = 4,
232 color = annotationcolor) +
233 geom_segment(data = segment_df_1,
234 aes(x = x1, y = y1, xend = x2, yend = y2),
235 arrow = arrow(length = unit(0.03, "npc")),
236 size = 1.3,
237 color = annotationcolor) +
238
239 annotate("text",
240 x = as.Date("1997-01-01"),
241 y = 52,
242 label = "Housing\nBubble",
243 size = 4,
244 color = annotationcolor) +
245 geom_segment(data = segment_df_2,
246 aes(x = x1, y = y1, xend = x2, yend = y2),
247 arrow = arrow(length = unit(0.03, "npc")),
248 size = 1.3,
249 color = annotationcolor) +
250
251 annotate("text",
252 x = as.Date("2009-01-01"),
253 y = 82,
254 label = "Current\nBubble",
255 size = 4,
256 color = annotationcolor) +
257 geom_segment(data = segment_df_3, aes(x = x1, y = y1, xend = x2, yend = y2),
258 arrow = arrow(length = unit(0.03, "npc")),
259 size = 1.3,
260 color = annotationcolor)
261print(p)
262
263readline(prompt = "Press [ENTER} to continue...")
264
265###########################################################################
266### Graph 2: Household Wealth to GDP ratio
267###########################################################################
268
269### Compute the ratio of Household Wealth to Nominal GDP
270wealth_to_gdp <- household_wealth / nominal_gdp
271
272### Create a dataframe for graphing
273data_df <- data.frame(date, wealth_to_gdp)
274
275### Add lines to show median (1951-1995) +/- 1 stdev
276sd <- wealth_to_gdp[date <= 1995] %>% sd()
277mean <- wealth_to_gdp[date <= 1995] %>% mean()
278mean_p1 <- mean + sd
279mean_m1 <- mean - sd
280
281### If you plot wealth_to_gdp, you see there are some long-term trends
282### that sit beneath the bubbles. We're primarily interest in the bubbles
283### as they tend not to fall below those trends when they pop. I model
284### the trend as three piecewise sections, take the local minima inside
285### each trend, and use a linear regression to determine the floors.
286### Then I use the "segments()" command to plot them.
287###
288### Pre-1960: Wealth_Floor <- -72.60170 + 0.038941*Year
289### 1960-1978.75: Wealth_Floor <- +52.16769 - 0.024760*Year
290### 1982 -> Present: Wealth_Floor <- -63.48539 + 0.033682*Year
291
292### Create the graph
293title <- "Ratio of Household Wealth to Nominal DDP"
294subtitle <- "Blue lines show 1952-1995 mean +/- 1 std dev\nRecessions marked with vertical bars"
295caption <- nw_cap
296xlab <- "Year"
297ylab <- "Ratio"
298
299### Arrow settings for the annotations
300segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
301 x2 = as.Date("1998-01-01"), y1 = 4.3, y2 = 4.3)
302segment_df_2 <- data.frame(x1 = as.Date("2000-07-01"),
303 x2 = as.Date("2003-07-01"), y1 = 4.8, y2 = 4.8)
304segment_df_3 <- data.frame(x1 = as.Date("2012-01-01"),
305 x2 = as.Date("2015-01-01"), y1 = 5.2, y2 = 5.2)
306
307### Trend line for 1952 -1958, 1958 - 1978, and 1978 - present
308segment_df_trend_1 <- data.frame(x1 = as.Date("1952-01-01"),
309 x2 = as.Date("1958-09-03"),
310 y1 = 3.411132, y2 = 3.67096)
311segment_df_trend_2 <- data.frame(x1 = as.Date("1958-09-03"),
312 x2 = as.Date("1978-12-14"),
313 y1 = 3.670960, y2 = 3.16885)
314segment_df_trend_3 <- data.frame(x1 = as.Date("1978-12-14"),
315 x2 = as.Date(now()),
316 y1 = 3.168855, y2 = 4.52617)
317
318### Generate the plot
319p <- ggplot(data = data_df,
320 mapping = aes(x = date, y = wealth_to_gdp)) +
321
322 theme_economist() + scale_colour_economist() +
323 theme(legend.position = "none") +
324 labs(title = title,
325 subtitle = subtitle,
326 caption = caption,
327 x = xlab,
328 y = ylab) +
329
330 geom_line(data = data_df,
331 size = 1.3,
332 aes(y = wealth_to_gdp, color = "Wealth to GDP")) +
333
334 # Add recession bars
335 geom_recession_bars(min(date), max(date)) +
336
337 geom_hline(yintercept = mean,
338 size = 1,
339 linetype = "solid",
340 alpha = 1,
341 color = "red") +
342
343 geom_hline(yintercept = mean_p1,
344 size = 1,
345 linetype = "dotted",
346 alpha = 1,
347 color = "red") +
348
349 geom_hline(yintercept = mean_m1,
350 size = 1,
351 linetype = "dotted",
352 alpha = 1,
353 color = "red") +
354
355 # Draw the three trend lines
356 geom_segment(data = segment_df_trend_1,
357 size = 1.3,
358 aes(x = x1, y = y1, xend = x2, yend = y2, color = "Segments")) +
359 geom_segment(data = segment_df_trend_2,
360 size = 1.3,
361 aes(x = x1, y = y1, xend = x2, yend = y2, color = "Segments")) +
362 geom_segment(data = segment_df_trend_3,
363 size = 1.3,
364 aes(x = x1, y = y1, xend = x2, yend = y2, color = "Segments")) +
365
366 # Annotate the graphs
367 annotate("text", x = as.Date("1990-01-01"), y = 4.3,
368 label = "Dot.Com\nStock Bubble",
369 size = 5, color = annotationcolor) +
370 geom_segment(data = segment_df_1, arrow = arrow(length = unit(0.03, "npc")),
371 aes(x = x1, y = y1, xend = x2, yend = y2), size = 1.3,
372 color = annotationcolor) +
373
374 annotate("text", x = as.Date("1997-01-01"), y = 4.8,
375 label = "Housing\nBubble",
376 size = 5, color = annotationcolor) +
377 geom_segment(data = segment_df_2, arrow = arrow(length = unit(0.03, "npc")),
378 aes(x = x1, y = y1, xend = x2, yend = y2), size = 1.3,
379 color = annotationcolor) +
380
381 annotate("text", x = as.Date("2009-01-01"), y = 5.2,
382 label = "Current\nBubble",
383 size = 5, color = annotationcolor) +
384 geom_segment(data = segment_df_3, arrow = arrow(length = unit(0.03, "npc")),
385 aes(x = x1, y = y1, xend = x2, yend = y2), size = 1.3,
386 color = annotationcolor)
387
388print(p)
389
390readline(prompt = "Press [ENTER} to continue...")
391
392###########################################################################
393### Graph 3: Bubble Size to GDP
394###########################################################################
395
396### Subtract out the long-term trend mentioned in the previous section
397### to get the size of the asset bubbles compared to GDP
398
399asset_bubbles <- rep(NA, length(wealth_to_gdp))
400early <- date <= as.Date("1959-09-03")
401late <- date > as.Date("1978-12-14")
402mid <- !early & !late
403asset_bubbles[early] <- wealth_to_gdp[early] +
404 72.6017 - 0.038941 * decimal_date(date[early])
405
406asset_bubbles[mid] <- wealth_to_gdp[mid] -
407 52.1677 + 0.024760 * decimal_date(date[mid])
408
409asset_bubbles[late] <- wealth_to_gdp[late] +
410 63.4854 - 0.033682 * decimal_date(date[late])
411
412### Add lines to show the mean and +/1 one std.dev line for 1952-1995
413mean <- asset_bubbles[date <= 1995] %>% mean()
414sd <- asset_bubbles[date <= 1995] %>% sd()
415mean_p1 <- mean + sd
416mean_m1 <- mean - sd
417
418data_df <- data.frame(date, asset_bubbles)
419
420### Graph start
421title <- "Ratio of Asset Bubble Size to GDP"
422subtitle <- "Blue lines show 1952-1995 mean +/- 1 std dev\nRecessions marked with vertical bars"
423caption <- nw_cap
424xlab <- "Year"
425ylab <- "Multiple of GDP"
426
427### Arrows for the annotations
428segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
429 x2 = as.Date("1998-01-01"), y1 = 0.45, y2 = 0.45)
430segment_df_2 <- data.frame(x1 = as.Date("2000-07-01"),
431 x2 = as.Date("2003-07-01"), y1 = 0.75, y2 = 0.75)
432segment_df_3 <- data.frame(x1 = as.Date("2012-01-01"),
433 x2 = as.Date("2015-01-01"), y1 = 0.75, y2 = 0.75)
434
435### Draw the graph
436p <- ggplot(data = data_df, mapping = aes(x = date, y = asset_bubbles)) +
437 theme_economist() + scale_colour_economist() +
438 theme(legend.position = "none") +
439 geom_line(data = data_df,
440 aes(y = asset_bubbles, color = "Asset Bubbles"), size = 1.3) +
441 # Add recession bars
442 geom_recession_bars(min(date), max(date)) +
443
444 geom_hline(yintercept = mean, size = 1, linetype = "solid",
445 alpha = 0.5, color = "red") +
446 geom_hline(yintercept = mean_p1, size = 1, linetype = "solid",
447 alpha = 0.2, color = "red") +
448 geom_hline(yintercept = mean_m1, size = 1, linetype = "solid",
449 alpha = 0.2, color = "red") +
450 labs(title = title, subtitle = subtitle, caption = caption,
451 x = xlab, y = ylab) +
452 annotate("text", x = as.Date("1990-01-01"), y = 0.45,
453 label = "Dot.Com\nStock Bubble",
454 size = 5, color = annotationcolor) +
455 geom_segment(data = segment_df_1, arrow = arrow(length = unit(0.03, "npc")),
456 aes(x = x1, y = y1, xend = x2, yend = y2), size = 1.3,
457 color = annotationcolor) +
458
459 annotate("text", x = as.Date("1997-01-01"), y = 0.75,
460 label = "Housing\nBubble",
461 size = 5, color = annotationcolor) +
462 geom_segment(data = segment_df_2, arrow = arrow(length = unit(0.03, "npc")),
463 aes(x = x1, y = y1, xend = x2, yend = y2), size = 1.3,
464 color = annotationcolor) +
465
466 annotate("text", x = as.Date("2009-01-01"), y = 0.75,
467 label = "Current\nBubble",
468 size = 5, color = annotationcolor) +
469 geom_segment(data = segment_df_3, arrow = arrow(length = unit(0.03, "npc")),
470 aes(x = x1, y = y1, xend = x2, yend = y2), size = 1.3,
471 color = annotationcolor)
472print(p)
473
474readline(prompt = "Press [ENTER} to continue...")
475
476###########################################################################
477### Graph 4: Bubble Size in real 2019 US dollars
478###########################################################################
479
480### FRED Real GDP gives Real GDP in 2012 dollars. To get it in real
481### 2019 dollars, we need to multiple by 1.12 to account for inflation
482inflation <- 1.12
483
484### Calulate the real 2019 dollar value of the asset bubbles
485asset_bubbles_real_dollars <- inflation * asset_bubbles * real_gdp / 1000
486
487### Our data frame for graphing...
488data_df <- data.frame(date, asset_bubbles_real_dollars)
489
490### Create the graph
491title <- "Asset Bubble Size in Real 2019 US$"
492subtitle <- "Recessions marked with vertical bars"
493caption <- nwr_cap
494xlab <- "Year"
495ylab <- "Trillions of 2019 US $"
496
497### Arrows for the annotations
498segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
499 x2 = as.Date("1998-01-01"), y1 = 7, y2 = 7)
500segment_df_2 <- data.frame(x1 = as.Date("2001-01-01"),
501 x2 = as.Date("2004-01-01"), y1 = 13, y2 = 13)
502segment_df_3 <- data.frame(x1 = as.Date("2013-01-01"),
503 x2 = as.Date("2016-01-01"), y1 = 16, y2 = 16)
504
505### Draw the graph
506p <- ggplot(data = data_df,
507 mapping = aes(x = date, y = asset_bubbles_real_dollars)) +
508
509 # Graph settings
510 theme_economist() +
511 scale_colour_economist() +
512 theme(legend.position = "none") +
513 labs(title = title,
514 subtitle = subtitle,
515 caption = caption,
516 x = xlab,
517 y = ylab) +
518
519 geom_line(data = data_df,
520 size = 1.3,
521 aes(y = asset_bubbles_real_dollars,
522 color = "Asset Bubbles")) +
523
524 # Add recession bars
525 geom_recession_bars(min(date), max(date)) +
526
527 annotate("text",
528 x = as.Date("1991-01-01"),
529 y = 7,
530 label = "Dot.Com\nStock Bubble",
531 size = 5,
532 color = annotationcolor) +
533
534 geom_segment(data = segment_df_1,
535 arrow = arrow(length = unit(0.03, "npc")),
536 aes(x = x1, y = y1, xend = x2, yend = y2),
537 size = 1.3,
538 color = annotationcolor) +
539
540 annotate("text",
541 x = as.Date("1998-01-01"),
542 y = 13,
543 label = "Housing\nBubble",
544 size = 5,
545 color = annotationcolor) +
546
547 geom_segment(data = segment_df_2,
548 arrow = arrow(length = unit(0.03, "npc")),
549 aes(x = x1, y = y1, xend = x2, yend = y2),
550 size = 1.3,
551 color = annotationcolor) +
552
553 annotate("text",
554 x = as.Date("2010-01-01"),
555 y = 16,
556 label = "Current\nBubble",
557 size = 5,
558 color = annotationcolor) +
559
560 geom_segment(data = segment_df_3,
561 arrow = arrow(length = unit(0.03, "npc")),
562 aes(x = x1, y = y1, xend = x2, yend = y2),
563 size = 1.3,
564 color = annotationcolor)
565print(p)
566
567readline(prompt = "Press [ENTER} to continue...")
568
569###########################################################################
570### Graph 5: Bubble Size in real 2019 US dollars (zoom on 1990 - present)
571###########################################################################
572
573### This graph is just a zoomed-in version of the graph in the previous
574### section, so all we have to do is add a "xlim()" to the appropriate
575### range.
576
577segment_df_1 <- data.frame(x1 = as.Date("1996-06-01"),
578 x2 = as.Date("1998-01-01"), y1 = 7, y2 = 7)
579segment_df_2 <- data.frame(x1 = as.Date("2002-01-01"),
580 x2 = as.Date("2004-01-01"), y1 = 13, y2 = 13)
581segment_df_3 <- data.frame(x1 = as.Date("2014-01-01"),
582 x2 = as.Date("2016-01-01"), y1 = 16, y2 = 16)
583
584p <- ggplot(data = data_df,
585 mapping = aes(x = date,
586 y = asset_bubbles_real_dollars)) +
587
588 # Graph settings
589 theme_economist() +
590 scale_colour_economist() +
591 theme(legend.position = "none") +
592 labs(title = title,
593 subtitle = subtitle,
594 caption = caption,
595 x = xlab,
596 y = ylab) +
597
598 geom_line(data = data_df,
599 size = 1.3,
600 aes(y = asset_bubbles_real_dollars,
601 color = "Asset Bubbles")) +
602
603 # Add recession bars
604 geom_recession_bars(min(date), max(date)) +
605
606
607 scale_x_date(date_breaks = "2 years",
608 labels = date_format("%Y"),
609 limits = as.Date(c("1990-01-01", now()))) +
610
611 annotate("text",
612 x = as.Date("1994-01-01"),
613 y = 7,
614 label = "Dot.Com\nStock Bubble",
615 size = 5,
616 color = annotationcolor) +
617
618 geom_segment(data = segment_df_1,
619 arrow = arrow(length = unit(0.03, "npc")),
620 aes(x = x1, y = y1, xend = x2, yend = y2),
621 size = 1.3,
622 color = annotationcolor) +
623
624 annotate("text",
625 x = as.Date("2000-01-01"),
626 y = 13,
627 label = "Housing\nBubble",
628 size = 5,
629 color = annotationcolor) +
630
631 geom_segment(data = segment_df_2,
632 arrow = arrow(length = unit(0.03, "npc")),
633 aes(x = x1, y = y1, xend = x2, yend = y2),
634 size = 1.3,
635 color = annotationcolor) +
636 annotate("text",
637 x = as.Date("2012-01-01"),
638 y = 16,
639 label = "Current\nBubble",
640 size = 5,
641 color = annotationcolor) +
642
643 geom_segment(data = segment_df_3,
644 arrow = arrow(length = unit(0.03, "npc")),
645 aes(x = x1, y = y1, xend = x2, yend = y2),
646 size = 1.3,
647 color = annotationcolor)
648
649print(p)