· 6 years ago · Jan 16, 2020, 12:30 AM
1### Leading recession indicator using unemployment.
2### by <Mathew.Binkley@Vanderbilt.edu>
3###
4### The algorithm is a close cousin of the Sahm Rule, which I derived after
5### experimenting with her method. Unlike the Sahm Rule which is a
6### *lagging* indicator, my rule offers a *leading* indicator of recessions.
7### It works perfectly across the entire 70 year UNRATENSA dataset, with no
8### false positives or negatives. So given its accuracy and its similar
9### level of simplicity to the Sahm Rule, I believe that the rule is doing
10### something very useful. And I have not found anyone using this
11### particular technique, so I believe the technique may be novel.
12###
13### What my rule does (and how it differs from the Sahm rule) are:
14###
15### * I use UNRATENSA unemployment data from FRED
16### (Sahm uses seasonally-adjusted UNRATE instead)
17###
18### * I use mstl() to extract the trend component of unemployment
19### (Sahm uses a moving average which should work somewhat similarly
20### on deseasonalized data)
21###
22### * I graph d(trend unemployment)/dt
23### (Sahm graphs the difference between the 3-month average and
24### the 12 month minimum)
25###
26### * If d(trend)/dt is above a small threshold, a recession is
27### extremely likely. (Sahm requires her rule to exceed a
28### similar threshold of 0.5 before calling a recession).
29###
30### For this indicator, the important feature is *not* the peak, but rather the
31### point where unemployment velocity turns positive. When the velocity rises
32### above the threshold, it is a reliable sign that a recession is coming a few
33### months down the road.
34
35### Set your FRED API key here. You may request an API key at:
36### https://research.stlouisfed.org/useraccount/apikeys
37api_key_fred <- "WHATEVER_YOUR_FRED_API_KEY_IS"
38
39####################################################################
40### Load necessary R packages, set the FRED API key, and set
41### start/end dates for graph
42####################################################################
43
44### We need the following packages for this example.
45packages <- c("fredr", "lubridate", "fredr", "ggplot2", "forecast",
46 "ggthemes", "tsibble", "dplyr", "magrittr", "broom", "scales")
47
48### Install packages if needed, then load them quietly
49new_packages <- packages[!(packages %in% installed.packages()[, "Package"])]
50if (length(new_packages)) install.packages(new_packages, quiet = TRUE)
51invisible(lapply(packages, "library", quietly = TRUE,
52 character.only = TRUE, warn.conflicts = FALSE))
53
54fredr_set_key(api_key_fred)
55
56### Specifiy the start/end date of the graph. 1948-01-01 is the
57### earliest possible time for UNRATE
58date_start <- "1948-01-01" %>% as.Date()
59date_end <- now() %>% as.Date()
60
61####################################################################
62### Add recession bars to ggplot graphs
63####################################################################
64geom_recession_bars <- function (date_start, date_end) {
65
66 date_start <- date_start %>% as.Date(origin = "1970-01-01")
67 date_end <- date_end %>% as.Date(origin = "1970-01-01")
68
69 recessions_tibble <- tibble(
70
71 peak = c("1857-06-01", "1860-10-01", "1865-04-01", "1869-06-01",
72 "1873-10-01", "1882-03-01", "1887-03-01", "1890-07-01",
73 "1893-01-01", "1895-12-01", "1899-06-01", "1902-09-01",
74 "1907-05-01", "1910-01-01", "1913-01-01", "1918-08-01",
75 "1920-01-01", "1923-05-01", "1926-10-01", "1929-08-01",
76 "1937-05-01", "1945-02-01", "1948-11-01", "1953-07-01",
77 "1957-08-01", "1960-04-01", "1969-12-01", "1973-11-01",
78 "1980-01-01", "1981-07-01", "1990-07-01", "2001-03-01",
79 "2007-12-01") %>% as.Date(),
80
81 trough = c("1858-12-01", "1861-06-01", "1867-12-01", "1870-12-01",
82 "1879-03-01", "1885-05-01", "1888-04-01", "1891-05-01",
83 "1894-06-01", "1897-06-01", "1900-12-01", "1904-08-01",
84 "1908-06-01", "1912-01-01", "1914-12-01", "1919-03-01",
85 "1921-07-01", "1924-07-01", "1927-11-01", "1933-03-01",
86 "1938-06-01", "1945-10-01", "1949-10-01", "1954-05-01",
87 "1958-04-01", "1961-02-01", "1970-11-01", "1975-03-01",
88 "1980-07-01", "1982-11-01", "1991-03-01", "2001-11-01",
89 "2009-06-01") %>% as.Date()
90 )
91
92 recessions_trim <- recessions_tibble %>%
93 filter(peak >= min(date_start) &
94 trough <= max(date_end))
95
96 if (nrow(recessions_trim) > 0) {
97 recession_bars = geom_rect(data = recessions_trim,
98 inherit.aes = F,
99 fill = "darkgray",
100 alpha = 0.25,
101 aes(xmin = as.Date(peak, origin="1970-01-01"),
102 xmax = as.Date(trough, origin="1970-01-01"),
103 ymin = -Inf, ymax = +Inf))
104 } else {
105 recession_bars = geom_blank()
106 }
107}
108
109
110####################################################################
111### Fetch data from FRED and compute unemployment rate
112####################################################################
113unemploy_data <- fredr(series_id = "UNEMPLOY", frequency = "m") %>% as_tsibble(index = "date")
114clf160v_data <- fredr(series_id = "CLF16OV", frequency = "m") %>% as_tsibble(index = "date")
115
116date <- unemploy_data %>% pull("date")
117
118unemploy_trend <- unemploy_data %>% as_tsibble(index = "date") %>% pull("value") %>%
119 ts(frequency = 12, start = c(year(min(date)), month(min(date)))) %>%
120 mstl() %>% trendcycle()
121
122clf160v_trend <- clf160v_data %>% as_tsibble(index = "date") %>% pull("value") %>%
123 ts(frequency = 12, start = c(year(min(date)), month(min(date)))) %>%
124 mstl() %>% trendcycle()
125
126unemployment <- 100 * unemploy_trend / clf160v_trend
127
128####################################################################
129### Calculations to derive unemployment "velocity", d(unemployment)/dt
130####################################################################
131diff_trend <- unemployment %>% diff()
132diff_date <- date %>% tail(n = length(diff_trend))
133
134### Use Friedman's SuperSmoother to eliminate "stairstepping" in the
135### derivative. Just comment out the two lines below if you want to
136### use raw data instead of the smoothed data. It works the same and
137### arrives at the same conclusions, but the unsmoothed data yields
138### uglier graphs.
139tmp <- supsmu(decimal_date(diff_date), diff_trend, span = 3/length(diff_trend))
140diff_trend <- tmp$y
141
142velocity_df <- data.frame(diff_date, diff_trend) %>%
143 filter(diff_date >= date_start &
144 diff_date <= date_end)
145
146####################################################################
147### Find locations where the unemployment velocity line grows
148### through x = 0
149####################################################################
150axis_crossing_locations <- function(date, value) {
151
152 # The threshold necessary to eliminate the two false positives from the 1960's
153 threshold <- 0.0105665
154
155 # Shift the value by the threshold
156 adj_value <- value - threshold
157
158 # See if the sign changes before/after, which indicates it has
159 # passed through x = 0
160 sign <- value %>% sign()
161 adj_sign <- adj_value %>% sign()
162
163 # Computer time derivative of sign changes
164 diff_sign <- sign %>% diff()
165 diff_adj_sign <- adj_sign %>% diff()
166
167 # Find dates when rising unemployment velocity exceeds the
168 # threshold. We want to add one month to the date this
169 # gives, thus the "%m+% months(1)" bit.
170 locs <- date[diff_adj_sign == 2] %m+% months(1)
171 locs
172}
173
174axiscrossings <- axis_crossing_locations(diff_date, diff_trend) %>% as.Date()
175
176####################################################################
177### Graph: Trend Unemployment Velocity
178####################################################################
179c1 <- "U.S. Bureau of Labor Statistics, Unemployment Level [UNEMPLOY]\n"
180c2 <- "U.S. Bureau of Labor Statistics, Civilian Labor Force Level [CLF16OV]\n"
181c3 <- "Retrieved from FRED, Federal Reserve Bank of St. Louis;\n"
182c4 <- paste("Data retrieved on", format(Sys.time(), "%B %d, %Y at %I:%M %p %Z"))
183
184s1 <- "Indicator (vertical dotted line) shows imminent recession when velocity rises above 0\n"
185s2 <- "The farther above/below 0, the faster unemployment is growing/falling\n"
186s3 <- "Recessions marked with vertical bars\n"
187
188title <- "Trend Unemployment Rate Velocity"
189subtitle <- paste(s1, s2, s3, sep = "")
190xlab <- "Year"
191ylab <- "Percent/Month"
192caption <- paste(c1, c2, c3, c4, sep = "")
193
194p <- ggplot(velocity_df, aes(x = diff_date, y = diff_trend)) +
195
196 ### Plot unemployment velocity
197 geom_line(size = 1.3, color = "red3") +
198
199 ### Add a line at velocity = 0. Above this line, unemployment is rising, and
200 ### the farther above the line, the faster it rises. Similarly, below the
201 ### line unemployment is falling, and the further below the line, the faster
202 ### it falls
203 geom_hline(yintercept = 0, size = 1) +
204
205 ### Draw the recession indicators when the unemployment velocity has
206 ### has grown beyond x = 0
207 geom_vline(xintercept = axiscrossings, linetype = "dashed") +
208
209 # Add recession bars
210 geom_recession_bars(min(velocity_df$diff_date), max(velocity_df$diff_date)) +
211
212 ### Misc graph stuff
213 theme_economist() +
214 scale_x_date(breaks = pretty_breaks(10), limits = c(date_start, date_end)) +
215 labs(title = title, subtitle = subtitle, caption = caption,
216 x = xlab, y = ylab)
217
218print(p)