Nothing
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, a = 1, b = 100) { ## One generalization of the Rosenbrock banana valley function (n parameters)
n <- length(x)
1.0 + sum (b * (x[-n]^2 - x[-1])^2 + (x[-1] - a)^2)
}
maxIt <- 25 # not excessive but so that we get some run-time on simple problems
haveDEoptim <- requireNamespace("DEoptim", quietly=TRUE)
suppressMessages({
if (haveDEoptim) {
library(DEoptim) # the original, currently 2.0.7
}
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))
if (haveDEoptim) {
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(ores <- basicDE(n, maxIt, fun, ...)))[3]
gc()
set.seed(42)
xptr <- RcppDE:::putFunPtrInXPtr(funname)
ct <- system.time(invisible(cres <- cppDE(n, maxIt, xptr, ...)))[3]
#stopifnot(all.equal(ores, cres))
gc()
set.seed(42)
rt <- system.time(invisible(rres <- cppDE(n, maxIt, fun, ...)))[3]
##stopifnot(all.equal(ores, rres))
return(data.frame(DEoptim=bt, RcppDEc=ct, RcppDEr=rt))
}
if (haveDEoptim) {
cat("# At", format(Sys.time()), "\n")
options(width=120)
reps <- c(5, 10, 20, 50)
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", a = 1, b = 100))
)
res <- rbind(res, colMeans(res))
rownames(res) <- c(paste("Rastrigin", reps, sep=""),
paste("Wild", reps, sep=""),
paste("Genrose", reps, sep=""),
"MEANS")
res$ratioRcppCompToBasic <- res[,2]/res[,1]
res$pctGainOfRcppComp <- (1-res[,2]/res[,1])*100
##res$netSpeedUpC <- res[,1]/res[,2]
res$ratioRcppRToBasic <- res[,3]/res[,1]
res$pctGainOfRcppR <- round((1-res[,3]/res[,1])*100, digits=3)
##res$netSpeedUpR <- res[,1]/res[,3]
print(res)
cat("# Done", format(Sys.time()), "\n")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.