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.

#thanks Systematic Investor, Michael Kapler
#for this post http://systematicinvestor.wordpress.com/2013/03/05/cluster-risk-parity-back-test/

###############################################################################
# Load Systematic Investor Toolbox (SIT)
# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
###############################################################################
setInternet2(TRUE)
con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
source(con)
close(con)

#*****************************************************************
# Load historical data for ETFs
#****************************************************************** 
load.packages('quantmod')

#tickers = spl('GLD,UUP,SPY,QQQ,IWM,EEM,EFA,IYR,USO,TLT')
#to reduce calls to Yahoo I saved the data in .Rdata
data <- new.env()
load(url("http://timelyportfolio.github.io/rCharts_dimple_systematic/data.Rdata"),envir=data)
#getSymbols(tickers, src = 'yahoo', from = '1900-01-01', env = data, auto.assign = T)
#for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T)

bt.prep(data, align='remove.na')

#*****************************************************************
# Code Strategies
#******************************************************************   
periodicity = 'months'
lookback.len = 250
cluster.group = cluster.group.kmeans.90

obj = portfolio.allocation.helper(
  data$prices, 
  periodicity = periodicity, lookback.len = lookback.len,
  min.risk.fns = list(
    EW=equal.weight.portfolio,
    RP=risk.parity.portfolio,
    C.EW = distribute.weights(equal.weight.portfolio, cluster.group),
    C.RP=distribute.weights(risk.parity.portfolio, cluster.group)
  )
)       
models = create.strategies(obj, data)$models

PerformanceAnalytics, Please Make All Your Tables

#use rCharts to get some interactive plots
require(rCharts)
require(reshape2)

#Performance Analytics wants the return series so let's merge returns into
#a single xts object
returns.xts <- do.call(merge,
  lapply(
   names(models),
   FUN=function(x){
     x.data <- models[[x]]$equity[endpoints(models[[x]]$equity,"months"),]
     colnames(x.data) <- x
     x.ret <- ROC( x.data, type = "discrete", n = 1 )
     return(x.ret)
   }
  )
)[-(1:11),]  #remove first 11 months since no data; will need to change if not monthly

perfTables <- list()
perfTables$AnnualizedReturns <- table.AnnualizedReturns(returns.xts)
perfTables$Autocorrelation <- table.Autocorrelation(returns.xts)
perfTables$CAPM <- table.CAPM(returns.xts[,-1],returns.xts[,1])
perfTables$CalendarReturns <- table.CalendarReturns(returns.xts)[,-(1:12)]/100 #ignore monthly data
perfTables$CaptureRatios <- t(table.CaptureRatios(returns.xts,returns.xts[,1]))
perfTables$Correlation <- t(table.Correlation(returns.xts,returns.xts[,1]))
perfTables$Distributions <- table.Distributions(returns.xts)
perfTables$DownsideRisk <- table.DownsideRisk(returns.xts)[-7,] #remove drawdown
perfTables$DownsideRiskRatio <- table.DownsideRiskRatio(returns.xts)
perfTables$DrawdownsRatio <- table.DrawdownsRatio(returns.xts)
perfTables$HigherMoments <- table.HigherMoments(returns.xts[,-1],returns.xts[,1])
perfTables$InformationRatio <- table.InformationRatio(returns.xts[,-1],returns.xts[,1])
perfTables$SpecificRisk <- table.SpecificRisk(returns.xts[,-1],returns.xts[,1])
perfTables$TrailingPeriods <- table.TrailingPeriods(returns.xts)
perfTables$Variability <- table.Variability( returns.xts )

rCharts, Please Make Us Lots of Bar Charts

require(RColorBrewer)
lapply(
  perfTables, #["InformationRatio"],
  FUN = function(x) {
    x.df <- data.frame( rownames(x),x )
    x.melt <- melt( x.df, id.vars = 1 )
    colnames( x.melt ) <- c( "metric", "strategy", "value")

    d1 <- dPlot(
      x = "value",
      y = c("metric","strategy"),
      groups = c("strategy"),
      data = x.melt,
      type = "bar",
      width = 800
    )
    d1$chart( x = 150, width = 550 )  #move over a little to allow room for y axis labels
    d1$yAxis( type = "addCategoryAxis", orderRule = rev(x.melt$metric) )
    d1$xAxis( type = "addMeasureAxis", outputFormat = ".2%"  )
    d1$legend(
      x = 725,
      y = 10,
      width = 75,
      height = 100,
      horizontalAlign = "left"
    )
    d1$defaultColors(
      latticeExtra::theEconomist.theme()$superpose.line$col,
      replace=T
    )
    d1$show("iframe")
  }
)

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