knitr Performance Report–Attempt 3

please see knitr Performance Report-Attempt 2 and knitr Performance Report-Attempt 1

Since the time of my last reporting post, RStudio, knitr, and Sweave have worked extremely hard to make document creation easier by becoming even more streamlined and cooperative (New Version of RStudio (v0.96)).  Thanks so much for these extremely helpful and generous contributors.

Over the years, I have developed an outline for client reports that I think applies in most situations in the money management world.  This also fits for performance reporting and marketing, except the transaction history section would either be eliminated or replaced by a section highlighting trades or ideas that have been used in the past.

From TimelyPortfolio

I thought I would have a completed product before displaying progress, but I just could not wait.  I started working on the Return section.  Please let me know what you think as your comments will guide the rest of the report.  If you are viewing in a RSS reader, you might need to view through this link, since the embed might not work.

R code from GIST:

	%great guides at epslatex.pdf
	%check miniplot for potential use
	%\documentclass[english,nohyper,noae]{tufte-handout}
	\documentclass{article}
	\usepackage{graphics}
	\usepackage{caption}
	\usepackage{sidecap}
	\usepackage{textpos}
	%\usepackage[section]{placeins}
	\title{Performance Report from knitr}
	\author{Timely Portfolio}
	\begin{document}
	\maketitle
	\SweaveOpts{concordance=TRUE}
	<<eval=TRUE,echo=FALSE,results=hide,warning=FALSE>>=
	#do requires and set up environment for reporting
	require(ggplot2)
	require(directlabels)
	require(reshape2)
	require(lattice)
	require(latticeExtra)
	require(xtable)
	require(quantmod)
	require(PerformanceAnalytics)
	#trying some new colors out
	mycolors=c(brewer.pal(9,"Blues")[c(7,5)],brewer.pal(9,"Greens")[6])
	#mycolors=c(brewer.pal(6,"Blues)[c(3,5)],"slategray4")
	data(managers)
	#get xts in df form so that we can melt with the reshape package
	#will use just manager 1, sp500, and 10y treasury
	managers <- managers[,c(1,8,9)]
	#add 0 at beginning so cumulative returns start at 1
	#also cumulative will match up datewise with returns
	managers <- as.xts(rbind(rep(0,NCOL(managers)),coredata(managers)),
	order.by=c(as.Date(format(index(managers)[1],"%Y-%m-01"))-1,index(managers)))
	managers.df <- as.data.frame(cbind(index(managers),coredata(managers)),stringsAsFactors=FALSE)
	#melt data which puts in a form that lattice and ggplot enjoy
	managers.melt <- melt(managers.df,id.vars=1)
	colnames(managers.melt) <- c("date","account","return")
	managers.melt[,1] <- as.Date(managers.melt[,1])
	#get cumulative returns starting at 1
	managers.cumul <- as.xts(
	apply(managers+1,MARGIN=2,FUN=cumprod),
	#add end of first month to accommodate the 1 that we add
	order.by=index(managers))
	managers.cumul.df <- as.data.frame(cbind(index(managers.cumul),
	coredata(managers.cumul)),
	stringsAsFactors=FALSE)
	managers.cumul.melt <- melt(managers.cumul.df,id.vars=1)
	colnames(managers.cumul.melt) <- c("date","account","return")
	managers.cumul.melt[,1] <- as.Date(managers.cumul.melt[,1])
	#this is tricky but necessary
	#reorder accounts and indexes to preserve order with manager and then benchmarks
	managers.cumul.melt$account <- factor(as.character(managers.cumul.melt$account),colnames(managers)[c(2,3,1)],ordered=TRUE)
	#get rolling returns for 1y, 3y, 5y, since inception
	trailing <- table.TrailingPeriods(managers[,c(2,3,1)], periods=c(12,36,60,NROW(managers)),FUNCS=c("Return.annualized"),funcs.names=c("return"))
	trailing.df <- as.data.frame(cbind(c("1y","3y","5y",paste("Since Inception ",format(index(managers)[1],"%b %Y"),sep="")),
	c(rep("return",4)), #will allow for multiple measures if we decide to include later
	coredata(trailing)),
	stringsAsFactors=TRUE)
	trailing.melt <- melt(trailing.df,id.vars=1:2)
	colnames(trailing.melt) <- c("period","measure","account","value")
	#this is tricky but necessary
	#reorder the period so that they will be in correct chronological order
	trailing.melt$period <- factor(as.character(trailing.melt$period),rev(c("1y","3y","5y",paste("Since Inception ",format(index(managers),"%b %Y"),sep=""))),ordered=TRUE)
	#reorder accounts and indexes to preserve order with manager and then benchmarks
	trailing.melt$account <- factor(as.character(trailing.melt$account),colnames(managers)[c(3,2,1)],ordered=TRUE)
	@
	%\newpage
	\section{Overview}
	This section should serve as a dashboard or executive summary for quick and easy access to the most informative risk and return measures. Also, most marketing will have a text description of the strategy, process, objective, category, and potential investments of the product.
	\newpage
	\section{Returns}
	Unfortunately, the Return section is generally the focus of the sales pitch and also is often the biggest concern for the prospect. Although it easiest to sell on return in the short-term, long-term success requires much more focus on the graphs presented in the Overview and Risk sections.
	\begin{figure}
	\begin{wide}
	%\begin{minipage}[t]{1.25\linewidth}
	\begin{textblock*}{165mm}(5mm,50mm)
	%\hspace*{-0.5in}
	<<echo=FALSE,eval=TRUE,fig=TRUE,width=8,height=8>>=
	#while latticeExtra theEconomist.theme is beautiful
	#I wanted to stretch my knowledge, so I will start from scratch
	#example given to left justify strip
	#http://maths.anu.edu.au/~johnm/r-book/xtras/boxcontrol.pdf
	stripfun <- function(which.given, which.panel,factor.levels, ...){
	grid.rect(name = trellis.grobname("bg", type = "strip"),
	gp = gpar(fill = "seashell3", col = "seashell3"))
	panel.text(x=0.10, y=0.6,
	lab = factor.levels[which.panel[which.given]],
	adj=0, font=3, cex=1.3)
	}
	#heavily stripped and modified theEconomist.axis() from latticeExtra
	timely.axis <- function (side = c("top", "bottom", "left", "right"), scales,
	components, ..., labels = c("default", "yes", "no"), ticks = c("default",
	"yes", "no"), line.col, noleft=TRUE)
	{
	side <- match.arg(side)
	if (side == "top") return()
	labels <- match.arg(labels)
	ticks <- match.arg(ticks)
	if (side %in% c("left", "right")) {
	if (side == "right") {
	scales$draw=TRUE
	labels <- "no"
	ticks <- "no"
	}
	if (side == "left") {
	labels <- "yes"
	ticks <- "yes"
	}
	}
	axis.default(side, scales = scales, components = components,
	..., labels = labels, ticks = ticks, line.col = "black")
	if (side == "right" & panel.number()==1) {
	comp.list <- components[["right"]]
	if (!is.list(comp.list))
	comp.list <- components[["left"]]
	panel.refline(h = comp.list$ticks$at)
	lims <- current.panel.limits()
	panel.abline(h = lims$y[1], col = "black")
	}
	}
	#set up ylimits to use for the two scales
	ylimits<-c(pretty(c(min(managers.cumul.melt$return),
	max(managers.cumul.melt$return)),4),as.numeric(round(last(managers.cumul)[,order(last(managers.cumul))],2)))
	ylabels<-c(ylimits[1:(length(ylimits)-3)],colnames(managers)[order(last(managers.cumul))])
	returns <- list(
	bar = barchart(account~value|period,col=mycolors,data=trailing.melt,
	layout=c(1,4),
	box.ratio=100,
	origin=0,
	reference=TRUE,
	par.settings=
	list(
	par.main.text = list(font = 1, cex=1.5, just = "left",x = grid::unit(5, "mm")),
	axis.line = list(col = NA)),
	scales=list(x=list(
	limits=c(0,max(trailing.melt$value)+0.025), #snug labels right up to bars by setting to 0
	at=pretty(trailing.melt$value),
	labels=paste(round(100*as.numeric(pretty(trailing.melt$value)), 2), "%", sep="")
	)),
	xlab=NULL,
	axis = timely.axis,
	strip=stripfun,
	strip.left=FALSE,
	panel=function(...) {
	panel.barchart(...)
	tmp <- list(...)
	tmp <- data.frame(x=tmp$x, y=tmp$y)
	# add text labels
	panel.text(x=tmp$x, y=tmp$y,
	label=sprintf("%1.2f%%", tmp$x * 100 ),
	cex=1, col="black", pos=4)
	},
	main="Annualized Returns"),
	cumulgrowth =
	xyplot(return~date,groups=account,data=managers.cumul.melt,
	# col=mycolors,
	type="l",lwd=3,
	xlab=NULL,
	ylab=NULL,
	par.settings=
	list(
	par.main.text = list(font = 1, cex=1.5, just = "left",x = grid::unit(5, "mm")),
	axis.line = list(col = "transparent"),
	superpose.line=list(col=mycolors)), #do this for direct.label
	scales=list(x=list(alternating=1,at=index(managers)[endpoints(managers,"years")],
	labels=format(index(managers)[endpoints(managers,"years")],"%Y")),
	y=list(alternating=3,at=ylimits,labels=ylabels)),
	axis=function (side = c("top", "bottom", "left", "right"), scales,
	components, ..., labels = c("default", "yes", "no"), ticks = c("default",
	"yes", "no"), line.col){
	side <- match.arg(side)
	labels <- match.arg(labels)
	ticks <- match.arg(ticks)
	axis.text <- trellis.par.get("axis.text")
	if(side == "top") return()
	if(side == "right") {
	components[["right"]]<-components[["left"]]
	components[["right"]]$ticks$at <- components[["right"]]$ticks$at[5:7]
	components[["right"]]$labels$at <- components[["right"]]$labels$at[5:7]
	components[["right"]]$labels$labels <- components[["right"]]$labels$labels[5:7]
	}
	if(side %in% c("bottom","right")){
	axis.default(side, scales = scales, components = components,
	..., labels = labels, ticks = ticks, line.col = axis.text$col)
	if (side == "right") {
	comp.list <- components[["left"]]
	panel.refline(h = comp.list$ticks$at[1:4])
	lims <- current.panel.limits()
	panel.abline(h = lims$y[1], col = axis.text$col)
	comp.list.left<-components[["left"]]
	comp.list.left$ticks$at <- components[["left"]]$ticks$at[1:4]
	comp.list.left$labels$at <- components[["left"]]$labels$at[1:4]
	comp.list.left$labels$labels <- components[["left"]]$labels$labels[1:4]
	panel.axis(side="left",at=comp.list.left$ticks$at,outside=TRUE)
	}
	}
	},
	main=paste("Cumulative Growth Since Inception ",format(index(managers)[1],"%B %Y"),sep=""))
	)
	print(returns$cumulgrowth,position=c(0,0.6,1,1),more=TRUE)
	print(returns$bar,position=c(0,0,1,0.6))
	@
	%\end{minipage}
	\begin{center}
	<<echo=FALSE,eval=TRUE,results=tex>>=
	percent <- function(x, digits = 2, format = "f", ...)
	{
	paste(formatC(100 * x, format = format, digits = digits, ...), "%", sep = "")
	}
	trailingtable <- apply(trailing,MARGIN=2,FUN=percent)
	rownames(trailingtable) <- c("1y","3y","5y",paste("Since Inception ",format(index(managers)[1],"%b %Y")))
	print(xtable(trailingtable), floating=FALSE)
	@
	\end{center}
	\end{textblock*}
	\end{wide}
	\end{figure}
	\newpage
	\section{Risk}
	\end{document}

view raw knitr performance 3 return.rnw hosted with ❤ by GitHub