[Returnanalytics-commits] r3291 - pkg/PortfolioAnalytics/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Dec 19 20:47:08 CET 2013


Author: rossbennett34
Date: 2013-12-19 20:47:08 +0100 (Thu, 19 Dec 2013)
New Revision: 3291

Modified:
   pkg/PortfolioAnalytics/R/optFUN.R
   pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
Minor edit to optFUN to correct bug and correcting how initialpop is set for DEoptim

Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R	2013-12-18 05:07:59 UTC (rev 3290)
+++ pkg/PortfolioAnalytics/R/optFUN.R	2013-12-19 19:47:08 UTC (rev 3291)
@@ -85,6 +85,7 @@
   
   # Remove the rows of Amat and elements of rhs.vec where rhs.vec is Inf or -Inf
   Amat <- Amat[!is.infinite(rhs.vec), ]
+  dir.vec <- dir.vec[!is.infinite(rhs.vec)]
   rhs.vec <- rhs.vec[!is.infinite(rhs.vec)]
   
   # Set up the quadratic objective

Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-12-18 05:07:59 UTC (rev 3290)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-12-19 19:47:08 UTC (rev 3291)
@@ -504,9 +504,9 @@
   }
   # match the args for momentFUN
   .formals <- formals(momentFUN)
-  .formals <- modify.args(formals=.formals, arglist=NULL, ..., dots=TRUE)
-  if("R" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE)
-  if("portfolio" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, portfolio=portfolio, dots=TRUE)
+  .formals <- modify.args(formals=.formals, arglist=NULL, ..., dots=FALSE)
+  if("R" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=FALSE)
+  if("portfolio" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, portfolio=portfolio, dots=FALSE)
   .formals$... <- NULL
   
   # call momentFUN
@@ -634,19 +634,21 @@
     } else{
       # Initial seed population is generated with random_portfolios function if rp is not passed in
       if(hasArg(rp_method)) rp_method=match.call(expand.dots=TRUE)$rp_method else rp_method="sample"
-      if(hasArg(eliminate)) eliminate=match.call(expand.dots=TRUE)$eliminate else eliminate=TRUE
+      # if(hasArg(eliminate)) eliminate=match.call(expand.dots=TRUE)$eliminate else eliminate=TRUE
       if(hasArg(fev)) fev=match.call(expand.dots=TRUE)$fev else fev=0:5
-      rp <- random_portfolios(portfolio=portfolio, permutations=NP, rp_method=rp_method, eliminate=eliminate, fev=fev)
+      rp <- random_portfolios(portfolio=portfolio, permutations=(NP+1), rp_method=rp_method, eliminate=FALSE, fev=fev)
       DEcformals$initialpop <- rp
     }
     
     controlDE <- do.call(DEoptim.control, DEcformals)
-    
     # We are passing fn_map to the optional fnMap function to do the 
     # transformation so we need to force normalize=FALSE in call to constrained_objective
     minw = try(DEoptim( constrained_objective,  lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, env=dotargs, normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio)$weights), silent=TRUE)
     
-    if(inherits(minw, "try-error")) { minw=NULL }
+    if(inherits(minw, "try-error")) { 
+      message(minw)
+      minw=NULL
+    }
     if(is.null(minw)){
       message(paste("Optimizer was unable to find a solution for target"))
       return (paste("Optimizer was unable to find a solution for target"))



More information about the Returnanalytics-commits mailing list