[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