Asset Pricing [5a : Fama French 3 Factor Model]

Starting with Keim(1981) and Banz(1981) in the early 1980s, a number of researchers found evidence that variation in firm size (defined as total market capitalisation) could help explain differences in expected returns, lending some empirical heft to the intuition that small stocks have a tendency to outperform large stocks.  In and of itself, the outperformance of small cap stocks does not violate the CAPM as long as average returns and systematic risk line up in a linear and positive manner as per theory. As such, statistically significant evidence of small stock portfolios systematically deviating positively from the fitted CAPM line, constituted a violation of the simple theory. This small firm effect,the tendency of small stock portfolios to earn a greater average return than larger stock portfolios, has been traditionally attributed to growth opportunities,fund corrections and volatile business environments that characterise many smaller firms as well as behavioural/psychological factors that beset investors.

Starting with Graham and Dodd in the late 1930s, a different line of inquiry was cast to investigate what is now termed the value effect. Value stocks tend to have market values that are small relative to their accounting book values and earn higher average returns than growth stocks which have less favourable book to market ratios. While value stocks are believed to be undervalued by the market and hence fetch significant positive expected returns when price corrections occur,growth stocks,also known as glamour stocks, tend to be overvalued by market participants and hence garner lower return expectations. Since violations of the CAPM typically constitute joint puzzles of expected returns and beta, it is useful to point out that the existence of high B/M (value) stocks with low prices and high expected returns is not a violation of the CAPM as long as these higher expected returns are justified by greater systematic risk. When perusing through some of the evidence found across various standard papers, there seems to be a hierarchy of violations, with an unexplained alpha (deviation of actual data from estimated relation) being the lesser of two evils when a negative relation between beta and average returns also emerges from the data. Hence finding an unexplained alpha is a less severe indictment of the CAPM than a negative risk-return relation. In the context of the value effect, there is nothing principally wrong about value stocks (high B/M) having higher returns than more expensive stocks (or stock groupings) as long as they also have higher betas to justify their higher expected returns. It is this absence of a positive risk return relationship that constitutes the value puzzle and hence a violation of the CAPM.

It should also be noted that the strength of both small firm and value effects are time dependent. The size effect appears to have vanished over the past 10-15 years.The value effect lined up surprisingly well with risk in the periods before 1963, the higher-beta-higher expected return relation fell through the cracks in periods after 1963 with growth stock portfolios being exposed to a level of systematic risk comparable to that of value portfolios without the disproportionate positive payoff that the latter enjoys. While the spread of returns between value and growth stocks may have been sensible on both sides of 1963, the betas did not line up with expected returns as required.

Motivated by the idea that value stocks and small firms may be exposed to sources of systematic risk not covered by the traditional CAPM beta, Fama and French (1993) specified a 3 factor model to account for this omission.

Before showing how the Fama/French 3 factor model  produces better explanations of expected returns than the single factor model (CAPM) , it is helpful to visualise some of the empirical facts that motivated the model in the first place. In the following section, monthly returns for the 25 size and value sorted portfolios are downloaded from the Kenneth French website,filtered for missing values and subsequently plotted in excess form against time. The subset of the data considered ranges from July 1963 to December 1993, the same period covered by the original authors.

Importing data from CSV file,dealing with missing values and subsetting data

#####################################################################################

#Import CSV file(s)
sz.bm.df <- read.csv('size_book_25.csv',header=T)
ff.df <- read.csv('Factor_data.csv',header=T)

#Deal with missing values
szbm.tot.data <- ts(data=sz.bm.df,start=c(1926,7),end=c(2012,12),frequency=12)
na.idx <- apply(szbm.tot.data == -99.99, 1, any)
sub.start <- time(szbm.tot.data)[tail(which(na.idx), 1)+1]
sub.end <- last(time(szbm.tot.data))
ff.tot.data <- ts(data=ff.df,start=c(1926,7),end=c(2012,12),frequency=12)/100

sub.c.1 <- c(1963,7)
sub.c.2 <- c(1993,12)

szbm.ts.data <- window(szbm.tot.data, start=sub.c.1,end=sub.c.2)/100

#Align FF factors,rf data to non-missing observations

exc.mkt <- window(ff.tot.data[,1],start=sub.c.1,end=sub.c.2)
smb.fct <- window(ff.tot.data[,2],start=sub.c.1,end=sub.c.2)
hml.fct <- window(ff.tot.data[,3],start=sub.c.1,end=sub.c.2)
rf.ret <- window(ff.tot.data[,4],start=sub.c.1,end=sub.c.2)

gh
Extracting portfolios from the subsetted data into list objects,time series regressions

for(i in 1:5){
  #Size focus
	SZ.BM$size.port[[i]] <- szbm.ts.data[,beg[i]:end[i]]
	SZ.BM$size.port.mean[[i]] <-matrix(colMeans(SZ.BM$size.port[[i]]),nrow=5)
	colnames(SZ.BM$size.port[[i]]) <- paste('Value',1:5)
	rownames(SZ.BM$size.port.mean[[i]]) <- paste ('Value',1:5)
	colnames(SZ.BM$size.port.mean[[i]]) <- paste ('Size',i)
	Returns.s <- rbind(Returns.s,SZ.BM$size.port.mean[[i]])

	#Value focus
	BM.SZ$value.port[[i]] <- szbm.ts.data[,beg+(i-1)]
  BM.SZ$value.port.mean[[i]] <-matrix(colMeans(BM.SZ$value.port[[i]]),nrow=5)
  colnames(BM.SZ$value.port[[i]]) <- paste('Size',1:5)
	rownames(BM.SZ$value.port.mean[[i]]) <- paste ('Size',1:5)
	colnames(BM.SZ$value.port.mean[[i]]) <- paste ('Value',i)
	Returns.v <- rbind(Returns.v,BM.SZ$value.port.mean[[i]])

	#Excess Size focus,regressions
	SZ.BM$size.excess[[i]] <- SZ.BM$size.port[[i]]-rf.ret
		colnames(SZ.BM$size.excess[[i]]) <- paste('Value',1:5)

	##time series capm
	  s.temp <- SZ.BM$size.excess[[i]]
		SZ.BM$size.excess[[i]]$ts.obj <- lm(s.temp~exc.mkt)
		SZ.BM$size.excess[[i]]$ts.alphas <- as.matrix(coef(SZ.BM$size.excess[[i]]$ts.obj)[1,])
		SZ.BM$size.excess[[i]]$ts.betas <- as.matrix(coef(SZ.BM$size.excess[[i]]$ts.obj)[2,])
	  SZ.BM$size.excess[[i]]$ts.fitted <- fitted(SZ.BM$size.excess[[i]]$ts.obj)
	  s.betas[[i]] <- SZ.BM$size.excess[[i]]$ts.betas

	##time series FF
    SZ.BM$size.excess[[i]]$ff.obj <- lm(s.temp~exc.mkt+smb.fct+hml.fct)
		SZ.BM$size.excess[[i]]$ff.alphas <- as.matrix(coef(SZ.BM$size.excess[[i]]$ff.obj)[1,])
		SZ.BM$size.excess[[i]]$ff.betas <- as.matrix(coef(SZ.BM$size.excess[[i]]$ff.obj)[2:4,])
	  SZ.BM$size.excess[[i]]$ff.fitted <- fitted(SZ.BM$size.excess[[i]]$ff.obj)
	  s.ff.betas[[i]] <- SZ.BM$size.excess[[i]]$ff.betas

	#Excess Value focus,regressions
	BM.SZ$value.excess[[i]] <- BM.SZ$value.port[[i]]-rf.ret
		colnames(BM.SZ$value.excess[[i]]) <- paste('Size',1:5)

	##time series capm
	  v.temp <- BM.SZ$value.excess[[i]]
		BM.SZ$value.excess[[i]]$ts.obj <- lm(v.temp~exc.mkt)
		BM.SZ$value.excess[[i]]$ts.alphas <- as.matrix(coef(BM.SZ$value.excess[[i]]$ts.obj)[1,])
		BM.SZ$value.excess[[i]]$ts.betas <- as.matrix(coef(BM.SZ$value.excess[[i]]$ts.obj)[2,])
	  BM.SZ$value.excess[[i]]$ts.fitted <- fitted(BM.SZ$value.excess[[i]]$ts.obj)
	  v.betas[[i]] <- BM.SZ$value.excess[[i]]$ts.betas

		##time series FF
    BM.SZ$value.excess[[i]]$ff.obj <- lm(v.temp~exc.mkt+smb.fct+hml.fct)
		BM.SZ$value.excess[[i]]$ff.alphas <- as.matrix(coef(BM.SZ$value.excess[[i]]$ff.obj)[1,])
		BM.SZ$value.excess[[i]]$ff.betas <- as.matrix(coef(BM.SZ$value.excess[[i]]$ff.obj)[2:4,])
	  BM.SZ$value.excess[[i]]$ff.fitted <- fitted(BM.SZ$value.excess[[i]]$ff.obj)
	  v.ff.betas[[i]] <- BM.SZ$value.excess[[i]]$ff.betas

	##cross section capm
    cb <- colMeans(v.temp)
  	BM.SZ$value.excess.avg[[i]] <- cb
	  coeff3.rhs <- matrix(v.betas[[i]])
    BM.SZ$value.excess.avg[[i]]$cs.obj <- lm(cb~coeff3.rhs)
		BM.SZ$value.excess[[i]]$cs.alphas <- as.matrix(coef(BM.SZ$value.excess.avg[[i]]$cs.obj)[1])
		BM.SZ$value.excess[[i]]$cs.betas <- as.matrix(coef(BM.SZ$value.excess.avg[[i]]$cs.obj)[2])
	  BM.SZ$value.excess[[i]]$cs.fitted <- fitted(BM.SZ$value.excess.avg[[i]]$cs.obj)

  ##cross section ff
	  cs2.temp <- colMeans(v.temp)
	  BM.SZ$value.avg.ff[[i]] <- cs2.temp
	  coeff4.rhs <- matrix(t(v.ff.betas[[i]]),ncol=3)
    BM.SZ$value.avg.ff[[i]]$cs.obj <- lm(cs2.temp~coeff4.rhs)
		BM.SZ$value.avg.ff[[i]]$cs.alphas <- as.matrix(coef(BM.SZ$value.avg.ff[[i]]$cs.obj)[1])
		BM.SZ$value.avg.ff[[i]]$cs.betas <- as.matrix(coef(BM.SZ$value.avg.ff[[i]]$cs.obj)[2:4])
	  BM.SZ$value.avg.ff[[i]]$cs.fitted <- fitted(BM.SZ$value.avg.ff[[i]]$cs.obj)

	##Rsquared;pvalue
		SZ.BM$size.excess[[i]]$capm.p.a <- NULL
		SZ.BM$size.excess[[i]]$capm.p.b <- NULL

		BM.SZ$value.excess[[i]]$capm.p.a <- NULL
		BM.SZ$value.excess[[i]]$capm.p.b <- NULL

		SZ.BM$size.excess[[i]]$capm.rsq <- NULL
		BM.SZ$value.excess[[i]]$capm.rsq <- NULL

		SZ.BM$size.excess[[i]]$ff.p.a <- NULL
		SZ.BM$size.excess[[i]]$ff.p.mkt <- NULL
		SZ.BM$size.excess[[i]]$ff.p.smb <- NULL
		SZ.BM$size.excess[[i]]$ff.p.hml <- NULL

		SZ.BM$size.excess[[i]]$ff.rsq <- NULL

	  BM.SZ$value.excess[[i]]$ff.p.a <- NULL
		BM.SZ$value.excess[[i]]$ff.p.mkt <- NULL
		BM.SZ$value.excess[[i]]$ff.p.smb <- NULL
		BM.SZ$value.excess[[i]]$ff.p.hml <- NULL

		BM.SZ$value.excess[[i]]$ff.rsq <- NULL

	  for(j in 1:5){
	  	#capm.p
	  	SZ.BM$size.excess[[i]]$capm.p.a <- cbind(SZ.BM$size.excess[[i]]$capm.p.a,summary(SZ.BM$size.excess[[i]]$ts.obj)[[j]][[4]][1,4])
	  	SZ.BM$size.excess[[i]]$capm.p.b <- cbind(SZ.BM$size.excess[[i]]$capm.p.b,summary(SZ.BM$size.excess[[i]]$ts.obj)[[j]][[4]][2,4])
	  	BM.SZ$value.excess[[i]]$capm.p.a <- cbind(SZ.BM$size.excess[[i]]$capm.p.a,summary(BM.SZ$value.excess[[i]]$ts.obj)[[j]][[4]][1,4])
	  	BM.SZ$value.excess[[i]]$capm.p.b <- cbind(SZ.BM$size.excess[[i]]$capm.p.b,summary(BM.SZ$value.excess[[i]]$ts.obj)[[j]][[4]][2,4])

	  	#ff.p
	  	SZ.BM$size.excess[[i]]$ff.p.a <- cbind(SZ.BM$size.excess[[i]]$ff.p.a,summary(SZ.BM$size.excess[[i]]$ff.obj)[[j]][[4]][1,4])
	  	SZ.BM$size.excess[[i]]$ff.p.mkt <- cbind(SZ.BM$size.excess[[i]]$ff.p.mkt,summary(SZ.BM$size.excess[[i]]$ff.obj)[[j]][[4]][2,4])
	  	SZ.BM$size.excess[[i]]$ff.p.smb <- cbind(SZ.BM$size.excess[[i]]$ff.p.smb,summary(SZ.BM$size.excess[[i]]$ff.obj)[[j]][[4]][3,4])
	  	SZ.BM$size.excess[[i]]$ff.p.hml <- cbind(SZ.BM$size.excess[[i]]$ff.p.hml,summary(SZ.BM$size.excess[[i]]$ff.obj)[[j]][[4]][2,4])

	  	BM.SZ$value.excess[[i]]$ff.p.a <- cbind(BM.SZ$value.excess[[i]]$ff.p.a,summary(BM.SZ$value.excess[[i]]$ff.obj)[[j]][[4]][1,4])
	  	BM.SZ$value.excess[[i]]$ff.p.mkt <- cbind(BM.SZ$value.excess[[i]]$ff.p.mkt,summary(BM.SZ$value.excess[[i]]$ff.obj)[[j]][[4]][2,4])
	  	BM.SZ$value.excess[[i]]$ff.p.smb <- cbind(BM.SZ$value.excess[[i]]$ff.p.smb,summary(BM.SZ$value.excess[[i]]$ff.obj)[[j]][[4]][3,4])
	  	BM.SZ$value.excess[[i]]$ff.p.hml <- cbind(BM.SZ$value.excess[[i]]$ff.p.hml,summary(BM.SZ$value.excess[[i]]$ff.obj)[[j]][[4]][4,4])

	  	#Rsq
	  	SZ.BM$size.excess[[i]]$capm.rsq <- cbind(SZ.BM$size.excess[[i]]$capm.rsq,summary(SZ.BM$size.excess[[i]]$ts.obj)[[j]][[9]])
	  	BM.SZ$value.excess[[i]]$capm.rsq <- cbind(BM.SZ$value.excess[[i]]$capm.rsq,summary(BM.SZ$value.excess[[i]]$ts.obj)[[j]][[9]])

	  	SZ.BM$size.excess[[i]]$ff.rsq <- cbind(SZ.BM$size.excess[[i]]$ff.rsq,summary(SZ.BM$size.excess[[i]]$ff.obj)[[j]][[9]])
	  	BM.SZ$value.excess[[i]]$ff.rsq <- cbind(BM.SZ$value.excess[[i]]$ff.rsq,summary(BM.SZ$value.excess[[i]]$ff.obj)[[j]][[9]])

	  }
}

k
Clearly it would have been better to embed these in separate functions,but I cannot be bothered right now. Also for some inexplicable reason, the copied code does not align as it used to in previous posts on this blog.

To visualise the collective time series plots of the 25 portfolios :

#Collective Plots for excess returns
port.exc <- list()
col.bar <- adjustcolor(col='gold',alpha.f=0.65)
col.bar2 <- adjustcolor(col='white',alpha.f=0.5)

windows()
layout(matrix(c(1:25),nrow=5,ncol=5))
for(i in 1:5){
  port.exc[[i]] <- BM.SZ$value.port[[i]]-rf.ret
	for(j in 1:5){
		if(j==1 && i>1 && i<5)
		{
			par(mai=c(0.015,0.025,0.25,0.025))
		  plot(yaxt='n',xaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
			mtext(text=paste('BM Portfolios',i),side=3,cex=0.65)
			abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
			abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j>1 && j<5 && i>1 && i<5)
		{
			par(mai=c(0.015,0.025,0.015,0.025))
		  plot(yaxt='n',xaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
			abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
			abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j==1 && i==1)
		{
			par(mai=c(0.015,0.25,0.25,0.025))
		  plot(xaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
			mtext(text=paste('BM Portfolios',i),side=3,cex=0.65)
			abline(h=mean(port.exc[[i]][,j]),col=col.bar)
			abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j==1 && i==5)
		{
			par(mai=c(0.015,0.025,0.25,0.15))
		  plot(yaxt='n',xaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
			mtext(text=paste('Size Portfolios',j),side=4,cex=0.65)
			mtext(text=paste('BM Portfolios',i),side=3,cex=0.65)
			abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
			abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j>1 && j<5 && i==1)
		{
		  par(mai=c(0.015,0.25,0.015,0.025))
		  plot(xaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
			abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
			abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j==5 && i==1)
		{
			par(mai=c(0.25,0.25,0.015,0.025))
		  plot(xlab='',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
			abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
			abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j==5 && i>1 && i<5)
		{
			par(mai=c(0.25,0.025,0.015,0.025))
		  plot(xlab='',yaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
			abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
			abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j==5 && i==5)
		{
		 par(mai=c(0.25,0.025,0.015,0.15))
	   plot(yaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
     mtext(text=paste('Size Portfolio',j),cex=0.65,side=4)
		 abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
		 abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

		 legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
		else if(j>1 && j<5  && i==5)
		{
		 par(mai=c(0.025,0.025,0.015,0.15))
	   plot(xaxt='n',yaxt='n',cex.main=0.85,cex.lab=0.65,cex.axis=0.65,port.exc[[i]][,j])
     mtext(text=paste('Size Portfolio',j),cex=0.65,side=4)
		 abline(h=mean(port.exc[[i]][,j]),col=col.bar,lwd=round(mean(port.exc[[i]][,j])*600))
		 abline(h=mean(port.exc[[i]][,j]),col=col.bar2,lwd=round(mean(port.exc[[i]][,j])*250))

			legend('topright',fill=col.bar,legend=paste('Mean',round(mean(port.exc[[i]][,j]),5)*100),ncol=1,bg='white',bty='n',cex=0.6)
		}
	}
}

g

This generates the following plot along with a high quality image here

gg

 

This collective plot charts excess monthly returns across the 25 portfolios. The yellow line is simply the mean return associated with each portfolio scaled to visualise return differences. Size portfolio 1 is a collection of the smallest stocks while BM portfolio 1 is a collection of stocks with the lowest book-to-market ratios (growth stocks). Hence horizontal movements starting from the left mimics moving along the growth/value spectrum and vertical movements starting from the top mimics moving along the small cap/large cap spectrum.  Holding size constant, mean returns tend to increase as we move toward value stocks and away from growth stocks. Holding value constant,mean returns tend to decrease as we move toward large stocks and away from small stocks. Hence the greatest mean return comes from holding small size value stocks (top right corner),visually corroborated by the plot having the widest yellow bar.  

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: