# Hidden Markov Models – Model Description Part 1 of 4

## Hidden Markov Models

This post will develop a general framework for classification tasks using hidden markov models. The tutorial series will cover how to build and train a hidden markov models in R. Initially the maths will be explained, then an example in R provided and then an application on financial data will be explored.

## General Pattern Recognition Framework

A set of features $\mathbf{o}$ are derived from data set $\mathbf{d}$ and a class $\omega$ identified by finding the most likely class given the data $\mathbf{o}$

$\hat{\omega}=argmax_{\omega}P(\omega|\mathbf{o})$

However $P(\omega|\mathbf{o})$ is unknown, so Bayes’ rule must be used.

$\hat{\omega}=argmax_{\omega}\frac{P(\mathbf{o}|\omega)P(\omega)}{P(\mathbf{o})}=argmax_{\omega}P(\mathbf{o}|\omega)P(\omega)$

Since the maximisation does not depend upon $P(\mathbf{o})$ we can ignore it. The terms $P(\mathbf{o}|\omega)$ and $P(\omega)$ , are the likelihood of the data given the class and prior probability of a class respective, both terms are defined by a model. The feature model $P(\mathbf{o}|\omega)$ will be described by the hidden markov model (HMM), each class will have it’s own HMM.

First we need to generate a set of features $\mathbf{o}$ from the raw data $\mathbf{d}$. I will skip this step for now because it is specific to the application of your hidden markov model, for example in finance $\mathbf{d}$ may be various stock prices and $\mathbf{o}$ could be a set of technical indicators / volatility calculations applied to the data $\mathbf{d}$. HMM’s are popular in speech recognition and typically $\mathbf{o}$ is a vector describing the characteristics of the frequency spectrum of the speech.

Secondly the feature vector $\mathbf{o}$ must then be assigned a class from the HMM. This is done the via maximum likelihood estimation, the HMM is a generative model, choose the class that is most likely to have generated the feature vector $\mathbf{o}$.
For finance the class might be a market regime (trending/mean reverting) or in speech recognition the class is a word.

## Example HMM Specification

$N$ The number of states in the HMM

$a_{ij}$ The probability of transitioning from state i to state j

$b_{j}(\mathbf{o})$ The probability of generating feature vector $\mathbf{o}$ upon entering state j (provided j is not the entry or exit state)

The HMM $\lambda$ may be written as $\lambda=[N,a_{ij},b_{j}]$

$\mathbf{O}=[\mathbf{o_{1},}\mathbf{o_{2},o_{T}]}$ the observed feature vectors

$X=[x_{1},x_{2},x_{T}]$ the specified state sequence

The joint probability is the probability of jumping from one state to the next multiplied by the prob of generating the feature vector in that state:

$p(\mathbf{O},X|\lambda)=a_{x_{0},x_{1}}\prod_{t=1}^{T}b_{x_{t}}(\mathbf{o_{t}})a_{x_{t},x_{t+1}}$

Where $x_{0}$ is always the entry state 1, and $x_{T+1}$ is always the exit state N.

## Likelihood Calculation

In the above joint probability calculation we have assumed a state sequence $X$. However this is a latent variable, we do not know it, it is hidden (hence the name HIDDEN markov model)! However if we sum over all possible state sequences we can marginalise it out.

$p(\mathbf{O}|\lambda)=\sum_{X}p(\mathbf{O},X|\lambda)$

This can be problematic due to the number of possible state sequences (especially in a real-time application), luckily algorithms exist to effectively perform the calculation without needing to explore every state sequence. One such algorithm is the forward algorithm.

## What is $b_{j}(\mathbf{o})$?

This is the output distribution for a given state j. The distribution can be anything you like however it should hopefully match the distribution of the data at state j, and it must be mathematically tractable. The most natural choice at this stage is to assume $\mathbf{o}$ can be described by the multivariate Gaussian. As a word of caution if the elements of your feature vector are highly correlated then $\Sigma$, the covariance matrix, has a lot of parameters to measure. See if you can collapse $\Sigma$
to a diagonal matrix.

E.g $b_{j}(\mathbf{o})\sim N(\mathbf{o};\mu_{j},\Sigma_{j})$

## How to train $b_{j}(\mathbf{o})$ / Viterbi Parameter Estimation

We already know how to fit a normal distribution, the MLE for $\mu$ is the mean, and $\Sigma$ the covariance of the feature vector. However we must only calculate the mean and covariance on feature vectors that came from state j, this is known as Viterbi Segmentation. Viterbi Segmentation means there is a hard assignment between feature vector and the state that generated it, an alternative method is called Balm-Welch which probabilistically assigns feature vectors to multiple states.

State j generated observations starting at $t_{j}$

$\hat{\mu}_{j}=\frac{1}{t_{j+1}-t_{j}}\sum_{t=t_{j}}^{t_{j+1}-1}\mathbf{o_{t}}$

$\hat{\mathbf{\Sigma}}_{j}=\frac{1}{t_{j+1}-t_{j}}\sum_{t=t_{j}}^{t_{j+1}-1}[(\mathbf{o_{t}-\hat{\mu}_{j}})(\mathbf{o_{t}-\hat{\mu}_{j}})$

It is not known in advance which state generated which observation vector, fortunately there is an algorithm called the Viterbi algorithm to approximately solve this problem.

The forward algorithm for efficient calculation of $p(\mathbf{O}|\lambda)$ and the Viterbi algorithm will be explored in my next post.

# Economic Data In R – Nonfarms Payroll & Other FED Data

This post is a simple demo to show how to get economic data into R.The data comes from the Federal Reserve Bank of St Louis http://research.stlouisfed.org/fred2/.

I will show how to download Nonfarms Payroll numbers, although it is very easy to modify the code below to download GDP, CPI etc…

The top chart shows non-farms plotted with the S&P 500. It is interesting to note that in the % change charts there is a crash in the market around mid 08 this is then followed by a crash in the non-farms numbers. Although not a very rigorous analysis it looks like non-farms numbers LAG the market.

The second chart regress the % change in payrolls with the % change in the S&P for the month. It is seen in the scatter plot that there is no clear relationship between payroll change and S&P change.

The second regression on the right takes this months payroll change and regress it against next months S&P return, ie try and see if the numbers from this month can tell us anything about the return in the S&P for the coming month. Payrolls don’t look very predictive at the 1month time horizon. I think a more interesting analysis would look at payrolls on the market over 10,20,30min horizons intraday.

Onto the code:

?View Code RSPLUS
 library("quantmod")   #To see what the datasets are available from the FED goto the link below #http://research.stlouisfed.org/fred2/   economicData <- new.env() #Make a new environment for quantmod to store data in   startDate = as.Date("2000-01-01") #Specify what date to get the prices from getSymbols("PAYEMS",src="FRED",env=economicData,from=startDate) #Payems is non-farms payrolls getSymbols("^GSPC",env=economicData,from=startDate) #S&P 500       economicData$PAYEMS <- window(economicData$PAYEMS,start=startDate) #Window our data (FRED ignores the from parameter above) :@ economicData$GSPC <- window(economicData$GSPC,start=startDate) #Window our data   mergedData <- merge(economicData$PAYEMS,Cl(economicData$GSPC),all=FALSE) #join the two datasets based on their SHARED dates   #Calculate the % diff mergedPercDiff<- mergedData mergedPercDiff$PAYEMS <- diff(mergedData$PAYEMS)/Lag(mergedData$PAYEMS) mergedPercDiff$GSPC.Close <- diff(mergedData$GSPC.Close)/Lag(mergedData$GSPC.Close)   dev.new() par(mfrow=c(2,2)) plot(mergedData$PAYEMS, main="Non-Farm Payrolls",ylab="Thousands of Persons") plot(mergedPercDiff$PAYEMS, main="Non-Farm Payrolls", ylab="% Change") plot(mergedData$GSPC.Close, main="S&P 500 Close",ylab="Close Price") plot(mergedPercDiff$GSPC.Close, main="&P 500 Close",ylab="% Change")   #Function to plot data and add regression line doPlot <- function(x,y,title,xlabel,ylabel){ x<-as.vector(x) y<-as.vector(y) regression <- lm(y~x) print(regression) plot(y~x,main=title, xlab=xlabel,ylab=ylabel) abline(regression,col="red",lwd=1.5) legend("bottomleft",paste("y=",regression$coefficients[2],"x+",regression$coefficients[1],sep=""),bg="lightblue") }   dev.new() par(mfrow=c(1,2)) doPlot(mergedPercDiff$PAYEMS,mergedPercDiff$GSPC.Close,"Regress Non-Farms Payroll with S&P Monthly Returns","Non-Farms Monthly % Change","S&P 500 Monthly % Change") doPlot(Lag(mergedPercDiff$PAYEMS),mergedPercDiff$GSPC.Close,"Regress Non-Farms Payroll with NEXT MONTH'S S&P Monthly Return","Non-Farms Monthly % Change","S&P 500 Monthly % Change")

# K-Nearest Neighbour Algo – Find Closest Period in History

Happy New Year! This post is going to continue on from my last post on the K-nearest algo http://gekkoquant.com/2013/12/02/k-nearest-neighbour-algo-fail/.

In the last post I speculated that the poor performance of the algo was potentially down to trying to compare the current day and find the most similar days in history, rather we should try to take the last N days and find the most similar period in history.

The code below does exactly that use windowSize to control how big the periods are that we compare.

Sharpe ratio: -0.537182

Sharpe ratio: -0.591864

The performance is still poor, perhaps the similarity measure i’m using is rubbish. Maybe using implied vol would be good for identifying market regimes and should be used in the similarity measure.

Unfortunately this algo is very very slow (and gets worse over time since we have more history to look back over), this makes it difficult / time consuming to optimise variables.

Onto the code:

?View Code RSPLUS

# Linear Regression Curves vs Bollinger Bands

In my last post I showed what a linear regression curve was, this post will use it as part of a mean reverting trading strategy.

The strategy is simple:

• Calculate a rolling ‘average’ and a rolling ‘deviation’
• If the Close price is greater than the average+n*deviation go short (and close when you cross the mean)
• If the Close price is less than the average-n*deviation go long (and close when you cross the mean)

Two cases will be analysed, one strategy will use a simple moving average(SMA), the other will use the linear regression curve(LRC) for the average. The deviation function will be Standard Devation, Average True Range, and LRCDeviation (same as standard deviation but replace the mean with the LRC).

Results (Lookback = 20 and Deviation Multiplier = 2:

Annualized Sharpe Ratio (Rf=0%)

• GSPC = 0.05257118
• Simple Moving Avg – Standard Deviation = 0.2535342
• Simple Moving Avg – Average True Range = 0.1165512
• Simple Moving Avg – LRC Deviation 0.296234
• Linear Regression Curve – Standard Deviation = 0.2818447
• Linear Regression Curve – Average True Range = 0.5824727
• Linear Regression Curve – LRC Deviation = 0.04672071

Optimisation analysis:

Annoyingly the colour scale is different between the two charts, however the sharpe ratio is written in each cell. Lighter colours indicate better performance.

Over a 13year period and trading the GSPC the LRC achieved a sharpe of ~0.6 where as the SMA achieved a sharpe of ~0.3. The LRC appears superior to the SMA.

I will update this post at a later point in time when my optimisation has finished running for the other strategies.

?View Code RSPLUS
 library("quantmod") library("PerformanceAnalytics") library("zoo") library("gplots")   #INPUTS marketSymbol <- "^GSPC"   nLookback <- 20 #The lookback to calcute the moving average / linear regression curve / average true range / standard deviation nDeviation <- 2   #Specify dates for downloading data, training models and running simulation startDate = as.Date("2000-01-01") #Specify what date to get the prices from symbolData <- new.env() #Make a new environment for quantmod to store data in   stockCleanNameFunc <- function(name){ return(sub("^","",name,fixed=TRUE)) }   getSymbols(marketSymbol, env = symbolData, src = "yahoo", from = startDate) cleanName <- stockCleanNameFunc(marketSymbol) mktData <- get(cleanName,symbolData)   linearRegressionCurve <- function(data,n){   regression <- function(dataBlock){ fit <-lm(dataBlock~seq(1,length(dataBlock),1)) return(last(fitfitted.values)) } return (rollapply(data,width=n,regression,align="right",by.column=FALSE,na.pad=TRUE)) } linearRegressionCurveStandardDeviation <- function(data,n){ deviation <- function(dataBlock){ fit <-lm(dataBlock~seq(1,length(dataBlock),1)) quasiMean <- (last(fitfitted.values)) quasiMean <- rep(quasiMean,length(dataBlock)) stDev <- sqrt((1/length(dataBlock))* sum((dataBlock - quasiMean)^2)) return (stDev) } return (rollapply(data,width=n,deviation,align="right",by.column=FALSE,na.pad=TRUE)) }   reduceLongTradeEntriesToTradOpenOrClosedSignal <- function(trades){ #Takes something like #000011110000-1-1000011 (1 = go long, -1 = go short) #and turns it into #00001111111100000011   #trades[is.na(trades)] <- 0 out <- trades #copy the datastructure over currentPos <-0 for(i in 1:length(out[,1])){ if((currentPos == 0) & (trades[i,1]==1)){ currentPos <- 1 out[i,1] <- currentPos next } if((currentPos == 1) & (trades[i,1]==-1)){ currentPos <- 0 out[i,1] <- currentPos next } out[i,1] <- currentPos }   return(out) }   reduceShortTradeEntriesToTradOpenOrClosedSignal <- function(trades){ return(-1*reduceLongTradeEntriesToTradOpenOrClosedSignal(-1*trades)) }   generateTradingReturns <- function(mktPrices, nLookback, nDeviation, avgFunction, deviationFunction,title,showGraph=TRUE){ quasiMean <- avgFunction(mktPrices,n=nLookback) quasiDeviation <- deviationFunction(mktPrices,n=nLookback) colnames(quasiMean) <- "QuasiMean" colnames(quasiDeviation) <- "QuasiDeviation" price <- Cl(mktPrices)   upperThreshold = quasiMean + nDeviation*quasiDeviation lowerThreshold = quasiMean - nDeviation*quasiDeviation   aboveUpperBand <- price>upperThreshold belowLowerBand <- pricequasiMean belowMAvg <- price 0){ colorFunc <- rgb(0,(255*x/4)/255 , 0/255, 1) } else { colorFunc <- rgb((255*(-1*x)/4)/255,0 , 0/255, 1) } }   optimiseTradingStrat <- function(mktData,lookbackStart,lookbackEnd,lookbackStep,deviationStart,deviationEnd,deviationStep,strategy,title){ lookbackRange <- seq(lookbackStart,lookbackEnd,lookbackStep) deviationRange <- seq(deviationStart,deviationEnd,deviationStep) combinations <- length(lookbackRange)*length(deviationRange) combLookback <- rep(lookbackRange,each=combinations/length(lookbackRange)) combDeviation <- rep(deviationRange,combinations/length(deviationRange))   optimisationMatrix <- t(rbind(t(combLookback),t(combDeviation),rep(NA,combinations),rep(NA,combinations),rep(NA,combinations))) colnames(optimisationMatrix) <- c("Lookback","Deviation","SharpeRatio","CumulativeReturns","MaxDrawDown")   for(i in 1:length(optimisationMatrix[,1])){ print(paste("On run",i,"out of",length(optimisationMatrix[,1]),"nLookback=",optimisationMatrix[i,"Lookback"],"nDeviation=",optimisationMatrix[i,"Deviation"])) runReturns <- strategy(mktData,optimisationMatrix[i,"Lookback"],optimisationMatrix[i,"Deviation"]) optimisationMatrix[i,"SharpeRatio"] <- SharpeRatio.annualized(runReturns) optimisationMatrix[i,"CumulativeReturns"] <- sum(runReturns) optimisationMatrix[i,"MaxDrawDown"] <- maxDrawdown(runReturns,geometric=FALSE) print(optimisationMatrix) } print(optimisationMatrix)       dev.new() z <- matrix(optimisationMatrix[,"SharpeRatio"],nrow=length(lookbackRange),ncol=length(deviationRange),byrow=TRUE) colors <- colorFunc(optimisationMatrix[,"SharpeRatio"])   rownames(z) <- lookbackRange colnames(z) <-deviationRange heatmap.2(z, key=TRUE,trace="none",cellnote=round(z,digits=2),Rowv=NA, Colv=NA, scale="column", margins=c(5,10),xlab="Deviation",ylab="Lookback",main=paste("Sharpe Ratio for Strategy",title))   }   if(FALSE){ dev.new() plot(Cl(mktData),type="l",main=paste(marketSymbol, "close prices")) lines(SMA(Cl(mktData),n=50),col="red",type="l") lines(linearRegressionCurve(Cl(mktData),n=50),col="blue",type="l") legend('bottomright',c("Close",paste("Simple Moving Average Lookback=50"),paste("Linear Regression Curve Lookback=50")),lty=1, col=c('black', 'red', 'blue'), bty='n', cex=.75) }   nLookbackStart <- 20 nLookbackEnd <- 200 nLookbackStep <- 20 nDeviationStart <- 1 nDeviationEnd <- 2.5 nDeviationStep <- 0.1 #optimiseTradingStrat(mktData,nLookbackStart,nLookbackEnd,nLookbackStep,nDeviationStart,nDeviationEnd,nDeviationStep,strategySMAandSTDEV,"AvgFunc=SMA and DeviationFunc=STDEV") #optimiseTradingStrat(mktData,nLookbackStart,nLookbackEnd,nLookbackStep,nDeviationStart,nDeviationEnd,nDeviationStep,strategySMAandATR,"AvgFunc=SMA and DeviationFunc=ATR") #optimiseTradingStrat(mktData,nLookbackStart,nLookbackEnd,nLookbackStep,nDeviationStart,nDeviationEnd,nDeviationStep,strategySMAandLRCDev,"AvgFunc=SMA and DeviationFunc=LRCDev") #optimiseTradingStrat(mktData,nLookbackStart,nLookbackEnd,nLookbackStep,nDeviationStart,nDeviationEnd,nDeviationStep,strategyLRCandSTDEV,"AvgFunc=LRC and DeviationFunc=STDEV") #optimiseTradingStrat(mktData,nLookbackStart,nLookbackEnd,nLookbackStep,nDeviationStart,nDeviationEnd,nDeviationStep,strategyLRCandATR,"AvgFunc=LRC and DeviationFunc=ATR") #doptimiseTradingStrat(mktData,nLookbackStart,nLookbackEnd,nLookbackStep,nDeviationStart,nDeviationEnd,nDeviationStep,strategyLRCandLRCDev,"AvgFunc=LRC and DeviationFunc=LRCDev")