[R-SIG-Finance] looking for functions that can test/estimate CAPM, APT, Fama's factor model, etc.

Mon Nov 13 21:35:54 CET 2006

This thread reminded me to post a somewhat improved and updated version of the code I was working on last year, re Fama French.
Most notably, I worked up something that would let me visualize how coefficients to value and growth factors change over time. The basic code could be modified to accomplish different goals, e.g. (getting significance test scores on the factors for the company you're looking at, doing the same for a longer list of companies). I once even created a version that treated a list of companies as longitudinal data, and used the lme package to do a mixed effects model for the FF-3 factor model for a list of companies within an industry. The interesting thing is that these coefficients are often not very stationary over time.

 I'm dropping the long, ugly, inadequately commented code below, and attatching it as a text file (I'm not an R-programmer, just someone who was willing to do a lot of trial and error and patch stuff together till I got the output I wanted. In the past some e-mail programs will mess up the code a little, by converting quotes or urls, so watch out for that. I did test it and it works as of R2.4 this afternoon on my Windows XP machine. Good luck.

getrffBeta= function(tool,span) {
require(MASS);
require(tseries);
require(wle)
require(zoo)
stock= (get.hist.quote(instrument = tool, quote =c("Ad"),compression="m",origin= as.Date(0)));
spx=(get.hist.quote(instrument = "^gspc", quote =c("Ad"),compression="m",origin= as.Date(0)));
today=Sys.Date();
seqmo=length(seq(as.Date("1926-07-01"),today,by="month"))-2;
url="http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors.zip";
destfile=tempfile();
dataff=download.file(url, destfile, mode='wb');
unzip=unz(destfile,"F-F_Research_Data_Factors.txt");
ff4 <- read.table(unzip, header=FALSE, sep="",na.strings="NA", dec=".", strip.white=TRUE, skip=4,nrows=seqmo)
ffdata <- ff4
attach(ffdata);
ffdata=ffdata/100
#find out starting year month for ffdata;
ffdatats=ts(ffdata, start=c(1926,7), frequency=12);
stock=ts(na.omit(coredata(stock)), start= as.numeric(as.yearmon(as.Date(start(stock)[1]))),
frequency=12);
spx=ts(na.remove(spx), start=
as.numeric(as.yearmon(as.Date(start(spx)[1]))),
frequency=12);
combined= na.remove(ts.union(stock,spx));
combreturn= na.remove(diff(log(combined)));
combined=na.remove(ts.intersect(combreturn,ffdatats), names=list("stockret", "spxret", "dates","ffmktret","smb","hml","rf"));
combined[,1]=combined[,1]-combined[,7]
combined[,2]=combined[,2]-combined[,7]
simplereg=lm(combined[,1]~combined[,4]);
stockbeta=simplereg$coef[2];
textout=paste("CAPM beta=", stockbeta);
robustreg=wle.lm(combined[,1]~combined[,4]);
robstockbeta=robustreg$coef[2];
textout2=paste("robust stock beta=", robstockbeta);
plot(as.numeric(combined[,1])~as.numeric(combined[,2]),xlab="Market",
ylab=tool)
title(main=textout, sub=list(textout2, col="red"))
abline(coef(simplereg));
abline(coef(robustreg),col="red")
print(textout);
print(textout2);
ffreg=wle.lm(combined[,1]~combined[,4]+combined[,5]+combined[,6]);
ffalpha=ffreg$coef[1]
ffbeta=ffreg$coef[2];
ffsmb=ffreg$coef[3];
ffhml=ffreg$coef[4] ;
textout3a= paste('robust ff alpha=',ffalpha) ;
textout3=paste('robust ff beta=',ffbeta) ;
textout4=paste('robust ff smb=',ffsmb) ;
textout5=paste('robust ff hml=',ffhml) ;
print(textout3a)
print(textout3) ;
print(textout4) ;
print(textout5) ;
rf=5
smb=1
hml=2
rm=5
ffcoe=rf+ffbeta*rm+ffsmb*smb+ffhml*hml
robcoe=rf+robstockbeta*rm
regcoe=rf+stockbeta*rm
textout6=paste('regular coe=',regcoe,' robustcoe=',
robcoe)
textout7=paste('Fama-French coe=',ffcoe)
print(textout6)
print(textout7) ;
ffreg2=lm(combined[,1]~combined[,4]+combined[,5]+combined[,6]);
a1=as.vector(combined[,1])
b1=as.vector(ffreg2$fitted)
c1=as.vector(simplereg$fitted)
plot3= (data.frame(a1,b1,c1))
win.graph()
panel.cor <- function(x, y, digits=2, prefix="", cex.cor)
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- abs(cor(x, y))
txt <- format(c(r, 0.123456789), digits=digits)[1]
txt <- paste(prefix, txt, sep="")
if(missing(cex.cor)) cex <- 0.8/strwidth(txt)
text(0.5, 0.5, txt, cex = cex * r)
}
pairs(plot3, upper.panel=panel.cor,labels=c("stock returns","FF fits","CAPM fits"))
ffreg2=lm(combined[,1]~combined[,4]+combined[,5]+combined[,6]);
zcombined=zoo(combined);

zoocoefcapmbeta=function(x) {
zoo.wle=wle.lm(x[,1]~x[,4]);
coef (zoo.wle)
}
rollcoefcapm=rollapply(zcombined,span,zoocoefcapmbeta,by.column=FALSE,align="right");
dfrollcoefcapm=as.data.frame(rollcoefcapm)
names(dfrollcoefcapm)[1]="alpha"
names(dfrollcoefcapm)[2]="mkt beta"
RollingCoefficientsCAPM=zoo(dfrollcoefcapm, order.by=index(rollcoefcapm))
win.graph()
plot(RollingCoefficientsCAPM)
zoocoefsa=function(x) {
zoo.wle=wle.lm(x[,1]~x[,4]+ x[,5]+ x[,6]);
coef (zoo.wle)
}
rollcoef=rollapply(zcombined,span,zoocoefsa,by.column=FALSE,align="right");
dfrollcoef=as.data.frame(rollcoef)
names(dfrollcoef)[1]="alpha"
names(dfrollcoef)[2]="mkt beta"
names(dfrollcoef)[3]="smb"
names(dfrollcoef)[4]="hml"
RollingCoefficients=zoo(dfrollcoef, order.by=index(rollcoef))
win.graph()
plot(RollingCoefficients)
compositecoef=merge(RollingCoefficients, RollingCoefficientsCAPM, zcombined[,7])
rollcapmcoe=function(x){
CAPMCOE=x[6]*rm+rf
}
rollffcoe=function(x){
FFCOE=x[2]*rm+x[3]*smb+x[4]*hml+rf
}
rollffbetacoe=function(x){
FFCOE=x[2]*rm +rf
}

rollffCOE=rollapply(compositecoef,1,rollffcoe,by.column=FALSE,align="right")
rollcapmCOE=rollapply(compositecoef,1,rollcapmcoe,by.column=FALSE,align="right")
rollffbetaCOE=rollapply(compositecoef,1,rollffbetacoe,by.column=FALSE,align="right")
dfrollcoe=as.data.frame(merge(rollffCOE,rollcapmCOE,rollffbetaCOE))
names(dfrollcoe)[1]="FFCOE"
names(dfrollcoe)[2]="CAPMCOE"
names(dfrollcoe)[3]="FF(beta)COE"
RollingCOE=zoo(dfrollcoe,order.by=index(rollcapmCOE))
win.graph()
plot(RollingCOE,plot.type="multiple")
if((AIC(simplereg))<(AIC(ffreg2))) "CAPM superior to FF" else "FF superior to CAPM";
}

----- Original Message ----
From: Brian G. Peterson <brian at braverock.com>
To: r-sig-finance at stat.math.ethz.ch
Sent: Monday, November 13, 2006 1:56:05 PM
Subject: Re: [R-SIG-Finance] looking for functions that can test/estimate CAPM, APT, Fama's factor model, etc.

On Monday 13 November 2006 12:13, Michael wrote:
> thanks a lot for your pointers! I've taken a look at the book and the R
> example website. That's super! Some of the examples there are very
> good.
>
> Yet I am still looking for Fama 3 factor model and Ross' APT
> implementation. The concept is not hard per se, however I am not sure
> how to classify some companies as H, and some companies as L and others
> as Value companies, and the others as Growth companies. There are a lot
> of implementation details that I am not sure of. Thus I guess learning
> from other people's implementation is a better approach for me as a
> green-hand.

Here's a great thread from this list last year about the Fama three-factor 
model:
http://blog.gmane.org/gmane.comp.lang.r.r-metrics/month=20050901

There is a ton of functionality in R for factor modeling, spread through 
lots of different packages.  I'd suggest that you do some searching on 
Primary Factor Analysis or Primary Component Analysis.

The best bet is to use the Value/Growth categorizations done by an 
external body, such as Reuters, Bloomberg, or S&P.  There doesn't seem to 
be much reason for you to independently categorize companies, especially 
in your learning stages.

For Arbitrage Pricing Theory, you've got to decide on a pricing model.  
There are many implementations of many pricing models in R.

> (The Rmetrics are not very complete I guess.)

RMetrics is very complete for what it does, with some notable exceptions 
(fixed income instruments).  I've generally had a lot of luck using 
functions from RMetrics as building blocks for more complex analysis.

Regards,

  - Brian

_______________________________________________
R-SIG-Finance at stat.math.ethz.ch mailing list
https://stat.ethz.ch/mailman/listinfo/r-sig-finance

___________________________________________________________________________________

http://voice.yahoo.com
-------------- next part --------------
An embedded and charset-unspecified text was scrubbed...
Name: getrffBeta.txt
Url: https://stat.ethz.ch/pipermail/r-sig-finance/attachments/20061113/d443ce24/attachment.txt 