Class: ECON 6635-01
School: Pompea College of Business
University: University of New Haven
Author: Kashik Kumar Dasari
Student ID: 00878446
#_ Suppress warnings and messages for a clean environment
suppressWarnings({
suppressPackageStartupMessages({
library(tidyverse)
library(quantmod)
library(tsbox)
library(zoo)
})
})
options(digits = 3, scipen = 99999)
graphics.off()
# Download economic data from FRED
getSymbols(c("PAYEMS", "INDPRO", "HOUST"),
src = "FRED", return.class = 'xts',
from = "2010-01-01", to = Sys.Date())
## [1] "PAYEMS" "INDPRO" "HOUST"
# Data Preprocessing
employment <- PAYEMS
industrial_production <- INDPRO
housing <- HOUST
# Subset data from 2010 to September 2024
employment_ss <- employment["2010-01-31/2024-09-01"] |> ts_ts()
industrial_ss <- industrial_production["2010-01-31/2024-09-01"] |> ts_ts()
housing_ss <- housing["2010-01-31/2024-09-01"] |> ts_ts()
# Combine data for further analysis
mydata <- cbind.data.frame(employment_ss, industrial_ss, housing_ss)
# Apply first-order differences to each series
mydf <- mydata %>%
mutate(
emp_diff = tsibble::difference(employment_ss, differences = 1),
ind_diff = tsibble::difference(industrial_ss, differences = 1),
house_diff = tsibble::difference(housing_ss, differences = 1)
) %>%
select(emp_diff, ind_diff, house_diff) %>%
na.omit()
## Registered S3 method overwritten by 'tsibble':
## method from
## as_tibble.grouped_df dplyr
Alignment: The trends of the custom Diffusion Index and the CFNAIDIFF show significant periods of overlap, which suggests that the constructed index captures major economic shifts effectively.
Divergence: At some points, the indices diverge, which could be attributed to the differences in the variables used in each index. The CFNAIDIFF encompasses a broader range of data points beyond the three variables in the custom index.
# Construct the diffusion index
mydf_mat <- apply(mydf, 2, sign)
pos <- apply(mydf_mat, 1, function(row) sum(row > 0))
neg <- apply(mydf_mat, 1, function(row) sum(row < 0))
tot <- pos + neg
index <- (pos / tot - neg / tot) * 100
ma_index <- rollmean(index, 7, align = "right", na.pad = TRUE)
# Create a date sequence corresponding to the diffusion index
Date <- seq.Date(from = as.Date("2010-05-01"), length.out = length(index), by = "month")
diffusion_df <- cbind.data.frame(Date, index, ma_index)
# Plot the diffusion index with custom enhancements
ggplot(diffusion_df, aes(x = Date, y = index)) +
geom_line(color = "steelblue", size = 0.8) +
geom_smooth(color = "forestgreen", fill = "palegreen", alpha = 0.3, size = 1.2) +
geom_text(data = diffusion_df[c(1, nrow(diffusion_df)), ],
aes(label = paste0(round(index, 2), "%")),
vjust = -1, size = 3.5, fontface = "bold", color = "midnightblue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray40", size = 0.8) +
geom_vline(xintercept = as.Date("2020-03-01"), linetype = "dotted", color = "firebrick", size = 1) +
annotate("text", x = as.Date("2020-03-01"), y = -90,
label = "COVID-19", color = "firebrick", size = 4, hjust = 0, angle = 90) +
labs(
title = "U.S. Economic Diffusion Index Over Time",
subtitle = "Analyzing economic trends",
x = "Year",
y = "Diffusion Index (%)"
) +
scale_y_continuous(limits = c(-120, 120)) +
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(size = 20, face = "bold", hjust = 0.5, color = "darkblue"),
plot.subtitle = element_text(size = 14, face = "italic", hjust = 0.5, color = "blue"),
axis.title.x = element_text(size = 14, face = "bold", color = "black"),
axis.title.y = element_text(size = 14, face = "bold", color = "black"),
axis.text = element_text(size = 12, color = "black"),
panel.grid.major = element_line(color = "gray85", size = 0.5),
panel.grid.minor = element_blank(),
legend.position = "none",
plot.background = element_rect(fill = "white", color = "white")
)
## 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.
## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
# Load CFNAIDIFF from FRED
getSymbols("CFNAIDIFF", src = "FRED", return.class = 'xts', from = "2010-01-01")
## [1] "CFNAIDIFF"
cfnaidiff_ss <- CFNAIDIFF["2010-05-01/2024-09-01"] |> ts_ts()
min_length <- min(length(ma_index), length(cfnaidiff_ss))
ma_index <- ma_index[1:min_length]
cfnaidiff_ss <- cfnaidiff_ss[1:min_length]
Date <- Date[1:min_length]
# Prepare the comparison dataframe
compare_df <- cbind.data.frame(Date, diffusion_index = ma_index, CFNAIDIFF = cfnaidiff_ss)
# Calculate the correlation between the two indices
correlation <- cor(compare_df$diffusion_index, compare_df$CFNAIDIFF, use = "complete.obs")
# Interactive plot comparison
plotly::ggplotly(
ggplot() +
geom_line(data = compare_df, aes(x = Date, y = diffusion_index, color = "Diffusion Index"), size = 1.2) +
geom_line(data = compare_df, aes(x = Date, y = CFNAIDIFF * 100, color = "CFNAIDIFF"), size = 1.2, linetype = "dashed") +
scale_color_manual(
values = c("Diffusion Index" = "steelblue", "CFNAIDIFF" = "darkorange")
) +
labs(
title = "Comparison of Diffusion Index and CFNAIDIFF",
x = "Year",
y = "Index Value",
color = "Legend"
) +
theme_minimal(base_size = 10) +
theme(
plot.title = element_text(size = 12, face = "bold", hjust = 0.5, color = "darkblue"),
axis.title.x = element_text(size = 10, face = "bold", color = "black"),
axis.title.y = element_text(size = 10, face = "bold", color = "black"),
axis.text = element_text(size = 9, color = "black"),
legend.position = "bottom",
legend.title = element_text(size = 10, face = "bold", color = "black"),
legend.text = element_text(size = 9, color = "black")
)
)