[Rcpp-commits] r2406 - in pkg/RcppDE: . demo src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 6 21:20:08 CET 2010
Author: edd
Date: 2010-11-06 21:20:08 +0100 (Sat, 06 Nov 2010)
New Revision: 2406
Added:
pkg/RcppDE/compBenchmark.r
pkg/RcppDE/demo/CompiledBenchmark.R
Modified:
pkg/RcppDE/benchmark.r
pkg/RcppDE/bigBenchmark.r
pkg/RcppDE/demo/LargeBenchmark.R
pkg/RcppDE/demo/SmallBenchmark.R
pkg/RcppDE/src/Makevars
Log:
new CompiledBenchmark demo and compBenchmark frontend
updated existing demo() files and frontends
updated src/Makevars to current use
Modified: pkg/RcppDE/benchmark.r
===================================================================
--- pkg/RcppDE/benchmark.r 2010-11-06 20:18:17 UTC (rev 2405)
+++ pkg/RcppDE/benchmark.r 2010-11-06 20:20:08 UTC (rev 2406)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
svnver <- system("svnversion", intern=TRUE)
-cat("# SVN", svnver, "\n")
+cat("# small benchmark at SVN", svnver, "\n")
source("demo/SmallBenchmark.R")
Modified: pkg/RcppDE/bigBenchmark.r
===================================================================
--- pkg/RcppDE/bigBenchmark.r 2010-11-06 20:18:17 UTC (rev 2405)
+++ pkg/RcppDE/bigBenchmark.r 2010-11-06 20:20:08 UTC (rev 2406)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
svnver <- system("svnversion", intern=TRUE)
-cat("# SVN", svnver, "\n")
+cat("# big benchmark at SVN", svnver, "\n")
source("demo/LargeBenchmark.R")
Added: pkg/RcppDE/compBenchmark.r
===================================================================
--- pkg/RcppDE/compBenchmark.r (rev 0)
+++ pkg/RcppDE/compBenchmark.r 2010-11-06 20:20:08 UTC (rev 2406)
@@ -0,0 +1,5 @@
+#!/usr/bin/r -t
+
+svnver <- system("svnversion", intern=TRUE)
+cat("# compiled benchmark at SVN", svnver, "\n")
+source("demo/CompiledBenchmark.R")
Property changes on: pkg/RcppDE/compBenchmark.r
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/RcppDE/demo/CompiledBenchmark.R
===================================================================
--- pkg/RcppDE/demo/CompiledBenchmark.R (rev 0)
+++ pkg/RcppDE/demo/CompiledBenchmark.R 2010-11-06 20:20:08 UTC (rev 2406)
@@ -0,0 +1,124 @@
+
+demo.LargeBenchmark <- function() {
+
+ Wild <- function(x) { ## 'Wild' function, global minimum at about -15.81515
+ sum(10 * sin(0.3 * x) * sin(1.3 * x^2) + 0.00001 * x^4 + 0.2 * x + 80)/length(x)
+ }
+
+ Rastrigin <- function(x) {
+ sum(x+2 - 10 * cos(2*pi*x)) + 20
+ }
+
+ Genrose <- function(x) { ## One generalization of the Rosenbrock banana valley function (n parameters)
+ n <- length(x)
+ 1.0 + sum (100 * (x[-n]^2 - x[-1])^2 + (x[-1] - 1)^2)
+ }
+
+ suppressMessages(require(inline))
+
+ inc <- 'double genrose(SEXP xs) {
+ Rcpp::NumericVector x(xs);
+ int n = x.size();
+ double sum = 1.0;
+ for (int i=1; i<n; i++) {
+ sum += 100*( pow(x[i-1]*x[i-1] - x[i], 2)) + (x[i] - 1)*(x[i] - 1);
+ }
+ return(sum);
+ }
+
+ double wild(SEXP xs) {
+ Rcpp::NumericVector x(xs);
+ int n = x.size();
+ double sum = 0.0;
+ for (int i=0; i<n; i++) {
+ sum += 10 * sin(0.3 * x[i]) * sin(1.3 * x[i]*x[i]) + 0.00001 * x[i]*x[i]*x[i]*x[i] + 0.2 * x[i] + 80;
+ }
+ sum /= n;
+ return(sum);
+ }
+
+ double rastrigin(SEXP xs) {
+ Rcpp::NumericVector x(xs);
+ int n = x.size();
+ double sum = 20.0;
+ for (int i=0; i<n; i++) {
+ sum += x[i]+2 - 10*cos(2*M_PI*x[i]);
+ }
+ return(sum);
+ }
+
+ class Fun {
+ public:
+ typedef double (*FunctionPointer)(SEXP);
+ Fun( FunctionPointer ptr_ ) : ptr(ptr_) {};
+ inline FunctionPointer get() { return ptr ; }
+ private:
+ FunctionPointer ptr ;
+ };
+ '
+
+ ## now via a class returning external pointer
+ src.xptr <- 'std::string fstr = Rcpp::as<std::string>(funname);
+ if (fstr == "genrose")
+ return(XPtr<Fun>(new Fun(&genrose)));
+ else if (fstr == "wild")
+ return(XPtr<Fun>(new Fun(&wild)));
+ else
+ return(XPtr<Fun>(new Fun(&rastrigin)));
+ '
+ create_xptr <- cxxfunction(signature(funname="character"), body=src.xptr, inc=inc, plugin="Rcpp")
+
+
+ maxIt <- 250 # not excessive but so that we get some run-time on simple problems
+
+ suppressMessages(library(DEoptim)) # the original, currently 2.0.7
+ suppressMessages(library(RcppDE)) # the contender
+
+ basicDE <- function(n, maxIt, fun) DEoptim::DEoptim(fn=fun, lower=rep(-25, n), upper=rep(25, n),
+ control=list(NP=10*n, itermax=maxIt, trace=FALSE))#, bs=TRUE))
+ cppDE <- function(n, maxIt, fun) RcppDE::DEoptim(fn=fun, lower=rep(-25, n), upper=rep(25, n),
+ control=list(NP=10*n, itermax=maxIt, trace=FALSE))#, bs=TRUE))
+
+ set.seed(42)
+ valBasic <- basicDE(5, maxIt, function(...) Rastrigin(...))
+ set.seed(42)
+ valCpp <- cppDE(5, maxIt, function(...) Rastrigin(...))
+ stopifnot( all.equal(valBasic, valCpp) )
+
+ runPair <- function(n, maxIt, fun, funname) {
+ gc()
+ set.seed(42)
+ bt <- system.time(invisible(basicDE(n, maxIt, fun)))[3]
+
+ gc()
+ set.seed(42)
+ xptr <- create_xptr(funname)
+ ct <- system.time(invisible(cppDE(n, maxIt, xptr)))[3]
+
+ return(data.frame(DEoptim=bt, RcppDE=ct))
+ }
+
+ cat("# At", format(Sys.time()), "\n")
+
+ reps <- c(50, 100, 200)
+
+ res <- rbind(do.call(rbind, lapply(reps, runPair, maxIt, function(...) Rastrigin(...), "rastrigin")),
+ do.call(rbind, lapply(reps, runPair, maxIt, function(...) Wild(...), "wild")),
+ do.call(rbind, lapply(reps, runPair, maxIt, function(...) Genrose(...), "genrose"))
+ )
+ res <- rbind(res, colMeans(res))
+
+ rownames(res) <- c(paste("Rastrigin", reps, sep=""),
+ paste("Wild", reps, sep=""),
+ paste("Genrose", reps, sep=""),
+ "MEANS")
+
+ res$ratioRcppToBasic <- res[,2]/res[,1]
+ res$pctGainOfRcpp <- (1-res[,2]/res[,1])*100
+ res$netSpeedUp <- res[,1]/res[,2]
+
+ print(res)
+ cat("# Done", format(Sys.time()), "\n")
+}
+
+demo.LargeBenchmark()
Modified: pkg/RcppDE/demo/LargeBenchmark.R
===================================================================
--- pkg/RcppDE/demo/LargeBenchmark.R 2010-11-06 20:18:17 UTC (rev 2405)
+++ pkg/RcppDE/demo/LargeBenchmark.R 2010-11-06 20:20:08 UTC (rev 2406)
@@ -59,6 +59,7 @@
res$ratioRcppToBasic <- res[,2]/res[,1]
res$pctGainOfRcpp <- (1-res[,2]/res[,1])*100
+ res$netSpeedUp <- res[,1]/res[,2]
print(res)
cat("# Done", format(Sys.time()), "\n")
Modified: pkg/RcppDE/demo/SmallBenchmark.R
===================================================================
--- pkg/RcppDE/demo/SmallBenchmark.R 2010-11-06 20:18:17 UTC (rev 2405)
+++ pkg/RcppDE/demo/SmallBenchmark.R 2010-11-06 20:20:08 UTC (rev 2406)
@@ -60,6 +60,7 @@
"MEANS")
res$ratioRcppToBasic <- res[,2]/res[,1]
res$pctGainOfRcpp <- (1-res[,2]/res[,1])*100
+ res$netSpeedUp <- res[,1]/res[,2]
print(res)
cat("# Done", format(Sys.time()), "\n")
Modified: pkg/RcppDE/src/Makevars
===================================================================
--- pkg/RcppDE/src/Makevars 2010-11-06 20:18:17 UTC (rev 2405)
+++ pkg/RcppDE/src/Makevars 2010-11-06 20:20:08 UTC (rev 2406)
@@ -1,11 +1,11 @@
## Hey Emacs make this a -*- mode: makefile; -*- file
##
## -- for OpenMP (with -D macro to switch to OpenMP enabled source file)
-PKG_CXXFLAGS=-fopenmp -DUSE_OPENMP
-PKG_LIBS= -fopenmp -lgomp $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
+#PKG_CXXFLAGS=-fopenmp -DUSE_OPENMP
+#PKG_LIBS= -fopenmp -lgomp $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
##
## -- for Google Perftools profiling
## PKG_LIBS= $(shell $(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()") $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) -lprofiler
##
## -- default
-#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)
More information about the Rcpp-commits
mailing list