[Deoptim-commits] r118 - pkg/DEoptim/R

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

Author: bodanker
Date: 2015-09-19 17:17:39 +0200 (Sat, 19 Sep 2015)
New Revision: 118

Modified:
   pkg/DEoptim/R/DEoptim.R
Log:
Avoid partial arg matching in pop/map functions

If the users' objective function contained an argument that partially
matched 'params', the DEoptim call could fail. For example:
http://stackoverflow.com/q/32638033/271616

require(DEoptim)
Rastrigin2 <- function(x,p) {
  sum(x^2-p*cos(2*pi*x))+10*length(x)
}
lower <- rep(-5.12, 2)
upper <- -lower
de <- DEoptim(Rastrigin2, lower, upper, p=10)



Modified: pkg/DEoptim/R/DEoptim.R
===================================================================
--- pkg/DEoptim/R/DEoptim.R	2014-09-10 06:22:51 UTC (rev 117)
+++ pkg/DEoptim/R/DEoptim.R	2015-09-19 15:17:39 UTC (rev 118)
@@ -167,9 +167,9 @@
       foreach:::registerDoSEQ()
     }
     args <-  ctrl$parallelArgs
-    fnPop <- function(params, ...) {
-      my_chunksize <- ceiling(NROW(params)/foreach:::getDoParWorkers())
-      my_iter <- iter(params,by="row",chunksize=my_chunksize)
+    fnPop <- function(`*params`, ...) {
+      my_chunksize <- ceiling(NROW(`*params`)/foreach:::getDoParWorkers())
+      my_iter <- iter(`*params`,by="row",chunksize=my_chunksize)
       args$i <- my_iter
       if(is.null(args$.combine)) args$.combine <- c
       args$.export <-c(args$.export,"fn")
@@ -190,24 +190,24 @@
     parallel:::clusterCall(cl, packFn, ctrl$packages)
     if(is.null(ctrl$parVar)) ctrl$parVar <- ls()
     parallel:::clusterExport(cl, ctrl$parVar)
-    fnPop <- function(params, ...) {
+    fnPop <- function(`*params`, ...) {
       #clusterApply(cl, x, fun, ...)
-      parallel:::parApply(cl=cl,x=params,fun=fn, ctrl$parallelArgs, ...)
+      parallel:::parApply(cl=cl,x=`*params`,fun=fn, ctrl$parallelArgs, ...)
     }
   }
   else {  ## use regular for loop / apply
-    fnPop <- function(params, ...) {
-      apply(params,1,fn,...)
+    fnPop <- function(`*params`, ...) {
+      apply(`*params`,1,fn,...)
     }
   }
 
   ## Mapping function
   if(is.null(fnMap)) {
-    fnMapC <- function(params,...) params
+    fnMapC <- function(`*params`,...) `*params`
   } else {
-    fnMapC <- function(params,...) {
-      mappedPop <- t(apply(params,1,fnMap))   ## run mapping function
-      if(all(dim(mappedPop) != dim(params)))  ## check results
+    fnMapC <- function(`*params`,...) {
+      mappedPop <- t(apply(`*params`,1,fnMap))   ## run mapping function
+      if(all(dim(mappedPop) != dim(`*params`)))  ## check results
         stop("mapping function did not return an object with ",
              "dim NP x length(upper).")
       dups <- duplicated(mappedPop)  ## check for duplicates