[Rcpp-commits] r2367 - pkg/RcppDE
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 28 16:33:09 CEST 2010
Author: edd
Date: 2010-10-28 16:33:09 +0200 (Thu, 28 Oct 2010)
New Revision: 2367
Modified:
pkg/RcppDE/benchmark.r
pkg/RcppDE/bigBenchmark.r
Log:
benchmark scripts now call demo/ files
Modified: pkg/RcppDE/benchmark.r
===================================================================
--- pkg/RcppDE/benchmark.r 2010-10-28 02:59:04 UTC (rev 2366)
+++ pkg/RcppDE/benchmark.r 2010-10-28 14:33:09 UTC (rev 2367)
@@ -1,65 +1,5 @@
#!/usr/bin/r -t
-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))
-}
-
svnver <- system("svnversion", intern=TRUE)
-cat("# At ", format(Sys.time()), "\n# SVN ", svnver, "\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")
+cat("# At", format(Sys.time()), "\n# SVN ", svnver, "\n", sep="")
+source("demo/SmallBenchmark.R")
Modified: pkg/RcppDE/bigBenchmark.r
===================================================================
--- pkg/RcppDE/bigBenchmark.r 2010-10-28 02:59:04 UTC (rev 2366)
+++ pkg/RcppDE/bigBenchmark.r 2010-10-28 14:33:09 UTC (rev 2367)
@@ -1,64 +1,5 @@
#!/usr/bin/r -t
-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))
-}
-
svnver <- system("svnversion", intern=TRUE)
-cat("# At ", format(Sys.time()), "\n# SVN ", svnver, "\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")
+cat("# At", format(Sys.time()), "\n# SVN ", svnver, "\n", sep="")
+source("demo/LargeBenchmark.R")
More information about the Rcpp-commits
mailing list