# 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 :

I 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 :

As 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 :

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.