[This article was first published on Timely Portfolio, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

---

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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()