Asset Pricing [Part 3a: Initial Tests & Issues]

The third part of the asset pricing series will be concerned with some initial tests of the CAPM as well as an outline of associated shortcomings that complicate interpretation and testing. This post will just gather and subsequently summarise some of the key statistics associated with risky assets (subject to data availability). Absolute and relative return/risk statistics are adapted from this reference guide. Once again the rpanel package will be used to provide some control over the asset of interest.


#Visualise
years <- seq(1995,2012,by=1)
annot <- rev(c('AVG monthly gain','AVG monthly loss','Months in excess','Best Outperformance','Worst Underperformance','Up number ratio','Down number ratios','Up capture','Down capture','Upside proficiency','Downside proficiency'))
std <- apply(monthly.ret,2,sd)
mret <- colMeans(monthly.ret)

windows()
layout(matrix(c(1,1,1,1,1,2,2,3,3,3,2,2,4,4,4,2,2,5,5,5),byrow=T,nrow=4,ncol=5))

if (interactive()) {
 draw <- function(panel) {
 ret.tab <- matrix(round(t(stock.ret[,panel$asset]),3),nrow=12)
 ret.tab <- apply(ret.tab, 2, rev)

ret.stat <- matrix(round(t(KeyReturnStats(stock.ret[,panel$asset],bench.ret)),3))
 ret.stat <- apply(ret.stat, 2, rev)

ret.stat<-cbind(annot,ret.stat)

par(mai=c(0,0,0.2,0))
 TableMaker(ret.tab,years,strip=T,strip.col=c('red','green'),alpha=0.7,border.col='grey',text.col='black',header.bcol='darkgrey',header.tcol='white',title=paste('Key return statistics for',colnames(monthly.ret[,panel$asset]),sep=' '))

par(mai=c(0.3,0.15,0,0))
 TableMaker(ret.stat,c('Measures','Values'),strip=F,strip.col=c('red','green'),alpha=0.6,border.col='lightgrey',text.col='black',header.bcol='darkgrey',header.tcol='white',title='')

par(mai=c(0,0.25,0.15,0.25))
 plot(xaxt='n',yaxt='n',stock.ret[,panel$asset],col='blue',xlab='',ylab='',cex.main=0.85,cex.lab=0.7,cex.axis=0.8,lwd=1,cex=0.75)
 lines(bench.ret,col='green')
 grid()
 legend('topright',fill=c('blue','green'),legend=c('Asset','Market'),ncol=1,bg='white',bty='n',border=NA,cex=0.7)
 mtext(side=2,'Monthly Return',cex=0.7)

par(mai=c(0,0.25,0,0.25))
 #plot(xaxt='n',yaxt='n',stock.ann[,panel$asset],col='blue',xlab='',ylab='',cex.main=0.85,cex.lab=0.7,cex.axis=0.8,lwd=1,cex=0.75)
 #lines(bench.ann,col='green')
 #mtext(side=2,'Annual Return',cex=0.7)
 plot(ylim=c(min(mret)-0.005,max(mret)+0.005),std,mret,xaxt='n',yaxt='n',xlab='',ylab='',cex.main=0.85,cex.lab=0.7,cex.axis=0.8,lwd=1,cex=0.75,pch=0,col='darkgrey')
 points(std[panel$asset],mret[panel$asset],cex=1,col='red',pch=15)
 points(apply(market.ret,2,sd),mean(market.ret),cex=1,col='green',pch=17)
 legend('topright',pch=c(15,17,0),col=c('red','green','darkgrey'),legend=c('Choice','Market','Assets'),ncol=1,bg='white',bty='n',border='black',cex=0.7)
 abline(v=std[panel$asset],h=mret[panel$asset],col='red')
 text(x=min(std)+0.025,max(mret)+0.005,col='black',paste('Ret: ',round(mret[panel$asset],4),' Std: ',round(std[panel$asset],4),sep=' '),cex=0.75)
 par(mai=c(0.45,0.25,0,0.25))
 ret.temp <- matrix(stock.ret[,panel$asset],nrow=12)
 boxplot((ret.temp),notch=F,col=ifelse(colMeans(t(ret.temp))>0,'gold','red'),cex.main=0.85,cex.lab=0.7,cex.axis=0.8,lwd=1,cex=0.75,xaxt='n')
 axis(side=1,labels=years,at=1:length(years),cex.axis=0.75)

 panel
 }
 panel<- rp.control(asset=1)
 rp.slider(panel,asset,1,(ncol(monthly.ret)), action=draw,resolution=1,showvalue=TRUE)
}

This generates the following plot of key return statistics.

jd

High Quality Pdf : here

An animated gif helps visualise the return characteristics across risky assets as follows.

bolo_1

Key risk statistics can also be conveniently summarised in the following dashboard of plots.


#Time series regression

ts.list <- list()
	ts.list$fit <- list()
  ts.list$fitted <- list()
  ts.list$resid <- list()
  ts.list$alphas <-NULL
  ts.list$betas <- NULL
  ts.list$alpha.p <- NULL
  ts.list$beta.p <- NULL

for(i in 1:ncol(monthly.ret))
{
	ts.list$fit[[i]] <- lm(ex.ret[,i]~exm.ret)
	ts.list$fitted[[i]] <- as.matrix(ts.list$fit[[i]]$fitted.values)
	ts.list$resid[[i]] <- as.matrix(ts.list$fit[[i]]$residuals)
	ts.list$alphas <- rbind(ts.list$alphas,ts.list$fit[[i]][[1]][1])
	ts.list$betas <- rbind(ts.list$betas,ts.list$fit[[i]][[1]][2])
	ts.list$alphas.p <- rbind(ts.list$alphas.p,summary(ts.list$fit[[i]])[[4]][7])
	ts.list$betas.p <- rbind(ts.list$betas.p,summary(ts.list$fit[[i]])[[4]][8])
  print(paste('Creating list object for: ',colnames(monthly.ret)[i]))
}

sp.risk <- round(matrix(unlist(lapply(ts.list$resid,sd)),ncol=1),2)
sp.var <- sp.risk^2
mkt.var <- apply(bench.ret,2,sd)^2

sd.asset <- round(apply(monthly.ret,2,sd),2)
sd.var <- sd.asset^2

dec.mat <- cbind(colnames(monthly.ret),round(ts.list$betas,2),sd.asset,sp.risk)
colnames(dec.mat) <- c('Company','Beta','Asset SD','Residual SD')

mkt.risk <- (ts.list$betas^2)*mkt.var
dec.p<-cbind(mkt.risk,sp.var)
colnames(dec.p)<-c('systematic','idiosyncratic')

#Key Risk statistics
windows()
layout(matrix(c(1,2,2,1,3,4,1,5,5,1,6,6),nrow=4,ncol=3,byrow=T))

if (interactive()) {
  draw <- function(panel) {

  	a<-monthly.ret[,panel$asset,drop=F]

#risk measure table
std.m <- round(mon.std(a),3)
std.ann <- round(ann.std(a),3)
gain <- round(gain.std(a),3)
loss<-round(loss.std(a),3)
dd<-round(down.dev(a,mean(rf.ret)),3)
gl <- round(gl.risk(a),3)
sk <- round(skewness(a),3)[1]
kt <- round(kurtosis(a),3)[1]
mdd <- round(maxDrawdown(a),3)
asset.var <- round(as.numeric(VaR(a)),2)
asset.cvar <- round(as.numeric(CVaR(a)),2)
asset.jbt <- round(as.numeric(jarque.bera.test(a)[1]),2)
asset.starr <- round(as.numeric(colMeans(ex.ret)[1]/CVaR(a)),2)

sp.m <- as.numeric(round(sharpe.r (a,rf.ret),3))[1]
sp.a <- as.numeric(round(sharpe.r (a,rf.ret),3))[2]

calm <- as.numeric(round(CalmarRatio(a),3))
terl <- as.numeric(round(SterlingRatio(a),3))
sort <- as.numeric(round(SortinoRatio(a),3))
omg <- as.numeric(round(Omega(a),3))

annot <- c('STD(monthly)','STD(annualised)','STD(gain)','STD(loss)','DrawD','G/L Ratio','Skewness','Kurtosis','Max DD','Value@Risk','CValue@Risk','Jarque-Bera','STARR','Sharpe(monthly)','Sharpe(annual)','Calmar','Sterling','Sortino','Omega')
tab <- cbind(annot,rbind(std.m,std.ann,gain,loss,dd,gl,sk,kt,mdd,asset.var,asset.cvar,asset.jbt,asset.starr,sp.m,sp.a,calm,terl,sort,omg))

par(mai=c(0,0.1,0.3,0))
TableMaker(apply(tab,2,rev),c('Measure','Values'),strip=F,strip.col=c('red','green'),alpha=0.6,border.col='lightgrey',text.col='black',header.bcol='gold',header.tcol='black',title='Absolute\n Risk (adjusted) measures')

#hist plot
par(mai=c(0,0.5,0.3,0.2))

m<-hist(a,breaks=seq(min(a),max(a),length.out=100),plot=F)
hist(xaxt='n',main=paste('Histogram of Returns for',colnames(a)),xlab='',cex.lab=0.7,cex.axis=0.8,lwd=1,cex=0.75,cex.main=0.85,a,col=ifelse(m$breaks<as.numeric(VaR(a)),'red',ifelse(m$breaks<0,'orange',ifelse(m$breaks<as.numeric(abs(VaR(a))),'blue','green'))),breaks=seq(min(a),max(a),length.out=100))
legend(ncol=1,'topright',fill=c('red','orange','blue','green'),legend=c('Shortfall','Negative','Positive','Upside'),bg='white',bty='n',cex=0.7)
abline(v=VaR(a),col='black',lwd=1,lty=2)
text(x=VaR(a),y=7,pos=4,paste('VaR\n',round(VaR(a),2)),cex=0.7)
abline(v=CVaR(a),col='black',lwd=1,lty=2)
text(x=CVaR(a),y=7,pos=2,paste('CVaR\n',round(CVaR(a),2)),cex=0.7)

#Variance decomp
par(mai=c(0,0.2,0.4,0))
pie(main='Variance Decomposition',cex=0.85,labels=c(paste('systematic\n',round((dec.p[panel$asset,1]*100),3),'%'),paste('idiosyncratic\n',round((dec.p[panel$asset,2]*100),3),'%')),dec.p[panel$asset,],col=c('darkblue','gold'),cex.main=0.85)

#Relative risk adj return measures
alpha.ann <- round(((1+ts.list$alphas[panel$asset])^12)-1,3)
jens.alpha <- round(mean(a)-(mean(rf.ret)+ts.list$betas[panel$asset]*(mean(exm.ret))),3)
trey.r <- round((((1+mean(a)^12)-1) - ((1+(mean(rf.ret)^12))-1)) / ts.list$betas[panel$asset],3)
beta <- round(ts.list$betas[panel$asset],3)
inf.r <- round(InformationRatio(a,market.ret[,1]),3)

annot<-c('Annualised Alpha','Jensen-alpha','Tryenor','Beta','Information Ratio')
tel.tab <- cbind(annot,rbind(alpha.ann,jens.alpha,trey.r,beta,inf.r))

par(mai=c(0,0.1,0.4,0.2))
TableMaker(apply(tel.tab,2,rev),c('Measure','Values'),strip=F,strip.col=c('red','green'),alpha=0.6,border.col='lightgrey',text.col='black',header.bcol='gold',header.tcol='black',title='Relative\nRisk adjusted return measures')

#drawdowns

par(mai=c(0,0,0.2,0))
d.tab <-table.Drawdowns(a)
TableMaker(apply(d.tab,2,rev),colnames(d.tab),strip=F,strip.col=c('red','green'),alpha=0.6,border.col='lightgrey',text.col='black',header.bcol='gold',header.tcol='black',title='Drawdown Table & Chart')

par(mai=c(0.25,0.15,0,0.15))
chart.Drawdown(xlab='',main='',a,cex.main=0.8)

panel
  }
	panel<- rp.control(asset=1)
	rp.slider(panel,asset,1,(ncol(monthly.ret)), action=draw,resolution=1,showvalue=TRUE)
}

A snapshot of the result follows.

asd

 

The pdf file can be found here

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: