[Returnanalytics-commits] r2715 - in pkg/PortfolioAnalytics: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 3 16:00:31 CEST 2013


Author: rossbennett34
Date: 2013-08-03 16:00:31 +0200 (Sat, 03 Aug 2013)
New Revision: 2715

Added:
   pkg/PortfolioAnalytics/R/applyFUN.R
   pkg/PortfolioAnalytics/man/applyFUN.Rd
   pkg/PortfolioAnalytics/man/plot.optimize.portfolio.ROI.Rd
Modified:
   pkg/PortfolioAnalytics/DESCRIPTION
   pkg/PortfolioAnalytics/NAMESPACE
   pkg/PortfolioAnalytics/R/charts.ROI.R
Log:
Adding an applyFUN function and modifying chart.Scatter.ROI to use applyFUN

Modified: pkg/PortfolioAnalytics/DESCRIPTION
===================================================================
--- pkg/PortfolioAnalytics/DESCRIPTION	2013-08-03 13:33:03 UTC (rev 2714)
+++ pkg/PortfolioAnalytics/DESCRIPTION	2013-08-03 14:00:31 UTC (rev 2715)
@@ -47,3 +47,4 @@
     'constraint_fn_map.R'
     'optFUN.R'
     'charts.ROI.R'
+    'applyFUN.R'

Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE	2013-08-03 13:33:03 UTC (rev 2714)
+++ pkg/PortfolioAnalytics/NAMESPACE	2013-08-03 14:00:31 UTC (rev 2715)
@@ -2,6 +2,7 @@
 export(add.objective_v1)
 export(add.objective_v2)
 export(add.objective)
+export(applyFUN)
 export(box_constraint)
 export(CCCgarch.MM)
 export(chart.Scatter.DE)
@@ -51,6 +52,7 @@
 export(optimize.portfolio)
 export(plot.optimize.portfolio.DEoptim)
 export(plot.optimize.portfolio.random)
+export(plot.optimize.portfolio.ROI)
 export(plot.optimize.portfolio)
 export(portfolio_risk_objective)
 export(portfolio.spec)

Added: pkg/PortfolioAnalytics/R/applyFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/applyFUN.R	                        (rev 0)
+++ pkg/PortfolioAnalytics/R/applyFUN.R	2013-08-03 14:00:31 UTC (rev 2715)
@@ -0,0 +1,69 @@
+#' Apply a risk or return function to a set of weights
+#' 
+#' This function is used to calculate risk or return metrics given a matrix of
+#' weights and is primarily used as a convenience function used in chart.Scatter functions
+#' 
+#' @param R 
+#' @param weights a matrix of weights generated from random_portfolios or \code{optimize.portfolio}
+#' @param FUN
+#' @param ... any passthrough arguments to FUN
+#' @author Ross Bennett
+#' @export
+applyFUN <- function(R, weights, FUN="mean", ...){
+  nargs <- list(...)
+  
+  moments <- function(R){
+    momentargs <- list()
+    momentargs$mu <- matrix(as.vector(apply(R, 2, "mean")), ncol = 1)
+    momentargs$sigma <- cov(R)
+    momentargs$m3 <- PerformanceAnalytics:::M3.MM(R)
+    momentargs$m4 <- PerformanceAnalytics:::M4.MM(R)
+    return(momentargs)
+  }
+  
+  nargs <- c(nargs, moments(R))
+  nargs$R <- R
+  
+  # match the FUN arg to a risk or return function
+  switch(FUN,
+         mean = {
+           fun = match.fun(mean)
+         },
+         sd =,
+         StdDev = { 
+           fun = match.fun(StdDev)
+         },
+         mVaR =,
+         VaR = {
+           fun = 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 = {
+           fun = match.fun(ES)
+           if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
+           if(is.null(nargs$invert)) nargs$invert = FALSE
+         },
+{   # see 'S Programming p. 67 for this matching
+  fun <- try(match.fun(FUN))
+}
+  ) # end switch block
+  
+  out <- rep(0, nrow(weights))
+  .formals  <- formals(fun)
+  onames <- names(.formals)
+  for(i in 1:nrow(weights)){
+    nargs$weights <- as.numeric(weights[i,])
+    nargs$x <- R %*% as.numeric(weights[i,])
+    dargs <- nargs
+    pm <- pmatch(names(dargs), onames, nomatch = 0L)
+    names(dargs[pm > 0L]) <- onames[pm]
+    .formals[pm] <- dargs[pm > 0L]
+    out[i] <- try(do.call(fun, .formals))
+  }
+  return(out)
+}
\ No newline at end of file

Modified: pkg/PortfolioAnalytics/R/charts.ROI.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.ROI.R	2013-08-03 13:33:03 UTC (rev 2714)
+++ pkg/PortfolioAnalytics/R/charts.ROI.R	2013-08-03 14:00:31 UTC (rev 2715)
@@ -108,83 +108,12 @@
   # 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
-  
+  # cbind the optimal weights and random portfolio weights
   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
-         }
-  )
+  returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, ...=...)
+  riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, ...=...)
   
-    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)

Added: pkg/PortfolioAnalytics/man/applyFUN.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/applyFUN.Rd	                        (rev 0)
+++ pkg/PortfolioAnalytics/man/applyFUN.Rd	2013-08-03 14:00:31 UTC (rev 2715)
@@ -0,0 +1,25 @@
+\name{applyFUN}
+\alias{applyFUN}
+\title{Apply a risk or return function to a set of weights}
+\usage{
+  applyFUN(R, weights, FUN = "mean", ...)
+}
+\arguments{
+  \item{R}{}
+
+  \item{weights}{a matrix of weights generated from
+  random_portfolios or \code{optimize.portfolio}}
+
+  \item{FUN}{}
+
+  \item{...}{any passthrough arguments to FUN}
+}
+\description{
+  This function is used to calculate risk or return metrics
+  given a matrix of weights and is primarily used as a
+  convenience function used in chart.Scatter functions
+}
+\author{
+  Ross Bennett
+}
+

Added: pkg/PortfolioAnalytics/man/plot.optimize.portfolio.ROI.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/plot.optimize.portfolio.ROI.Rd	                        (rev 0)
+++ pkg/PortfolioAnalytics/man/plot.optimize.portfolio.ROI.Rd	2013-08-03 14:00:31 UTC (rev 2715)
@@ -0,0 +1,61 @@
+\name{plot.optimize.portfolio.ROI}
+\alias{plot.optimize.portfolio.ROI}
+\title{scatter and weights chart for portfolios}
+\usage{
+  plot.optimize.portfolio.ROI(ROI, R, rp = NULL,
+    portfolio = NULL, risk.col = "StdDev",
+    return.col = "mean", element.color = "darkgray",
+    neighbors = NULL, main = "ROI.Portfolios", ...)
+}
+\arguments{
+  \item{ROI}{object created by
+  \code{\link{optimize.portfolio}}}
+
+  \item{R}{an xts, vector, matrix, data frame, timeSeries
+  or zoo object of asset returns, used to recalulate the
+  risk and return metric}
+
+  \item{rp}{set of weights generated by
+  \code{\link{random_portfolio}}}
+
+  \item{portfolio}{pass in a different portfolio object
+  used in set.portfolio.moments}
+
+  \item{risk.col}{string matching the objective of a 'risk'
+  objective, on horizontal axis}
+
+  \item{return.col}{string matching the objective of a
+  'return' objective, on vertical axis}
+
+  \item{...}{any other passthru parameters}
+
+  \item{cex.axis}{The magnification to be used for axis
+  annotation relative to the current setting of \code{cex}}
+
+  \item{element.color}{color for the default plot scatter
+  points}
+
+  \item{neighbors}{set of 'neighbor' portfolios to
+  overplot}
+
+  \item{main}{an overall title for the plot: see
+  \code{\link{title}}}
+}
+\description{
+  The ROI optimizers do not store the portfolio weights
+  like DEoptim or random portfolios so we will generate
+  random portfolios for the scatter plot.
+}
+\details{
+  \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
+}
+\author{
+  Ross Bennett
+}
+\seealso{
+  \code{\link{optimize.portfolio}}
+}
+



More information about the Returnanalytics-commits mailing list