Imports

The cell below imports all packages needed to run this R markdown file.

library(devtools)
library(blsAPI)
library(rjson)
library(tidyverse)

Instructions

The Federal Reserve’s mandate from Congress is to control inflation and to maintain low unemployment. These seem to be contradictory objectives.

For this story you will need to source the following data for the last 25 years:

The Consumer Price Index (CPI) (Bureau of Labor Statistics)
The FED Funds Rate (FRED) (Federal Reserve Board)
Unemployment Rate (Bureau of Labor Statistics)

Your Data Visualizations should be designed to answer the question: “Has the FED been able to fulfill the mandate given to it by Congress?”

Gathering Data

First, the cell below uses the publically available API from the Bureau of Labor Statistics (BLS) to pull the monthly Consumer Price Index (CPI) for all goods from January 1998 to August 2023 (last ~25 years). More information on how to pull the pertinent data from the API can be found on the BLS website.

# only can include data for 10 years in each payload (need to split query)

# create payloads
payload1 <- list('seriesid'=c('CUUR0000SA0'), 
                 'startyear'=1998, 'endyear'=2008,
                 'registrationKey'='fec0da0eb7b9457a98f9babf068f5364')
payload2 <- list('seriesid'=c('CUUR0000SA0'),
                 'startyear'=2008, 'endyear'=2018,
                 'registrationKey'='fec0da0eb7b9457a98f9babf068f5364')
payload3 <- list('seriesid'=c('CUUR0000SA0'), 
                 'startyear'=2018, 'endyear'=2023,
                 'registrationKey'='fec0da0eb7b9457a98f9babf068f5364')

# send API request, convert to dataframe.
response1 <- blsAPI(payload1)
json1 <- fromJSON(response1)
df1 <- apiDF(json1$Results$series[[1]]$data)

response2 <- blsAPI(payload2)
json2 <- fromJSON(response2)
df2 <- apiDF(json2$Results$series[[1]]$data)

response3 <- blsAPI(payload3)
json3 <- fromJSON(response3)
df3 <- apiDF(json3$Results$series[[1]]$data)

# join dataframes together, clean, and display.
cpi_df <- rbind(df1, df2, df3)
cpi_df <- select(cpi_df, 1, 2, 4)
colnames(cpi_df) <- c('year', 'period', 'cpi')
cpi_df$cpi <- as.numeric(cpi_df$cpi)
head(cpi_df)

##   year period     cpi
## 1 2008    M12 210.228
## 2 2008    M11 212.425
## 3 2008    M10 216.573
## 4 2008    M09 218.783
## 5 2008    M08 219.086
## 6 2008    M07 219.964

The data from the code shown above is stored in the cpi_df dataframe.

Next, the cell below creates and processes another API query that pulls the federal unemployment rate for the same time period. This data is stored in a dataframe called uer_df.

# only can include data for 10 years in each payload (need to split query)

# create payloads
payload1 <- list('seriesid'=c('LAUST360000000000003'), 
                 'startyear'=1998, 'endyear'=2008,
                 'registrationKey'='fec0da0eb7b9457a98f9babf068f5364')
payload2 <- list('seriesid'=c('LAUST360000000000003'),
                 'startyear'=2008, 'endyear'=2018,
                 'registrationKey'='fec0da0eb7b9457a98f9babf068f5364')
payload3 <- list('seriesid'=c('LAUST360000000000003'), 
                 'startyear'=2018, 'endyear'=2023,
                 'registrationKey'='fec0da0eb7b9457a98f9babf068f5364')

# send API request, convert to dataframe.
response1 <- blsAPI(payload1)
json1 <- fromJSON(response1)
df1 <- apiDF(json1$Results$series[[1]]$data)

response2 <- blsAPI(payload2)
json2 <- fromJSON(response2)
df2 <- apiDF(json2$Results$series[[1]]$data)

response3 <- blsAPI(payload3)
json3 <- fromJSON(response3)
df3 <- apiDF(json3$Results$series[[1]]$data)

# join dataframes together, clean, and display.
uer_df <- rbind(df1, df2, df3)
uer_df <- select(uer_df, 1, 2, 4)
colnames(uer_df) <- c('year', 'period', 'unemployment_rate')
uer_df$unemployment_rate <- as.numeric(uer_df$unemployment_rate)
head(uer_df)

##   year period unemployment_rate
## 1 2008    M12               6.5
## 2 2008    M11               5.9
## 3 2008    M10               5.6
## 4 2008    M09               5.5
## 5 2008    M08               5.6
## 6 2008    M07               5.4

Lastly, the cell below pulls in data on the Federal Funds Rate (FFR) from the Federal Reserve’s publically available data sources. A csv was created that contains monthly data of the FFR (also for the last 25 years), which is converted and stored in the dataframe ffr_df:

ffr_df <- read.csv('federal_funds_rates.csv')
colnames(ffr_df) <- c('month', 'ffr')
ffr_df$month <- paste(ffr_df$month, '-01', sep='')
head(ffr_df)

##        month  ffr
## 1 1998-01-01 5.56
## 2 1998-02-01 5.51
## 3 1998-03-01 5.49
## 4 1998-04-01 5.45
## 5 1998-05-01 5.49
## 6 1998-06-01 5.56

In preparation of joining the three dataframes, the cell below cleans what will become the key column of each so that they are all in the same format (and thus, joinable).

cpi_df$period <- substring(cpi_df$period, 2)
cpi_df$month <- paste(cpi_df$year, '-', cpi_df$period, '-01', sep='')
cpi_df <- cpi_df %>%
  select(month, cpi) %>% arrange(month)

uer_df$period <- substring(uer_df$period, 2)
uer_df$month <- paste(uer_df$year, '-', uer_df$period, '-01', sep='')
uer_df <- uer_df %>%
  select(month, unemployment_rate) %>% arrange(month)

Now that each of the individual components have been properly cleaned, they can be joined together:

df <- cpi_df %>%
  left_join(uer_df, by='month') %>% left_join(ffr_df, by='month')

## Warning in left_join(., uer_df, by = "month"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 121 of `x` matches multiple rows in `y`.
## ℹ Row 121 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

df$month <- as.Date(df$month)
head(df)

##        month   cpi unemployment_rate  ffr
## 1 1998-01-01 161.6               6.7 5.56
## 2 1998-02-01 161.9               6.6 5.51
## 3 1998-03-01 162.2               6.4 5.49
## 4 1998-04-01 162.5               5.4 5.45
## 5 1998-05-01 162.8               5.3 5.49
## 6 1998-06-01 163.0               5.3 5.56

As can be seen from the above, df is the final dataframe containing information from all three of our data sources.

Analysis

First, the cell below calculates the monthly rate of inflation using the data in the cpi column of df. To calculate we need both the CPI in the current month \(c_f\) and the CPI one year earlier \(c_i\). The rate of inflation \(I\) is then:

\[ I = \frac{c_f - c_i}{c_i} \cdot 100 \]

df$last_month_cpi <- lag(df$cpi, n=12)
df$inflation <- ((df$cpi - df$last_month_cpi) / df$last_month_cpi) * 100
df <- select(df, -last_month_cpi)
df <- tail(df, nrow(df) - 12)
df <- head(df, nrow(df) - 1)
head(df)

##         month   cpi unemployment_rate  ffr inflation
## 13 1999-01-01 164.3               5.8 4.63  1.670792
## 14 1999-02-01 164.5               6.0 4.76  1.605930
## 15 1999-03-01 165.0               5.5 4.81  1.726264
## 16 1999-04-01 166.2               5.2 4.74  2.276923
## 17 1999-05-01 166.2               4.9 4.74  2.088452
## 18 1999-06-01 166.2               5.2 4.76  1.963190

The cell below uses df to prepare a separate dataframe that will be more useful for plotting purposes.

plt_df <- df
plt_df <- select(df, -cpi)
colnames(plt_df) <- c('Month', 'Unemployment', 'FFR', 'Inflation')

plt_df <- plt_df %>% 
    pivot_longer(!Month)

colnames(plt_df) <- c('Month', 'Metric', 'Value')
head(plt_df)

## # A tibble: 6 × 3
##   Month      Metric       Value
##   <date>     <chr>        <dbl>
## 1 1999-01-01 Unemployment  5.8 
## 2 1999-01-01 FFR           4.63
## 3 1999-01-01 Inflation     1.67
## 4 1999-02-01 Unemployment  6   
## 5 1999-02-01 FFR           4.76
## 6 1999-02-01 Inflation     1.61

We can now attempt to answer the question of whether or not the Federal Reserve is able to fulfill its mandate and keep both inflation and unemployment at reasonable levels. To get a better understanding of how these values shift over time, the code below produces a plot that shows how inflation, unemployment, and the federal funds rate have changed over time:

ggplot(data = plt_df, aes(x=Month, y=Value, group=Metric, color=Metric)) +
  geom_line() +
  xlab("Year") +
  ylab("Value (%)") + 
  scale_x_date(date_labels="%Y",date_breaks  ="2 year")

While the plot above does seem to indicate that changing the Federal Funds rate affects both the levels of unemployment and inflation, it does not give reliable insight into how. As such, we can instead look at how the effect of changing the FFR \(x\) months into the past affects the inflation (or unemployment) rate \(y\) months into the future. The cell below checks to see for which combination of \(x\) and \(y\) changing FFR and inflation (or unemployment) rates are most correlated:

cors <- c()
num_months <- 24
corrs <- data.frame(i=integer(), j=integer(), r_inf=double(), r_uer=double())

for(i in 1:num_months){ 
  tmp <- df
  tmp$ffr_lag <- lag(tmp$ffr, i)
  tmp$ffr_change <- tmp$ffr - tmp$ffr_lag
  for(j in 1:num_months){
    tmp$inf_lead <- lead(tmp$inflation, j) 
    tmp$inf_change <- tmp$inf_lead - tmp$inflation
    tmp$uer_lead <- lead(tmp$unemployment_rate, j)
    tmp$uer_change <- tmp$uer_lead - tmp$unemployment_rate
    tmp <- na.omit(tmp)
    r_inf <- cor(tmp$inf_change, tmp$ffr_change)
    r_uer <- cor(tmp$uer_change, tmp$ffr_change)
    row <- c(i, j, r_inf, r_uer)
    corrs[(i-1)*12+j,] <- row
  }
}
corrs <- na.omit(corrs)
head(corrs)

##   i j        r_inf      r_uer
## 1 1 1  0.031827489 -0.2957921
## 2 1 2 -0.006322652 -0.2068425
## 3 1 3 -0.031980033 -0.1549722
## 4 1 4  0.023865747 -0.1491502
## 5 1 5  0.109982174 -0.1695008
## 6 1 6  0.136167782 -0.1786796

We can then use these correlation values to select look-back and look-ahead periods of interest in order to plot them over time. This is done in the cell below in order to compare the change in FFR and inflation rate:

lookback <- 23
lookahead <- 24

tmp <- df
tmp$ffr_lag <- lag(tmp$ffr,lookback)
tmp$ffr_change <- tmp$ffr - tmp$ffr_lag
tmp$inf_lead <- lead(tmp$inflation, lookahead) 
tmp$inf_change <- tmp$inf_lead - tmp$inflation
tmp <- na.omit(tmp)

plt_df <- tmp
plt_df <- select(tmp, month, inf_change, ffr_change)
colnames(plt_df) <- c('Month', 'Inflation Change (6 Months Ahead)', 'FFR Change (3 Months Prior)')

plt_df <- plt_df %>% 
    pivot_longer(!Month)

colnames(plt_df) <- c('Month', 'Metric', 'Value')

ggplot(data = plt_df, aes(x=Month, y=Value, group=Metric, color=Metric)) +
  geom_line() +
  xlab("Year") +
  ylab("Value (%)") + 
  scale_x_date(date_labels="%Y",date_breaks  ="2 year")

We can see from the above graph that the FFR rate changes tend to be on the opposite side of the inflation rate changes, which means that when inflation starts getting too high, the FED begins to raise interest rates.

A similar picture is plotted below showing the comparison of the FFR and unemployment rate:

lookback <- 23
lookahead <- 24

tmp <- df
tmp$ffr_lag <- lag(tmp$ffr,lookback)
tmp$ffr_change <- tmp$ffr - tmp$ffr_lag
tmp$uer_lead <- lead(tmp$inflation, lookahead) 
tmp$uer_change <- tmp$uer_lead - tmp$unemployment_rate
tmp <- na.omit(tmp)

plt_df <- tmp
plt_df <- select(tmp, month, uer_change, ffr_change)
colnames(plt_df) <- c('Month', 'Unemployment Change (6 Months Ahead)', 'FFR Change (3 Months Prior)')

plt_df <- plt_df %>% 
    pivot_longer(!Month)

colnames(plt_df) <- c('Month', 'Metric', 'Value')

ggplot(data = plt_df, aes(x=Month, y=Value, group=Metric, color=Metric)) +
  geom_line() +
  xlab("Year") +
  ylab("Value (%)") + 
  scale_x_date(date_labels="%Y",date_breaks  ="2 year")

Once again, we see opposing peaks that indicate when unemployment starts to rise the FED begins to lower interest rates.

Conclusion

Based on the results of the visualizations shown above, it is clear that the FED does its best to fulfill its mandate from congress: it uses interest rates as a way to both curb inflation and unemployment.

Story 2 - Efficacy of the FED

William Jasmine

2023-09-27

Imports

Instructions

Gathering Data

Analysis

Conclusion