[Deoptim-commits] r111 - in pkg/DEoptim: man sandbox src

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

Author: kmm
Date: 2012-09-30 09:18:17 +0200 (Sun, 30 Sep 2012)
New Revision: 111

Modified:
   pkg/DEoptim/man/DEoptim.Rd
   pkg/DEoptim/sandbox/slimLargeN_map.R
   pkg/DEoptim/src/de4_0.c
   pkg/DEoptim/src/evaluate.c
Log:
eval cnter

Modified: pkg/DEoptim/man/DEoptim.Rd
===================================================================
--- pkg/DEoptim/man/DEoptim.Rd	2012-09-27 23:41:45 UTC (rev 110)
+++ pkg/DEoptim/man/DEoptim.Rd	2012-09-30 07:18:17 UTC (rev 111)
@@ -19,7 +19,8 @@
   \item{control}{a list of control parameters; see \code{\link{DEoptim.control}}.}
   \item{fnMap}{an optional function that will be run after each population is
     created, but before the population is passed to the objective function. This
-    allows the user to impose integer/cardinality constriants.}
+    allows the user to impose integer/cardinality constriants.  See the
+    the sandbox directory of the source code for a simple example. }
   \item{...}{further arguments to be passed to \code{fn}.}
 }
 \details{

Modified: pkg/DEoptim/sandbox/slimLargeN_map.R
===================================================================
--- pkg/DEoptim/sandbox/slimLargeN_map.R	2012-09-27 23:41:45 UTC (rev 110)
+++ pkg/DEoptim/sandbox/slimLargeN_map.R	2012-09-30 07:18:17 UTC (rev 111)
@@ -1,8 +1,8 @@
 setwd("~/R/packages/deoptim/pkg/DEoptim/sandbox")
-suppressMessages({
+#suppressMessages({
 library(PerformanceAnalytics)
 library(DEoptim)
-})
+#})
 
 load("10y_returns.rda")
 load("random_portfolios.rda")
@@ -50,9 +50,9 @@
   x <- round(x,2) # produce some dups
   x/sum(x)
 }
+
 set.seed(1234)
 system.time(out <- DEoptim(fn=obj, lower=lower,
   upper=upper, control=controlDE, fnMap=mappingFun))
 out$optim$iter
 out$optim$bestval
-

Modified: pkg/DEoptim/src/de4_0.c
===================================================================
--- pkg/DEoptim/src/de4_0.c	2012-09-27 23:41:45 UTC (rev 110)
+++ pkg/DEoptim/src/de4_0.c	2012-09-30 07:18:17 UTC (rev 111)
@@ -41,7 +41,7 @@
            double d_reltol, int i_steptol, SEXP fnMap);
 void permute(int ia_urn2[], int i_urn2_depth, int i_NP, int i_avoid, int ia_urn1[]);
 double evaluate(long *l_nfeval, SEXP par, SEXP fcall, SEXP env);
-SEXP popEvaluate(long *l_nfeval, SEXP parMat, SEXP fcall, SEXP env);
+SEXP popEvaluate(long *l_nfeval, SEXP parMat, SEXP fcall, SEXP env, int incrementEval);
 
 
 /*------General functions-----------------------------------------*/
@@ -262,10 +262,10 @@
         ngta_popP[i+i_NP*j] = initialpop[i][j];
     }
   }
-  PROTECT(sexp_map_pop  = popEvaluate(l_nfeval, sexp_gta_popP, fnMap, rho));
+  PROTECT(sexp_map_pop  = popEvaluate(l_nfeval, sexp_gta_popP, fnMap, rho, 0));
   memcpy(REAL(sexp_gta_popP), REAL(sexp_map_pop), i_NP * i_D * sizeof(double));
   UNPROTECT(1);  // sexp_map_pop
-  PROTECT(sexp_gta_popC = popEvaluate(l_nfeval, sexp_gta_popP,  fcall, rho));
+  PROTECT(sexp_gta_popC = popEvaluate(l_nfeval, sexp_gta_popP,  fcall, rho, 1));
   ngta_popC = REAL(sexp_gta_popC);
   for (i = 0; i < i_NP; i++) {
     if (i == 0 || ngta_popC[i] <= t_bestC) {
@@ -423,10 +423,10 @@
     /*------Trial mutation now in t_tmpP-----------------*/
     /* evaluate mutated population */
     if(i_iter > 1) UNPROTECT(1);  // previous iteration's sexp_t_tmpC
-    PROTECT(sexp_map_pop = popEvaluate(l_nfeval, sexp_t_tmpP,  fnMap, rho));
+    PROTECT(sexp_map_pop = popEvaluate(l_nfeval, sexp_t_tmpP,  fnMap, rho, 0));
     memcpy(REAL(sexp_t_tmpP), REAL(sexp_map_pop), i_NP * i_D * sizeof(double));
     UNPROTECT(1);  // sexp_map_pop
-    PROTECT(sexp_t_tmpC  = popEvaluate(l_nfeval, sexp_t_tmpP, fcall, rho));
+    PROTECT(sexp_t_tmpC  = popEvaluate(l_nfeval, sexp_t_tmpP, fcall, rho, 1));
     nt_tmpC = REAL(sexp_t_tmpC);
 
     /* compare old pop with mutated pop */

Modified: pkg/DEoptim/src/evaluate.c
===================================================================
--- pkg/DEoptim/src/evaluate.c	2012-09-27 23:41:45 UTC (rev 110)
+++ pkg/DEoptim/src/evaluate.c	2012-09-30 07:18:17 UTC (rev 111)
@@ -21,7 +21,8 @@
    return(f_result);
 }
 
-SEXP popEvaluate(long *l_nfeval, SEXP parMat, SEXP fcall, SEXP env)
+SEXP popEvaluate(long *l_nfeval, SEXP parMat, SEXP fcall, SEXP env, 
+		 int incrementEval)
 {
    SEXP sexp_fvec, fn;
    double *d_result;
@@ -31,7 +32,8 @@
  
    PROTECT(sexp_fvec = eval(fn, env)); P++;
    int nr = nrows(sexp_fvec);
-   (*l_nfeval) += nr;  
+   if(incrementEval)
+     (*l_nfeval) += nr;  
    if(nr != nrows(parMat))
      error("objective function result has different length than parameter matrix");
    switch(TYPEOF(sexp_fvec)) {