Asset Pricing [7c : Macroeconomic factor model]

The previous post summarised some of the results obtained by applying the FB procedure in the context of a 60 month rolling window of fixed size across returns data spanning Jan 1995 to Dec 2010. As promised, this post will address what is essentially the same issue but in the context of the full sample. Instead of using the rolling time series regression estimates as inputs to the subsequent cross section regression for each month in the next year, the full sample approach involves a single time series regression on the basis of the total period and cross sectional regressions in every month of the available data. In other words, we are trading off time variation in beta (rolling windows) in favour of a simplistic approach that uses more data to estimate betas and which assumes constancy in estimated risk exposures over time. The individual estimates of risk premia obtained from the second stage of the FB method are then collated as before to provide a time series of estimates across each month of the available data. I have suppressed the intercept in the cross section regression for the full sample just to see what happens. I probably should have kept it in,but i cannot be bothered to change it right now.

f

[ Full Sample Approach ]

#######################################################################
#Full-Sample FamaMacbeth
#######################################################################</pre>
#store each regression in seperate list element
num.assets <- ncol(test.assets)
ts.reg.list <- list()

for(i in 1:num.assets){
 ts.reg.list[[i]] <- lm(test.assets[,i]~macrofactors.data)
}

#extract estimates
Ext.estim <- RegExtractor(x=ts.reg.list,type='est')
rownames(Ext.estim)<-colnames(test.assets)
colnames(Ext.estim)<-c('intercept',colnames(macrofactors.data))

#extract pvals
Ext.pval <- RegExtractor(x=ts.reg.list,type='pval')
rownames(Ext.pval)<-colnames(test.assets)
colnames(Ext.pval)<-c('intercept',colnames(macrofactors.data))

#extract rsq
Ext.rsq <- RegExtractor(x=ts.reg.list,type='rsq')*100
colnames(Ext.rsq)<-colnames(test.assets)

#Visualise Premia
windows()
rownames(Ext.estim)<-asset.names
melted.data <- melt(Ext.estim)
colnames(melted.data) <- c('Asset','Estimates','Value')
ggplot(melted.data, aes(Estimates, Value, fill=Asset)) +
 geom_bar(stat="identity") +
 facet_wrap(~Asset, nrow=5) +
 coord_flip()+
 theme_bw()

#Visualise p-values
windows()
rownames(Ext.pval)<-asset.names
melted.data <- melt(Ext.pval)
colnames(melted.data) <- c('Asset','PValue','Value')
ggplot(melted.data, aes(PValue, Value, fill=Asset)) +
 geom_bar(stat="identity") +
 facet_wrap(~Asset, nrow=5) +
 coord_flip()+
 theme_bw()

#Visualise Tables
windows()
est.tab <- round(Ext.estim,5)
 est.tab <- apply(est.tab, 2, rev)
 est.tab <- cbind(rev(asset.names),est.tab)
 par(mai=c(0.35,0.15,0.5,0.15))
 TableMaker(row.h=1,est.tab,c('Test Asset ',colnames(Ext.estim)),strip=F,strip.col=c('green','blue'),col.cut=0.05,alpha=0.7,border.col='lightgrey',text.col='black',header.bcol='blue',header.tcol='white',title=c('Time Series Estimates of parameters'))

windows()
pval.tab <- round(Ext.pval,5)
 pval.tab <- apply(pval.tab, 2, rev)
 pval.tab <- cbind(rev(asset.names),pval.tab)
 par(mai=c(0.35,0.15,0.5,0.15))
 TableMaker(row.h=1,pval.tab,c('Test Asset ',colnames(Ext.pval)),strip=T,strip.col=c('green','red'),col.cut=0.05,alpha=0.7,border.col='lightgrey',text.col='black',header.bcol='blue',header.tcol='white',title=c('Time Series p-val\n[Significance at the 5% level-GREEN]'))

#Cross section regression at each period t
cross.dep <- t(test.assets)
cross.beta <-Ext.estim[,-1]
rownames(cross.dep)<-asset.names
reg.coll <- list()

for(i in 1:ncol(cross.dep)){
 reg.coll[[i]]=lm(cross.dep[,i]~0+cross.beta)
}

#Extract parameters,t,pvalues,etc
full.num.t <- nrow(test.assets)
full.premia<- RegExtractor(reg.coll,type='est')
full.tval<- RegExtractor(reg.coll,type='tval')
full.pval <- RegExtractor(reg.coll,type='pval')
full.resid <- RegExtractor(reg.coll,type='res')

#Compute individual test
full.mean.premia <- colMeans(full.premia)
full.std.premia <- (apply(full.premia,2,var)/full.num.t)^0.5
full.t.stat <- full.mean.premia/(full.std.premia/(full.num.t^0.5))
full.p.val <- pt(-abs(full.t.stat),df=full.num.t-1)

#Compute joint test
full.num.t <- nrow(test.assets)
full.resid <- RegExtractor(reg.coll,type='res')
full.mean.resid <- rowMeans(full.resid)

alpha.diff1 <- full.resid-full.mean.resid
alpha.diff2 <- t(alpha.diff1)
alpha.sum <- alpha.diff1%*%alpha.diff2
cov.term <- alpha.sum/(full.num.t^2)

full.joint.test <- t(full.mean.resid)%*%ginv(cov.term)%*%full.mean.resid
#Visualise full sample premia
windows()
par(mai=c(0.2,0.50,0.2,0.25))
full.mean.premia<-matrix(full.mean.premia,ncol=numcol(macrofactors))
colnames(full.mean.premia)<-colnames(macrofactors)
layout(matrix(c(1,1,2),nrow=3,ncol=1))
col.scheme <- rainbow(20)[10:13]
plot(ylab='Estimates',xaxt='n',cex.main=0.85,cex.lab=0.75,cex.axis=0.75,main='Risk Premium estimates using full sample betas',ylim=c(min(full.premia),max(full.premia)),full.premia[,1],col='red',type='l')

for(i in 2:length(macrofactors)){
 lines(full.premia[,i],col=col.scheme[i])
}
legend(bty='o',y.intersp=1,title='Macroeconomic factors','topright',fill=c('red',col.scheme,'green','gold'),legend=c('MP - Chg. Industrial Production','UI - Unanticipated Infl','DEI - Chg.Expected Infl','UTS - Unanticipated ret on LT Bonds','UPR - BAA minus AAA yield','95% Significance','90% Significance'),ncol=1,bg='white',cex=0.75)
text(20,max(full.premia),paste("Joint Statistic :",round(full.joint.test,4)),cex=0.75)
text(20,max(full.premia)-0.02,paste("P-value :",round(1-pchisq(full.joint.test,df=24),4)),cex=0.75)

par(mai=c(0.55,0.50,0.2,0.25))
plot(ylab='P-Values',xlab='Dates',cex.main=0.85,cex.lab=0.75,cex.axis=0.75,main='Risk Premium P-values',ylim=c(min(full.pval),max(full.pval)),full.pval[,1],col='red',type='l')
for(i in 2:length(macrofactors)){
 lines(full.pval[,i],col=col.scheme[i])
}
abline(h=0.05,col='green',lwd=2)
abline(h=0.10,col='gold',lwd=2)
<pre>
#####################################################################################

f
I have summarised the time series estimates across the 25 randomly selected stocks using ggplot2 for a pleasant change :

s1

s3I have also extracted the p-values for the estimated risk exposures based on the full sample. It appears that only the MKT (excess market return) factor is consistently significant at the 5% level :

s2

s4As you can see, I have also attached the tabulated values corresponding to the data plotted for both ggplots. The green fields in the second table correspond to significant estimates at the 5% level and corroborate the conclusions reached from the collection of bar charts of the plot above.

Finally I have also plotted the second stage risk premia estimates (collected across time) as follows :

s5

The top plot shows how risk premia change across time for each previously estimated factor exposure. I have also computed the joint test along with its p-value (located in top left corner of plot). The null hypothesis, of pricing errors being jointly equal to 0, cannot be rejected…i think. The bottom plot simply shows the associated p-values and significance at the 5% and 10% levels. When p-values dip below the horizontal line(s) we can conclude statistical significance at the corresponding percent level.

As usual,take these posts with a grain of salt.

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: