· 6 years ago · Nov 28, 2019, 02:00 PM
1### Sahm's rule in R - by /u/MetricT
2### based on Claudia Sahm's paper at:
3### https://www.hamiltonproject.org/assets/files/Sahm_web_20190506.pdf
4###
5### Sahm's law is a lagging indicator of a recession. It is based on the
6### difference between the three month moving average of unemployment and
7### the lowest unemployment over the last 12 months. If the difference
8### is > 0.5 (at the Federal level), then the US is or is about to be in
9### recession.
10
11### Edit FRED_API_KEY and add your personal API key to access the FRED database.
12### You may request an API key at: https://research.stlouisfed.org/useraccount/apikeys
13FRED_API_KEY = "2534759c75ba3f25da07c3c971f98d0b"
14
15###################################################################
16### Load necessary packages, installing if necessary
17###################################################################
18packages <- c("fredr", "forecast", "ggplot2", "ggthemes",
19 "tsibble", "dplyr", "TTR")
20
21new.packages <- packages[!(packages %in% installed.packages()[,"Package"])]
22if(length(new.packages)) install.packages(new.packages, quiet = TRUE)
23invisible(lapply(packages, "library",
24 quietly = TRUE,
25 character.only = TRUE,
26 warn.conflicts = FALSE))
27
28### Set FRED API key
29fredr_set_key(FRED_API_KEY)
30
31
32###################################################################
33### A data.frame containing recession start/stop dates, so we
34### can add recession bars to our graph
35###################################################################
36recessions.df = read.table(textConnection(
37 "Peak, Trough
381857-06-01, 1858-12-01
391860-10-01, 1861-06-01
401865-04-01, 1867-12-01
411869-06-01, 1870-12-01
421873-10-01, 1879-03-01
431882-03-01, 1885-05-01
441887-03-01, 1888-04-01
451890-07-01, 1891-05-01
461893-01-01, 1894-06-01
471895-12-01, 1897-06-01
481899-06-01, 1900-12-01
491902-09-01, 1904-08-01
501907-05-01, 1908-06-01
511910-01-01, 1912-01-01
521913-01-01, 1914-12-01
531918-08-01, 1919-03-01
541920-01-01, 1921-07-01
551923-05-01, 1924-07-01
561926-10-01, 1927-11-01
571929-08-01, 1933-03-01
581937-05-01, 1938-06-01
591945-02-01, 1945-10-01
601948-11-01, 1949-10-01
611953-07-01, 1954-05-01
621957-08-01, 1958-04-01
631960-04-01, 1961-02-01
641969-12-01, 1970-11-01
651973-11-01, 1975-03-01
661980-01-01, 1980-07-01
671981-07-01, 1982-11-01
681990-07-01, 1991-03-01
692001-03-01, 2001-11-01
702007-12-01, 2009-06-01"), sep=',', colClasses=c('Date', 'Date'), header=TRUE)
71
72
73##########################################################################
74### Fetch unemployment data from FRED and calculate Sahm Rule probability
75##########################################################################
76Series = "UNRATE"
77
78data <- as_tsibble(fredr(series_id = Series,
79 frequency = "m"), index = "date")
80
81Date <- as.Date(data %>% pull('date'))
82Unemployment <- data %>% pull('value')
83
84### Compute the moving average of unemployment over past 3 months
85Unemployment.ma = SMA(Unemployment, n=3)
86
87### Compute the minimum unemployment over the past 12 months
88Unemployment.min = vector(length = length(Unemployment))
89for (i in (length(Unemployment):(1+12))) {
90 Unemployment.min[i] = min(Unemployment[(i-13):(i)])
91}
92
93### Compute the difference between the 3 month average
94### and the 12 month minimum unemployment
95Sahm_Rule = vector(length = (length(Unemployment)))
96for (i in 1:length(Unemployment)) {
97 Sahm_Rule[i] = Unemployment.ma[i] - Unemployment.min[i]
98}
99
100### Strip off the first 14 months of data since it's junk
101### 2 months come from the 3-month moving average
102### 12 months come from the 12-month minimum window
103Sahm_Rule = Sahm_Rule[(14):(length(Sahm_Rule))]
104Date.diff = Date[(14):(length(Date))]
105
106###################################################################
107### Graph Sahm Rule probability
108###################################################################
109Sahm_Rule.df <- data.frame(Date = Date.diff, Values = Sahm_Rule)
110recessions.trim = subset(recessions.df, Peak >= min(Date.diff))
111
112C1 = "Sahm Rule indicator derived from U.S. Bureau of Labor Statistics, Unemployment Rate [UNRATE]\n"
113C2 = "retrieved from FRED, Federal Reserve Bank of St. Louis\n"
114C3 = "https://fred.stlouisfed.org/series/UNRATE\n"
115C4 = paste("Data retrieved on", format(Sys.time(), "%B %d, %Y at %I:%M %p %Z"))
116
117Title = "Sahm Rule for the United States"
118Subtitle = "Recessions marked with vertical bars"
119XLab = "Year"
120YLab = "Percent"
121Caption = paste(C1, C2, C3, C4)
122
123P <- ggplot(Sahm_Rule.df, aes(x = Date, y = Values)) +
124 theme_economist() +
125 scale_colour_economist() +
126 theme(legend.position = "none") +
127 geom_line(data = Sahm_Rule.df, size = 1.3, aes(y = Sahm_Rule, color = "Sahm Rule")) +
128 geom_rect(data = recessions.trim, inherit.aes = F, fill = "darkgray", alpha = 0.5,
129 mapping = aes(xmin = Peak, xmax = Trough, ymin = -Inf, ymax = +Inf)) +
130 geom_hline(yintercept = 0.5, size = 1, linetype = "dotted", color = "red", alpha = 0.5) +
131 labs(title = Title, subtitle = Subtitle, caption = Caption, x = XLab, y = YLab)
132print(P)