Recession forecasting-Me

Build Model.R

#################################################
# Build a model
#################################################

#Choose Differencing window
#Hussman uses 6 months
Diff <- 6		
Data$PAYEMS <- (Data$PAYEMS-Lag(Data$PAYEMS,Diff))/Lag(Data$PAYEMS,Diff)
Data$UNRATE <- (Data$UNRATE-Lag(Data$UNRATE,Diff))/Lag(Data$UNRATE,Diff)
Data$SP500 <- (Data$SP500-Lag(Data$SP500,Diff))/Lag(Data$SP500,Diff)

#Omit rows missing X vars
Keep <- apply(is.na(Data[,-1]),1,sum)==0
Data <- Data[Keep,]

#Examine dataset
library(caTools)
head(Data)
sum(Data$USREC)
AUCdata <- na.omit(Data)
colAUC(AUCdata[,-1],AUCdata[,1],plot=TRUE)

#Model building function
#Takes an index, returns a prediction for the next index
fitmodel <- function(index,...) {

	#Load Relevant Data
	HistData <- data.frame(Data[1:(index-1),])
	CurrentData <- data.frame(Data[index,])

	#Fit model
	require(caret)
	model <- train(as.factor(Target)~.,HistData,metric = "ROC",...,
					trControl=trainControl(method='boot632',number=2,
						classProbs=TRUE,
						summaryFunction = twoClassSummary,
						verboseIter=FALSE)
					)					
	#Predict for next period
	out <- predict(model,CurrentData,"raw")
	row.names(out) <- NULL
	return(out)
}

#Use at least 12 months of recessions for training
TotalRec <- na.omit(as.numeric(cumsum(Data$Target)))
Start <- (1:length(TotalRec))[TotalRec==12]

#Roll the model through the dataset
require(pbapply)
indexes <- seq(Start,nrow(Data))		
predictions <- pbsapply(indexes,fitmodel,method='glm',tuneLength=1)
Data$pTarget <- c(rep(NA,Start-1),as.numeric(as.character(predictions)))

#################################################
# Evaluate model
#################################################
pTarget <- predictions
Target <- factor(as.numeric(Data$Target))
Target <- Target[(length(Target)-length(pTarget)+1):length(Target)]

#Confusion matrix
confusionMatrix(pTarget,Target,positive = '1')

Get Data.R

rm(list = ls(all = TRUE)) #CLEAR WORKSPACE
library(quantmod)

#################################################
# 1. Get Data
#################################################

#Credit Spreads
getSymbols('CP3M',src='FRED') #3-Month Commercial Paper (Old Series)
getSymbols('CPF3M',src='FRED') #3-Month Financial Commercial Paper (New Series)
ComPaper <- c(CP3M,CPF3M)
getSymbols('TB3MS',src='FRED') #3-Month Treasury
CS <- na.omit(ComPaper-TB3MS)
names(CS) <- 'CS'

#Stock Prices
getSymbols('^GSPC',src='yahoo',from='1900-01-01')
GSPC2 <- adjustOHLC(GSPC,use.Adjusted = TRUE) #Asjust for splits and dividends
GSPC <- Cl(to.monthly(GSPC))
library(lubridate)  #re-index to start of month
index(GSPC) <- as.Date(ISOdate(year(index(GSPC)),month(index(GSPC)),1))
SP500 <- GSPC
names(SP500) <- 'SP500'

#Purchasing Managers index
getSymbols('NAPM',src='FRED') #Non-farm emploment
PMI <- NAPM
names(PMI) <- 'PMI'

#Employment
getSymbols('PAYEMS',src='FRED') #Non-farm emploment
names(PAYEMS) <- 'PAYEMS'

#Unemployment
getSymbols('UNRATE',src='FRED')
names(UNRATE) <- 'UNRATE'

#Yeild Curve
getSymbols('GS10',src='FRED')
YC <- na.omit(GS10-TB3MS)
names(YC) <- 'YC'

#Kansas City Fed Financial Stress Indicator
getSymbols('KCFSI',src='FRED')
names(KCFSI) <- 'KCFSI'

#Recessions
getSymbols('USREC',src='FRED') 

#Recessions next month
Target <- Next(USREC)
names(Target) <- 'Target'

#Combine into one dataset
Data <- merge.xts(Target,USREC)	#Starts 1921
Data <- merge.xts(Data,PAYEMS)	#Starts 1939
Data <- merge.xts(Data,PMI)		#Starts 1948
Data <- merge.xts(Data,UNRATE)	#Starts 1948
Data <- merge.xts(Data,SP500)	#Starts 1950
Data <- merge.xts(Data,YC)		#Starts 1953
Data <- merge.xts(Data,CS)		#Starts 1971
#Data <- merge.xts(Data,KCFSI)	#Starts 1990