Tuesday, July 19, 2011

Shorting Mebane Faber

Although I do not personally know Mebane Faber, I know enough that I do not want to short him.

However, I thought it would be insightful to see how the short side of his “A Quantitative Approach To Tactical Asset Allocation” might look.  Once we see how it looks, I think it confirms my focus on drawdown as my primary risk measure (see post Drawdown Control Can Also Determine Ending Wealth) and proves the difficulty of shorting upward sloping U.S. equities.

From TimelyPortfolio
From TimelyPortfolio
From TimelyPortfolio

I thought this chart was a nice modification of PerformanceAnalytics RiskReturnScatter.

From TimelyPortfolio

Here is an illustration of how all the other risk measures don't say much except for the drawdown number.

From TimelyPortfolio

R code (click to download):

require(quantmod)
require(PerformanceAnalytics)   #completely from the PerformanceAnalytics package chart.RiskReturn
#cannot claim any of the credit for the fine work in this package   chart.DrawdownReturn <- function (R, Rf = 0, main = "Annualized Return and Worst Drawdown", add.names = TRUE,
xlab = "WorstDrawdown", ylab = "Annualized Return", method = "calc",
geometric = TRUE, scale = NA, add.sharpe = c(1, 2, 3), add.boxplots = FALSE,
colorset = 1, symbolset = 1, element.color = "darkgray",
legend.loc = NULL, xlim = NULL, ylim = NULL, cex.legend = 1,
cex.axis = 0.8, cex.main = 1, cex.lab = 1, ...)
{
if (method == "calc")
x = checkData(R, method = "zoo")
else x = t(R)
if (!is.null(dim(Rf)))
Rf = checkData(Rf, method = "zoo")
columns = ncol(x)
rows = nrow(x)
columnnames = colnames(x)
rownames = rownames(x)
if (length(colorset) < columns)
colorset = rep(colorset, length.out = columns)
if (length(symbolset) < columns)
symbolset = rep(symbolset, length.out = columns)
if (method == "calc") {
comparison = cbind(t(Return.annualized(x[, columns:1])),
t(maxDrawdown(x[, columns:1])))
returns = comparison[, 1]
risk = comparison[, 2]
rnames = row.names(comparison)
}
else {
x = t(x[, ncol(x):1])
returns = x[, 1]
risk = x[, 2]
rnames = names(returns)
}
if (is.null(xlim[1]))
xlim = c(0, max(risk) + 0.02)
if (is.null(ylim[1]))
ylim = c(min(c(0, returns)), max(returns) + 0.02)
if (add.boxplots) {
original.layout <- par()
layout(matrix(c(2, 1, 0, 3), 2, 2, byrow = TRUE), c(1,
6), c(4, 1), )
par(mar = c(1, 1, 5, 2))
}
plot(returns ~ risk, xlab = "", ylab = "", las = 1, xlim = xlim,
ylim = ylim, col = colorset[columns:1], pch = symbolset[columns:1],
axes = FALSE, ...)
if (ylim[1] != 0) {
abline(h = 0, col = element.color)
}
axis(1, cex.axis = cex.axis, col = element.color)
axis(2, cex.axis = cex.axis, col = element.color)
if (!add.boxplots) {
title(ylab = ylab, cex.lab = cex.lab)
title(xlab = xlab, cex.lab = cex.lab)
}
if (!is.na(add.sharpe[1])) {
for (line in add.sharpe) {
abline(a = (Rf * 12), b = add.sharpe[line], col = "gray",
lty = 2)
}
}
if (add.names)
text(x = risk, y = returns, labels = rnames, pos = 4,
cex = 0.8, col = colorset[columns:1])
rug(side = 1, risk, col = element.color)
rug(side = 2, returns, col = element.color)
title(main = main, cex.main = cex.main)
if (!is.null(legend.loc)) {
legend(legend.loc, inset = 0.02, text.col = colorset,
col = colorset, cex = cex.legend, border.col = element.color,
pch = symbolset, bg = "white", legend = columnnames)
}
box(col = element.color)
if (add.boxplots) {
par(mar = c(1, 2, 5, 1))
boxplot(returns, axes = FALSE, ylim = ylim)
title(ylab = ylab, line = 0, cex.lab = cex.lab)
par(mar = c(5, 1, 1, 2))
boxplot(risk, horizontal = TRUE, axes = FALSE, ylim = xlim)
title(xlab = xlab, line = 1, cex.lab = cex.lab)
par(original.layout)
}
}     getSymbols("DJIA",src="FRED")
#if you prefer Yahoo! Finance
#getSymbols("^DJI",from="1919-01-01",to=Sys.Date())   DJIA <- to.monthly(DJIA)[,4]
index(DJIA) <- as.Date(index(DJIA))   signalUp <- ifelse(DJIA > runMean(DJIA,n=10), 1, 0)
signalDown <- ifelse(DJIA < runMean(DJIA,n=10), -1, 0)   retUp <- lag(signalUp,k=1)* ROC(DJIA,type="discrete",n=1)
retDown <- lag(signalDown, k=1) * ROC(DJIA,type="discrete",n=1)
ret <- merge(retUp + retDown,retUp,retDown,-retDown,ROC(DJIA,type="discrete",n=1))
colnames(ret) <- c("Combined","LongAbove","ShortBelow","LongBelow","DJIA")   #jpeg(filename="performance summary all.jpg",quality=100,
# width=6.25, height = 6.25, units="in",res=96)
charts.PerformanceSummary(ret,ylog=TRUE,
colorset=c("cadetblue","darkolivegreen3","goldenrod","purple","gray70"),
main="DJIA 10 Month Moving Average Strategy Comparisons
May 1896-Jun 2011"
)
#dev.off()
#jpeg(filename="performance summary before 1932.jpg",quality=100,
# width=6.25, height = 6.25, units="in",res=96)
charts.PerformanceSummary(ret["::1932-06",3],ylog=TRUE,
main="DJIA Short Below 10 Month Moving Average Works
May 1896-Jun 1932"
)
#dev.off()
#jpeg(filename="performance summary after 1932.jpg",quality=100,
# width=6.25, height = 6.25, units="in",res=96)
charts.PerformanceSummary(ret["1932-07::",3],ylog=TRUE,
main="DJIA Short Below 10 Month Moving Average Fails
Jul 1932-Jun 2011"
)
#dev.off()   #jpeg(filename="drawdown annualized return scatter.jpg",quality=100,
# width=6.25, height = 6.25, units="in",res=96)
chart.DrawdownReturn(ret[,1:5])
#dev.off()   #look at risk measures
require(ggplot2)
#jpeg(filename="risk.jpg",quality=100,width=6.25, height = 5,
# units="in",res=96)
downsideTable<-table.DownsideRisk(ret)
downsideTable<-melt(cbind(rownames(downsideTable),
downsideTable))
colnames(downsideTable)<-c("Statistic","Portfolio","Value")
ggplot(downsideTable, stat="identity",
aes(x=Statistic,y=Value,fill=Portfolio)) +
geom_bar(position="dodge") + coord_flip()
#dev.off()

Created by Pretty R at inside-R.org