Thursday, September 15, 2011

Reporting Good Enough to Share

Sorry to all my faithful readers for my absence recently. I started a new job at a new firm, so my blogging has moved down the priority list but only temporarily. I am still committed to documenting my thoughts, especially finance and R thoughts as discussed in Why Talk My Book? .

So far, I have used R primarily for my own use without the intention of sharing with clients <> R stats finance geeks. However, R is so powerful that I would like to leverage it for more general communication.

Our shop uses Advent Axys, which I believe is still the industry standard despite its extremely poor and inflexible reporting capabilities. At one point in a previous life, I believed some of the inflexibility could be overcome through its replang scripting, and I endured a very painful journey documenting and experimenting http://www.axysreporting.com. I now believe the best solution is to use Axys only to export its information to better, more capable reporting engines.

In this example, I amended the Axys 631 report to export performance to a .csv file. I'm concerned that sharing my amended report might violate the very aggressive IP attorneys at Advent. I will try to write from scratch at some point to share while still avoiding this ire.  Please let me know if you have already done this to save me some time and effort.  Click on the screenshot to get the .csv file from Google Docs.

image

For now, I will share a sample performance file generated from my 631 exporter, and change the fine PerformanceAnalytics charts.PerformanceSummary report.  In later posts I will add some ggplot2 charts.  I think the chart is now good enough to share with clients, but unfortunately, my code is nowhere near as clean or robust as I would like.  I combined all the code into one R script, and here is the result.  I would love input and thoughts.

The original charts.PerformanceSummary with no modifications.

From TimelyPortfolio

My new version

From TimelyPortfolio

R code (click to download from Google Docs):

#this report uses the PerformanceAnalytics charts.PerformanceSummary
#as the base for a new one-pager
#99% of the code is from the PerformanceAnalytics package
#all credit should be given to the PerformanceAnalytics team
#all errors should be assigned to me
 
 
#this is almost entirely from the PerformanceAnalytics
#chart.CumReturns function
#I only change to label the endpoints
na.skip <- function (x, FUN=NULL, ...) # maybe add a trim capability?
{ # @author Brian Peterson
 
# DESCRIPTION:
 
# Time series data often contains NA's, either due to missing days,
# noncontiguous series, or merging multiple series,
#
# Some Calulcations, such as return calculations, require data that
# looks like a vector, and needs the output of na.omit
#
# It is often convenient to apply these vector-like functions, but
# you still need to keep track of the structure of the oridginal data.
 
# Inputs
# x the time series to apply FUN too
# FUN function to apply
# ... any additonal parameters to FUN
 
# Outputs:
# An xts time series that has the same index and NA's as the data
# passed in, after applying FUN
 
nx <- na.omit(x)
fx <- FUN(nx, ... = ...)
if (is.vector(fx)) {
result <- .xts(fx, .index(x), .indexCLASS = indexClass(x))
}
else {
result <- merge(fx, .xts(, .index(x)))
}
return(result)
}
 
 
 
chart.CumReturnsX <-
function (R, wealth.index = FALSE, geometric = TRUE, legend.loc = NULL, colorset = (1:12), begin = c("first","axis"), ...)
{ # @author Peter Carl
 
# DESCRIPTION:
# Cumulates the returns given and draws a line graph of the results as
# a cumulative return or a "wealth index".
 
# Inputs:
# R: a matrix, data frame, or timeSeries of returns
# wealth.index: if true, shows the "value of $1", starting the cumulation
# of returns at 1 rather than zero
# legend.loc: use this to locate the legend, e.g., "topright"
# colorset: use the name of any of the palattes above
# method: "none"
 
# Outputs:
# A timeseries line chart of the cumulative return series
 
# FUNCTION:
 
# Transform input data to a matrix
begin = begin[1]
x = checkData(R)
 
# Get dimensions and labels
columns = ncol(x)
columnnames = colnames(x)
 
# Calculate the cumulative return
one = 0
if(!wealth.index)
one = 1
 
##find the longest column, calc cum returns and use it for starting values
 
if(begin == "first") {
length.column.one = length(x[,1])
# find the row number of the last NA in the first column
start.row = 1
start.index = 0
while(is.na(x[start.row,1])){
start.row = start.row + 1
}
x = x[start.row:length.column.one,]
if(geometric)
reference.index = na.skip(x[,1],FUN=function(x) {cumprod(1+x)})
else
reference.index = na.skip(x[,1],FUN=function(x) {cumsum(x)})
}
for(column in 1:columns) {
if(begin == "axis") {
start.index = FALSE
} else {
# find the row number of the last NA in the target column
start.row = 1
while(is.na(x[start.row,column])){
start.row = start.row + 1
}
start.index=ifelse(start.row > 1,TRUE,FALSE)
}
if(start.index){
# we need to "pin" the beginning of the shorter series to the (start date - 1 period)
# value of the reference index while preserving NA's in the shorter series
if(geometric)
z = na.skip(x[,column],FUN = function(x,index=reference.index[(start.row - 1)]) {rbind(index,1+x)})
else
z = na.skip(x[,column],FUN = function(x,index=reference.index[(start.row - 1)]) {rbind(1+index,1+x)})
} else {
z = 1+x[,column]
}
column.Return.cumulative = na.skip(z,FUN = function(x, one, geometric) {if(geometric) cumprod(x)-one else (1-one) + cumsum(x-1)},one=one, geometric=geometric)
if(column == 1)
Return.cumulative = column.Return.cumulative
else
Return.cumulative = merge(Return.cumulative,column.Return.cumulative)
}
if(columns == 1)
Return.cumulative = as.xts(Return.cumulative)
colnames(Return.cumulative) = columnnames
 
# Chart the cumulative returns series
chart.TimeSeries(Return.cumulative, col = colorset, legend.loc = legend.loc, ...)
for (i in 1:NCOL(Return.cumulative)) {
text(x=NROW(Return.cumulative),
y=coredata(Return.cumulative)[NROW(Return.cumulative),i],
sprintf("%1.0f%%",round(coredata(Return.cumulative)[NROW(Return.cumulative),i],2)*100),
adj = c(0, 0.5),lwd=0.5,col=colorset[i])
}
}
 
#this function shows bar plot side-by-side comparisons for rolling annualized
#returns
#please proceed with caution as function is not robust
#and does not perform adequate error checking
chart.SideBar <- function (w, auto.grid = TRUE, xaxis = TRUE, yaxis = TRUE, yaxis.right = FALSE,
type = "l", lty = 1, lwd = 2, main = NULL, ylab = "Annualized Returns", xlab = NULL,
xlim = NULL, ylim = NULL, element.color = "darkgray", event.lines = NULL,
event.labels = NULL, period.areas = NULL, event.color = "darkgray",
period.color = "aliceblue", colorset = (1:12), pch = (1:12),
legend.loc = NULL, cex.axis = 0.8, cex.legend = 0.8,
cex.lab = 1, cex.labels = 0.8, cex.main = 1, major.ticks = "auto",
minor.ticks = TRUE, grid.color = "lightgray", grid.lty = "dotted",
xaxis.labels = NULL, ...)
{
barplot(w, beside=TRUE, col = colorset[1:NROW(w)],
xlab = xlab, ylab = ylab, axes = FALSE,
ylim = c(min(0,min(w)),max(w)+0.05),...)
 
if (auto.grid) {
abline(v=0, col = element.color, lty = grid.lty)
grid(NA, NULL, col = grid.color)
}
abline(h = 0, col = grid.color)
 
axis(2, cex.axis = cex.axis, col = element.color)
title(ylab = ylab, cex = cex.lab)
 
 
 
if (!is.null(legend.loc)) {
legend(legend.loc, inset = 0.02, text.col = colorset,
col = colorset, cex = cex.legend, border.col = grid.color,
lty = lty, lwd = 2, bg = "white", legend = rownames(w))
}
 
box(col = element.color)
}
 
 
charts.PerformanceSummaryX <-
function (R, Rf = 0, main = NULL, submain=NULL, geometric=TRUE, methods = "none", width = 0, event.labels = NULL, ylog = FALSE, wealth.index = FALSE, gap = 12, begin=c("first","axis"), legend.loc="bottomright", p=0.95, maxdraw = TRUE,...)
{ # @author Peter Carl
 
# DESCRIPTION:
# A wrapper to create a wealth index chart, bars for monthly peRformance,
# and underwater chart for drawdown.
 
# Inputs:
# R: a matrix, data frame, or timeSeries, usually a set of monthly returns.
# The first column is assumed to be the returns of interest, the next
# columns are assumed to be relevant benchmarks for comparison.
# Rf: this is the risk free rate. Remember to set this to the same
# periodicity as the data being passed in.
# method: Used to select the risk parameter to use in the chart.BarVaR. May
# be any of:
# modVaR - uses CF modified VaR
# VaR - uses traditional Value at Risk
# StdDev - monthly standard deviation of trailing 12 month returns
#
 
# Outputs:
# A stack of three related timeseries line charts
 
# FUNCTION:
begin = begin[1]
x = checkData(R)
colnames = colnames(x)
ncols = ncol(x)
 
# This repeats a bit of code from chart.CumReturns, but it's intended
# to align the start dates of all three charts. Basically, it assumes
# that the first column in the list is the column of interest, and
# starts everything from that start date
 
length.column.one = length(x[,1])
# find the row number of the last NA in the first column
start.row = 1
start.index = 0
while(is.na(x[start.row,1])){
start.row = start.row + 1
}
x = x[start.row:length.column.one,]
 
if(ncols > 1)
legend.loc = legend.loc
else
legend.loc = NULL
 
if(is.null(main))
main = paste(colnames[1],"Performance", sep=" ")
 
if(ylog)
wealth.index = TRUE
 
op <- par(no.readonly=TRUE)
 
# First, we lay out the graphic as a three row, one column format
# plot.new()
layout(matrix(c(1,2,3)),height=c(2,1,1.3),width=1)
# to see the resulting layout, use layout.show(3)
 
# mar: a numerical vector of the form c(bottom, left, top, right) which
# gives the number of lines of margin to be specified on the four sides
# of the plot. The default is c(5, 4, 4, 2) + 0.1
 
# The first row is the cumulative returns line plot
par(oma=c(2,2,4,2))
par(mar=c(1,6,8,4))
chart.CumReturnsX(x, main = "", xaxis = FALSE, legend.loc = legend.loc, cex.legend = 1, event.labels = event.labels, ylog = ylog, wealth.index = wealth.index, begin = begin, geometric = geometric, ylab="Cumulative Return",...)
 
# title(main=main, sub=submain, cex.main=2, cex.sub=1.5, adj=0, outer =FALSE)
mtext(text=main, line = -2, outer = TRUE, adj = 0.1, cex=2)
mtext(text=submain, line = -4, outer = TRUE, adj = 0.075, cex=1.5)
 
 
 
# The second row is the monthly returns bar plot
# par(mar=c(1,4,0,2))
 
freq = periodicity(x)
 
switch(freq$scale,
seconds = { date.label = "Second"},
minute = { date.label = "Minute"},
hourly = {date.label = "Hourly"},
daily = {date.label = "Daily"},
weekly = {date.label = "Weekly"},
monthly = {date.label = "Monthly"},
quarterly = {date.label = "Quarterly"},
yearly = {date.label = "Annual"}
)
 
# chart.BarVaR(x, main = "", xaxis = FALSE, width = width, ylab = paste(date.label,"Return"), methods = methods, event.labels = NULL, ylog=FALSE, gap = gap, p=p, ...)
 
# The third row is the underwater plot
par(mar=c(3,6,0,4))
chart.Drawdown(x, geometric = geometric, main = "", xlab=NA, ylab = "Drawdown", event.labels = NULL, ylog=FALSE, ...)
if (maxdraw) {
abline(h=-0.1,col="tomato3",lwd=3,lty="dashed")
text(x=2,y=-0.1,"maximum acceptable drawdown",adj = c(0, 0.5))
}
 
# If we wanted to add a fourth row with the table of monthly returns
# par(mar=c(0,0,0,0))
# textplot(table.Returns(as.matrix(R)),cex=.7,cmar=1.5,rmar=0.5,halign="center", valign="center")
 
par(mar=c(6,6,0,4))
 
returnTable <- returnTable <- table.TrailingPeriods(x,
periods=c(12,24,36,NROW(x)),
FUNCS="Return.annualized")
rownames(returnTable) <- c(paste(c(1:3)," Year",sep=""),"Since Inception")[1:NROW(returnTable)]
 
chart.SideBar(t(as.matrix(returnTable)),...)
 
par(op)
 
}
 
 
 
 
#now let's use the amended report to look at performance
require(quantmod)
require(PerformanceAnalytics)
 
clientPerf <- read.csv("clientperf.csv",stringsAsFactors=FALSE)
clientPerf[,2:NCOL(clientPerf)] <- lapply(clientPerf[,2:NCOL(clientPerf)],as.numeric)
clientPerf <- as.xts(clientPerf[,2:NCOL(clientPerf)]/100,
order.by = as.Date(clientPerf[,1],format="%m-%d-%y"))
colnames(clientPerf) <- c("Client","BarclaysAgg","SP500")
 
jpeg(filename="performance summary.jpg",quality=100,width=6, height = 7, units="in",res=96)
charts.PerformanceSummary(clientPerf)
dev.off()
 
jpeg(filename="performance one-pager.jpg",quality=100,width=6, height = 7, units="in",res=96)
charts.PerformanceSummaryX(clientPerf,main="Client Performance",
submain=paste("Since Inception - ",format(seq(index(clientPerf)[1], length=2, by="-1 months")[2],"%B %Y"),sep=""),legend.loc="bottomright",maxdraw=FALSE,
colorset=c("cadetblue4","darkgray","bisque3"),lwd=c(3,2,2))
dev.off()

Created by Pretty R at inside-R.org

5 comments:

  1. seems like it's just around the corner when you start doing sort of reproducible research with tools like sweave and ggplot is very good for such a stuff at least in the industry

    ReplyDelete
  2. Nice reports. A couple years ago I built and fielded a commercial system to handle client performance reporting out of Advent, so I can sympathize with your replang thoughts.

    I use R more like your blog posts, to analyze strategies, but have recently been thinking about how nicely it handles a lot of the reporting stuff I built custom and removes some of the uglier pieces (helloooo reportlab, I'm lookin' at you).

    ReplyDelete
    Replies
    1. some interesting stuff now coming out of http://axysreporting.com. You might want to check it out.

      Delete
  3. Thanks for sharing. Here is a version of the charts.PerformanceSummary made with ggplot2, for whatever it's worth:

    http://stackoverflow.com/questions/14817006/ggplot-version-of-charts-performancesummary/15716118#15716118

    ReplyDelete
    Replies
    1. oh very nice. I have had much better luck with latticeExtra and xtsExtra for making slightly prettier PerformanceAnalytics charts. ggplot2 is amazing but I just can't ever get my mind to match up with the framework.

      Delete