[Returnanalytics-commits] r2682 - pkg/PortfolioAnalytics/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 30 21:27:01 CEST 2013
Author: rossbennett34
Date: 2013-07-30 21:27:01 +0200 (Tue, 30 Jul 2013)
New Revision: 2682
Added:
pkg/PortfolioAnalytics/R/charts.ROI.R
Log:
adding plotting methods for optimize.portfolio output objects with optimize_method=ROI
Added: pkg/PortfolioAnalytics/R/charts.ROI.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.ROI.R (rev 0)
+++ pkg/PortfolioAnalytics/R/charts.ROI.R 2013-07-30 19:27:01 UTC (rev 2682)
@@ -0,0 +1,227 @@
+
+#' boxplot of the weights in the portfolio
+#'
+#' @param ROI object created by \code{\link{optimize.portfolio}}
+#' @param neighbors set of 'neighbor' portfolios to overplot
+#' @param las numeric in \{0,1,2,3\}; the style of axis labels
+#' \describe{
+#' \item{0:}{always parallel to the axis [\emph{default}],}
+#' \item{1:}{always horizontal,}
+#' \item{2:}{always perpendicular to the axis,}
+#' \item{3:}{always vertical.}
+#' }
+#' @param xlab a title for the x axis: see \code{\link{title}}
+#' @param cex.lab The magnification to be used for x and y labels relative to the current setting of \code{cex}
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param element.color color for the default plot lines
+#' @param ... any other passthru parameters
+#' @param main an overall title for the plot: see \code{\link{title}}
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Ross Bennett
+#' @export
+chart.Weights.ROI <- function(ROI, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){
+
+ if(!inherits(ROI, "optimize.portfolio.ROI")) stop("ROI must be of class 'optimize.portfolio.ROI'")
+
+ columnnames = names(ROI$weights)
+ numassets = length(columnnames)
+
+ constraints <- get_constraints(ROI$portfolio)
+
+ if(is.null(xlab))
+ minmargin = 3
+ else
+ minmargin = 5
+ if(main=="") topmargin=1 else topmargin=4
+ if(las > 1) {# set the bottom border to accommodate labels
+ bottommargin = max(c(minmargin, (strwidth(columnnames,units="in"))/par("cin")[1])) * cex.lab
+ if(bottommargin > 10 ) {
+ bottommargin<-10
+ columnnames<-substr(columnnames,1,19)
+ # par(srt=45) #TODO figure out how to use text() and srt to rotate long labels
+ }
+ }
+ else {
+ bottommargin = minmargin
+ }
+ par(mar = c(bottommargin, 4, topmargin, 2) +.1)
+ plot(ROI$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=c(0,max(constraints$max)), ylab="Weights", main=main, pch=16, ...)
+ points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24)
+ points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25)
+ # if(!is.null(neighbors)){
+ # if(is.vector(neighbors)){
+ # xtract=extractStats(ROI)
+ # weightcols<-grep('w\\.',colnames(xtract)) #need \\. to get the dot
+ # if(length(neighbors)==1){
+ # # overplot nearby portfolios defined by 'out'
+ # orderx = order(xtract[,"out"])
+ # subsetx = head(xtract[orderx,], n=neighbors)
+ # for(i in 1:neighbors) points(subsetx[i,weightcols], type="b", col="lightblue")
+ # } else{
+ # # assume we have a vector of portfolio numbers
+ # subsetx = xtract[neighbors,weightcols]
+ # for(i in 1:length(neighbors)) points(subsetx[i,], type="b", col="lightblue")
+ # }
+ # }
+ # if(is.matrix(neighbors) | is.data.frame(neighbors)){
+ # # the user has likely passed in a matrix containing calculated values for risk.col and return.col
+ # nbweights<-grep('w\\.',colnames(neighbors)) #need \\. to get the dot
+ # for(i in 1:nrow(neighbors)) points(as.numeric(neighbors[i,nbweights]), type="b", col="lightblue")
+ # # note that here we need to get weight cols separately from the matrix, not from xtract
+ # # also note the need for as.numeric. points() doesn't like matrix inputs
+ # }
+ # }
+ # points(ROI$weights, type="b", col="blue", pch=16)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+}
+
+#' classic risk return scatter of random portfolios
+#'
+#' The ROI optimizers do not store the portfolio weights like DEoptim or random
+#' portfolios so we will generate random portfolios for the scatter plot.
+#'
+#' \code{return.col} must be the name of a function used to compute the return metric on the random portfolio weights
+#' \code{risk.col} must be the name of a function used to compute the risk metric on the random portfolio weights
+#'
+#' @param ROI object created by \code{\link{optimize.portfolio}}
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric
+#' @param rp set of weights generated by \code{\link{random_portfolio}}
+#' @param portfolio pass in a different portfolio object used in set.portfolio.moments
+#' @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 ... any other passthru parameters
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param element.color color for the default plot scatter points
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Ross Bennett
+#' @export
+chart.Scatter.ROI <- function(ROI, R, rp=NULL, portfolio=NULL, return.col="mean", risk.col="StdDev", ..., element.color = "darkgray", cex.axis=0.8, main=""){
+
+ # If the user does not pass in rp, then we will generate random portfolios
+ if(is.null(rp)){
+ if(!hasArg(permutations)) permutations <- 2000
+ rp <- random_portfolios(portfolio=ROI$portfolio, permutations=permutations)
+ }
+
+ # Get the optimal weights from the output of optimize.portfolio
+ wts <- ROI$weights
+
+ nargs <- list(...)
+ if(length(nargs)==0) nargs <- NULL
+ if (length('...')==0 | is.null('...')) {
+ # rm('...')
+ nargs <- NULL
+ }
+
+ # Allow the user to pass in a different portfolio object used in set.portfolio.moments
+ if(is.null(portfolio)) portfolio <- ROI$portfolio
+
+ nargs <- set.portfolio.moments(R=R, portfolio=portfolio, momentargs=nargs)
+
+ nargs$R <- R
+ nargs$weights <- wts
+
+ rp <- rbind(wts, rp)
+
+ # Match the return.col arg to a function
+ switch(return.col,
+ mean =,
+ median = {
+ returnFUN = match.fun(return.col)
+ nargs$x <- ( R %*% wts ) #do the multivariate mean/median with Kroneker product
+ }
+ )
+
+ if(is.function(returnFUN)){
+ returnpoints <- rep(0, nrow(rp))
+ .formals <- formals(returnFUN)
+ onames <- names(.formals)
+ for(i in 1:nrow(rp)){
+ nargs$weights <- rp[i,]
+ nargs$x <- R %*% rp[i,]
+ dargs <- nargs
+ pm <- pmatch(names(dargs), onames, nomatch = 0L)
+ names(dargs[pm > 0L]) <- onames[pm]
+ .formals[pm] <- dargs[pm > 0L]
+ returnpoints[i] <- do.call(returnFUN, .formals)
+ }
+ }
+
+ # match the risk.col arg to a function
+ switch(risk.col,
+ sd =,
+ StdDev = {
+ riskFUN = match.fun(StdDev)
+ },
+ mVaR =,
+ VaR = {
+ riskFUN = match.fun(VaR)
+ if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
+ if(is.null(nargs$invert)) nargs$invert = FALSE
+ },
+ es =,
+ mES =,
+ CVaR =,
+ cVaR =,
+ ES = {
+ riskFUN = match.fun(ES)
+ if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
+ if(is.null(nargs$invert)) nargs$invert = FALSE
+ }
+ )
+
+ if(is.function(riskFUN)){
+ riskpoints <- rep(0, nrow(rp))
+ .formals <- formals(riskFUN)
+ onames <- names(.formals)
+ for(i in 1:nrow(rp)){
+ nargs$weights <- rp[i,]
+ dargs <- nargs
+ pm <- pmatch(names(dargs), onames, nomatch = 0L)
+ names(dargs[pm > 0L]) <- onames[pm]
+ .formals[pm] <- dargs[pm > 0L]
+ riskpoints[i] <- do.call(riskFUN, .formals)
+ }
+ }
+ plot(x=riskpoints, y=returnpoints, xlab=risk.col, ylab=return.col, col="darkgray", axes=FALSE, main=main)
+ points(x=riskpoints[1], y=returnpoints[1], col="blue", pch=16) # optimal
+ axis(1, cex.axis = cex.axis, col = element.color)
+ axis(2, cex.axis = cex.axis, col = element.color)
+ box(col = element.color)
+}
+
+#' scatter and weights chart for portfolios
+#'
+#' The ROI optimizers do not store the portfolio weights like DEoptim or random
+#' portfolios so we will generate random portfolios for the scatter plot.
+#'
+#' \code{return.col} must be the name of a function used to compute the return metric on the random portfolio weights
+#' \code{risk.col} must be the name of a function used to compute the risk metric on the random portfolio weights
+#'
+#' @param ROI object created by \code{\link{optimize.portfolio}}
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric
+#' @param rp set of weights generated by \code{\link{random_portfolio}}
+#' @param portfolio pass in a different portfolio object used in set.portfolio.moments
+#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis
+#' @param return.col string matching the objective of a 'return' objective, on vertical axis
+#' @param ... any other passthru parameters
+#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex}
+#' @param element.color color for the default plot scatter points
+#' @param neighbors set of 'neighbor' portfolios to overplot
+#' @param main an overall title for the plot: see \code{\link{title}}
+#' @seealso \code{\link{optimize.portfolio}}
+#' @author Ross Bennett
+#' @export
+charts.ROI <- function(ROI, R, rp=NULL, portfolio=NULL, risk.col="StdDev", return.col="mean",
+ cex.axis=0.8, element.color="darkgray", neighbors=NULL, main="ROI.Portfolios", ...){
+ # Specific to the output of the optimize_method=ROI
+ op <- par(no.readonly=TRUE)
+ layout(matrix(c(1,2)),height=c(2,1.5),width=1)
+ par(mar=c(4,4,4,2))
+ chart.Scatter.ROI(ROI, R, rp=rp, portfolio=NULL, return.col=return.col, risk.col=risk.col, ..., element.color=element.color, cex.axis=cex.axis, main=main)
+ par(mar=c(2,4,0,2))
+ chart.Weights.ROI(ROI, neighbors=neighbors, ..., main="", las=3, xlab=NULL, cex.lab=1, element.color=element.color, cex.axis=ce.axis)
+ par(op)
+}
More information about the Returnanalytics-commits
mailing list