[Returnanalytics-commits] r3313 - in pkg/PortfolioAnalytics: . R demo man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Feb 17 03:11:55 CET 2014
Author: rossbennett34
Date: 2014-02-17 03:11:49 +0100 (Mon, 17 Feb 2014)
New Revision: 3313
Added:
pkg/PortfolioAnalytics/R/chart.concentration.R
pkg/PortfolioAnalytics/demo/chart_concentration.R
pkg/PortfolioAnalytics/man/chart.Concentration.Rd
Modified:
pkg/PortfolioAnalytics/DESCRIPTION
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/demo/00Index
Log:
Adding function to chart concentration based on Peter's symposium slides along with a demo
Modified: pkg/PortfolioAnalytics/DESCRIPTION
===================================================================
--- pkg/PortfolioAnalytics/DESCRIPTION 2014-02-14 03:04:37 UTC (rev 3312)
+++ pkg/PortfolioAnalytics/DESCRIPTION 2014-02-17 02:11:49 UTC (rev 3313)
@@ -64,3 +64,4 @@
'equal.weight.R'
'inverse.volatility.weight.R'
'utils.R'
+ 'chart.concentration.R'
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2014-02-14 03:04:37 UTC (rev 3312)
+++ pkg/PortfolioAnalytics/NAMESPACE 2014-02-17 02:11:49 UTC (rev 3313)
@@ -3,6 +3,7 @@
export(applyFUN)
export(box_constraint)
export(CCCgarch.MM)
+export(chart.Concentration)
export(chart.EfficientFrontier)
export(chart.EfficientFrontierOverlay)
export(chart.GroupWeights)
Added: pkg/PortfolioAnalytics/R/chart.concentration.R
===================================================================
--- pkg/PortfolioAnalytics/R/chart.concentration.R (rev 0)
+++ pkg/PortfolioAnalytics/R/chart.concentration.R 2014-02-17 02:11:49 UTC (rev 3313)
@@ -0,0 +1,181 @@
+
+# conc.type = weight or pct_contrib for risk budget optimization
+
+#' Classic risk reward scatter and concentration
+#'
+#' This function charts the \code{optimize.portfolio} object in risk-return space
+#' and the degree of concentration based on the weights or percentage component
+#' contribution to risk.
+#'
+#' @param object optimal portfolio created by \code{\link{optimize.portfolio}}.
+#' @param \dots any other passthru parameters.
+#' @param return.col string matching the objective of a 'return' objective, on vertical axis.
+#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis.
+#' @param chart.assets TRUE/FALSE. Includes a risk reward scatter of the assets in the chart.
+#' @param conc.type concentration type can be based on the concentration of weights
+#' or concentration of percentage component contribution to risk (only works with risk
+#' budget objective for the optimization).
+#' @param col color palette or vector of colors to use.
+#' @param element.color color for the border and axes.
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}.
+#' @param xlim set the x-axis limit, same as in \code{\link{plot}}.
+#' @param ylim set the y-axis limit, same as in \code{\link{plot}}.
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Peter Carl and Ross Bennett
+#' @export
+chart.Concentration <- function(object,
+ ...,
+ return.col='mean',
+ risk.col='ES',
+ chart.assets=FALSE,
+ conc.type=c("weights", "pct_contrib"),
+ col=heat.colors(20),
+ element.color = "darkgray",
+ cex.axis=0.8,
+ xlim=NULL, ylim=NULL){
+ # check the object
+ if(!inherits(object, "optimize.portfolio")){
+ stop("object must be of class 'optimize.portfolio'")
+ }
+
+ # extract the stats
+ xtract <- try(extractStats(object), silent=TRUE)
+ if(inherits(xtract, "try-error")) {
+ message(xtract)
+ return(NULL)
+ }
+
+ # get the concentration type
+ # We can either chart the concentration of the weights or the concentration
+ # of the percentage contribution to risk for risk budget optimizations
+ conc.type <- match.arg(conc.type)
+
+ columnnames <- colnames(xtract)
+
+ # Get the return and risk columns from xtract
+ return.column <- pmatch(return.col, columnnames)
+ if(is.na(return.column)) {
+ return.col <- paste(return.col, return.col, sep='.')
+ return.column <- pmatch(return.col, columnnames)
+ }
+ risk.column <- pmatch(risk.col, columnnames)
+ if(is.na(risk.column)) {
+ risk.col <- paste(risk.col, risk.col, sep='.')
+ risk.column <- pmatch(risk.col, columnnames)
+ }
+
+ # If the user has passed in return.col or risk.col that does not match extractStats output
+ # This will give the flexibility of passing in return or risk metrics that are not
+ # objective measures in the optimization. This may cause issues with the "neighbors"
+ # functionality since that is based on the "out" column
+ if(is.na(return.column) | is.na(risk.column)){
+ return.col <- gsub("\\..*", "", return.col)
+ risk.col <- gsub("\\..*", "", risk.col)
+ warning(return.col,' or ', risk.col, ' do not match extractStats output of $objective_measures slot')
+ # Get the matrix of weights for applyFUN
+ wts_index <- grep("w.", columnnames)
+ wts <- xtract[, wts_index]
+ if(is.na(return.column)){
+ tmpret <- applyFUN(R=R, weights=wts, FUN=return.col)
+ xtract <- cbind(tmpret, xtract)
+ colnames(xtract)[which(colnames(xtract) == "tmpret")] <- return.col
+ }
+ if(is.na(risk.column)){
+ tmprisk <- applyFUN(R=R, weights=wts, FUN=risk.col)
+ xtract <- cbind(tmprisk, xtract)
+ colnames(xtract)[which(colnames(xtract) == "tmprisk")] <- risk.col
+ }
+ columnnames = colnames(xtract)
+ return.column = pmatch(return.col,columnnames)
+ if(is.na(return.column)) {
+ return.col = paste(return.col,return.col,sep='.')
+ return.column = pmatch(return.col,columnnames)
+ }
+ risk.column = pmatch(risk.col,columnnames)
+ if(is.na(risk.column)) {
+ risk.col = paste(risk.col,risk.col,sep='.')
+ risk.column = pmatch(risk.col,columnnames)
+ }
+ }
+
+ if(chart.assets){
+ # Get the arguments from the optimize.portfolio$portfolio object
+ # to calculate the risk and return metrics for the scatter plot.
+ # (e.g. arguments=list(p=0.925, clean="boudt")
+ arguments <- NULL # maybe an option to let the user pass in an arguments list?
+ if(is.null(arguments)){
+ tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE)
+ tmp.args <- tmp.args[!duplicated(names(tmp.args))]
+ if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single"
+ arguments <- tmp.args
+ }
+ # Include risk reward scatter of asset returns
+ asset_ret <- scatterFUN(R=R, FUN=return.col, arguments)
+ asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments)
+ xlim <- range(c(xtract[,risk.column], asset_risk))
+ ylim <- range(c(xtract[,return.column], asset_ret))
+ } else {
+ asset_ret <- NULL
+ asset_risk <- NULL
+ }
+
+ if(conc.type == "weights"){
+ idx <- grep("w.", colnames(xtract))
+ if(length(idx) == 0) stop("weights not detected in output of extractStats")
+ tmp.x <- xtract[, idx]
+ } else if(conc.type == "pct_contrib"){
+ idx <- grep("pct_contrib", colnames(xtract))
+ if(length(idx) == 0) stop("pct_contrib not detected in output of extractStats")
+ tmp.x <- xtract[, idx]
+ }
+ # need a check to make sure that tmp.x is valid
+
+ # # Use HHI to compute the concentration of the pct_contrib_MES or concentration of weights
+ x.hhi <- apply(tmp.x, MARGIN=1, FUN="HHI")
+ # normalized HHI between 0 and 1
+ y <- (x.hhi - min(x.hhi)) / (max(x.hhi) - min(x.hhi))
+
+ op <- par(no.readonly=TRUE)
+ layout(matrix(c(1,2)),height=c(4,1.25),width=1)
+ par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right)
+
+ # plot the asset in risk-return space ordered based on degree of concentration
+ plot(xtract[order(y, decreasing=TRUE), risk.column], xtract[order(y, decreasing=TRUE), return.column], xlab=risk.col, ylab=return.col, col=col, axes=FALSE, xlim=xlim, ylim=ylim, ...)
+
+ # plot the risk-reward scatter of the assets
+ if(chart.assets){
+ points(x=asset_risk, y=asset_ret)
+ text(x=asset_risk, y=asset_ret, labels=colnames(R), pos=4, cex=0.8)
+ }
+
+ axis(1, cex.axis = cex.axis, col = element.color)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+
+ # Now plot the portfolio concentration part
+ # Add legend to bottom panel
+ par(mar=c(5,5.5,1,3)+.1, cex=0.7)
+ x <- x.hhi
+ scale01 <- function(x, low = min(x), high = max(x)) {
+ return((x - low) / (high - low))
+ }
+
+ breaks <- seq(min(x.hhi, na.rm=TRUE), max(x.hhi, na.rm=TRUE), length=(length(col)+1))
+ min.raw <- min(x, na.rm = TRUE)
+ max.raw <- max(x, na.rm = TRUE)
+ z <- seq(min.raw, max.raw, length=length(col))
+ image(z = matrix(z, ncol=1), col=col, breaks=breaks, xaxt="n", yaxt="n")
+ par(usr=c(0, 1, 0, 1)) # needed to draw the histogram correctly
+ lv <- pretty(breaks)
+ xv <- scale01(as.numeric(lv), min.raw, max.raw)
+ axis(1, at=xv, labels=sprintf("%s%%", pretty(lv)))
+ h <- hist(x, plot=FALSE, breaks=breaks)
+ hx <- scale01(breaks, min(x), max(x))
+ hy <- c(h$counts, h$counts[length(h$counts)])
+ lines(hx, hy / max(hy) * 0.95, lwd=2, type="s", col="blue")
+ axis(2, at=pretty(hy) / max(hy) * 0.95, pretty(hy))
+ title(ylab="Count")
+ title(xlab="Degree of Concentration")
+ par(op)
+ invisible(NULL)
+}
Modified: pkg/PortfolioAnalytics/demo/00Index
===================================================================
--- pkg/PortfolioAnalytics/demo/00Index 2014-02-14 03:04:37 UTC (rev 3312)
+++ pkg/PortfolioAnalytics/demo/00Index 2014-02-17 02:11:49 UTC (rev 3313)
@@ -26,4 +26,4 @@
demo_risk_budgets Demonstrate using risk budget objectives.
demo_roi_solvers Demonstrate specifying a solver using ROI.
risk_budget_backtesting Demonstrate optimize.portfolio.rebalancing with standard deviation risk budget objective.
-
+chart_concentration Demonstrate chart.Concentration
Added: pkg/PortfolioAnalytics/demo/chart_concentration.R
===================================================================
--- pkg/PortfolioAnalytics/demo/chart_concentration.R (rev 0)
+++ pkg/PortfolioAnalytics/demo/chart_concentration.R 2014-02-17 02:11:49 UTC (rev 3313)
@@ -0,0 +1,63 @@
+
+library(PortfolioAnalytics)
+
+data(edhec)
+R <- edhec[, 1:8]
+funds <- colnames(R)
+
+# Construct initial portfolio
+init.portf <- portfolio.spec(assets=funds)
+init.portf <- add.constraint(portfolio=init.portf,
+ type="leverage",
+ min_sum=0.99,
+ max_sum=1.01)
+
+init.portf <- add.constraint(portfolio=init.portf,
+ type="box",
+ min=0,
+ max=1)
+
+init.portf <- add.objective(portfolio=init.portf,
+ type="return",
+ name="mean",
+ multiplier=0)
+
+init.portf <- add.objective(portfolio=init.portf,
+ type="risk",
+ name="ES")
+
+rb.portf <- add.objective(portfolio=init.portf,
+ type="risk_budget",
+ name="ES",
+ max_prisk=0.4,
+ arguments=list(p=0.92))
+
+# Use DEoptim for optimization
+opt <- optimize.portfolio(R=R,
+ portfolio=init.portf,
+ optimize_method="random",
+ search_size=2000,
+ trace=TRUE)
+
+opt_rb <- optimize.portfolio(R=R,
+ portfolio=rb.portf,
+ optimize_method="random",
+ search_size=2000,
+ trace=TRUE)
+
+# This won't work because opt is not a risk budget optimization
+# This should result in an error and not plot anything
+chart.Concentration(opt, conc.type="pct_contrib")
+
+# opt is minimum ES optimization so we can still chart it using weights as
+# the measure of concentration
+chart.Concentration(opt, conc.type="weights", chart.assets=TRUE, col=heat.colors(10))
+chart.Concentration(opt, conc.type="weights", chart.assets=TRUE, col=bluemono)
+
+# The concentration is based on the HHI of the percentage component
+# contribution to risk
+chart.Concentration(opt_rb, conc.type="pct_contrib")
+
+# The concentration is based on the HHI of the weights
+chart.Concentration(opt_rb, conc.type="weights")
+
Added: pkg/PortfolioAnalytics/man/chart.Concentration.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/chart.Concentration.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/chart.Concentration.Rd 2014-02-17 02:11:49 UTC (rev 3313)
@@ -0,0 +1,57 @@
+\name{chart.Concentration}
+\alias{chart.Concentration}
+\title{Classic risk reward scatter and concentration}
+\usage{
+ chart.Concentration(object, ..., return.col = "mean",
+ risk.col = "ES", chart.assets = FALSE,
+ conc.type = c("weights", "pct_contrib"),
+ col = heat.colors(20), element.color = "darkgray",
+ cex.axis = 0.8, xlim = NULL, ylim = NULL)
+}
+\arguments{
+ \item{object}{optimal portfolio created by
+ \code{\link{optimize.portfolio}}.}
+
+ \item{\dots}{any other passthru parameters.}
+
+ \item{return.col}{string matching the objective of a
+ 'return' objective, on vertical axis.}
+
+ \item{risk.col}{string matching the objective of a 'risk'
+ objective, on horizontal axis.}
+
+ \item{chart.assets}{TRUE/FALSE. Includes a risk reward
+ scatter of the assets in the chart.}
+
+ \item{conc.type}{concentration type can be based on the
+ concentration of weights or concentration of percentage
+ component contribution to risk (only works with risk
+ budget objective for the optimization).}
+
+ \item{col}{color palette or vector of colors to use.}
+
+ \item{element.color}{color for the border and axes.}
+
+ \item{cex.axis}{The magnification to be used for axis
+ annotation relative to the current setting of
+ \code{cex}.}
+
+ \item{xlim}{set the x-axis limit, same as in
+ \code{\link{plot}}.}
+
+ \item{ylim}{set the y-axis limit, same as in
+ \code{\link{plot}}.}
+}
+\description{
+ This function charts the \code{optimize.portfolio} object
+ in risk-return space and the degree of concentration
+ based on the weights or percentage component contribution
+ to risk.
+}
+\author{
+ Peter Carl and Ross Bennett
+}
+\seealso{
+ \code{\link{optimize.portfolio}}
+}
+
More information about the Returnanalytics-commits
mailing list