{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE)
# Load required libraries
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(yaml)
library(httr)
library(jsonlite)
library(caret)
## Loading required package: lattice
##
## Attaching package: 'caret'
## The following object is masked from 'package:httr':
##
## progress
# Check the current working directory
working_dir <- getwd()
# Set working directory to the Documents folder
setwd(working_dir)
working_dir
## [1] "H:/DATA 608/Homework 2"
config <- yaml::read_yaml("fred_api.yml")
api_key <- config$FRED_API_KEY
# Define the start date and get the current date
start_date <- '1998-01-01'
end_date <- Sys.Date() # Get the current date dynamically
### Retrieve CPI Data ###
cpi_url <- paste0("https://api.stlouisfed.org/fred/series/observations?",
"series_id=CPIAUCSL&api_key=", api_key,
"&file_type=json&observation_start=", start_date,
"&observation_end=", end_date)
cpi_response <- GET(cpi_url)
if (status_code(cpi_response) == 200) {
# Parse the JSON response
cpi_data <- fromJSON(content(cpi_response, "text"))
# Extract the 'observations' data and convert to a data frame
cpi <- as.data.frame(cpi_data$observations)
# Convert 'date' column to Date type and ensure it's valid
cpi <- cpi %>%
mutate(Date = as.Date(date), # Convert to Date type
Year = year(Date), # Extract Year
Month = month(Date, label = TRUE), # Extract Month in abbreviated form
CPI = as.numeric(value)) %>% # Convert CPI value to numeric
select(Year, Month, CPI, Date) # Rearrange the columns
} else {
stop(paste("Error fetching CPI data:", status_code(cpi_response)))
}
### Retrieve Unemployment Data ###
unemployment_url <- paste0("https://api.stlouisfed.org/fred/series/observations?",
"series_id=UNRATE&api_key=", api_key,
"&file_type=json&observation_start=", start_date,
"&observation_end=", end_date)
unemployment_response <- GET(unemployment_url)
if (status_code(unemployment_response) == 200) {
# Parse the JSON response
unemployment_data <- fromJSON(content(unemployment_response, "text"))
# Convert unemployment data into a data frame and ensure Date is valid
unemployment <- as.data.frame(unemployment_data$observations)
unemployment <- unemployment %>%
mutate(Date = as.Date(date), # Convert to Date type
Year = year(Date), # Extract Year
Month = month(Date, label = TRUE), # Extract Month in abbreviated form
Unemployment_Rate = as.numeric(value)) %>% # Convert Unemployment Rate to numeric
select(Year, Month, Unemployment_Rate, Date) # Select the relevant columns
} else {
stop(paste("Error fetching Unemployment data:", status_code(unemployment_response)))
}
### Retrieve Federal Funds Rate Data ###
fedfunds_url <- paste0("https://api.stlouisfed.org/fred/series/observations?",
"series_id=FEDFUNDS&api_key=", api_key,
"&file_type=json&observation_start=", start_date,
"&observation_end=", end_date)
fedfunds_response <- GET(fedfunds_url)
if (status_code(fedfunds_response) == 200) {
# Parse the JSON response
fedfunds_data <- fromJSON(content(fedfunds_response, "text"))
# Convert the data into a data frame and format the columns
fedfunds <- as.data.frame(fedfunds_data$observations)
fedfunds <- fedfunds %>%
mutate(Date = as.Date(date), # Convert to Date type
FEDFUNDS = as.numeric(value)) %>% # Convert Fed Funds Rate to numeric
select(Date, FEDFUNDS) # Select relevant columns
} else {
stop(paste("Error fetching Fed Funds Rate data:", status_code(fedfunds_response)))
}
### Calculate YoY Percentage Change for CPI and Unemployment ###
cpi <- cpi %>%
arrange(Date) %>%
mutate(YoY_Change_CPI = (CPI / lag(CPI, 12) - 1) * 100) %>%
filter(!is.na(YoY_Change_CPI))
unemployment <- unemployment %>%
arrange(Date) %>%
mutate(YoY_Change_Unemployment = (Unemployment_Rate / lag(Unemployment_Rate, 12) - 1) * 100) %>%
filter(!is.na(YoY_Change_Unemployment))
### Merge Data Frames ###
merged_df <- merge(cpi[, c("Date", "YoY_Change_CPI")],
unemployment[, c("Date", "YoY_Change_Unemployment")], by = "Date")
merged_df <- merge(merged_df, fedfunds, by = "Date")
# Normalize using rescale from the scales package
# Create a preProcess object for Min-Max scaling
scaler <- preProcess(merged_df[, c("YoY_Change_CPI", "YoY_Change_Unemployment", "FEDFUNDS")], method = "range")
# Apply Min-Max scaling
merged_df <- predict(scaler, merged_df)
# Define color scheme based on time periods
rate_color_map <- function(date) {
if (date >= as.Date("1999-01-01") & date <= as.Date("2000-06-01")) {
return('red') # Rate hikes
} else if (date >= as.Date("2000-06-01") & date <= as.Date("2003-06-01")) {
return('green') # Rate cuts
} else if (date >= as.Date("2004-06-01") & date <= as.Date("2006-06-01")) {
return('red') # Rate hikes
} else if (date >= as.Date("2007-06-01") & date <= as.Date("2009-01-01")) {
return('green') # Rate cuts
} else if (date >= as.Date("2015-11-01") & date <= as.Date("2019-06-01")) {
return('red') # Rate hikes
} else if (date >= as.Date("2019-07-01") & date <= as.Date("2020-03-01")) {
return('green') # Rate cuts
} else if (date >= as.Date("2022-02-01") & date <= as.Date("2023-06-01")) {
return('red') # Rate hikes
} else {
return('grey') # Minimal or no changes
}
}
# Apply color scheme to data
merged_df$RateCategory <- sapply(merged_df$Date, rate_color_map)
# Create a new data frame for the heatmap
heatmap_df <- merged_df %>%
select(Date, RateCategory)
### Plot with Yearly Ticks, Borders, and Axis Lines ###
ggplot() +
# Reduce heatmap height to half and place it just above the x-axis
geom_tile(data = heatmap_df, aes(x = Date, y = -0.05, fill = RateCategory), height = 0.025) +
# Plot FEDFUNDS, CPI, and Unemployment rates
geom_line(data = merged_df, aes(x = Date, y = FEDFUNDS, color = "Fed Funds Rate"), linewidth = 1) +
geom_line(data = merged_df, aes(x = Date, y = YoY_Change_CPI, color = "YoY Change in CPI"), linewidth = 1, linetype = 'solid') +
geom_line(data = merged_df, aes(x = Date, y = YoY_Change_Unemployment, color = "YoY Change in Unemployment Rate"), linewidth = 1, linetype = 'solid') +
# Highlight bands for specific periods
annotate("rect", xmin = as.Date("2000-01-01"), xmax = as.Date("2002-12-31"), ymin = -Inf, ymax = Inf, fill = "lightgreen", alpha = 0.1) +
annotate("rect", xmin = as.Date("2008-01-01"), xmax = as.Date("2009-12-31"), ymin = -Inf, ymax = Inf, fill = "lightgreen", alpha = 0.1) +
annotate("rect", xmin = as.Date("2010-01-01"), xmax = as.Date("2012-12-31"), ymin = -Inf, ymax = Inf, fill = "lightgrey", alpha = 0.1) +
annotate("rect", xmin = as.Date("2020-01-01"), xmax = as.Date("2021-12-31"), ymin = -Inf, ymax = Inf, fill = "lightgreen", alpha = 0.1) +
annotate("rect", xmin = as.Date("2022-01-01"), xmax = as.Date("2024-01-01"), ymin = -Inf, ymax = Inf, fill = "lightcoral", alpha = 0.1) +
# Add titles for the color bands
annotate("text", x = as.Date("2001-06-01"), y = 0.9, label = "Dot-com Bubble", angle = 90, vjust = 1) +
annotate("text", x = as.Date("2009-06-01"), y = 0.9, label = "Financial Crisis", angle = 90, vjust = 1) +
annotate("text", x = as.Date("2011-06-01"), y = 0.9, label = "Great Recession", angle = 90, vjust = 1) +
annotate("text", x = as.Date("2020-06-01"), y = 0.9, label = "COVID-19 Pandemic", angle = 90, vjust = 1) +
annotate("text", x = as.Date("2023-01-01"), y = 0.9, label = "Inflation Surge", angle = 90, vjust = 1) +
# Set ticks at the beginning of each year starting from 1999
scale_x_date(limits = as.Date(c("1999-01-01", end_date)), date_breaks = "5 year", date_labels = "%Y") +
# Manually set colors for the different curves and rate change heatmap
scale_color_manual(
values = c(
"Fed Funds Rate" = "black", # Black for the continuous Fed Funds Rate line
"YoY Change in CPI" = "blue", # Blue for CPI
"YoY Change in Unemployment Rate" = "orange" # Orange for Unemployment Rate
)
) +
scale_fill_manual(values = c("red" = "red", "green" = "green", "grey" = "grey"),
labels = c("green" = "Rate cut", "red" = "Rate hike", "grey" = "Steady rate")) +
labs(x = "Year", y = "Rate (%)", title = "Fed Funds Rate with YoY Changes in CPI and Unemployment Rate", color = "Indicator", fill = "Rate Change") +
# Remove grid lines and adjust theme with border and axis lines
theme_minimal() +
theme(legend.position = "bottom", legend.title = element_blank(),
panel.grid = element_blank(), # Remove grid lines
axis.line = element_line(color = "black"), # Add axis lines
panel.border = element_rect(color = "black", fill = NA), # Add border
plot.margin = margin(t = 20, r = 20, b = 20, l = 20))
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_tile()`).
# Load necessary libraries
library(httr)
library(dplyr)
library(lubridate)
library(ggplot2)
library(scales)
library(jsonlite)
# Check the current working directory
working_dir <- getwd()
# Set working directory to the Documents folder
setwd(working_dir)
config <- yaml::read_yaml("fred_api.yml")
api_key <- config$FRED_API_KEY
# Function to fetch data from FRED API
fetch_fred_data <- function(series_id, start_date = '1998-01-01', end_date = '2024-12-31') {
url <- paste0("https://api.stlouisfed.org/fred/series/observations?series_id=", series_id,
"&api_key=", api_key, "&file_type=json&observation_start=", start_date,
"&observation_end=", end_date)
response <- GET(url)
if (status_code(response) == 200) {
data <- fromJSON(content(response, "text", encoding = "UTF-8"))
df <- data.frame(date = as.Date(data$observations$date),
value = as.numeric(data$observations$value))
return(df)
} else {
stop(paste("Error fetching", series_id, "data:", status_code(response)))
}
}
# Fetch CPI, Unemployment Rate, and Federal Funds Rate from FRED API
cpi_data <- fetch_fred_data("CPIAUCSL") # Consumer Price Index
unemployment_data <- fetch_fred_data("UNRATE") # Unemployment Rate
fed_rate_data <- fetch_fred_data("FEDFUNDS") # Federal Funds Rate
# Calculate Year-over-Year (YoY) percentage change for CPI and Unemployment
cpi_data <- cpi_data %>%
arrange(date) %>%
mutate(YoY_Change_CPI = (value / lag(value, 12) - 1) * 100)
unemployment_data <- unemployment_data %>%
arrange(date) %>%
mutate(YoY_Change_Unemployment = (value / lag(value, 12) - 1) * 100)
# Remove rows with NA values (due to the lag calculation)
cpi_data <- na.omit(cpi_data)
unemployment_data <- na.omit(unemployment_data)
# Merge CPI, Unemployment, and Federal Funds Rate data by date
merged_df <- merge(cpi_data[, c("date", "YoY_Change_CPI")],
unemployment_data[, c("date", "YoY_Change_Unemployment")], by = "date")
merged_df <- merge(merged_df, fed_rate_data[, c("date", "value")], by = "date")
colnames(merged_df)[4] <- "FEDFUNDS"
# Normalize the YoY Change in CPI, Unemployment Rate, and Fed Funds Rate using Min-Max scaling
normalize <- function(x) (x - min(x)) / (max(x) - min(x))
merged_df <- merged_df %>%
mutate(YoY_Change_CPI_Norm = normalize(YoY_Change_CPI),
YoY_Change_Unemployment_Norm = normalize(YoY_Change_Unemployment),
FEDFUNDS_Norm = normalize(FEDFUNDS))
# Add jitter to the normalized CPI and Unemployment values
set.seed(42)
jitter_strength <- 0.05
merged_df <- merged_df %>%
mutate(YoY_Change_CPI_Jitter = YoY_Change_CPI_Norm + runif(n(), -jitter_strength, jitter_strength),
YoY_Change_Unemployment_Jitter = YoY_Change_Unemployment_Norm + runif(n(), -jitter_strength, jitter_strength))
# Define periods of interest with distinct colors and labels with rate action description
highlight_periods <- data.frame(
start = as.Date(c('2000-01-01', '2008-01-01', '2010-01-01', '2020-01-01', '2022-01-01')),
end = as.Date(c('2002-12-31', '2009-12-31', '2012-12-31', '2021-12-31', '2024-01-01')),
event = c('Dot-com Bubble (cut)', 'Financial Crisis (cut)', 'Great Recession Aftermath (maintain)',
'COVID-19 Pandemic (cut)', 'Inflation Surge (hike)'),
color = c('purple', 'orange', 'black', 'green', 'red')
)
# Assign colors to each data point based on the date range
merged_df$Event <- 'Other Points'
merged_df$Color <- 'darkgrey'
for (i in 1:nrow(highlight_periods)) {
mask <- merged_df$date >= highlight_periods$start[i] & merged_df$date <= highlight_periods$end[i]
merged_df$Event[mask] <- highlight_periods$event[i]
merged_df$Color[mask] <- highlight_periods$color[i]
}
# Create scatter plot
ggplot(merged_df, aes(x = YoY_Change_CPI_Jitter, y = YoY_Change_Unemployment_Jitter, color = Color)) +
geom_point(alpha = 0.6, size = 2) +
scale_color_identity() +
labs(title = "Inflation vs. Unemployment with Highlighted Economic Events",
x = "Normalized Year-over-Year Change in CPI",
y = "Normalized Year-over-Year Change in Unemployment Rate") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5)) +
guides(color = guide_legend(title = "Economic Events"))