[Rcpp-commits] r2329 - in pkg/RcppDE: . R src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Oct 18 13:31:20 CEST 2010


Author: edd
Date: 2010-10-18 13:31:19 +0200 (Mon, 18 Oct 2010)
New Revision: 2329

Modified:
   pkg/RcppDE/R/DEoptim.R
   pkg/RcppDE/benchmark.txt
   pkg/RcppDE/src/Makevars
   pkg/RcppDE/src/de4_0.cpp
   pkg/RcppDE/src/evaluate.cpp
Log:
large commit as R-Forge was down for a day
de4_0 changes include
 - changing d_storepop to be a Rcpp list that gets population matrices directly
 - strategy if/else is now a switch
 - use static_cast<int> for unif_rand
 - continued experimentation with evaluate() and permute() interfaces
DEoptim R file simplified as storepop is already a list when coming from C++


Modified: pkg/RcppDE/R/DEoptim.R
===================================================================
--- pkg/RcppDE/R/DEoptim.R	2010-10-16 23:08:47 UTC (rev 2328)
+++ pkg/RcppDE/R/DEoptim.R	2010-10-18 11:31:19 UTC (rev 2329)
@@ -96,16 +96,17 @@
   outC <- .Call("DEoptimC", lower, upper, fn1, ctrl, new.env(), PACKAGE = "RcppDE")
   ##
   if (length(outC$storepop) > 0) {
-    nstorepop <- floor((outC$iter - ctrl$storepopfrom) / ctrl$storepopfreq)
-    storepop <- list()
-    cnt <- 1
-    for(i in 1:nstorepop) {
-      idx <- cnt:((cnt - 1) + (ctrl$NP * ctrl$npar))
-      storepop[[i]] <- matrix(outC$storepop[idx], nrow = ctrl$NP, ncol = ctrl$npar,
-                         byrow = TRUE)
-      cnt <- cnt + (ctrl$NP * ctrl$npar)
-      dimnames(storepop[[i]]) <- list(1:ctrl$NP, nam)
-    }
+    ## nstorepop <- floor((outC$iter - ctrl$storepopfrom) / ctrl$storepopfreq)
+    ## storepop <- list()
+    ## cnt <- 1
+    ## for(i in 1:nstorepop) {
+    ##   idx <- cnt:((cnt - 1) + (ctrl$NP * ctrl$npar))
+    ##   storepop[[i]] <- matrix(outC$storepop[idx], nrow = ctrl$NP, ncol = ctrl$npar,
+    ##                      byrow = TRUE)
+    ##   cnt <- cnt + (ctrl$NP * ctrl$npar)
+    ##   dimnames(storepop[[i]]) <- list(1:ctrl$NP, nam)
+    ## }
+    storepop <- outC$storepop
   }
   else {
     storepop = NULL

Modified: pkg/RcppDE/benchmark.txt
===================================================================
--- pkg/RcppDE/benchmark.txt	2010-10-16 23:08:47 UTC (rev 2328)
+++ pkg/RcppDE/benchmark.txt	2010-10-18 11:31:19 UTC (rev 2329)
@@ -256,7 +256,7 @@
 MEANS       0.564717 0.577228           1.0222      -2.21547
 
 
-# At  2010-10-16 18:07:26.014139
+# At  2010-10-16 18:07:26.014139 
 # SVN  2327M 
              DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
 Rastrigin2  0.040556 0.041333           1.0192      -1.91781
@@ -270,3 +270,99 @@
 Genrose20   0.900778 0.897722           0.9966       0.33921
 Genrose50   2.522278 2.598667           1.0303      -3.02857
 MEANS       0.564606 0.575750           1.0197      -1.97385
+
+
+# At  2010-10-17 14:11:35.50636
+# SVN  2328M 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040667 0.041444           1.0191      -1.91257
+Rastrigin5  0.105889 0.107833           1.0184      -1.83631
+Rastrigin20 0.551611 0.554111           1.0045      -0.45322
+Wild2       0.066278 0.067333           1.0159      -1.59262
+Wild5       0.179833 0.182944           1.0173      -1.73000
+Wild20      1.041667 1.049222           1.0073      -0.72533
+Genrose2    0.068667 0.069778           1.0162      -1.61812
+Genrose5    0.179111 0.183056           1.0220      -2.20223
+Genrose20   0.877722 0.884722           1.0080      -0.79752
+Genrose50   2.504111 2.571556           1.0269      -2.69335
+MEANS       0.561556 0.571200           1.0172      -1.71745
+
+
+# At  2010-10-17 14:31:23.884337
+# SVN  2328M 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040444 0.042167           1.0426      -4.25824
+Rastrigin5  0.106111 0.109389           1.0309      -3.08901
+Rastrigin20 0.547722 0.556889           1.0167      -1.67360
+Wild2       0.066167 0.067222           1.0160      -1.59530
+Wild5       0.179722 0.182222           1.0139      -1.39104
+Wild20      1.041222 1.049056           1.0075      -0.75232
+Genrose2    0.068278 0.070278           1.0293      -2.92921
+Genrose5    0.181056 0.183333           1.0126      -1.25805
+Genrose20   0.878833 0.886500           1.0087      -0.87237
+Genrose50   2.544944 2.574889           1.0118      -1.17662
+MEANS       0.565450 0.572194           1.0119      -1.19276
+
+
+# At  2010-10-17 15:13:45.700745
+# SVN  2328M 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040556 0.041278           1.0178       -1.7808
+Rastrigin5  0.106111 0.107778           1.0157       -1.5707
+Rastrigin20 0.548167 0.560222           1.0220       -2.1993
+Wild2       0.066167 0.067833           1.0252       -2.5189
+Wild5       0.179722 0.188000           1.0461       -4.6059
+Wild20      1.043611 1.064833           1.0203       -2.0335
+Genrose2    0.068389 0.071056           1.0390       -3.8993
+Genrose5    0.180333 0.186889           1.0364       -3.6352
+Genrose20   0.877667 0.905778           1.0320       -3.2029
+Genrose50   2.506000 2.642111           1.0543       -5.4314
+MEANS       0.561672 0.583578           1.0390       -3.9001
+edd at max:~/svn/rcpp/pkg/RcppDE$ svnversion ; ./benchmark.r
+
+
+# At  2010-10-17 15:18:19.55212
+# SVN  2328M 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040667 0.041500           1.0205       -2.0492
+Rastrigin5  0.106333 0.108833           1.0235       -2.3511
+Rastrigin20 0.545778 0.560722           1.0274       -2.7382
+Wild2       0.066611 0.068389           1.0267       -2.6689
+Wild5       0.179167 0.185444           1.0350       -3.5039
+Wild20      1.042556 1.070389           1.0267       -2.6697
+Genrose2    0.069056 0.071222           1.0314       -3.1376
+Genrose5    0.180278 0.187833           1.0419       -4.1911
+Genrose20   0.875556 0.905944           1.0347       -3.4708
+Genrose50   2.512778 2.640722           1.0509       -5.0918
+MEANS       0.561878 0.584100           1.0395       -3.9550
+
+
+# At  2010-10-17 15:24:36.53087
+# SVN  2328M 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040389 0.042111           1.0426       -4.2641
+Rastrigin5  0.106778 0.109778           1.0281       -2.8096
+Rastrigin20 0.551556 0.568389           1.0305       -3.0520
+Wild2       0.066389 0.068111           1.0259       -2.5941
+Wild5       0.181167 0.186056           1.0270       -2.6986
+Wild20      1.048333 1.066667           1.0175       -1.7488
+Genrose2    0.067944 0.070444           1.0368       -3.6795
+Genrose5    0.181722 0.185833           1.0226       -2.2623
+Genrose20   0.883389 0.899778           1.0186       -1.8552
+Genrose50   2.500611 2.630778           1.0521       -5.2054
+
+
+# At  2010-10-17 20:12:05.239237
+# SVN  2328M 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040500 0.042167           1.0412       -4.1152
+Rastrigin5  0.106111 0.109667           1.0335       -3.3508
+Rastrigin20 0.547056 0.557444           1.0190       -1.8991
+Wild2       0.066222 0.068167           1.0294       -2.9362
+Wild5       0.180778 0.184556           1.0209       -2.0897
+Wild20      1.037444 1.056056           1.0179       -1.7939
+Genrose2    0.068111 0.071722           1.0530       -5.3018
+Genrose5    0.182389 0.187389           1.0274       -2.7414
+Genrose20   0.876778 0.902833           1.0297       -2.9717
+Genrose50   2.494500 2.597722           1.0414       -4.1380
+MEANS       0.559989 0.577772           1.0318       -3.1757

Modified: pkg/RcppDE/src/Makevars
===================================================================
--- pkg/RcppDE/src/Makevars	2010-10-16 23:08:47 UTC (rev 2328)
+++ pkg/RcppDE/src/Makevars	2010-10-18 11:31:19 UTC (rev 2329)
@@ -3,4 +3,5 @@
 ##PKG_LIBS=$(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) -fopenmp
 ##PKG_LIBS= -fopenmp -lgomp $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
 ##PKG_CXXFLAGS+=-D_FORTIFY_SOURCE=0 -g0 -funsafe-loop-optimizations -Wunsafe-loop-optimizations
-PKG_LIBS= $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
+##PKG_LIBS= $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) -lprofiler
+PKG_LIBS= $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 

Modified: pkg/RcppDE/src/de4_0.cpp
===================================================================
--- pkg/RcppDE/src/de4_0.cpp	2010-10-16 23:08:47 UTC (rev 2328)
+++ pkg/RcppDE/src/de4_0.cpp	2010-10-18 11:31:19 UTC (rev 2329)
@@ -8,6 +8,7 @@
 // (http://www.icsi.berkeley.edu/~storn/DeWin.zip)
 
 #include <RcppArmadillo.h>
+//#include <google/profiler.h>
 
 RcppExport SEXP DEoptimC(SEXP lower, SEXP upper, SEXP fn, SEXP control, SEXP rho);
 void devol(double VTR, double f_weight, double fcross, int i_bs_flag, 
@@ -18,12 +19,15 @@
            arma::mat    & ta_popP, arma::mat    & ta_oldP, arma::mat    & ta_newP, arma::rowvec & t_bestP, 
 	   arma::rowvec & ta_popC, arma::rowvec & ta_oldC, arma::rowvec & ta_newC, double       & t_bestC,	
            arma::rowvec & t_bestitP, arma::rowvec & t_tmpP, arma::rowvec & tempP,
-           arma::mat & d_pop, arma::rowvec & d_storepop, arma::mat & d_bestmemit, arma::rowvec & d_bestvalit,
+           arma::mat & d_pop, /*arma::rowvec*/ Rcpp::List & d_storepop, arma::mat & d_bestmemit, arma::rowvec & d_bestvalit,
            int & i_iterations, double i_pPct, long & l_nfeval);
+//RcppExport void permute(arma::icolvec & ia_urn2, int i_avoid, arma::icolvec & ia_urntmp);
+//RcppExport double evaluate(long & l_nfeval, const arma::rowvec & param, SEXP par, SEXP fcall, SEXP env);
 void permute(int ia_urn2[], int i_urn2_depth, int i_NP, int i_avoid, int ia_urntmp[]);
-RcppExport double evaluate(long & l_nfeval, const arma::rowvec & param, SEXP par, SEXP fcall, SEXP env);
+RcppExport double evaluate(long &l_nfeval, const double *param, SEXP parS, SEXP fcall, SEXP env);
 
 RcppExport SEXP DEoptimC(SEXP lowerS, SEXP upperS, SEXP fnS, SEXP controlS, SEXP rhoS) {
+    //ProfilerStart("/tmp/RcppDE.prof");
     BEGIN_RCPP ;	// macro to fill in try part of try/catch exception handler
 
     Rcpp::Function fn(fnS);						// function to mininise
@@ -69,7 +73,8 @@
 
     int i_nstorepop = ceil((i_itermax - i_storepopfrom) / i_storepopfreq);
     arma::mat d_pop(i_NP, i_D); 
-    arma::rowvec d_storepop(i_NP*i_D*i_nstorepop); 
+    //arma::rowvec d_storepop(i_NP*i_D*i_nstorepop); 
+    Rcpp::List d_storepop(i_nstorepop);
     arma::mat d_bestmemit(i_itermax, i_D);       
     arma::rowvec d_bestvalit(i_itermax); 	 
     int i_iter = 0;
@@ -95,22 +100,25 @@
 
 void devol(double VTR, double f_weight, double f_cross, int i_bs_flag,
            arma::rowvec & fa_minbound, arma::rowvec & fa_maxbound, SEXP fcall, SEXP rho, int i_trace,
-           int i_strategy, int i_D, int i_NP, int i_itermax,
-           arma::mat & initialpopm, int i_storepopfrom, int i_storepopfreq, 
-           int i_specinitialpop, int i_check_winner, int i_av_winner,
-           arma::mat &ta_popP, arma::mat &ta_oldP, arma::mat &ta_newP, 
-	   arma::rowvec & t_bestP, arma::rowvec & ta_popC, arma::rowvec & ta_oldC, arma::rowvec & ta_newC, 
-	   double & t_bestC,
+           int i_strategy, int i_D, int i_NP, int i_itermax, arma::mat & initialpopm, 
+	   int i_storepopfrom, int i_storepopfreq, int i_specinitialpop, int i_check_winner, int i_av_winner,
+           arma::mat &ta_popP, arma::mat &ta_oldP, arma::mat &ta_newP, arma::rowvec & t_bestP, 
+           arma::rowvec & ta_popC, arma::rowvec & ta_oldC, arma::rowvec & ta_newC, double & t_bestC,
            arma::rowvec & t_bestitP, arma::rowvec & t_tmpP, arma::rowvec & tempP,
-           arma::mat &d_pop, arma::rowvec &d_storepop, arma::mat & d_bestmemit, arma::rowvec & d_bestvalit,
+           arma::mat &d_pop, /*arma::rowvec*/ Rcpp::List &d_storepop, arma::mat & d_bestmemit, arma::rowvec & d_bestvalit,
            int & i_iterations, double i_pPct, long & l_nfeval) {
 
     const int urn_depth = 5;   			// 4 + one index to avoid 
-    Rcpp::NumericVector par(i_D);  		// initialize parameter vector to pass to evaluate function 
+    //arma::rowvec parvec(i_D);  		// initialize parameter vector to pass to evaluate function 
+    //SEXP par = Rcpp::wrap(parvec);
+    Rcpp::NumericVector par(i_D);
     int i, j, k, i_r1, i_r2, i_r3, i_r4;  	// counting variables and placeholders for random indexes
     
     int ia_urn2[urn_depth];
-    Rcpp::IntegerVector ia_urntmp(i_NP); 	// so that we don't need to re-allocated each time in permute
+    //Rcpp::IntegerVector ia_urntmp(i_NP); 	// so that we don't need to re-allocated each time in permute
+    arma::irowvec ia_urntmp(i_NP);
+    //arma::icolvec::fixed<urn_depth> ia_urn2; 	// fixed-size vector for urn draws
+    //arma::icolvec ia_urntmp(i_NP); 		// so that we don't need to re-allocated each time in permute
 
     int i_nstorepop = ceil((i_itermax - i_storepopfrom) / i_storepopfreq);
     int i_xav, popcnt, bestacnt, same; 		// lazy cnters 
@@ -135,19 +143,13 @@
     d_bestmemit.zeros();    			// initialize best members
     d_bestvalit.zeros();			// initialize best values 
     d_pop.zeros();				// initialize best population
-    d_storepop.zeros();				// initialize stored populations 
+    //d_storepop.zeros();			// initialize stored populations 
     i_nstorepop = (i_nstorepop < 0) ? 0 : i_nstorepop;
       
     if (i_specinitialpop > 0) {    		// if initial population provided, initialize with values 
-	k = 0;
-	for (j = 0; j < i_D; j++) { 		// FIXME: should really have a matrix passed in ! 
-	    for (i = 0; i < i_NP; i++) {
-		initialpop.at(i,j) = initialpopm[k];
-		k += 1;
-	    }
-	}
+	initialpop = initialpopm;
     }
-    l_nfeval = 0;    				// number of function evaluations (this is an input via DEoptim.control, but we over-write it?) 
+    //l_nfeval = 0;    				// already init'ed in main function
 
     for (i = 0; i < i_NP; i++) {		// ------Initialization-----------------------------
 	if (i_specinitialpop <= 0) { 		// random initial member 
@@ -157,7 +159,8 @@
 	} else { 				// or user-specified initial member 
 	    ta_popP.row(i) = initialpop.row(i);
 	} 
-	ta_popC[i] = evaluate(l_nfeval, ta_popP.row(i), par, fcall, rho);
+	arma::rowvec r = ta_popP.row(i);
+	ta_popC[i] = evaluate(l_nfeval, r.memptr(), par, fcall, rho);
 	if (i == 0 || ta_popC[i] <= t_bestC) {
 	    t_bestC = ta_popC[i];
 	    t_bestP = ta_popP.row(i);
@@ -174,12 +177,13 @@
   
     while ((i_iter < i_itermax) && (t_bestC > VTR)) {    // main loop ====================================
 	if (i_iter % i_storepopfreq == 0 && i_iter >= i_storepopfrom) {  	// store intermediate populations -- FIXME could be list (or arma::field) of matrices
-	    for (i = 0; i < i_NP; i++) {
-		for (j = 0; j < i_D; j++) {
-		    d_storepop[popcnt] = ta_oldP.at(i,j);
-		    popcnt++;
-		}
-	    }
+	    // for (i = 0; i < i_NP; i++) {
+	    // 	for (j = 0; j < i_D; j++) {
+	    // 	    d_storepop[popcnt] = ta_oldP.at(i,j);
+	    // 	    popcnt++;
+	    // 	}
+	    // }
+	    d_storepop[popcnt++] = Rcpp::wrap(ta_oldP);
 	} // end store pop 
       
 	d_bestmemit.row(i_iter) = t_bestP;	// store the best member
@@ -200,102 +204,85 @@
 	    t_tmpP = ta_oldP.row(i);		// t_tmpP is the vector to mutate and eventually select
 	    t_tmpC = ta_oldC[i];
 
-	    permute(ia_urn2, urn_depth, i_NP, i, ia_urntmp.begin()); // Pick 4 random and distinct 
-	    i_r1 = ia_urn2[1];  // population members 
+	    permute(ia_urn2, urn_depth, i_NP, i, ia_urntmp.memptr()); // Pick 4 random and distinct 
+	    //permute(ia_urn2, i, ia_urntmp); 	// Pick 4 random and distinct 
+	    i_r1 = ia_urn2[1];  		// population members 
 	    i_r2 = ia_urn2[2];
 	    i_r3 = ia_urn2[3];
 	    i_r4 = ia_urn2[4];
-		
+	    k = 0;				// loop counter used in all strategies below 
+
 	    // ===Choice of strategy=======================================================
-	    if (i_strategy == 1) { 		// ---classical strategy DE/rand/1/bin-----------------------------------------
-	  
-		j = (int)(unif_rand() * i_D); 	// random parameter 
-		k = 0;
-		do {
-		    // add fluctuation to random target 
-		    t_tmpP[j] = ta_oldP.at(i_r1,j) + f_weight * (ta_oldP.at(i_r2,j) - ta_oldP.at(i_r3,j));
-		    j = (j + 1) % i_D;
-		    k++;
-		} while ((unif_rand() < f_cross) && (k < i_D));
+	    switch (i_strategy) { 		// and putting default value one first
 
-	    } else if (i_strategy == 2) {	// ---DE/local-to-best/1/bin---------------------------------------------------
-	 
-		j = (int)(unif_rand() * i_D); 	// random parameter 
-		k = 0;
-		do {
-		    // add fluctuation to random target 
+	    case 2:				// ---DE/local-to-best/1/bin---------------------------------------------------
+		j = static_cast<int>(unif_rand() * i_D); 	// random parameter 
+		do {				// add fluctuation to random target 
 		    t_tmpP[j] = t_tmpP[j] + f_weight * (t_bestitP[j] - t_tmpP[j]) + f_weight * (ta_oldP.at(i_r2,j) - ta_oldP.at(i_r3,j));
 		    j = (j + 1) % i_D;
-		    k++;
-		} while ((unif_rand() < f_cross) && (k < i_D));
+		} while ((unif_rand() < f_cross) && (++k < i_D));
+		break;
 
-	    } else if (i_strategy == 3) {	// ---DE/best/1/bin with jitter------------------------------------------------
-	 	  
-		j = (int)(unif_rand() * i_D); 	// random parameter 
-		k = 0;
-		do {
-		    f_jitter = 0.0001 * unif_rand() + f_weight; // add fluctuation to random target 
+	    case 1:				// ---classical strategy DE/rand/1/bin-----------------------------------------
+		j = static_cast<int>(unif_rand() * i_D); 	// random parameter 
+		do {				// add fluctuation to random target 
+		    t_tmpP[j] = ta_oldP.at(i_r1,j) + f_weight * (ta_oldP.at(i_r2,j) - ta_oldP.at(i_r3,j));
+		    j = (j + 1) % i_D;
+		} while ((unif_rand() < f_cross) && (++k < i_D));
+		break;
+
+	    case 3:				// ---DE/best/1/bin with jitter------------------------------------------------
+		j = static_cast<int>(unif_rand() * i_D); 	// random parameter 
+		do {				// add fluctuation to random target 
+		    f_jitter = 0.0001 * unif_rand() + f_weight; 
 		    t_tmpP[j] = t_bestitP[j] + f_jitter * (ta_oldP.at(i_r1,j) - ta_oldP.at(i_r2,j));
 		    j = (j + 1) % i_D;
-		    k++;
-		} while ((unif_rand() < f_cross) && (k < i_D));
+		} while ((unif_rand() < f_cross) && (++k < i_D));
+		break;
 
-	    } else if (i_strategy == 4) {	// ---DE/rand/1/bin with per-vector-dither-------------------------------------
-		  
-		j = (int)(unif_rand() * i_D); 	// random parameter 
-		k = 0;
-		do {
-		    // add fluctuation to random target *
+	    case 4:				// ---DE/rand/1/bin with per-vector-dither-------------------------------------
+		j = static_cast<int>(unif_rand() * i_D); 	// random parameter 
+		do {				// add fluctuation to random target *
 		    t_tmpP[j] = ta_oldP.at(i_r1,j) + (f_weight + unif_rand()*(1.0 - f_weight))* (ta_oldP.at(i_r2,j) - ta_oldP.at(i_r3,j));
 		    j = (j + 1) % i_D;
-		    k++;
-		} while ((unif_rand() < f_cross) && (k < i_D));
+		} while ((unif_rand() < f_cross) && (++k < i_D));
+		break;
 
-	    } else if (i_strategy == 5) {	// ---DE/rand/1/bin with per-generation-dither---------------------------------
-	  
-		j = (int)(unif_rand() * i_D); 	// random parameter 
-		k = 0;
-		do {
-		    // add fluctuation to random target 
+	    case 5:				// ---DE/rand/1/bin with per-generation-dither---------------------------------
+		j = static_cast<int>(unif_rand() * i_D); 	// random parameter 
+		do {				// add fluctuation to random target 
 		    t_tmpP[j] = ta_oldP.at(i_r1,j) + f_dither * (ta_oldP.at(i_r2,j) - ta_oldP.at(i_r3,j));
-	    
 		    j = (j + 1) % i_D;
-		    k++;
-		} while ((unif_rand() < f_cross) && (k < i_D));
-       
-	    } else if (i_strategy == 6) {	// ---DE/current-to-p-best/1 (JADE)--------------------------------------------
+		} while ((unif_rand() < f_cross) && (++k < i_D));
+		break;
 
-		i_pbest = sortIndex[(int)(unif_rand() * p_NP)]; // select from [0, 1, 2, ..., (pNP-1)] 
-		j = (int)(unif_rand() * i_D); 			// random parameter 
-		k = 0;
-		do {
-		    // add fluctuation to random target 
+	    case 6:				// ---DE/current-to-p-best/1 (JADE)--------------------------------------------
+		i_pbest = sortIndex[static_cast<int>(unif_rand() * p_NP)]; // select from [0, 1, 2, ..., (pNP-1)] 
+		j = static_cast<int>(unif_rand() * i_D); 	// random parameter 
+		do {				// add fluctuation to random target 
 		    t_tmpP[j] = ta_oldP.at(i,j) + f_weight * (ta_oldP.at(i_pbest,j) - ta_oldP.at(i,j)) + f_weight * (ta_oldP.at(i_r1,j) - ta_oldP.at(i_r2,j));
 		    j = (j + 1) % i_D;
-		    k++;
-		} while((unif_rand() < f_cross) && (k < i_D));
+		} while ((unif_rand() < f_cross) && (++k < i_D));
+		break;
 
-	    } else {				// ---variation to DE/rand/1/bin: either-or-algorithm--------------------------
-	  
-		j = (int)(unif_rand() * i_D); 	// random parameter 
-		k = 0;
+	    default:				// ---variation to DE/rand/1/bin: either-or-algorithm--------------------------
+		j = static_cast<int>(unif_rand() * i_D); 	// random parameter 
 		if (unif_rand() < 0.5) { 	// differential mutation, Pmu = 0.5 
 		    do {
 			// add fluctuation to random target */
 			t_tmpP[j] = ta_oldP.at(i_r1,j) + f_weight * (ta_oldP.at(i_r2,j) - ta_oldP.at(i_r3,j));
 			j = (j + 1) % i_D;
-			k++;
-		    } while((unif_rand() < f_cross) && (k < i_D));
+		    } while ((unif_rand() < f_cross) && (++k < i_D));
 
 		} else { 			// recombination with K = 0.5*(F+1) -. F-K-Rule 
 		    do {
 			// add fluctuation to random target */
 			t_tmpP[j] = ta_oldP.at(i_r1,j) + 0.5 * (f_weight + 1.0) * (ta_oldP.at(i_r2,j) + ta_oldP.at(i_r3,j) - 2 * ta_oldP.at(i_r1,j));
 			j = (j + 1) % i_D;
-			k++;
-		    } while((unif_rand() < f_cross) && (k < i_D));
+		    } while ((unif_rand() < f_cross) && (++k < i_D));
 		}
-	    } // end if (i_strategy ...
+		break;
+	    } // end switch (i_strategy) ...
 	
 	    // ----boundary constraints, bounce-back method was not enforcing bounds correctly
 	    for (j = 0; j < i_D; j++) {
@@ -308,7 +295,7 @@
 	    }
 
 	    // ------Trial mutation now in t_tmpP-----------------
-	    t_tmpC = evaluate(l_nfeval, t_tmpP, par, fcall, rho); 	    // Evaluate mutant in t_tmpP[]
+	    t_tmpC = evaluate(l_nfeval, t_tmpP.memptr(), par, fcall, rho);	// Evaluate mutant in t_tmpP[]
 
 	    // note that i_bs_flag means that we will choose the best NP vectors from the old and new population later
 	    if (t_tmpC <= ta_oldC[i] || i_bs_flag) {
@@ -368,7 +355,7 @@
 		}
 	    if (same && i_iter > 1)  {
 		i_xav++;
-		tmp_best = evaluate(l_nfeval, t_bestP, par, fcall, rho);			// if re-evaluation of winner 
+		tmp_best = evaluate(l_nfeval, t_bestP.memptr(), par, fcall, rho);			// if re-evaluation of winner 
 		
 		if (i_av_winner)		//  possibly letting the winner be the average of all past generations 
 		    t_bestC = ((1/(double)i_xav) * t_bestC) + ((1/(double)i_xav) * tmp_best) + (d_bestvalit[i_iter-1] * ((double)(i_xav - 2))/(double)i_xav);
@@ -381,13 +368,11 @@
 	t_bestitP = t_bestP;
 	t_bestitC = t_bestC;
 
-	if ( i_trace > 0 ) {
-	    if ( (i_iter % i_trace) == 0 ) {
-		Rprintf("Iteration: %d bestvalit: %f bestmemit:", i_iter, t_bestC);
-		for (j = 0; j < i_D; j++)
-		    Rprintf("%12.6f", t_bestP[j]);
-		Rprintf("\n");
-	    }
+	if ( (i_trace > 0)  &&  ((i_iter % i_trace) == 0) ) {
+	    Rprintf("Iteration: %d bestvalit: %f bestmemit:", i_iter, t_bestC);
+	    for (j = 0; j < i_D; j++)
+		Rprintf("%12.6f", t_bestP[j]);
+	    Rprintf("\n");
 	}
     } // end loop through generations 
     
@@ -395,9 +380,11 @@
     i_iterations = i_iter;
 
     PutRNGstate();
+    //ProfilerStop();
 }
 
 inline void permute(int ia_urn2[], int i_urn2_depth, int i_NP, int i_avoid, int ia_urn1[])
+//RcppExport inline void permute(arma::icolvec & ia_urn2, int i_avoid, arma::icolvec & ia_urn1)
 /********************************************************************
  ** Function       : void permute(int ia_urn2[], int i_urn2_depth)
  ** Author         : Rainer Storn (w/bug fixes contributed by DEoptim users)
@@ -420,12 +407,14 @@
  *********************************************************************/
 {
     GetRNGstate();
-
     int k = i_NP;
+    //int i_urn2_depth = ia_urn2.n_elem; 		// ie const urn_depth
+    //int i_NP = ia_urn1.n_elem;			
+    //int k = ia_urn1.n_elem;			
     int i_urn1 = 0;
     int i_urn2 = 0;
     for (int i = 0; i < i_NP; i++)
-	ia_urn1[i] = i; /* initialize urn1 */
+	ia_urn1[i] = i; 		   /* initialize urn1 */
 
     i_urn1 = i_avoid;                      /* get rid of the index to be avoided and place it in position 0. */
     while (k > i_NP - i_urn2_depth) {      /* i_urn2_depth is the amount of indices wanted (must be <= NP) */
@@ -433,8 +422,7 @@
 	ia_urn1[i_urn1] = ia_urn1[k-1];    /* move highest index to fill gap */
 	k = k - 1;                         /* reduce number of accessible indices */
 	i_urn2 = i_urn2 + 1;               /* next position in urn2 */
-	i_urn1 = (int)(unif_rand() * k);   /* choose a random index */
+	i_urn1 = static_cast<int>(unif_rand() * k);   /* choose a random index */
     }
-
     PutRNGstate();
 }

Modified: pkg/RcppDE/src/evaluate.cpp
===================================================================
--- pkg/RcppDE/src/evaluate.cpp	2010-10-16 23:08:47 UTC (rev 2328)
+++ pkg/RcppDE/src/evaluate.cpp	2010-10-18 11:31:19 UTC (rev 2329)
@@ -7,12 +7,12 @@
 
 #include <RcppArmadillo.h>
 
-RcppExport double evaluate(long &l_nfeval, const arma::rowvec & param, SEXP parS, SEXP fcall, SEXP env) {
-    //RcppExport double evaluate(long &l_nfeval, const double *param, SEXP parS, SEXP fcall, SEXP env) {
+//RcppExport double evaluate(long &l_nfeval, const arma::rowvec & param, SEXP parS, SEXP fcall, SEXP env) {
+RcppExport double evaluate(long &l_nfeval, const double *param, SEXP parS, SEXP fcall, SEXP env) {
     Rcpp::NumericVector par(parS); 			// access parS as numeric vector to fill it
-    memcpy(par.begin(), param.memptr(), par.size() * sizeof(double));
+    //memcpy(par.begin(), param.memptr(), par.size() * sizeof(double));
     //std::copy(param.begin(), param.end(), par.begin()); // STL way of copying
-    //memcpy(par.begin(), param, par.size() * sizeof(double));
+    memcpy(par.begin(), param, par.size() * sizeof(double));
     SEXP fn = ::Rf_lang2(fcall, par); 			// this could be done with Rcpp 
     SEXP sexp_fvec = ::Rf_eval(fn, env);		// but is still a lot slower right now
     double f_result = Rcpp::as<double>(sexp_fvec);



More information about the Rcpp-commits mailing list