Story2 D608

Story 2

The Federal Reserve’s mandate from Congress is to control inflation and to maintain low unemployment. You can read about it here: Dual Mandate. These seem to be contradictory objectives- see this wikipedia article on the Phillips Curve. Another good but short news article which focuses on the specific context of recessions is here: Soft Landing.

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)- note that there are numerous ways to define a CPI, and you can create a custom definition on the BLS page. If you want the standard CPI it is the CPI for all Urban Consumers, or CPI-U. You can find this and other BLS datasets here: https://data.bls.gov/toppicks?survey=bls

The FED Funds Rate (FRED) (Federal Reserve Board)- This can be found here: https://fred.stlouisfed.org/series/FEDFUNDS

Unemployment Rate (Bureau of Labor Statistics). I recommend using the seasonally adjusted rate. Your Data Visualizations should be designed to answer the question “Has the FED been able to fulfill the mandate given to it by Congress?”

Notes:

I recommend using quarto to compose your report with either R or python for the visualizations, though you may use something different if you choose.

Remember, the FED raises rate after reviewing the CPI and other data and unemployment (layoffs) occur after company operating costs go up.

This assignment is due at the end of week four of the semester

# Load required libraries
library(tidyverse)

## Warning: package 'tidyverse' was built under R version 4.4.2

## Warning: package 'ggplot2' was built under R version 4.4.2

## Warning: package 'tidyr' was built under R version 4.4.2

## Warning: package 'readr' was built under R version 4.4.2

## Warning: package 'dplyr' was built under R version 4.4.2

## Warning: package 'stringr' was built under R version 4.4.2

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(lubridate)
library(fpp3)

## Warning: package 'fpp3' was built under R version 4.4.2

## Registered S3 method overwritten by 'tsibble':
##   method               from 
##   as_tibble.grouped_df dplyr
## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.1 ──
## ✔ tsibble     1.1.6     ✔ feasts      0.4.1
## ✔ tsibbledata 0.4.1     ✔ fable       0.4.1

## Warning: package 'tsibble' was built under R version 4.4.2

## Warning: package 'tsibbledata' was built under R version 4.4.2

## Warning: package 'feasts' was built under R version 4.4.2

## Warning: package 'fabletools' was built under R version 4.4.2

## Warning: package 'fable' was built under R version 4.4.2

## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date()    masks base::date()
## ✖ dplyr::filter()      masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval()  masks lubridate::interval()
## ✖ dplyr::lag()         masks stats::lag()
## ✖ tsibble::setdiff()   masks base::setdiff()
## ✖ tsibble::union()     masks base::union()

# Define file paths
fed_funds_path <- "C:/Users/Dell/Downloads/Fedfunrate.csv"
cpi_path <- "C:/Users/Dell/Downloads/CPIU.csv"
unemployment_path <- "C:/Users/Dell/Downloads/Unemploymentrate.csv"

# Load datasets
fed_funds <- read_csv(fed_funds_path)

## Rows: 312 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl  (1): FEDFUNDS
## date (1): observation_date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

cpi <- read_csv(cpi_path)

## Rows: 26 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (15): Year, Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec, ...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

unemployment <- read_csv(unemployment_path)

## Rows: 26 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (13): Year, Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

# Clean and format the Federal Funds Rate dataset
fed_funds <- fed_funds %>%
  rename(date = observation_date) %>%  # Rename column
  mutate(date = as.Date(date, format = "%Y-%m-%d"))

# Convert CPI data to long format
cpi_long <- cpi %>%
  pivot_longer(cols = -Year, names_to = "Month", values_to = "cpi_u") %>%
  mutate(date = as.Date(paste(Year, Month, "01"), format = "%Y %b %d")) %>%
  select(date, cpi_u)

# Convert Unemployment data to long format
unemployment_long <- unemployment %>%
  pivot_longer(cols = -Year, names_to = "Month", values_to = "unemployment_rate") %>%
  mutate(date = as.Date(paste(Year, Month, "01"), format = "%Y %b %d")) %>%
  select(date, unemployment_rate)

# Merge datasets by date
economic_data <- fed_funds %>%
  left_join(cpi_long, by = "date") %>%
  left_join(unemployment_long, by = "date")

# Convert the merged data to tsibble format and fill gaps
economic_data_ts <- economic_data %>%
  as_tsibble(index = date) %>%
  fill_gaps() %>%
  fill(cpi_u, .direction = "downup") %>%
  fill(FEDFUNDS, .direction = "downup") %>%
  fill(unemployment_rate, .direction = "downup")

# Plot the trends
economic_data_ts %>%
  pivot_longer(cols = c(FEDFUNDS, cpi_u, unemployment_rate),
               names_to = "Indicator", values_to = "Value") %>%
  ggplot(aes(x = date, y = Value, color = Indicator)) +
  geom_line(size = 1) +
  labs(title = "Trends in Federal Funds Rate, CPI, and Unemployment Rate",
       x = "Year", y = "Value",
       color = "Economic Indicator") +
  theme_minimal()

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# Explore the CPI series
autoplot(economic_data_ts, cpi_u)

gg_season(economic_data_ts, cpi_u)

gg_subseries(economic_data_ts, cpi_u)

gg_lag(economic_data_ts, cpi_u)

ACF(economic_data_ts, cpi_u) %>% autoplot()

# Explore the FED Funds Rate series
autoplot(economic_data_ts, FEDFUNDS)

gg_season(economic_data_ts, FEDFUNDS)

gg_subseries(economic_data_ts, FEDFUNDS)

gg_lag(economic_data_ts, FEDFUNDS)

ACF(economic_data_ts, FEDFUNDS) %>% autoplot()

# Explore the Unemployment Rate series
autoplot(economic_data_ts, unemployment_rate)

gg_season(economic_data_ts, unemployment_rate)

gg_subseries(economic_data_ts, unemployment_rate)

gg_lag(economic_data_ts, unemployment_rate)

ACF(economic_data_ts, unemployment_rate) %>% autoplot()

# Split data into training and test sets (before and after 2011)
economic_data_train <- economic_data_ts %>%
  filter(year(date) < 2011)

# Check that the data have been split appropriately
autoplot(economic_data_ts, cpi_u) +
  autolayer(economic_data_train, cpi_u, colour = "red")

# Fit a seasonal naive model to the CPI data
fit_cpi_u <- economic_data_train %>%
  model(SNAIVE(cpi_u))

# Fit a seasonal naive model to the FED Funds Rate data
fit_fedfunds <- economic_data_train %>%
  model(SNAIVE(FEDFUNDS))

# Fit a seasonal naive model to the Unemployment Rate data
fit_unemployment <- economic_data_train %>%
  model(SNAIVE(unemployment_rate))

# Check the residuals for each model
fit_cpi_u %>% gg_tsresiduals()

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_line()`).

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_point()`).

## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_bin()`).

fit_fedfunds %>% gg_tsresiduals()

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_line()`).

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_point()`).

## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_bin()`).

fit_unemployment %>% gg_tsresiduals()

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_line()`).

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_point()`).

## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_bin()`).

# Produce forecasts for each model
fc_cpi_u <- fit_cpi_u %>%
  forecast(new_data = anti_join(economic_data_ts, economic_data_train))

## Joining with `by = join_by(date, FEDFUNDS, cpi_u, unemployment_rate)`

fc_fedfunds <- fit_fedfunds %>%
  forecast(new_data = anti_join(economic_data_ts, economic_data_train))

## Joining with `by = join_by(date, FEDFUNDS, cpi_u, unemployment_rate)`

fc_unemployment <- fit_unemployment %>%
  forecast(new_data = anti_join(economic_data_ts, economic_data_train))

## Joining with `by = join_by(date, FEDFUNDS, cpi_u, unemployment_rate)`

# Plot forecasts
fc_cpi_u %>% autoplot(economic_data_ts) + labs(title = "CPI Forecast")

fc_fedfunds %>% autoplot(economic_data_ts) + labs(title = "FED Funds Rate Forecast")

fc_unemployment %>% autoplot(economic_data_ts) + labs(title = "Unemployment Rate Forecast")

# Compare the accuracy of the forecasts against the actual values
fit_cpi_u %>% accuracy()

## # A tibble: 1 × 10
##   .model        .type       ME  RMSE   MAE    MPE   MAPE  MASE RMSSE  ACF1
##   <chr>         <chr>    <dbl> <dbl> <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(cpi_u) Training 0.263  1.30 0.470 0.0458 0.0801     1     1 0.851

fc_cpi_u %>% accuracy(economic_data_ts)

## # A tibble: 1 × 10
##   .model        .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE  ACF1
##   <chr>         <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(cpi_u) Test   111.  138.  111.  13.6  13.6  237.  106. 0.999

fit_fedfunds %>% accuracy()

## # A tibble: 1 × 10
##   .model           .type          ME  RMSE    MAE    MPE  MAPE  MASE RMSSE  ACF1
##   <chr>            <chr>       <dbl> <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(FEDFUNDS) Training -0.00712 0.100 0.0289 -0.832  1.89     1     1 0.856

fc_fedfunds %>% accuracy(economic_data_ts)

## # A tibble: 1 × 10
##   .model           .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE  ACF1
##   <chr>            <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(FEDFUNDS) Test   1.11  2.06  1.18 -1.29  86.0  40.9  20.5 0.999

fit_unemployment %>% accuracy()

## # A tibble: 1 × 10
##   .model               .type      ME   RMSE    MAE   MPE  MAPE  MASE RMSSE  ACF1
##   <chr>                <chr>   <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(unemployment… Trai… 0.00800 0.0812 0.0278 0.114 0.484     1     1 0.856

fc_unemployment %>% accuracy(economic_data_ts)

## # A tibble: 1 × 10
##   .model                   .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE  ACF1
##   <chr>                    <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(unemployment_rat… Test  -3.77  4.29  3.91 -87.8  88.9  140.  52.9 0.997

Analyzing the Plots:

Regarding the Federal Funds Rate:

Historical and Forecasted Trends: The Federal Funds Rate fluctuates over time, reflecting the FED’s monetary policy adjustments in response to economic conditions. Significant drops around 2008 and fluctuations highlight the FED’s efforts to manage economic crises.

ACF and Residuals Analysis: Minimal significant autocorrelation and residuals resembling white noise suggest the model captures the essential patterns.

CPI (Consumer Price Index):

Historical and Forecasted Trends: The CPI shows a general upward trend, indicating inflation over time. The forecast captures this trend with well-defined confidence intervals, reflecting the FED’s efforts to maintain stable prices.

Seasonality and Residuals Analysis: The CPI exhibits seasonal patterns, and residual analysis shows a good model fit with residuals resembling white noise.

Unemployment Rate:

Historical and Forecasted Trends: The Unemployment Rate varies significantly, with spikes during economic downturns (e.g., 2008 and 2020). The forecast shows expected future values with confidence intervals, reflecting the FED’s efforts to promote maximum employment.

Seasonality and Residuals Analysis: The Unemployment Rate data show patterns, with residual analysis indicating a good model fit.

Conclusion

The visualizations provide insights into the FED’s ability to fulfill its mandate. The FED has actively adjusted the Federal Funds Rate to manage economic conditions, influencing unemployment and inflation.

The CPI and Unemployment Rate trends suggest that the FED’s policies have aimed to stabilize prices and promote employment, as mandated by Congress. As Residuals and ACF plots indicate the models used effectively capture the data patterns, suggesting the forecasts are reliable.

As a summary for the data visualizations suggested that FED has been responsive to economic conditions, actively managing interest rates to influence inflation and employment. While there are fluctuations and challenges, the overall trends indicate efforts to fulfill the Congressional mandate.

Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.