Monday, August 22, 2011

Drawdown Visualization

Drawdown is my favorite measure of risk.  It picks up extended autocorrelated pain often not seen in risk measures, and best illustrates frustration, panic, and loss of confidence (Drawdown Control Can Also Determine Ending Wealth).  I thought I should try some new ways to see it in R.  This first graph uses the zoo package to show 20% drawdowns in light pink and 40% drawdowns in darker pink.

From TimelyPortfolio

PerformanceAnalytics makes drawdown graphs and overlays very easy, but for some reason I got an error in findDrawdowns, so I instead used the table.Drawdowns function to see the 5 worst drawdowns.

From TimelyPortfolio
From TimelyPortfolio

R code (click to download from Google Docs):

require(quantmod)
require(PerformanceAnalytics)   getSymbols("DJIA",src="FRED")
getSymbols("DJTA",src="FRED")
getSymbols("DJUA",src="FRED")   DJ <- merge(DJIA,DJTA,DJUA)   #DJ.yearly <- DJ[endpoints(DJ, on="years", k=1),]
DJ.roc <- ROC(DJ,n=1,type="discrete")
DJ.draw = Drawdowns(DJ.roc)   #jpeg(filename="DJ plot with Drawdowns zoo.jpg",
# quality=100,width=6.25, height = 6.25, units="in",res=96)
plot.zoo(log(DJ),plot.type="single",
col=c(2,3,4),ylab="log Price",xlab=NA,main="Dow Jones Indexes")
rgb <- hcl(c(0, 0, 260), c = c(100, 0, 100), l = c(50, 90, 50), alpha = 0.3)
xblocks(index(DJ),as.vector(DJ.draw[,1] < -0.20),col = rgb[1])
xblocks(index(DJ),as.vector(DJ.draw[,1] < -0.40),col = rgb[1])
legend("topleft",inset=0.05,colnames(DJ),fill=c(2,3,4),bg="white")
#dev.off()   #if we want to add linear models
#abline(lm(log(coredata(DJ[,1]))~as.Date(index(DJ))),col=2)
#abline(lm(log(coredata(DJ[,2]))~as.Date(index(DJ))),col=3)
#abline(lm(log(coredata(DJ[,3]))~as.Date(index(DJ))),col=4)     #another method of viewing drawdowns
#this is really easy with PerformanceAnalytics
#but for some reason I am getting an error
#with findDrawdowns
#will just shade worst drawdowns until I figure it out
drawdowns <- table.Drawdowns(DJ.roc[,1])
drawdowns.dates <- cbind(format(drawdowns$From),format(drawdowns$To))
drawdowns.dates[is.na(drawdowns.dates)] <- format(index(DJ.roc)[NROW(DJ.roc)])
# to get in proper list format
# thanks http://stackoverflow.com/questions/6819804/how-to-convert-a-matrix-to-a-list-in-r
drawdowns.dates <- lapply(seq_len(nrow(drawdowns.dates)), function(i) drawdowns.dates[i,])   #jpeg(filename="DJ plot with Drawdowns chart TimeSeries.jpg",
# quality=100,width=6.25, height = 6.25, units="in",res=96)
chart.TimeSeries(DJ,ylog=TRUE,
period.areas = drawdowns.dates,period.color = rgb[1],
colorset=c(2,3,4),
legend.loc="topleft",
main = "Dow Jones Indexes" )
#dev.off()
#or even fancier
#jpeg(filename="DJ plot with Drawdowns chart PerformanceSummary.jpg",
# quality=100,width=6.25, height = 8.25, units="in",res=96)
charts.PerformanceSummary(DJ.roc,ylog=TRUE,
period.areas = drawdowns.dates,period.color = rgb[1],
colorset=c(2,3,4),
legend.loc="topleft",
main = "Dow Jones Indexes" )
#dev.off()

Created by Pretty R at inside-R.org

3 comments:

  1. The function findDrawdowns should probably be internal rather than exposed, since it hands back a confusing list that needs to be sorted to make sense. But let me know what the error is and I'd be glad to take a look.

    Also, take a look at the example in ?chart.Event for another visualization of drawdowns, in this case stacking them for comparison.

    ReplyDelete
  2. Love the drawdown overlay chart but felt bad including the example. Maybe I should add just to publicize it since it is so neat. I could also extend to economic data series to demonstrate another use.

    Again, thanks for all of your work on this phenomenal package (really the reason I could finally wholeheartedly adopt R). If there is anything I can do besides extend documentation through examples, please let me know.

    ReplyDelete
  3. just discovered the error on findDrawdowns. 2011-05-30 and 2011-05-31 are NA, so once I change to 0, the function works perfectly. Why wouldn't checkData have kicked it out?

    Anyways I will make the change in the code.

    ReplyDelete