Fork me on GitHub

Interactive Analysis of Systematic Investor - PerformanceAnalytics Tables

In a previous post, I thought it would be good fun to take one of the posts from Systematic Investor and d3-ify it. Let's have a look at returns now using the mutliple tables provided by PerformanceAnalytics. I will just use the defaults on each of these tables and then plot the table with a dimplejs bar chart.

Copy/Paste Systematic Investor Brilliance

As before, let's start by getting the data and performing the calculations in R. This is a direct copy and paste from the Systematic Investor post. Thanks again Systematic Investor.

  1. #thanks Systematic Investor, Michael Kapler
  2. #for this post http://systematicinvestor.wordpress.com/2013/03/05/cluster-risk-parity-back-test/
  3. ###############################################################################
  4. # Load Systematic Investor Toolbox (SIT)
  5. # http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
  6. ###############################################################################
  7. setInternet2(TRUE)
  8. con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
  9. source(con)
  10. close(con)
  11. #*****************************************************************
  12. # Load historical data for ETFs
  13. #******************************************************************
  14. load.packages('quantmod')
  15. #tickers = spl('GLD,UUP,SPY,QQQ,IWM,EEM,EFA,IYR,USO,TLT')
  16. #to reduce calls to Yahoo I saved the data in .Rdata
  17. data <- new.env()
  18. load(url("http://timelyportfolio.github.io/rCharts_dimple_systematic/data.Rdata"),envir=data)
  19. #getSymbols(tickers, src = 'yahoo', from = '1900-01-01', env = data, auto.assign = T)
  20. #for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T)
  21. bt.prep(data, align='remove.na')
  22. #*****************************************************************
  23. # Code Strategies
  24. #******************************************************************
  25. periodicity = 'months'
  26. lookback.len = 250
  27. cluster.group = cluster.group.kmeans.90
  28. obj = portfolio.allocation.helper(
  29. data$prices,
  30. periodicity = periodicity, lookback.len = lookback.len,
  31. min.risk.fns = list(
  32. EW=equal.weight.portfolio,
  33. RP=risk.parity.portfolio,
  34. C.EW = distribute.weights(equal.weight.portfolio, cluster.group),
  35. C.RP=distribute.weights(risk.parity.portfolio, cluster.group)
  36. )
  37. )
  38. models = create.strategies(obj, data)$models

PerformanceAnalytics, Please Make All Your Tables

  1. #use rCharts to get some interactive plots
  2. require(rCharts)
  3. require(reshape2)
  4. #Performance Analytics wants the return series so let's merge returns into
  5. #a single xts object
  6. returns.xts <- do.call(merge,
  7. lapply(
  8. names(models),
  9. FUN=function(x){
  10. x.data <- models[[x]]$equity[endpoints(models[[x]]$equity,"months"),]
  11. colnames(x.data) <- x
  12. x.ret <- ROC( x.data, type = "discrete", n = 1 )
  13. return(x.ret)
  14. }
  15. )
  16. )[-(1:11),] #remove first 11 months since no data; will need to change if not monthly
  17. perfTables <- list()
  18. perfTables$AnnualizedReturns <- table.AnnualizedReturns(returns.xts)
  19. perfTables$Autocorrelation <- table.Autocorrelation(returns.xts)
  20. perfTables$CAPM <- table.CAPM(returns.xts[,-1],returns.xts[,1])
  21. perfTables$CalendarReturns <- table.CalendarReturns(returns.xts)[,-(1:12)]/100 #ignore monthly data
  22. perfTables$CaptureRatios <- t(table.CaptureRatios(returns.xts,returns.xts[,1]))
  23. perfTables$Correlation <- t(table.Correlation(returns.xts,returns.xts[,1]))
  24. perfTables$Distributions <- table.Distributions(returns.xts)
  25. perfTables$DownsideRisk <- table.DownsideRisk(returns.xts)[-7,] #remove drawdown
  26. perfTables$DownsideRiskRatio <- table.DownsideRiskRatio(returns.xts)
  27. perfTables$DrawdownsRatio <- table.DrawdownsRatio(returns.xts)
  28. perfTables$HigherMoments <- table.HigherMoments(returns.xts[,-1],returns.xts[,1])
  29. perfTables$InformationRatio <- table.InformationRatio(returns.xts[,-1],returns.xts[,1])
  30. perfTables$SpecificRisk <- table.SpecificRisk(returns.xts[,-1],returns.xts[,1])
  31. perfTables$TrailingPeriods <- table.TrailingPeriods(returns.xts)
  32. perfTables$Variability <- table.Variability( returns.xts )

rCharts, Please Make Us Lots of Bar Charts

  1. require(RColorBrewer)
  2. lapply(
  3. perfTables, #["InformationRatio"],
  4. FUN = function(x) {
  5. x.df <- data.frame( rownames(x),x )
  6. x.melt <- melt( x.df, id.vars = 1 )
  7. colnames( x.melt ) <- c( "metric", "strategy", "value")
  8. d1 <- dPlot(
  9. x = "value",
  10. y = c("metric","strategy"),
  11. groups = c("strategy"),
  12. data = x.melt,
  13. type = "bar",
  14. width = 800
  15. )
  16. d1$chart( x = 150, width = 550 ) #move over a little to allow room for y axis labels
  17. d1$yAxis( type = "addCategoryAxis", orderRule = rev(x.melt$metric) )
  18. d1$xAxis( type = "addMeasureAxis", outputFormat = ".2%" )
  19. d1$legend(
  20. x = 725,
  21. y = 10,
  22. width = 75,
  23. height = 100,
  24. horizontalAlign = "left"
  25. )
  26. d1$defaultColors(
  27. latticeExtra::theEconomist.theme()$superpose.line$col,
  28. replace=T
  29. )
  30. d1$show("iframe")
  31. }
  32. )

tables.AnnualizedReturns

tables.Autocorrelation

tables.CAPM

tables.CalendarReturns

tables.CaptureRatios

tables.Correlation

tables.Distributions

tables.DownsideRisk

tables.DownsideRiskRatio

tables.DrawdownsRatio

tables.HigherMoments

tables.InformationRatio

tables.SpecificRisk

tables.TrailingPeriods

tables.Variability

For an explanation of some of these risk and return measures, a good resource is