Tuesday, November 22, 2011

Risk and Return by Size/Momentum and Industry

In lots of previous posts, I have demonstrated how to use the wonderful and free Kenneth French data in R, but I have not shown a basic risk/return plot by size/momentum and industry.  Hopefully, it will just be another example that somebody somewhere will find useful.

From TimelyPortfolio
From TimelyPortfolio

R code in GIST:

Magical RUT with GIST

In search of better ways to post my R code, I finally discovered how GIST can help make my R blogging easier.  I know I am way behind, and I apologize to my loyal readers for my shortcomings.  Here is yesterday’s Magical Russell 2000 code using GIST:

Monday, November 21, 2011

Magical Russell 2000

I have marveled at the magical Russell 2000 in Crazy RUT, but I am still surprised at its behavior through this selloff.  With a 20-day move of 30% (6% in one hour) and big outperformance to the developed and developing world, the Russell 2000 continues its magical display.

From TimelyPortfolio

R code:

#look at distance from the 3 month minimum
#to compare the magical US Russell 2000
#to the world

require(quantmod)

tkrs <- c("^W2DOW","^RUT")

getSymbols(tkrs,from="1896-01-01",to=Sys.Date())

#merge the closing values
markets <- na.omit(merge(W2DOW[,4],RUT[,4]))

#this is ugly but it works
altitude <- function(x) x/min(x)-1
mins <- as.xts(apply(markets[(NROW(markets)-250):NROW(markets),1:2],
    MARGIN=2,FUN=
    altitude))
plot.zoo(mins,screens=1,
    col=c("cadetblue4","darkolivegreen3"),
    lwd=2,ylab="% from 250 day minimum",xlab=NA,
    main="Russell 2000 and DJ World ex US
    Distance from 250 Day Minimum")
legend("bottom",c("DJ World ex US","Russell 2000"),lty=1,lwd=2,
    col=c("cadetblue4","darkolivegreen3"),horiz=TRUE)

Sunday, November 20, 2011

Cross Pollination from Systematic Investor

After reading the fine article Style Analysis from Systematic Investor and What we can learn from Bill Miller and the Legg Mason Value Trust from Asymmetric Investment Returns, I thought I should combine the two in R with the FactorAnalytics package.  Let’s explore the Legg Mason Value Trust run by Bill Miller to get some insight into the source of his returns over many years by using the Ken French momentum by size data set as factors.

From TimelyPortfolio
From TimelyPortfolio
From TimelyPortfolio

R code (click to download from Google Docs):

#use Ken French momentum style indexes for style analysis
#http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/6_Portfolios_ME_Prior_12_2.zip   require(PerformanceAnalytics)
require(FactorAnalytics)
require(quantmod)   my.url="http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/6_Portfolios_ME_Prior_12_2.zip"
my.tempfile<-paste(tempdir(),"\\frenchmomentum.zip",sep="")
my.usefile<-paste(tempdir(),"\\6_Portfolios_ME_Prior_12_2.txt",sep="")
download.file(my.url, my.tempfile, method="auto",
quiet = FALSE, mode = "wb",cacheOK = TRUE)
unzip(my.tempfile,exdir=tempdir(),junkpath=TRUE)
#read space delimited text file extracted from zip
french_momentum <- read.table(file=my.usefile,
header = TRUE, sep = "",
as.is = TRUE,
skip = 12, nrows=1017)
colnames(french_momentum) <- c(paste("Small",
colnames(french_momentum)[1:3],sep="."),
paste("Large",colnames(french_momentum)[1:3],sep="."))   #get dates ready for xts index
datestoformat <- rownames(french_momentum)
datestoformat <- paste(substr(datestoformat,1,4),
substr(datestoformat,5,7),"01",sep="-")   #get xts for analysis
french_momentum_xts <- as.xts(french_momentum[,1:6],
order.by=as.Date(datestoformat))   french_momentum_xts <- french_momentum_xts/100   #get price series from monthly returns
french_price<-as.xts(
apply(1+coredata(french_momentum_xts[,1:6]),MARGIN=2,cumprod),
index(french_momentum_xts))
#check data for reasonability
plot.zoo(french_price,log="y")   #for this example let's use Bill Miller's fund
getSymbols("LMVTX",from="1896-01-01", to=Sys.Date(), adjust=TRUE)
LMVTX <- to.monthly(LMVTX)
index(LMVTX) <- as.Date(format(as.Date(index(LMVTX)),"%Y-%m-01"))
LMVTX.roc <- ROC(LMVTX[,4],type="discrete",n=1)   perfComp <- na.omit(merge(LMVTX.roc,french_momentum_xts))   chart.RollingStyle(perfComp[,1],perfComp[,2:NCOL(perfComp)],
width=36,
colorset=c("darkseagreen1","darkseagreen3","darkseagreen4","slateblue1","slateblue3","slateblue4"),
main="LMVTX Rolling 36mo French Momentum Weights")
#could use the packaged chart.Style but does not allow the
#flexibility I would like
#chart.Style(perfComp[,1],perfComp[,2:NCOL(perfComp)],
# colorset=c("darkseagreen1","darkseagreen3","darkseagreen4","slateblue1","slateblue3","slateblue4"),
# main="LMVTX French Momentum Weights")   #get weights for the cumulative period
style.weight <- as.matrix(style.fit(perfComp[,1],
perfComp[,2:NCOL(perfComp)])$weights)
barplot(style.weight,beside=TRUE,ylim=c(0,max(style.weight)+0.2),
names.arg=rownames(style.weight),cex.names=0.7,
col=c("darkseagreen1","darkseagreen3","darkseagreen4",
"slateblue1","slateblue3","slateblue4"),
main=paste("LMVTX French Momentum Weights
Since "
,format(index(LMVTX)[1],"%b %Y"),sep=""))   #look at total R to determine goodness of fit
style.R <- style.fit(perfComp[,1],
perfComp[,2:NCOL(perfComp)])$R.squared     styleR <- function(x) {
as.numeric(style.fit(R.fund=x[,1,drop=FALSE],R.style=x[,2:NCOL(x),drop=FALSE],method="constrained",selection="none",leverage=FALSE)$R.squared)
}
#convert to matrix since I get
#error "The data cannot be converted into a time series."
#when I use xts as data
style.RollingR <- as.xts(rollapply(data=as.matrix(perfComp),
width=12,FUN=styleR,by.column=FALSE,by=1),
order.by=index(perfComp)[12:NROW(perfComp)])
chart.TimeSeries(style.RollingR,ylab="Rolling 12-mo R",
main=paste("LMVTX Rolling R versus French Momentum
Since "
,format(index(LMVTX)[1],"%b %Y"),sep=""))
abline(h=style.R,col="indianred")
text(x=1,y=style.R,labels="r for entire series",adj=0,col="indianred")

Created by Pretty R at inside-R.org

Friday, November 18, 2011

Let the Lagging Lead

THIS IS NOT INVESTMENT ADVICE AND WILL PROBABLY WIPE OUT ALL YOUR MONEY IF PURSUED.  While exploring utilities, I discovered a strange phenomenon that I have not quite thoroughly understood, but I attribute to the business cycle.  If I dust off the system proposed in Unrequited lm Love, apply that signal to utilities as my total entry/exit, and then use relative strength to decide utilities or transports (really all cyclicals work with chemicals best), I get some magic. This is much longer than my normal simple process but I think the result might be worth the effort.

From TimelyPortfolio

Although I use the Kenneth French data set (thanks again), the method works very similarly on the Dow Jones series easily obtained through getSymbols with Yahoo! Finance or FRED.

Sloppy R code (Click to Download from Google Docs):

#get very helpful Ken French data
#for this project we will look at Industry Portfolios
#http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/17_Industry_Portfolios.zip   require(PerformanceAnalytics)
require(quantmod)
require(RColorBrewer)   #my.url will be the location of the zip file with the data
my.url="http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/17_Industry_Portfolios.zip"
#this will be the temp file set up for the zip file
my.tempfile<-paste(tempdir(),"\\frenchindustry.zip",sep="")
#my.usefile is the name of the txt file with the data
my.usefile<-paste(tempdir(),"\\17_Industry_Portfolios.txt",sep="")
download.file(my.url, my.tempfile, method="auto",
quiet = FALSE, mode = "wb",cacheOK = TRUE)
unzip(my.tempfile,exdir=tempdir(),junkpath=TRUE)
#read space delimited text file extracted from zip
french_industry <- read.table(file=my.usefile,
header = TRUE, sep = "",
as.is = TRUE,
skip = 11, nrows=1021)   #get dates ready for xts index
datestoformat <- rownames(french_industry)
datestoformat <- paste(substr(datestoformat,1,4),
substr(datestoformat,5,7),"01",sep="-")   #get xts for analysis
french_industry_xts <- as.xts(french_industry[,1:17],
order.by=as.Date(datestoformat))   french_industry_xts <- french_industry_xts/100   #get price series from monthly returns for utilities and transports
Utils <- cumprod(1+french_industry_xts[,14])
Trans <- cumprod(1+french_industry_xts[,13]) #use chemicals #6 for best result
Utilsmean <- runMean(Utils,n=4)   #get relative strength Utils to Transports
UtilsTrans <- Utils/Trans   width = 3
for (i in (width+1):NROW(Utils)) {
linmod <- lm(Utils[((i-width):i),1]~index(Utils[((i-width):i)]))
ifelse(i==width+1,signal <- coredata(linmod$residuals[length(linmod$residuals)]),
signal <- rbind(signal,coredata(linmod$residuals[length(linmod$residuals)])))
ifelse(i==width+1,signal2 <- coredata(linmod$coefficients[2]),
signal2 <- rbind(signal2,coredata(linmod$coefficients[2])))
ifelse(i==width+1,signal3 <- cor(linmod$fitted.values,Utils[((i-width):i),1]),
signal3 <- rbind(signal3,cor(linmod$fitted.values,Utils[((i-width):i),1])))
}   signal <- as.xts(signal,order.by=index(Utils[(width+1):NROW(Utils)]))
signal2 <- as.xts(signal2,order.by=index(Utils[(width+1):NROW(Utils)]))
signal3 <- as.xts(signal3,order.by=index(Utils[(width+1):NROW(Utils)]))
signal4 <- ifelse(Utils > Utilsmean,1,0)   price_ret_signal <- merge(Utils,
lag(signal,k=1),
lag(signal2,k=1),
lag(signal3,k=1),
lag(signal4,k=1),
lag(ROC(Utils,type="discrete",n=4),k=1),
ROC(Utils,type="discrete",n=1))
price_ret_signal[,2] <- price_ret_signal[,2]/price_ret_signal[,1]
price_ret_signal[,3] <- price_ret_signal[,3]/price_ret_signal[,1]
ret <- ifelse((price_ret_signal[,5] == 1) | (price_ret_signal[,5] == 0 &
runMean(price_ret_signal[,3],n=12) > 0 & runMean(price_ret_signal[,2],n=3) < 0 ),
1, 0) * price_ret_signal[,7]
retCompare <- merge(ret, price_ret_signal[,7])
colnames(retCompare) <- c("Linear System", "BuyHoldUtils")
#jpeg(filename="performance summary.jpg",
# quality=100,width=6.25, height = 8, units="in",res=96)
charts.PerformanceSummary(retCompare,ylog=TRUE,cex.legend=1.2,
colorset=c("black","gray70"),main="Utils System Return Comparison")   #eliminate NA at start of return series
retCompare[is.na(retCompare)] <- 0
price_system <- merge(Utils,ifelse((price_ret_signal[,5] == 1) |
(price_ret_signal[,5] == 0 &
runMean(price_ret_signal[,3],n=12) > 0 &
runMean(price_ret_signal[,2],n=3) < 0 ),
NA, 1),coredata(Utils)[width+12]*cumprod(retCompare[,1]+1))
price_system[,2] <- price_system[,1]*price_system[,2]
colnames(price_system) <- c("In","Out","System")   chartSeries(price_system$System,theme="white",log=TRUE,up.col="black",
yrange=c(min(price_system[,c(1,3)]),max(price_system[,c(1,3)])),
TA="addTA(price_system$In,on=1,col=3);
addTA(price_system$Out,on=1,col=2)"
,
name="Utils Linear Model System")   #let's try an easy relative strength signal to choose small cap or large cap
#know I can do this better in R but here is my ugly code
#to calculate 12 month or 1 year slope of utils/trans
width=12
#get relative strength slope of high beta/low vol
for (i in 1:(NROW(UtilsTrans)-width)) {
model<-lm(UtilsTrans[i:(i+width),1]~index(UtilsTrans[i:(i+width)]))
ifelse(i==1,indexRS<-model$coefficients[2],indexRS<-rbind(indexRS,model$coefficients[2]))
}
indexRS<-xts(cbind(indexRS),order.by=index(UtilsTrans)[(width+1):NROW(UtilsTrans)])   price_ret_signal <- na.omit(merge(price_ret_signal, lag(indexRS,k=1), ROC(Trans,type="discrete",n=1)))
#use same linear system signal for in out but add RS to choose Russell 2000 or SP500
retRS <- ifelse((price_ret_signal[,5] == 1) | (price_ret_signal[,5] == 0 &
runMean(price_ret_signal[,3],n=12) > 0 & runMean(price_ret_signal[,2],n=3) < 0 ),
1, 0) * ifelse(price_ret_signal[,8]<0,price_ret_signal[,9],price_ret_signal[,7])
retCompareWithRS <- na.omit(merge(retRS,retCompare,ROC(Trans, n=1, type="discrete")))
colnames(retCompareWithRS) <- c("Linear.With.RS",colnames(retCompareWithRS)[2:3],
"BuyHoldTrans")   #jpeg(filename="performance summary.jpg",
# quality=100,width=6.25, height = 8, units="in",res=96)
charts.PerformanceSummary(retCompareWithRS,ylog=TRUE,cex.legend=1.2,
main="Utility and Transports System Rotator", colorset=brewer.pal(4,"Paired"))
mtext("Source: http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/data_library.html",
side=1,adj=0,cex=0.75)
#dev.off()   corr <- runCor(price_ret_signal[,7],price_ret_signal[,9],n=12)
plot.zoo(corr)

Created by Pretty R at inside-R.org

Thursday, November 17, 2011

Very Fine Work at Systematic Investor

I just wanted to quickly highlight the extremely fine work being done over at http://systematicinvestor.wordpress.com/.  The well documented statistical finance examples (mostly in R) are extremely helpful and stimulating.

Some of my favorites are

Black-Litterman Model

Maximizing Omega Ratio

Expected shortfall (CVaR) and Conditional Drawdown at Risk (CDaR)

Be sure to check it out.

Wednesday, November 16, 2011

Update on Scary Derivatives

After reading Bloomberg’s article,

JPMorgan Chase & Co. and Goldman Sachs Group Inc., among the world’s biggest traders of credit derivatives, disclosed to shareholders that they have sold protection on more than $5 trillion of debt globally.

http://bloom.bg/txiyuG

I thought we should update my post Scary Derivatives and Scary XML in R in which I said

The massive damage caused in 2008-2009 by the sliver of derivatives called credit default swaps seems like a faint warning siren when we see that they only represent < 7% of total derivatives exposure. Interest rate and currency derivatives, also where I think the next disaster occurs, are more than 10 times larger than these credit contracts at $226 Trillion.

From TimelyPortfolio

This amount of money, bilaterally netted or not, is truly unbelievable and staggering.  Total debt outstanding of the sovereign nations is not the real problem.  Like housing, the exponential exacerbation caused by the leverage and derivatives traded on the underlying is where the real potential catastrophe occurs.  No government and no central bank has the ability to counter any major damage in currencies or interest rates.

 

R code (click to download from Google Docs):

#read xml derivatives data from the
#US Treasury OCC Quarterly Derivatives Report
#2 methods
#still way too manual since it appears the format changes
#each reporting period

#as far as I can tell
#the first published example of how to read
#Microsoft Excel xml workbooks

require(XML)
#require(ggplot2)

#get 2nd Quarter of 2011 report (dq211)
url = "http://www.occ.treas.gov/topics/capital-markets/financial-markets/trading/derivatives/dq211-xml.xml"

doc = xmlInternalTreeParse(url)
#define namespaces
#figuring this out took hours
#but using getNodeSet was much cleaner than the
#next method
namespaces = c(o="urn:schemas-microsoft-com:office:office",
    x="urn:schemas-microsoft-com:office:excel",
    ss="urn:schemas-microsoft-com:office:spreadsheet",
    html="http://www.w3.org/TR/REC-html40")
#this gets row 41 from the Table 3 worksheet for the total $ of derivatives
ns <- getNodeSet(doc,"/ss:Workbook/ss:Worksheet[@ss:Name='Table 3']/ss:Table/ss:Row",namespaces)[[41]]
amt <- df <- as.data.frame(as.numeric(xmlSApply(ns, xmlValue))[4:11])
#believe it or not this is $trillions of dollars
#remove some zeros so we can label better on the graph
amt <- amt/1000000
df <- df/1000000
#this gets row 10 for labels
ns <- getNodeSet(doc,"/ss:Workbook/ss:Worksheet[@ss:Name='Table 3']/ss:Table/ss:Row",namespaces)[[10]]
lab <- as.character(xmlSApply(ns, xmlValue)[4:11])
#combine the labels with
df <- cbind(lab,df)
#jpeg(filename="derivatives by type.jpg",quality=100,
#    width=6.25, height = 8,  units="in",res=96)
barplot(df[5:8,2],names.arg = factor(df[5:8,1]),main="US Bank Derivatives by Type
    Q2 2011",ylab="$ (in trillions)",ylim=c(0,max(df[5:8,2]+50)),space=0,
    col=c("indianred4","darkolivegreen4","cadetblue4","goldenrod3"))
mtext("Source: US Dept of Treasury OCC Quarterly Derivatives Report",
    side=1,line=3,cex=0.8,adj=0)
#dev.off()

Tuesday, November 1, 2011

Evolving Domestic Frontier

When we learn the efficient frontier, most are misled to believe that the frontier is static and unchanging.  However, we should have all learned by recent experience that the frontier is as volatile as the assets that construct it.  If we look at just US Stocks (SP 500) and US Bonds (Barclays Agg), we can see how this shifting frontier can dramatically affect your returns.

Using R and fPortfolio, let’s construct the frontier every rolling 5-year period to see what has happened since 1975.

From TimelyPortfolio

R code (click to download from Google Docs):

require(quantmod)
require(fPortfolio)
require(reshape)   #############################################################
#get data; unfortunately cannot share since I would violate
#copyright
sp_agg <- read.csv("C:\\Users\\Kent.TLEAVELL_NT\\Documents\\old\\R\\sp_agg.csv",stringsAsFactors=FALSE)
sp_agg <- sp_agg[2:NROW(sp_agg),3:NCOL(sp_agg)]
sp_agg <- sp_agg[,c(1,3,5)]   len <- nchar(sp_agg[,1])
xtsdate <- paste(substr(sp_agg[,1],len-3,len),"-",
ifelse(len==9,"0",""),substr(sp_agg[,1],1,len-8),"-01",sep="")   sp_agg.xts <- xts(data.matrix(sp_agg[,2:NCOL(sp_agg)]),order.by=as.Date(xtsdate))
sp_agg.xts <- sp_agg.xts/100
#############################################################     #for svg
#require(Cairo)
#CairoSVG("frontier.svg", width=8 ,height=8 )
#jpeg(filename="evolving frontier.jpg",
# quality=100,width=6, height = 7.5, units="in",res=96)#############################################################
## spec -
Spec = portfolioSpec()
setTargetReturn(Spec) = mean(colMeans(as.timeSeries(sp_agg.xts)))   ## constraints -
Constraints = "LongOnly"
#get frontiers by 5-year range
from = time(as.timeSeries(sp_agg.xts))[c(1,1,49,109,169,229,289,349,385)]
to = time(as.timeSeries(sp_agg.xts))[c(NROW(sp_agg.xts),48,108,168,228,288,348,NROW(sp_agg.xts)-8,NROW(sp_agg.xts)-8)]   rollFron <- rollingPortfolioFrontier(as.timeSeries(sp_agg.xts),Spec,Constraints,
from=from,to=to)   #chartcol <- topo.colors(length(rollFron))
chartcol <- 1:length(rollFron)
#hindsight bias; yellow is too hard to read so change
chartcol[length(rollFron)-2] <- "goldenrod"     i=1
frontierPlot(rollFron[[1]],col=rep(chartcol[1],2),xlim=c(0,0.08),ylim=c(-0.01,0.025))
frontierlabels <- frontierPoints(rollFron[[i]])
text(x=frontierlabels[NROW(frontierlabels),1],y=frontierlabels[NROW(frontierlabels),2],
labels=paste(from[i]," to ",to[i],sep=""),
pos=4,offset=0.5,cex=0.5,col = chartcol[i])   for (i in 2:(length(rollFron)-3) ) {
frontierPlot(rollFron[[i]],add=TRUE,col = rep(chartcol[i],2),pch=19,auto=FALSE,
title=FALSE)
frontierlabels <- frontierPoints(rollFron[[i]])
text(x=frontierlabels[NROW(frontierlabels),1],y=frontierlabels[NROW(frontierlabels),2],
labels=paste(from[i]," to ",to[i],sep=""),
pos=4,offset=0.5,cex=0.5,col = chartcol[i])
}   i=7
lowerFrontier = frontierPoints(rollFron[[i]], frontier = "both")
points(lowerFrontier,col = rep(chartcol[i],2),pch=19)
frontierlabels <- frontierPoints(rollFron[[i]])
text(x=frontierlabels[1,1],y=frontierlabels[1,2],
labels=paste(from[i]," to ",to[i],sep=""),
pos=4,offset=0.5,cex=0.5,col = chartcol[i])     #legend("topright",legend=paste(from,to,sep=" "),pch=19,
# col=chartcol,cex=0.7)
for (i in 8:length(rollFron)) {
lowerFrontier = frontierPoints(rollFron[[i]], frontier = "lower")
points(lowerFrontier,col = rep(chartcol[i],2),pch=19)
frontierlabels <- frontierPoints(rollFron[[i]],frontier="lower")
text(x=frontierlabels[1,1],y=frontierlabels[1,2],
labels=paste(from[i]," to ",to[i],sep=""),
pos=4,offset=0.5,cex=0.5,col = chartcol[i])
}
#
#frontier <- portfolioFrontier(as.timeSeries(sp_agg.xts))
#frontierPlot(frontier,col=rep(chartcol[length(rollFron)+1],2),add=TRUE,pch=19,auto=FALSE,
# title=FALSE)   #dev.off()

Created by Pretty R at inside-R.org