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

[noreply at r-forge.r-project.org]

Author: rossbennett34
Date: 2013-11-14 20:08:37 +0100 (Thu, 14 Nov 2013)
New Revision: 3256

Added:
   pkg/PortfolioAnalytics/R/utils.R
Modified:
   pkg/PortfolioAnalytics/DESCRIPTION
   pkg/PortfolioAnalytics/R/constrained_objective.R
Log:
Adding modify.args function from quantstrat and using it in constrained_objective to match the arguments for setting the portfolio moments

Modified: pkg/PortfolioAnalytics/DESCRIPTION
===================================================================
--- pkg/PortfolioAnalytics/DESCRIPTION	2013-11-14 19:05:26 UTC (rev 3255)
+++ pkg/PortfolioAnalytics/DESCRIPTION	2013-11-14 19:08:37 UTC (rev 3256)
@@ -61,3 +61,5 @@
     'utility.combine.R'
     'equal.weight.R'
     'inverse.volatility.weight.R'
+    'utils.R'
+

Modified: pkg/PortfolioAnalytics/R/constrained_objective.R
===================================================================
--- pkg/PortfolioAnalytics/R/constrained_objective.R	2013-11-14 19:05:26 UTC (rev 3255)
+++ pkg/PortfolioAnalytics/R/constrained_objective.R	2013-11-14 19:08:37 UTC (rev 3256)
@@ -514,16 +514,33 @@
       out <- out + penalty * mult * abs(sum(abs(w)) - constraints$leverage)
     }
   } # End leverage exposure penalty
-    
-  nargs <- list(...)
-  if(length(nargs)==0) nargs <- NULL
-  if (length('...')==0 | is.null('...')) {
-    # rm('...')
-    nargs <- NULL
-  }
   
-  nargs <- set.portfolio.moments(R, portfolio, momentargs=nargs)
+  # The "..." are passed in from optimize.portfolio and contain the output of
+  # the momentFUN. The default is momentFUN=set.portfolio.moments and returns
+  # moments$mu, moments$sigma, moments$m3, moments$m4, etc. depending on the
+  # the functions corresponding to portfolio$objective$name. Would it be better
+  # to make this a formal argument for constrained_objective?
   
+  # nargs are used as the arguments for functions corresponding to 
+  # objective$name called in the objective loop later
+  
+  momentargs <- eval(substitute(alist(...)))
+  .formals <- formals(set.portfolio.moments)
+  .formals <- modify.args(formals=.formals, arglist=alist(momentargs=momentargs), dots=TRUE)
+  .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE)
+  .formals <- modify.args(formals=.formals, arglist=NULL, portfolio=portfolio, dots=TRUE)
+  .formals$... <- NULL
+  # print(.formals)
+  nargs <- do.call(set.portfolio.moments, .formals)
+  
+  #nargs <- list(...)
+  #if(length(nargs)==0) nargs <- NULL
+  #if (length('...')==0 | is.null('...')) {
+  #  # rm('...')
+  #  nargs <- NULL
+  #}
+  #nargs <- set.portfolio.moments(R, portfolio, momentargs=nargs)
+  
   if(is.null(portfolio$objectives)) {
     warning("no objectives specified in portfolio")
   } else{
@@ -537,7 +554,8 @@
         switch(objective$name,
                mean =,
                median = {
-                 fun = match.fun(objective$name)  
+                 fun = match.fun(objective$name)
+                 # would it be better to do crossprod(w, moments$mu)?
                  nargs$x <- ( R %*% w ) #do the multivariate mean/median with Kroneker product
                },
                sd =,
@@ -596,6 +614,11 @@
           }
         } # TODO do some funky return magic here on try-error
         
+        #.formals <- formals(fun)
+        #.formals <- modify.args(formals=.formals, arglist=objective$arguments, ...=nargs, dots=TRUE)
+        #print(.formals)
+        #print(nargs)
+        
         tmp_measure <- try((do.call(fun,.formals)), silent=TRUE)
         
         if(isTRUE(trace) | isTRUE(storage)) {

Added: pkg/PortfolioAnalytics/R/utils.R
===================================================================
--- pkg/PortfolioAnalytics/R/utils.R	                        (rev 0)
+++ pkg/PortfolioAnalytics/R/utils.R	2013-11-14 19:08:37 UTC (rev 3256)
@@ -0,0 +1,52 @@
+
+modify.args <- function(formals, arglist, ..., dots=FALSE)
+{
+  # modify.args function from quantstrat
+  
+  # avoid evaluating '...' to make things faster
+  dots.names <- eval(substitute(alist(...)))
+  
+  if(missing(arglist))
+    arglist <- NULL
+  arglist <- c(arglist, dots.names)
+  
+  # see 'S Programming' p. 67 for this matching
+  
+  # nothing to do if arglist is empty; return formals
+  if(!length(arglist))
+    return(formals)
+  
+  argnames <- names(arglist)
+  if(!is.list(arglist) && !is.null(argnames) && !any(argnames == ""))
+    stop("'arglist' must be a *named* list, with no names == \"\"")
+  
+  .formals  <- formals
+  onames <- names(.formals)
+  
+  pm <- pmatch(argnames, onames, nomatch = 0L)
+  #if(any(pm == 0L))
+  #    message(paste("some arguments stored for", fun, "do not match"))
+  names(arglist[pm > 0L]) <- onames[pm]
+  .formals[pm] <- arglist[pm > 0L]
+  
+  # include all elements from arglist if function formals contain '...'
+  if(dots && !is.null(.formals$...)) {
+    dotnames <- names(arglist[pm == 0L])
+    .formals[dotnames] <- arglist[dotnames]
+    #.formals$... <- NULL  # should we assume we matched them all?
+  }
+  .formals
+}
+
+# This is how it is used in quantstrat in applyIndicators()
+# # replace default function arguments with indicator$arguments
+# .formals <- formals(indicator$name)
+# .formals <- modify.args(.formals, indicator$arguments, dots=TRUE)
+# # now add arguments from parameters
+# .formals <- modify.args(.formals, parameters, dots=TRUE)
+# # now add dots
+# .formals <- modify.args(.formals, NULL, ..., dots=TRUE)
+# # remove ... to avoid matching multiple args
+# .formals$`...` <- NULL
+# 
+# tmp_val <- do.call(indicator$name, .formals)