This case study explores the development and analysis of two critical economic indicators of the US Economy Diffusion Index and the Chicago Fed National Activity Index (CFNAI). These indices were derived from key economic metrics such as unemployment rates, average hourly earnings, and consumer price indices, spanning data from January 2010 to October 2024. By examining trends and correlations between these indices, this study aims to provide insights into the health and direction of the US economy.
## Data Sources and Preprocessing
### Data Acquisition
library(markovchain)
library(tidyverse)
library(quantmod)
library(tsibble)
library(tsbox)
library(forecast)
library(openintro)
library(ggthemes)
library(knitr)
library(DT)
# Load data from FRED
getSymbols(c("UNRATE", "CES0500000003", "CPIAUCSL", "CFNAIDIFF"),
src = "FRED", return.class = "xts",
from = "2010-01-01", to = Sys.Date())
## [1] "UNRATE" "CES0500000003" "CPIAUCSL" "CFNAIDIFF"
unemp <- UNRATE
avghr <- CES0500000003
cpi <- CPIAUCSL
cfnaid <- CFNAIDIFF
# Convert to time series
unemp <- ts(unemp["2010-01-01/2024-10-01"])
avghr <- ts(avghr["2010-01-01/2024-10-01"])
cpi <- ts(cpi["2010-01-01/2024-10-01"])
# First differences
unempD1 <- tsibble::difference(unemp, differences = 1)
avghrD1 <- tsibble::difference(avghr, differences = 1)
cpiD1 <- tsibble::difference(cpi, differences = 1)
# Combine data and remove NA rows
data <- data.frame(unempD1 = as.numeric(unempD1),
avghrD1 = as.numeric(avghrD1),
cpiD1 = as.numeric(cpiD1))
data <- na.omit(data)
datatable(data, caption = 'Metrics of unemployment rates, average hourly earnings, and consumer price indices')
# Load necessary libraries
library(dygraphs)
library(xts)
# Placeholder data for the metrics (replace with your actual data)
# These should be loaded as time series objects
unemp_data <- ts(data = rnorm(180, mean = 5, sd = 1), start = c(2010, 1), frequency = 12) # Replace with actual UNRATE data
avghr_data <- ts(data = rnorm(180, mean = 25, sd = 5), start = c(2010, 1), frequency = 12) # Replace with actual CES0500000003 data
cpi_data <- ts(data = rnorm(180, mean = 250, sd = 10), start = c(2010, 1), frequency = 12) # Replace with actual CPIAUCSL data
cfnaidiff_data <- ts(data = rnorm(180, mean = 0, sd = 0.1), start = c(2010, 1), frequency = 12) # Replace with actual CFNAIDIFF data
# Combine the data into a data frame
data_combined <- data.frame(
UNRATE = as.numeric(unemp_data),
CES0500000003 = as.numeric(avghr_data),
CPIAUCSL = as.numeric(cpi_data),
CFNAIDIFF = as.numeric(cfnaidiff_data)
)
# Create time index (assuming monthly data starting from 2010-01-01)
time_index <- seq.Date(from = as.Date("2010-01-01"), by = "month", length.out = length(unemp_data))
# Create xts object for dygraph
data_xts <- xts(data_combined, order.by = time_index)
# Check the structure of the xts object
print(head(data_xts))
## UNRATE CES0500000003 CPIAUCSL CFNAIDIFF
## 2010-01-01 6.015520 35.23770 256.1446 -0.26605042
## 2010-02-01 6.036600 28.90569 236.8921 0.02387906
## 2010-03-01 3.919212 24.38026 256.9517 0.10456053
## 2010-04-01 4.914597 25.35439 241.3200 0.15802024
## 2010-05-01 5.002535 28.07608 249.1450 -0.08254752
## 2010-06-01 4.052307 23.11026 239.6684 -0.08409871
print(dim(data_xts))
## [1] 180 4
# Create dygraph with custom options
dygraph(data_xts, main = "EconomicIndicators: Unemployment,Earnings,CPI, & Activity Index") %>%
dyOptions(colors = c("steelblue", "darkgreen", "firebrick", "purple")) %>%
dyLegend(show = "always") %>%
dyRangeSelector() %>%
dySeries("UNRATE", label = "Unemployment Rate") %>%
dySeries("CES0500000003", label = "Average Hourly Earnings") %>%
dySeries("CPIAUCSL", label = "Consumer Price Index") %>%
dySeries("CFNAIDIFF", label = "Chicago Fed National Activity Index Diffusion Index")
## Results and Visualization
### Diffusion Index Calculation
# Calculate signs and diffusion index
data_sign <- apply(data, 2, sign)
pos <- apply(data_sign, 1, function(row) sum(row > 0))
neg <- apply(data_sign, 1, function(row) sum(row < 0))
index <- pos / (pos + neg) - neg / (pos + neg)
# Create date sequence and data frame
dates <- seq.Date(from = as.Date("2010-05-01"), length.out = length(index), by = "month")
index_df <- data.frame(time = dates, index = index)
#kable(index_df, caption = "Diffusion Index Calculation")
datatable(index_df, caption = 'Diffusion Index Calculation')
library(ggplot2)
ggplot(index_df, aes(x = time, y = index)) +
geom_line(color = "blue") +
geom_hline(yintercept = 0, color = "darkred") +
labs(title = "US Economy Diffusion Index - Fig-1", x = "Date", y = "Index Value") +
theme_minimal()
# Diffusion Index with smoother
ggplot(index_df, aes(x = time, y = index)) +
geom_line() +
geom_hline(yintercept = 0, color = "darkred") +
geom_smooth(colour = "blue") +
labs(title = "US Economy Diffusion Index with Smoother - Fig-2") +
xlab("Months") +
ylab("Change") +
theme(axis.line.x = element_line(size = 0.75, colour = "black"),
axis.line.y = element_line(size = 0.75, colour = "black"),
legend.position = "bottom",
legend.direction = "horizontal",
element_blank()) +
theme_tufte()
## 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'
# CFNAI processing
cfnaid_trimmed <- cfnaid[1:length(dates)]
cfnaid_df <- data.frame(Date = dates, cfnaid = as.numeric(cfnaid_trimmed))
ggplot(cfnaid_df, aes(x = Date, y = cfnaid)) +
geom_line() +
geom_hline(yintercept = 0, color = "darkred") +
geom_smooth(color = "blue") +
labs(title = "CFNAI Diffusion Index with Smoother - Fig-3", x = "Date", y = "Index Value") +
theme_minimal()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
# Correlation
correlation <- cor(index_df$index, cfnaid_df$cfnaid)
correlation
## [1] 0.03027711
# Ensure necessary libraries are loaded
library(tidyr)
library(dplyr)
# Trim index and cfnaid vectors to matching lengths
index_trimmed <- index[1:length(dates)]
cfnaid_trimmed <- as.numeric(cfnaid[1:length(dates)])
# Create the combined data frame
combined_data <- data.frame(
Date = dates,
`US.Economy.Diffusion.Index` = index_trimmed,
`Chicago.Fed.National.Activity.Index` = cfnaid_trimmed
)
# Convert data to long format
combined_data_long <- pivot_longer(
combined_data,
cols = c("US.Economy.Diffusion.Index", "Chicago.Fed.National.Activity.Index"),
names_to = "Index",
values_to = "Value"
)
# Create the plot with facet_wrap for side-by-side comparison
ggplot(combined_data_long, aes(x = Date, y = Value)) +
geom_line() + # Line plot for both series
geom_hline(yintercept = 0, color = "darkred") + # Horizontal line at 0
geom_smooth(colour = "blue") + # Smoother (trend line)
labs(title = "Comparison of Diffusion Indices - Fig-4",
x = "Months",
y = "Change") +
theme(axis.line.x = element_line(size = 0.75, colour = "black"),
axis.line.y = element_line(size = 0.75, colour = "black"),
legend.position = "bottom",
legend.direction = "horizontal",
panel.background = element_blank()) +
theme_tufte() +
facet_wrap(~Index, scales = "free_y") # Facet for side-by-side comparison
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
This study highlights the utility of diffusion indices as tools for economic analysis. By synthesizing data from diverse metrics, these indices provide a coherent narrative of economic trends. Future work could extend this analysis by incorporating additional economic variables or exploring advanced modeling techniques, such as machine learning, to enhance predictive accuracy.