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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Oct 16 17:16:13 CEST 2010


Author: edd
Date: 2010-10-16 17:16:12 +0200 (Sat, 16 Oct 2010)
New Revision: 2307

Added:
   pkg/RcppDE/src/evaluate.cpp
Removed:
   pkg/RcppDE/src/evaluate.c
Modified:
   pkg/RcppDE/benchmark.txt
   pkg/RcppDE/src/de4_0.cpp
Log:
evaluate is now a C++ function
l_nfeval also passed as reference
Rcpp converters for SEXP functions calls


Modified: pkg/RcppDE/benchmark.txt
===================================================================
--- pkg/RcppDE/benchmark.txt	2010-10-16 14:40:55 UTC (rev 2306)
+++ pkg/RcppDE/benchmark.txt	2010-10-16 15:16:12 UTC (rev 2307)
@@ -29,4 +29,32 @@
 Genrose50   2.546500 2.528111          0.99278      0.722124
 MEANS       0.567244 0.564806          0.99570      0.429954
 
+# At  2010-10-15 21:01:22.385205 
+# SVN  2302 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040667 0.040222          0.98907       1.09290
+Rastrigin5  0.106167 0.104833          0.98744       1.25589
+Rastrigin20 0.542278 0.548000          1.01055      -1.05522
+Wild2       0.066444 0.066000          0.99331       0.66890
+Wild5       0.182000 0.180500          0.99176       0.82418
+Wild20      1.046444 1.040389          0.99421       0.57868
+Genrose2    0.071000 0.070000          0.98592       1.40845
+Genrose5    0.187667 0.183944          0.98017       1.98342
+Genrose20   0.900278 0.890333          0.98895       1.10460
+Genrose50   2.545444 2.598444          1.02082      -2.08215
+MEANS       0.568839 0.572267          1.00603      -0.60259
 
+# At  2010-10-16 09:51:11.671913
+# SVN  2306M 
+             DEoptim   RcppDE ratioRcppToBasic pctGainOfRcpp
+Rastrigin2  0.040556 0.039889          0.98356       1.64384
+Rastrigin5  0.106167 0.104722          0.98639       1.36054
+Rastrigin20 0.540778 0.546333          1.01027      -1.02733
+Wild2       0.066722 0.066278          0.99334       0.66611
+Wild5       0.182222 0.180778          0.99207       0.79268
+Wild20      1.039167 1.043944          1.00460      -0.45977
+Genrose2    0.071167 0.069389          0.97502       2.49805
+Genrose5    0.186722 0.182944          0.97977       2.02321
+Genrose20   0.894722 0.891167          0.99603       0.39739
+Genrose50   2.562056 2.593056          1.01210      -1.20997
+MEANS       0.569028 0.571850          1.00496      -0.49597

Modified: pkg/RcppDE/src/de4_0.cpp
===================================================================
--- pkg/RcppDE/src/de4_0.cpp	2010-10-16 14:40:55 UTC (rev 2306)
+++ pkg/RcppDE/src/de4_0.cpp	2010-10-16 15:16:12 UTC (rev 2307)
@@ -43,7 +43,7 @@
            double *gd_pop, double *gd_storepop, double *gd_bestmemit, double *gd_bestvalit,
            int *gi_iter, double i_pPct, long & l_nfeval);
 void permute(int ia_urn2[], int i_urn2_depth, int i_NP, int i_avoid, int ia_urntmp[]);
-extern "C" double evaluate(long *l_nfeval, double *param, SEXP par, SEXP fcall, SEXP env);
+RcppExport double evaluate(long &l_nfeval, double *param, SEXP par, SEXP fcall, SEXP env);
 
 RcppExport SEXP DEoptimC(SEXP lowerS, SEXP upperS, SEXP fnS, SEXP controlS, SEXP rhoS) {
     BEGIN_RCPP ;
@@ -113,7 +113,6 @@
 			      Rcpp::Named("pop")       = d_pop,         // sexp_pop,
 			      Rcpp::Named("storepop")  = d_storepop);   // sexp_storepop)
     END_RCPP
-
 }
 
 void devol(double VTR, double f_weight, double f_cross, int i_bs_flag,
@@ -121,9 +120,7 @@
            int i_strategy, int i_D, int i_NP, int i_itermax,
            double *initialpopv, int i_storepopfrom, int i_storepopfreq, 
            int i_specinitialpop, int i_check_winner, int i_av_winner,
-           /*double **gta_popP*/ arma::mat &ta_popP, 
-	   /*double **gta_oldP*/ arma::mat &ta_oldP, 
-	   /*double **gta_newP*/ arma::mat &ta_newP, 
+           arma::mat &ta_popP, arma::mat &ta_oldP, arma::mat &ta_newP, 
 	   double *gt_bestP,
            double *gta_popC, double *gta_oldC, double *gta_newC, 
 	   double & t_bestC,
@@ -225,7 +222,7 @@
 	  ta_popP.at(i,j) = initialpop.at(i,j);
     } 
     arma::rowvec r = ta_popP.row(i);
-    gta_popC[i] = evaluate(&l_nfeval, r.memptr(), par, fcall, rho);
+    gta_popC[i] = evaluate(l_nfeval, r.memptr(), par, fcall, rho);
 
     if (i == 0 || gta_popC[i] <= t_bestC) {
       t_bestC = gta_popC[i];
@@ -429,8 +426,7 @@
 
 	/*------Trial mutation now in t_tmpP-----------------*/
 	/* Evaluate mutant in t_tmpP[]*/
-
-	t_tmpC = evaluate(&l_nfeval, t_tmpP, par, fcall, rho); 
+	t_tmpC = evaluate(l_nfeval, t_tmpP, par, fcall, rho); 
 	
 	/* note that i_bs_flag means that we will choose the
 	 *best NP vectors from the old and new population later*/
@@ -516,7 +512,7 @@
 	if(same && i_iter > 1)  {
 	  i_xav++;
 	  /* if re-evaluation of winner */
-	  tmp_best = evaluate(&l_nfeval, gt_bestP, par, fcall, rho);
+	  tmp_best = evaluate(l_nfeval, gt_bestP, par, fcall, rho);
 	 
 	  /* possibly letting the winner be the average of all past generations */
 	  if(i_av_winner)
@@ -558,7 +554,7 @@
   PutRNGstate();
 }
 
-void permute(int ia_urn2[], int i_urn2_depth, int i_NP, int i_avoid, int ia_urn1[])
+inline void permute(int ia_urn2[], int i_urn2_depth, int i_NP, int i_avoid, int ia_urn1[])
 /********************************************************************
  ** Function       : void permute(int ia_urn2[], int i_urn2_depth)
  ** Author         : Rainer Storn (w/bug fixes contributed by DEoptim users)

Deleted: pkg/RcppDE/src/evaluate.c
===================================================================
--- pkg/RcppDE/src/evaluate.c	2010-10-16 14:40:55 UTC (rev 2306)
+++ pkg/RcppDE/src/evaluate.c	2010-10-16 15:16:12 UTC (rev 2307)
@@ -1,24 +0,0 @@
-#include <R.h>
-#include <Rdefines.h>
-
-/*------objective function---------------------------------------*/
-
-double evaluate(long *l_nfeval, double *param, SEXP par, SEXP fcall, SEXP env) {
-    int i;
-    SEXP sexp_fvec, fn;
-    double f_result;  
-
-    for (i = 0; i < nrows(par); i++) {
-	NUMERIC_POINTER(par)[i] = param[i];
-    }
-    fn = lang2(fcall, par); 
-    (*l_nfeval)++;  /* increment function evaluation count */
-
-    sexp_fvec = eval(fn, env); 
-    f_result = NUMERIC_POINTER(sexp_fvec)[0];
-   
-    if(ISNAN(f_result))
-	error("NaN value of objective function! \nPerhaps adjust the bounds.");
-   
-   return(f_result); 
-}

Copied: pkg/RcppDE/src/evaluate.cpp (from rev 2306, pkg/RcppDE/src/evaluate.c)
===================================================================
--- pkg/RcppDE/src/evaluate.cpp	                        (rev 0)
+++ pkg/RcppDE/src/evaluate.cpp	2010-10-16 15:16:12 UTC (rev 2307)
@@ -0,0 +1,25 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Port of DEoptim (2.0.7) to Rcpp/RcppArmadillo/Armadillo
+// Copyright (C) 2010  Dirk Eddelbuettel <edd at debian.org>
+
+#include <Rcpp.h>
+
+/*------objective function---------------------------------------*/
+
+RcppExport double evaluate(long &l_nfeval, double *param, SEXP parS, SEXP fcall, SEXP env) {
+    Rcpp::NumericVector par(parS);
+    memcpy(par.begin(), param, par.size() * sizeof(double));
+
+    l_nfeval++;  		// increment function evaluation count 
+
+    SEXP fn = ::Rf_lang2(fcall, par); 			// this can 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);
+   
+    if (ISNAN(f_result)) 
+	::Rf_error("NaN value of objective function! \nPerhaps adjust the bounds.");
+   
+   return(f_result); 
+}
+



More information about the Rcpp-commits mailing list