API tools faq
paste
Advertisement
binkleym

Estimating total asset bubble / stock bubble with R

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