[Rcpp-commits] r2340 - pkg/RcppDE/demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 19 05:36:28 CEST 2010
Author: edd
Date: 2010-10-19 05:36:27 +0200 (Tue, 19 Oct 2010)
New Revision: 2340
Added:
pkg/RcppDE/demo/LargeBenchmark.R
pkg/RcppDE/demo/SmallBenchmark.R
Modified:
pkg/RcppDE/demo/00Index
Log:
added small + large size benchmarks as new demo files
Modified: pkg/RcppDE/demo/00Index
===================================================================
--- pkg/RcppDE/demo/00Index 2010-10-19 01:42:00 UTC (rev 2339)
+++ pkg/RcppDE/demo/00Index 2010-10-19 03:36:27 UTC (rev 2340)
@@ -1 +1,3 @@
DEoptim some examples of the DEoptim function.
+SmallBenchmark repeated runs of RcppDE vs DEoption on small vectors
+LargeBenchmark single runs of RcppDE vs DEoption on large vectors
Added: pkg/RcppDE/demo/LargeBenchmark.R
===================================================================
--- pkg/RcppDE/demo/LargeBenchmark.R (rev 0)
+++ pkg/RcppDE/demo/LargeBenchmark.R 2010-10-19 03:36:27 UTC (rev 2340)
@@ -0,0 +1,67 @@
+
+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)
+ }
+
+ 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) {
+ gc()
+ set.seed(42)
+ bt <- system.time(invisible(basicDE(n, maxIt, fun)))[3]
+
+ gc()
+ set.seed(42)
+ ct <- system.time(invisible(cppDE(n, maxIt, fun)))[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(...))),
+ do.call(rbind, lapply(reps, runPair, maxIt, function(...) Wild(...))),
+ do.call(rbind, lapply(reps, runPair, maxIt, function(...) 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
+
+ print(res)
+ cat("# Done ", format(Sys.time()), "\n")
+}
+
+demo.LargeBenchmark()
Added: pkg/RcppDE/demo/SmallBenchmark.R
===================================================================
--- pkg/RcppDE/demo/SmallBenchmark.R (rev 0)
+++ pkg/RcppDE/demo/SmallBenchmark.R 2010-10-19 03:36:27 UTC (rev 2340)
@@ -0,0 +1,68 @@
+
+demo.SmallBenchmark <- 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)
+ }
+
+ 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))
+ 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))
+
+ 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) {
+
+ gc()
+ set.seed(42)
+ bt <- mean(replicate(10, system.time(invisible(basicDE(n, maxIt, fun)))[3]), trim=0.1)
+
+ gc()
+ set.seed(42)
+ ct <- mean(replicate(10, system.time(invisible(cppDE(n, maxIt, fun)))[3]), trim=0.1)
+
+ return(data.frame(DEoptim=bt, RcppDE=ct))
+ }
+
+ cat("# At ", format(Sys.time()), "\n")
+
+ reps <- c(5, 10, 20)
+
+ res <- rbind(do.call(rbind, lapply(reps, runPair, maxIt, function(...) Rastrigin(...))),
+ do.call(rbind, lapply(reps, runPair, maxIt, function(...) Wild(...))),
+ do.call(rbind, lapply(reps, runPair, maxIt, function(...) Genrose(...)))
+ # runPair(50, maxIt, function(...) Genrose(...))
+ # runPair(100, maxIt, function(...) 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
+
+ print(res)
+ cat("# Done ", format(Sys.time()), "\n")
+}
+
+demo.SmallBenchmark()
More information about the Rcpp-commits
mailing list