· 6 years ago · Dec 02, 2019, 02:42 PM
1################################################################################
2### Derive the size of asset bubbles in the US economy in US 2019 dollars.
3###
4### * Mathew Binkley <Mathew.Binkley@Vanderbilt.edu>
5###
6### Right now this script can derive the total size of the asset bubble,
7### and also the size of the stock bubble portion. I am working on creating
8### measures for housing & commercial real estate and commodity bubbles as well.
9################################################################################
10
11
12################################################################################
13### Load necessary packages, installing if necessary
14################################################################################
15packages <- c("fredr", "ggplot2", "ggthemes", "lubridate", "forecast",
16 "tsibble", "dplyr")
17
18new.packages <- packages[!(packages %in% installed.packages()[,"Package"])]
19if(length(new.packages)) install.packages(new.packages, quiet = TRUE)
20invisible(lapply(packages, "library",
21 quietly = TRUE,
22 character.only = TRUE,
23 warn.conflicts = FALSE))
24
25### Set my FRED API key to access the FRED database.
26### The actual value is in Include/API_Keys.R
27### You may request an API key at:
28### https://research.stlouisfed.org/useraccount/apikeys
29fredr_set_key(API_KEY_FRED)
30
31################################################################################
32### A data.frame containing recession start/stop dates, so we can add recession
33### bars to our graph
34################################################################################
35
36recessions.df = read.table(textConnection(
37 "Peak, Trough
381948-11-01, 1949-10-01
391953-07-01, 1954-05-01
401957-08-01, 1958-04-01
411960-04-01, 1961-02-01
421969-12-01, 1970-11-01
431973-11-01, 1975-03-01
441980-01-01, 1980-07-01
451981-07-01, 1982-11-01
461990-07-01, 1991-03-01
472001-03-01, 2001-11-01
482007-12-01, 2009-06-01"),
49 sep=',', colClasses=c('Date', 'Date'), header=TRUE)
50
51### What date ranges do we want?
52Date.start = "1996-01-01"
53Date.end = "2017-01-01" # I wish market cap dataset had more current data...
54
55### FRED Real GDP gives Real GDP in 2012 dollars. To get it in real
56### 2019 dollars, multiply by 1.12 to account for inflation. Adjust
57### inflation if you're running it in different years.
58Inflation = 1.12
59
60################################################################################
61### Import Household Wealth from FRED
62################################################################################
63Series = "TNWBSHNO"
64
65data <- as_tsibble(fredr(series_id = Series,
66 frequency = "a",
67 observation_start = as.Date(Date.start),
68 observation_end = as.Date(Date.end)), index = "date")
69
70Date <- data %>% pull('date')
71HouseholdWealth <- data %>% pull('value')
72
73
74################################################################################
75### Import Stock Market Capitalization to GDP for US from FRED
76################################################################################
77Series = "DDDM01USA156NWDB"
78
79data <- as_tsibble(fredr(series_id = Series,
80 frequency = "a",
81 observation_start = as.Date(Date.start),
82 observation_end = as.Date(Date.end)), index = "date")
83
84StockMarketCapitalization_to_GDP <- data %>% pull('value')
85
86################################################################################
87### Import Nominal GDP from FRED
88################################################################################
89Series = "GDP"
90
91data <- as_tsibble(fredr(series_id = Series,
92 frequency = "a",
93 observation_start = as.Date(Date.start),
94 observation_end = as.Date(Date.end)), index = "date")
95
96NominalGDP <- data %>% pull('value')
97
98################################################################################
99### Import Real GDP from FRED
100################################################################################
101Series = "GDPC1"
102
103data <- as_tsibble(fredr(series_id = Series,
104 frequency = "a",
105 observation_start = as.Date(Date.start),
106 observation_end = as.Date(Date.end)), index = "date")
107
108RealGDP <- data %>% pull('value')
109
110
111
112################################################################################
113### Calculation section for total asset bubble size
114### (including stocks, homes, gold, etc.)
115################################################################################
116
117### Compute the ratio of Household Wealth to Nominal GDP
118Wealth_to_GDP = HouseholdWealth / NominalGDP
119
120### If you plot Wealth_to_GDP, you see there are some long-term trends that sit
121### beneath the asset bubbles. Judging by their long-term correlation with
122### bond prices, they may reflect "bond bubbles", or perhaps longer-term
123### economic/public policy changes.
124###
125### I'm primarily interested in the "frothy" bubbles on top, as they tend not
126### to fall below the trends when they pop. So I extract them from the
127### underlying "bond bubbles" by modeling the trend as three piecewise sections,
128### taking the local minima inside each trend, and using a linear regression to
129### determine the floors.
130
131### Pre-1960: Wealth_Floor = -72.60170 + 0.038941*Year
132### 1960-1978.75: Wealth_Floor = +52.16769 - 0.024760*Year
133### 1982 -> Present: Wealth_Floor = -63.48539 + 0.033682*Year
134
135AllAssetBubbles <- rep( NA, length( Wealth_to_GDP ))
136early <- Date <= as.Date("1959-09-03")
137late <- Date > as.Date("1978-12-14")
138mid <- !early & !late
139AllAssetBubbles[early] <- Wealth_to_GDP[early] + 72.6017 - 0.038941*decimal_date(Date[early])
140AllAssetBubbles[mid] <- Wealth_to_GDP[mid] - 52.1677 + 0.024760*decimal_date(Date[mid])
141AllAssetBubbles[late] <- Wealth_to_GDP[late] + 63.4854 - 0.033682*decimal_date(Date[late])
142
143### Calulate the real 2019 dollar value of the asset bubbles
144AllAssetBubbles_RealDollars = Inflation * AllAssetBubbles * RealGDP / 1000
145
146################################################################################
147### Calculation section for stock bubble size
148################################################################################
149
150### Analogous to extracting total asset bubble size by examining household
151### wealth to GDP, we examine stock market wealth to GDP to find the size of the
152### stock market bubble. This only approximate for several reasons such as
153### significantly less data to analyze with, the coarseness of the data
154### (annually for household wealth vs quarterly for stock market cap from FRED),
155### and the initial starting date of the value is close to the dot.com bubble.
156### Better data sources would help tremendously here.
157
158### Get the Stock Market Cap to GDP, scaled correctly for our calculation
159StockBubble_in_GDP = ((StockMarketCapitalization_to_GDP/100) - 1)
160
161### Multiply by Real GDP, multiply by inflation, and scale by 1000
162### to get the size of the stock bubble in trillions of real 2019 US $
163StockBubbleSize = Inflation * StockBubble_in_GDP * RealGDP / 1000
164
165
166################################################################################
167### Calculation section for housing bubble size
168################################################################################
169
170### Note: I'm still working on a method to directly derive the size of the
171### housing bubble. Until then, as a decent approximation, assume that:
172HousingBubble = AllBubbles - StockBubbles
173
174
175################################################################################
176### Graphing section
177################################################################################
178
179### Our data frame for graphing...
180data.df = data.frame(Date = Date,
181 AllBubbles = AllAssetBubbles_RealDollars,
182 StockBubbles = StockBubbleSize,
183 HousingBubbles = HousingBubble)
184
185### The subset of recessions that lie within the data range of our data
186recessions.trim = subset(recessions.df, Peak >= min(Date))
187
188### Graph globals
189AnnotationColor = "black"
190
191### Common caption strings to make doing the caption easier
192C1 = "Board of Governors of the Federal Reserve System (US), Households and nonprofit organizations; net worth, Level [TNWBSHNO]\n"
193C2 = "World Bank, Stock Market Capitalization to GDP for United States [DDDM01USA156NWDB]\n"
194C3 = "U.S. Bureau of Economic Analysis, Gross Domestic Product [GDP]\n"
195C4 = "U.S. Bureau of Economic Analysis, Real Gross Domestic Product [GDPC1]\n"
196C5 = paste("Data retrieved from FRED, Federal Research Bank of St. Louis on", format(Sys.time(), "%B %d, %Y at %I:%M %p %Z"))
197
198### Create the graph
199Title = "Total Asset Bubble Size alongside Stock Bubble Size"
200Subtitle = "Recessions marked with vertical bars"
201Caption = paste(C1, C2, C3, C4, C5)
202XLab = "Year"
203YLab = "Trillions of 2019 US $"
204
205P <- ggplot(data = data.df, mapping = aes(x = Date, y = AllBubbles)) +
206
207 theme_economist() + scale_colour_economist() +
208 theme(legend.title = element_blank()) +
209 labs(title = Title, subtitle = Subtitle, caption = Caption, x = XLab, y = YLab) +
210 scale_x_date(limits = c(as.Date(Date.start), as.Date(Date.end))) +
211
212
213 geom_line(data = data.df, size = 1.3,
214 aes(y = AllBubbles,
215 color = "All Asset Bubbles", linetype = "All Asset Bubbles")) +
216
217 geom_line(data = data.df, size = 1.3,
218 aes(y = StockBubbles,
219 color = "Stock Bubbles", linetype = "Stock Bubbles")) +
220
221 geom_line(data = data.df, size = 1.3,
222 aes(y = AllBubbles - StockBubbles,
223 color = "Imputed Housing Bubbles", linetype = "Imputed Housing Bubbles")) +
224
225 scale_linetype_manual(name = "colour",
226 values = c("All Asset Bubbles" = "solid",
227 "Stock Bubbles" = "solid",
228 "Imputed Housing Bubbles" = "dotted")) +
229
230 geom_rect(data = recessions.trim, inherit.aes = F, fill='darkgray', alpha=0.25,
231 aes(xmin = as.Date(Peak), xmax = as.Date(Trough), ymin = -Inf, ymax = +Inf)) +
232
233 annotate("text", x = as.Date("2000-01-01"), y = 10,
234 label = "Dot.Com\nBubble", size = 5, color = AnnotationColor) +
235 annotate("text", x = as.Date("2006-04-01"), y = 16,
236 label = "Great Recession\nBubble", size = 5, color = AnnotationColor) +
237 annotate("text", x = as.Date("2017-01-01"), y = 19,
238 label = "\nCurrent\nBubble", size = 5, color = AnnotationColor)
239print(P)