Advertisement
MetricT

Bubble script for /u/swolebird

Jan 23rd, 2020
706
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 25.04 KB | None | 0 0
  1. ### We need the following packages for this example.
  2. packages <- 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
  9. new_packages <- packages[!(packages %in% installed.packages()[, "Package"])]
  10. if (length(new_packages)) install.packages(new_packages, quiet = TRUE)
  11. invisible(lapply(packages, "library", quietly = TRUE,
  12.                  character.only = TRUE, warn.conflicts = FALSE))
  13.  
  14. ### Load API Keys
  15. api_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())
  19. theme_set(theme_economist())
  20.  
  21. ####################################################################
  22. ### Add recession bars to ggplot graphs
  23. ####################################################################
  24. geom_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
  79. fredr_set_key(api_key_fred)
  80.  
  81. ### What date ranges do we want?
  82. date_start <- "1952-01-01"
  83. date_end   <- "2019-04-01"
  84.  
  85. ### A frequency selector to automate selecting the data frequency
  86. #frequency <- c("m", 12, "Seasonal12") # For monthly data
  87. frequency <- 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. ###########################################################################
  94. series <- "TNWBSHNO"
  95.  
  96. data <- 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.  
  101. date             <- data %>% pull("date")
  102. household_wealth <- data %>% pull("value")
  103. household_wealth_decomposed <- household_wealth %>%
  104.                                ts(frequency = as.numeric(frequency[2])) %>%
  105.                                mstl()
  106.  
  107. household_wealth_seasonal  <- household_wealth_decomposed %>% seasonal()
  108. household_wealth_trend     <- household_wealth_decomposed %>% trendcycle()
  109. household_wealth_remainder <- household_wealth_decomposed %>% remainder()
  110.  
  111. ### You can use trend, trend + remainder, or trend + seasonal + remainder
  112. household_wealth <- household_wealth_trend + household_wealth_remainder
  113.  
  114. ###########################################################################
  115. ### Import Nominal GDP from FRED
  116. ###########################################################################
  117. series <- "GDP"
  118.  
  119. data <- 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.  
  124. nominal_gdp <- data %>% pull("value")
  125. nominal_gdp_decomposed <- nominal_gdp %>%
  126.                           ts(frequency = as.numeric(frequency[2])) %>%
  127.                           mstl()
  128.  
  129. nominal_gdp_seasonal  <- nominal_gdp_decomposed %>% seasonal()
  130. nominal_gdp_trend     <- nominal_gdp_decomposed %>% trendcycle()
  131. nominal_gdp_remainder <- nominal_gdp_decomposed %>% remainder()
  132.  
  133. ### You can use trend, trend + remainder, or trend + seasonal + remainder
  134. nominal_gdp  <- nominal_gdp_trend + nominal_gdp_remainder
  135.  
  136. ###########################################################################
  137. ### Import Real GDP from FRED
  138. ###########################################################################
  139. series <- "GDPC1"
  140.  
  141. data <- 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.  
  146. real_gdp <- data %>% pull("value")
  147. real_gdp_decomposed <- real_gdp %>%
  148.                        ts(frequency = as.numeric(frequency[2])) %>%
  149.                        mstl()
  150.  
  151. real_gdp_seasonal  <- real_gdp_decomposed %>% seasonal()
  152. real_gdp_trend     <- real_gdp_decomposed %>% trendcycle()
  153. real_gdp_remainder <- real_gdp_decomposed %>% remainder()
  154.  
  155. ### You can use trend, trend + remainder, or trend + seasonal + remainder
  156. real_gdp  <- real_gdp_trend + real_gdp_remainder
  157.  
  158. ### Graph globals
  159. annotationcolor <- "black"
  160.  
  161. ### Common caption strings to make doing the caption easier
  162. real_gdp_cap <- "U.S. Bureau of Economic Analysis, Real Gross Domestic Product [GDPC1]\n"
  163. nom_gdp_cap  <- "U.S. Bureau of Economic Analysis, Gross Domestic Product [GDP]\n"
  164. wealth_cap   <- "Board of Governors of the Federal Reserve System (US), Households and nonprofit organizations; net worth, Level [TNWBSHNO]\n"
  165.  
  166. nw_cap <- paste(wealth_cap,
  167.                 nom_gdp_cap,
  168.                 "retrieved from FRED, Federal Reserve Bank of St. Louis")
  169.  
  170. nwr_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)
  181. norm_household_wealth <- household_wealth / household_wealth[1]
  182. norm_nominal_gdp      <- nominal_gdp      / nominal_gdp[1]
  183.  
  184. ### Create a dataframe for graphing
  185. data_df <- data.frame(date, norm_household_wealth, norm_nominal_gdp)
  186.  
  187. ### Create the graph
  188. title    <- paste("Household Wealth and Nominal GDP growth relative to",
  189.                   date_start)
  190. subtitle <- "Recessions marked with vertical bars"
  191. caption  <- nw_cap
  192. xlab     <- "Year"
  193. ylab     <- paste("Growth relative to ", date_start)
  194.  
  195. ### Arrow settings for the annotations
  196. segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
  197.                            x2 = as.Date("1998-01-01"), y1 = 32, y2 = 32)
  198. segment_df_2 <- data.frame(x1 = as.Date("2000-07-01"),
  199.                            x2 = as.Date("2003-07-01"), y1 = 52, y2 = 52)
  200. segment_df_3 <- data.frame(x1 = as.Date("2012-01-01"),
  201.                            x2 = as.Date("2015-01-01"), y1 = 82, y2 = 82)
  202.  
  203. p <- 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)
  261. print(p)
  262.  
  263. readline(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
  270. wealth_to_gdp    <- household_wealth   / nominal_gdp
  271.  
  272. ### Create a dataframe for graphing
  273. data_df <- data.frame(date, wealth_to_gdp)
  274.  
  275. ### Add lines to show median (1951-1995) +/- 1 stdev
  276. sd      <- wealth_to_gdp[date <= 1995] %>% sd()
  277. mean    <- wealth_to_gdp[date <= 1995] %>% mean()
  278. mean_p1 <- mean + sd
  279. mean_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
  293. title    <- "Ratio of Household Wealth to Nominal DDP"
  294. subtitle <- "Blue lines show 1952-1995 mean +/- 1 std dev\nRecessions marked with vertical bars"
  295. caption  <- nw_cap
  296. xlab     <- "Year"
  297. ylab     <- "Ratio"
  298.  
  299. ### Arrow settings for the annotations
  300. segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
  301.                            x2 = as.Date("1998-01-01"), y1 = 4.3, y2 = 4.3)
  302. segment_df_2 <- data.frame(x1 = as.Date("2000-07-01"),
  303.                            x2 = as.Date("2003-07-01"), y1 = 4.8, y2 = 4.8)
  304. segment_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
  308. segment_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)
  311. segment_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)
  314. segment_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
  319. p <- 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.  
  388. print(p)
  389.  
  390. readline(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.  
  399. asset_bubbles <- rep(NA, length(wealth_to_gdp))
  400. early <- date <= as.Date("1959-09-03")
  401. late  <- date >  as.Date("1978-12-14")
  402. mid   <- !early & !late
  403. asset_bubbles[early] <- wealth_to_gdp[early] +
  404.                               72.6017 - 0.038941 * decimal_date(date[early])
  405.  
  406. asset_bubbles[mid]   <- wealth_to_gdp[mid]   -
  407.                               52.1677 + 0.024760 * decimal_date(date[mid])
  408.  
  409. asset_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
  413. mean    <- asset_bubbles[date <= 1995] %>% mean()
  414. sd      <- asset_bubbles[date <= 1995] %>% sd()
  415. mean_p1 <- mean + sd
  416. mean_m1 <- mean - sd
  417.  
  418. data_df <- data.frame(date, asset_bubbles)
  419.  
  420. ### Graph start
  421. title    <- "Ratio of Asset Bubble Size to GDP"
  422. subtitle <- "Blue lines show 1952-1995 mean +/- 1 std dev\nRecessions marked with vertical bars"
  423. caption  <- nw_cap
  424. xlab     <- "Year"
  425. ylab     <- "Multiple of GDP"
  426.  
  427. ### Arrows for the annotations
  428. segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
  429.                            x2 = as.Date("1998-01-01"), y1 = 0.45, y2 = 0.45)
  430. segment_df_2 <- data.frame(x1 = as.Date("2000-07-01"),
  431.                            x2 = as.Date("2003-07-01"), y1 = 0.75, y2 = 0.75)
  432. segment_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
  436. p <- 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)
  472. print(p)
  473.  
  474. readline(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
  482. inflation <- 1.12
  483.  
  484. ### Calulate the real 2019 dollar value of the asset bubbles
  485. asset_bubbles_real_dollars <- inflation * asset_bubbles * real_gdp / 1000
  486.    
  487. ### Our data frame for graphing...
  488. data_df <- data.frame(date, asset_bubbles_real_dollars)
  489.  
  490. ### Create the graph
  491. title    <- "Asset Bubble Size in Real 2019 US$"
  492. subtitle <- "Recessions marked with vertical bars"
  493. caption  <- nwr_cap
  494. xlab     <- "Year"
  495. ylab     <- "Trillions of 2019 US $"
  496.  
  497. ### Arrows for the annotations
  498. segment_df_1 <- data.frame(x1 = as.Date("1995-01-01"),
  499.                            x2 = as.Date("1998-01-01"), y1 = 7, y2 = 7)
  500. segment_df_2 <- data.frame(x1 = as.Date("2001-01-01"),
  501.                            x2 = as.Date("2004-01-01"), y1 = 13, y2 = 13)
  502. segment_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
  506. p <- 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)
  565. print(p)
  566.  
  567. readline(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.  
  577. segment_df_1 <- data.frame(x1 = as.Date("1996-06-01"),
  578.                            x2 = as.Date("1998-01-01"), y1 = 7, y2 = 7)
  579. segment_df_2 <- data.frame(x1 = as.Date("2002-01-01"),
  580.                            x2 = as.Date("2004-01-01"), y1 = 13, y2 = 13)
  581. segment_df_3 <- data.frame(x1 = as.Date("2014-01-01"),
  582.                            x2 = as.Date("2016-01-01"), y1 = 16, y2 = 16)
  583.  
  584. p <- 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.  
  649. print(p)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement