The diffusion index is a critical tool used to gauge the overall direction and momentum of economic activity. It is particularly effective in summarizing trends across various economic variables.
This document explores the creation of a diffusion index for the U.S. economy by analyzing three key economic variables:
Personal Consumption Expenditures (PCE): Represents consumer spending on goods and services and is a significant component of GDP.
Unemployment Rate (UNRATE): Measures the percentage of the labor force that is unemployed, providing insights into labor market health.
Consumer Price Index for All Urban Consumers (CPIAUCSL): Tracks changes in the price level of a basket of consumer goods and services, indicating inflation trends.
suppressWarnings({
suppressPackageStartupMessages({
library(markovchain)
library(tidyverse)
library(quantmod)
library(tsbox)
library(TSstudio)
library(vars)
library(lubridate)
library(xts)
library(plotly)
# Load necessary libraries
library(dygraphs)
library(xts)
})
})
getSymbols(c("PCE", "UNRATE", "CPIAUCSL"),
freq = "monthly",
src = "FRED", return.class = 'xts',
index.class = 'Date',
from = "2010-01-01",
to = Sys.Date(),
periodicity = "monthly")
## [1] "PCE" "UNRATE" "CPIAUCSL"
ts_info(PCE)
## The PCE series is a xts object with 1 variable and 178 observations
## Frequency: monthly
## Start time: 2010-01-01
## End time: 2024-10-01
ts_info(UNRATE)
## The UNRATE series is a xts object with 1 variable and 179 observations
## Frequency: monthly
## Start time: 2010-01-01
## End time: 2024-11-01
ts_info(CPIAUCSL)
## The CPIAUCSL series is a xts object with 1 variable and 179 observations
## Frequency: monthly
## Start time: 2010-01-01
## End time: 2024-11-01
PCE = PCE
UNRATE = UNRATE
CPIAUCSL = CPIAUCSL
#pick a smaller window (for aesthetic purposes)
pce_ss <- PCE["2010-01-31/2024-09-01"] |> ts_ts()
unrate_ss <- UNRATE["2010-01-31/2024-09-01"] |> ts_ts()
cpiaucsl_ss <- CPIAUCSL["2010-01-31/2024-09-01"] |> ts_ts()
#assemble it
mydata = cbind.data.frame(pce_ss, unrate_ss, cpiaucsl_ss)
#' Obtain first differences
mydf = mydata %>%
mutate(pceD1 = tsibble::difference(pce_ss, differences = 1),
unrateD1 = tsibble::difference(unrate_ss, differences = 1),
cpiaucslD1 = tsibble::difference(cpiaucsl_ss, differences = 1)
) %>% dplyr::select(c(pceD1, unrateD1, cpiaucslD1)) |> na.omit()
#colSums(is.na(mydf))
#convert to up,down, or no change
mydf_mat = apply(mydf, 2, sign)
#table(mydf_mat)
pos = apply(mydf_mat, 1, function(row) sum(row>0) ) # counts the positive
neg = apply(mydf_mat, 1, function(row) sum(row<0) ) # counts the negatives
tot = pos + neg
( index = (pos/tot - neg/tot)*100 )
#table(index)
cbind(mydf_mat, pos, neg, tot, index)
#ma_index = zoo::rollmean(index, 6,fill = NA, align = "right")
#length(ma_index)
Date = seq.Date(from = as.Date("2010-05-1"), length.out = 175, by = "month")
sa= cbind.data.frame(Date, index)
# Convert data to xts format (required by dygraphs)
data_xts <- xts(sa$index, order.by = sa$Date)
ma_index = zoo::rollmean(data_xts, 6,fill = NA, align = "right")
combined_xts <- cbind(data_xts, ma_index)
Economic Activity: The fluctuations in the diffusion index likely reflect changes in economic activity. Periods of high values like 100 in indicate strong economic growth, while low values might suggest a slowdown or contraction.
Trend: The upward trend in the smoothed line suggests that, overall, the US economy has been experiencing a period of expansion.
getSymbols("CFNAIDIFF",
freq = "monthly",
src = "FRED", return.class = 'xts',
index.class = 'Date',
from = "2010-01-01",
to = Sys.Date(),
periodicity = "monthly")
CFNAIDIFF=CFNAIDIFF
ts_info(CFNAIDIFF)
#pick a smaller window (for aesthetic purposes)
CFNAIDIFF_ss <- CFNAIDIFF["2010-01-31/2024-09-01"] |> ts_ts()
#assemble it
mydata1 = cbind.data.frame(CFNAIDIFF_ss)
#head(mydata1,3)
#' Obtain first differences
#mydf1 = mydata1 %>%
# mutate(CFNAIDIFFD1 = tsibble::difference(CFNAIDIFF_ss, differences = 1)
#) %>% dplyr::select(CFNAIDIFFD1) |> na.omit()
#convert to up,down, or no change
mydf_mat1 = apply(mydata1, 2, sign)
#table(mydf_mat1)
#mydf_mat1
pos1 = apply(mydf_mat1, 1, function(row) sum(row>0) ) # counts the positive
neg1 = apply(mydf_mat1, 1, function(row) sum(row<0) ) # counts the negatives
tot1 = pos1 + neg1
( index1 = (pos1/tot1 - neg1/tot1)*100 )
#table(index1)
cbind(mydf_mat1, pos1, neg1, tot1, index1)
#ma_index1 = zoo::rollmean(index1, 6, align = "right")
#length(ma_index1)
# match lengths (accounting for omits and the smoother lags)
ts_info(CFNAIDIFF)
#length(ma_index1)
Date1 = seq.Date(from = as.Date("2010-03-1"), length.out = 176, by = "month")
sa1= cbind.data.frame(Date1, CFNAIDIFF_ss)
length(Date1)
length(CFNAIDIFF_ss)
#length(index1)
# Convert data to xts format (required by dygraphs)
data_xts1 <- xts(sa1$CFNAIDIFF_ss, order.by = sa1$Date1)
The correlation value of -0.04067206 indicates an extremely weak negative correlation between the U.S. and Chicago diffusion indexes. This suggests that when one index rises, the other tends to decrease slightly, but the relationship is so weak that it is almost negligible.
Interpreting the Negative Correlation:
A correlation of -1 represents a perfect negative linear relationship, meaning that as one variable increases, the other decreases in exact proportion. A correlation of 0 indicates no linear relationship, implying the variables are independent of each other. A correlation of +1 denotes a perfect positive linear relationship, where both variables increase or decrease together in perfect proportion. With a correlation of -0.04, there is virtually no significant linear relationship between the two diffusion indexes. The slightly negative value suggests a minor inverse trend, but it is too weak to infer any meaningful connection.
The U.S. Economic Scorecard has demonstrated oscillating trends, frequently moving between positive and negative territories, typically within a moderate range. Notably, it displayed a positive trajectory up until October, signaling a potential recovery.
In contrast, the Chicago Diffusion Index has recently remained flat at -100, showing no fluctuations. Historically, there were periods where the Chicago Index mirrored the movements of the U.S. Economic Scorecard, such as in October-November 2010, May-June 2011, July 2012, July 2014, and November 2015. However, this mirrored behavior has broken in 2024, with the Chicago Index displaying a constant value, diverging from the U.S. Economic Scorecard’s positive oscillations.