Commit fe86efc3 authored by Florian Gerber's avatar Florian Gerber

arxiv version

parent 2e2369f6
Package: optimParallel
Type: Package
Title: Parallel Optim
Version: 0.5
Date: 2018-04-03
Title: Parallel Versions of the Gradient-Based optim() Methods
Version: 0.7
Date: 2018-04-30
Author: Florian Gerber
Maintainer: Florian Gerber <florian.gerber@math.uzh.ch>
Description: provides a parallel version of the gradient based
stats::optim() methods "L-BFGS-B", "BFGS", and "CG". This can lead
to a significantly performance boost of stats::optim().
Description: provides a parallel versions of the gradient-based optim() methods. The main function of the package is optimParallel(), which has the same usage and output as optim(). Using optimParallel() can significantly reduce the optimization time.
License: GPL (>= 2)
URL: https://git.math.uzh.ch/florian.gerber/optimParallel
BugReports: https://git.math.uzh.ch/florian.gerber/optimParallel
Depends: R (>= 3.1), stats, parallel
Suggests: roxygen2, spam, testthat
Suggests: roxygen2, spam, microbenchmark, testthat, ggplot2, numDeriv
RoxygenNote: 6.0.1
# Generated by roxygen2: do not edit by hand
export(optimParallel)
importFrom(parallel,clusterExport)
importFrom(parallel,parLapply)
importFrom(stats,optim)
do.call
parallel_fg_generator <- function(fn, gr=NULL, args_list=NULL,
one_sided=FALSE, lower=-Inf, upper=Inf,
lapply_variant = getOption("optimParallel.lapply"),
ndeps = 1e-3, fnscale=NULL, parscale=NULL){
stopifnot(is.function(fn))
if(is.null(fnscale)) fnscale <- 1
if(is.null(parscale)) parscale <- 1
if(any(is.na(lower))) lower[is.na(lower)] <- -Inf
if(any(is.na(upper))) lower[is.na(upper)] <- Inf
fun <- function(par, ...){ fn(par, ...)/fnscale }
if(!is.null(gr))
gra <- function(par, ...){ fn(par, ...)/fnscale }
eval <- function(par){
## the first argument of fun has to be a vector of length length(par)
if(identical(par, par_last))
return(list(value=value, grad=grad))
par_last <<- par
if(is.null(gr)){
n <- length(par)
ndeps <- ndeps*parscale
ndeps_mat <- array(0, c(n,n))
ndeps_vec <- rep(ndeps, length.out=n)
diag(ndeps_mat) <- ndeps_vec
if(one_sided){
ndepsused <- ndeps_vec
PAR <- data.frame(cbind(array(par, c(n,n))+ndeps_mat))
if(!(is.null(upper) || all(is.na(upper)) || all(upper==Inf))){
hitu <- unlist(lapply(PAR, function(par){any(par>upper)}))
if(any(hitu)){
PARl <- data.frame(cbind(array(par, c(n,n))-ndeps_mat))
PAR[hitu] <- PARl[hitu]
ndepsused[hitu] <- -ndeps_vec[hitu]
}
}
PAR <- cbind(PAR, par)
if(is.null(args_list))
args <- list(X=PAR, FUN=fun)
else
args <- c(list(X=PAR, FUN=fun), args_list)
e <- unname(unlist(do.call(lapply_variant, args)))
value <<- e[length(e)]
length(e) <- length(e)-1
grad <<- (e-value)/ndepsused
} else { # two sided
ndepsused <- 2*ndeps_vec
PAR <- data.frame(cbind(array(par, c(n,n))+ndeps_mat, array(par, c(n,n))-ndeps_mat))
if(!(is.null(upper) || all(is.na(upper)) || all(upper==Inf))){
hitu <- unlist(lapply(PAR, function(par){any(par>upper)}))
if(any(hitu)){
PAR[hitu] <- par
hitui <- apply(matrix(hitu, ncol=2), 1, any)
ndepsused[hitui] <- ndeps_vec[hitui]
}
}
if(!(is.null(lower) || all(is.na(lower)) || all(lower==Inf))){
hitl <- unlist(lapply(PAR, function(par){any(par<lower)}))
if(any(hitl)){
PAR[hitl] <- par
hitli <- apply(matrix(hitl, ncol=2), 1, any)
ndepsused[hitli] <- ndeps_vec[hitli]
}
}
PAR <- cbind(PAR, par)
if(is.null(args_list))
args <- list(X=PAR, FUN=fun)
else
args <- c(list(X=PAR, FUN=fun), args_list)
e <- unname(unlist(do.call(lapply_variant, args)))
value <<- e[length(e)]
length(e) <- length(e)-1
e_mat <- matrix(e, ncol=2)
grad <<- c(e_mat[,1]-e_mat[,2])/ndepsused
}
}else{ # gr is not null
args <- c(par=par, args_list)
expr <- list(expression(do.call("fun", args=args)),
expression(do.call("gra", args=args)))
args2 <- list(expr, eval, envir=parent.frame(2))
res <- do.call("lapply", args2)
value <<- res[[1]]
grad <<- res[[2]]
}
i_e <<- i_e+1
return(list(value=value, grad=grad))
}
f <- function(par){
eval(par)
i_f <<- i_f+1
return(value)
}
g <- function(par){
eval(par)
i_g <<- i_g+1
return(grad)
}
init <- function(){
i_f <<- i_g <<- i_e <<- 0
par_last <<- value <<- grad <<- NA
}
countes <- function(){
c(i_e, i_f, i_g)
}
i_f <- i_g <- i_e <- 0
par_last <- value <- grad <- NA
list(f=f, g=g, init=init, eval=eval, countes=countes)
}
parallel_fg_generator <- function(fn, gr=NULL, args_list=NULL,
one_sided=FALSE, lower=-Inf, upper=Inf,
lapply_variant = getOption("optimParallel.lapply"),
ndeps = 1e-3, fnscale=NULL, parscale=NULL){
stopifnot(is.function(fn))
if(is.null(fnscale)) fnscale <- 1
if(is.null(parscale)) parscale <- 1
if(any(is.na(lower))) lower[is.na(lower)] <- -Inf
if(any(is.na(upper))) lower[is.na(upper)] <- Inf
fun <- function(par, ...){ fn(par, ...)/fnscale }
if(!is.null(gr))
gra <- function(par, ...){ fn(par, ...)/fnscale }
eval <- function(par){
## the first argument of fun has to be a vector of length length(par)
if(identical(par, par_last))
return(list(value=value, grad=grad))
par_last <<- par
if(is.null(gr)){
n <- length(par)
ndeps <- ndeps*parscale
ndeps_mat <- array(0, c(n,n))
ndeps_vec <- rep(ndeps, length.out=n)
diag(ndeps_mat) <- ndeps_vec
if(one_sided){
ndepsused <- ndeps_vec
PAR <- data.frame(cbind(array(par, c(n,n))+ndeps_mat))
if(!(is.null(upper) || all(is.na(upper)) || all(upper==Inf))){
hitu <- unlist(lapply(PAR, function(par){any(par>upper)}))
if(any(hitu)){
PARl <- data.frame(cbind(array(par, c(n,n))-ndeps_mat))
PAR[hitu] <- PARl[hitu]
ndepsused[hitu] <- -ndeps_vec[hitu]
}
}
PAR <- cbind(PAR, par)
if(is.null(args_list))
args <- list(X=PAR, FUN=fun)
else
args <- c(list(X=PAR, FUN=fun), args_list)
e <- unname(unlist(do.call(lapply_variant, args)))
value <<- e[length(e)]
length(e) <- length(e)-1
grad <<- (e-value)/ndepsused
} else { # two sided
ndepsused <- 2*ndeps_vec
PAR <- data.frame(cbind(array(par, c(n,n))+ndeps_mat, array(par, c(n,n))-ndeps_mat))
if(!(is.null(upper) || all(is.na(upper)) || all(upper==Inf))){
hitu <- unlist(lapply(PAR, function(par){any(par>upper)}))
if(any(hitu)){
PAR[hitu] <- par
hitui <- apply(matrix(hitu, ncol=2), 1, any)
ndepsused[hitui] <- ndeps_vec[hitui]
}
}
if(!(is.null(lower) || all(is.na(lower)) || all(lower==Inf))){
hitl <- unlist(lapply(PAR, function(par){any(par<lower)}))
if(any(hitl)){
PAR[hitl] <- par
hitli <- apply(matrix(hitl, ncol=2), 1, any)
ndepsused[hitli] <- ndeps_vec[hitli]
}
}
PAR <- cbind(PAR, par)
if(is.null(args_list))
args <- list(X=PAR, FUN=fun)
else
args <- c(list(X=PAR, FUN=fun), args_list)
e <- unname(unlist(do.call(lapply_variant, args)))
value <<- e[length(e)]
length(e) <- length(e)-1
e_mat <- matrix(e, ncol=2)
grad <<- c(e_mat[,1]-e_mat[,2])/ndepsused
}
}else{ # gr is not null
args <- c(par=par, args_list)
expr <- list(expression(do.call("fun", args=args)),
expression(do.call("gra", args=args)))
args2 <- list(expr, "eval", envir=parent.frame(2))
res <- do.call("lapply", args2)
value <<- res[[1]]
grad <<- res[[2]]
}
i_e <<- i_e+1
return(list(value=value, grad=grad))
}
f <- function(par){
eval(par)
i_f <<- i_f+1
return(value)
}
g <- function(par){
eval(par)
i_g <<- i_g+1
return(grad)
}
init <- function(){
i_f <<- i_g <<- i_e <<- 0
par_last <<- value <<- grad <<- NA
}
countes <- function(){
c(i_e, i_f, i_g)
}
i_f <- i_g <- i_e <- 0
par_last <- value <- grad <- NA
list(f=f, g=g, init=init, eval=eval, countes=countes)
}
fun <- sum
gra <- prod
par=c(1,2)
args_list=NULL
args2
str(args2)
eval
expr
lapply(expr, eval )
lapply(expr, "eval")
args
args
args
lapply_variant="lapply"
vaue
value
integratArgs <- function(f, args){
form <- formals(f)
if(!is.null(form))
for(i in seq_along(form))
assign(names(form)[i], form[[i]])
if(!is.null(args))
for(i in seq_along(args))
assign(names(args)[i], args[[i]])
ff <- function(){}
body(ff) <- body(f)
if(any(names(form) == "..."))
formals(ff) <- form[names(form) == "..."]
ff
}
getFunctions <- function(f, args, firstArg){
if(is.vector(firstArg))
firstArg <- matrix(data=firstArg)
lapply(1:ncol(firstArg), function(x){
args[[names(formals(f))[1]]] <- firstArg[,x]
integratArgs(f=f, args=args)
})
}
#' @importFrom parallel parLapply
evalParallel <- function(cl, f, args, firstArg){
funlist <- getFunctions(f=f, args=args, firstArg=firstArg)
parallel::parLapply(cl=cl, X=funlist, fun=function(x) x())
}
This diff is collapsed.
.onLoad <- function(libname, pkgname)
{
if(is.null(options()$optimParallel.lapply)){
if(.Platform$OS.type == "windows")
options(optimParallel.lapply = "parLapply")
else
options(optimParallel.lapply = "mclapply")
}
if(is.null(options()$optimParallel.one_sided))
options(optimParallel.one_sided = FALSE)
options(optimParallel.forward=getOption("optimParallel.forward", FALSE))
options(optimParallel.loginfo=getOption("optimParallel.loginfo", FALSE))
}
rm(list=ls())
library("optimParallel")
library("microbenchmark")
library("ggplot2"); theme_set(theme_bw())
measure <- function(expr, times=5, unit="s"){
m <- microbenchmark(list=expr, times=times)
summary(m, unit="s")["mean"]
}
PAR <- 100
FN <- function(par, sleep){
Sys.sleep(sleep)
sum(par^2)
}
GR <- function(par, sleep){
Sys.sleep(sleep)
2*par
}
CONTROL <- list(maxit=10, factr=.Machine$double.eps)
METHOD <- "L-BFGS-B"
grid <- expand.grid(p=1:3,Tf=c(0,.05,.2,.4,.6,.8,1),
parallel=c("optimParallel","optim"), gr=FALSE, To=NA)
grid <- rbind(grid,
data.frame(p=3, Tf=unique(grid$Tf), parallel="optimParallel", gr=TRUE, To=NA))
grid <- rbind(grid,
data.frame(p=3, Tf=unique(grid$Tf), parallel="optim", gr=TRUE, To=NA))
cl <- makeCluster(8); setDefaultCluster(cl=cl)
for(i in 1:nrow(grid)){
par <- rep(PAR, grid[i,"p"])
if(grid[i,"parallel"]=="optimParallel"){
if(grid[i,"gr"]){
total <- measure(
expression(out <<- optimParallel(par=par, fn=FN, gr=GR, sleep=grid[i,"Tf"],
method=METHOD,
control=CONTROL)))
} else {
total <- measure(
expression(out <<- optimParallel(par=par, fn=FN, gr=NULL, sleep=grid[i,"Tf"],
method=METHOD,
control=CONTROL)))
}
grid[i, "To"] <- total/out$counts[1]
} else {
if(grid[i,"gr"]){
total <- measure(
expression(out <<- optim(par=par, fn=FN, gr=GR, sleep=grid[i,"Tf"],
method=METHOD,
control=CONTROL)))
}else{
total <- measure(
expression(out <<- optim(par=par, fn=FN, gr=NULL, sleep=grid[i,"Tf"],
method=METHOD,
control=CONTROL)))
}
grid[i, "To"] <- total/out$counts[1]
}
print(grid[i,])
print(out$counts[1])
}
save(grid, file="benchmark.RData")
pdf("benchmark.pdf", width = 8*.9*.9, height = 5*.8*.9)
size <- .8
sizes <- 4
stroke <- 1.1
shape <- 1
grid$par <- as.factor(grid$p)
grid$Tolog <- log(grid$To)
grid$parallel <- factor(grid$parallel)
#grid$parallel <- factor(grid$parallel,levels(grid$parallel)[c(2,1)])
grid$pa <- factor(ifelse(grid$gr, paste0("p = ", grid$par, ", gradient"), paste("p =", grid$par)))
grid$pa <- factor(grid$pa,levels(grid$pa)[c(3,2,1,4)])
ggplot(grid, aes(x=Tf, y=To, color=pa, group=interaction(pa,parallel),
linetype=parallel)) + geom_point(size=sizes, shape=shape, stroke=stroke) + geom_line(size=size) +
geom_point(data=grid[grid$parallel=="optimParallel",], mapping=aes(x=Tf, y=To), color="black", size=sizes, shape=shape, stroke=stroke) +
geom_line(data=grid[grid$parallel=="optimParallel"&grid$par==1,], mapping=aes(x=Tf, y=To),
color="black", size=size) +
xlab("Elapsed time [s] for one evalutation of fn(x)") +
ylab("Elapsed time [s] per iteration") +
theme(legend.title=element_blank()) +
scale_x_continuous(minor_breaks = seq(0 , 1, .1), breaks = seq(0, 1, .2))
dev.off()
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/optimParallel.R
\docType{package}
\name{optimParallel-package}
\alias{optimParallel-package}
\alias{optimParallel-Package}
\alias{OptimParallel-Package}
\title{Overview}
\description{
The function provides a parallel version of the gradient based \code{\link{optim}} methods
"L-BFGS-B", "BFGS", and "CG".
If the evaluation of the target function takes more that 0.5 seconds, \code{\link{optimParallel}} can reduce the optimization time significantly.
For "L-BFGS-B" the speed increase is between factor 2 in the case where \code{gr} is specified and
factor 2p+1 (p = number of parameters) in the case where \code{gr} is not specified.
}
\seealso{
\code{\link{optimParallel}}
}
\author{
Florian Gerber, \email{florian.gerber@math.uzh.ch}.
}
\keyword{package}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/optimParallel.R
\docType{package}
\name{optimParallel}
\alias{optimParallel}
\alias{optim}
\alias{parallel}
\title{parallel version of \code{\link{optim}}}
\alias{optimparallel}
\alias{optimParallel-package}
\alias{optimParallel-Package}
\alias{OptimParallel-package}
\alias{OptimParallel-Package}
\alias{optimparallel-package}
\alias{optimparallel-Package}
\alias{optimParallel-package}
\title{parallel version of \code{\link[stats]{optim}}}
\usage{
optimParallel(par, fn, gr = NULL, ..., method = c("BFGS", "L-BFGS-B", "CG"),
lower = -Inf, upper = Inf, control = list(), hessian = FALSE,
parallel_args = list())
parallel = list())
}
\arguments{
\item{par}{see the documentation of \code{\link{optim}}.}
\item{par}{see the documentation of \code{\link[stats]{optim}}.}
\item{fn}{see the documentation of \code{\link{optim}}.}
\item{fn}{see the documentation of \code{\link[stats]{optim}}.}
\item{gr}{see the documentation of \code{\link{optim}}.}
\item{gr}{see the documentation of \code{\link[stats]{optim}}.}
\item{...}{see the documentation of \code{\link{optim}}.}
\item{...}{see the documentation of \code{\link[stats]{optim}}.
Note that depending on the chosen cluster type, \code{fn} and \code{gr} have no access to \code{.GlobalEnv}.
Hence, all object required by \code{fn} and \code{gr} have to be added here.}
\item{method}{only the gradient based methods "L-BFGS-B", "BFGS", and "CG" are available.
See the documentation of \code{\link{optim}}.}
\item{method}{parallel versions of the gradient-based methods \code{"L-BFGS-B"}, \code{"BFGS"}, and \code{"CG"} of \code{\link[stats]{optim}} are available.
See the documentation of \code{\link[stats]{optim}}.
If another method is specified, the arguments are directly passed to \code{\link[stats]{optim}}.}
\item{lower}{see the documentation of \code{\link{optim}}.}
\item{lower}{see the documentation of \code{\link[stats]{optim}}.}
\item{upper}{see the documentation of \code{\link{optim}}.}
\item{upper}{see the documentation of \code{\link[stats]{optim}}.}
\item{control}{see the documentation of \code{\link{optim}}.}
\item{control}{see the documentation of \code{\link[stats]{optim}}.}
\item{hessian}{see the documentation of \code{\link{optim}}.}
\item{hessian}{see the documentation of \code{\link[stats]{optim}}.}
\item{parallel_args}{is a list control parameters for the parallel execution.
\itemize{
\item{\code{lapply}}{charcter vector of length 1. The default is "mclapply" (not Windows) and "parLapply" (Windows)}
\item{\code{one_sided}}{logical vector of length 1. If \code{TRUE} (default) two-sided derivatives are calculated.}
\item{\code{cl}}{object of class 'cluster'.}
\item{parallel}{is a list of additional control parameters and can supply any of the following components:
\describe{
\item{\code{cl}}{ an object of class \code{"cluster"}} specifying the cluster to be used for parallel execution.
See \code{\link[parallel]{makeCluster}} for more information.
If the argument is not specified or \code{NULL}, the default cluster is used.
See \code{\link[parallel]{setDefaultCluster}} for information on how to set up a default cluster.
\item{\code{forward}}{ logical vector of length 1. If \code{FALSE} (default when loading the package), a numeric central difference approximation of the gradient defined as
\eqn{(fn(x+\epsilon)-fn(x-\epsilon))/(2\epsilon)} is used, which corresponds to the approximation used in \code{\link[stats]{optim}}.
If \code{TRUE}, a nummeric forward difference approximation of the gradient essentially defined as
\eqn{(fn(x+\epsilon)-fn(x))/\epsilon} is used. This reduces the number of function calls from \eqn{1+2p} to \eqn{1+p} and can be useful, if the number of available cores is smaller than \eqn{1+2p}.}
\item{\code{loginfo}}{ logical vector of length 1 with default value \code{FALSE} when loading the package. If \code{TRUE},
additional log information containing the evaluated parameters as well as return the values of \code{fn} and \code{gr} is returned.}
}}
}
\value{
Same as \code{\link{optim}}. See the documentation thereof.
Same as \code{\link[stats]{optim}}. See the documentation thereof.\cr
If a gradient-based method is specified and \code{parallel=list(loginfo=TRUE)}, additional log information containing the evaluated parameters as well as
the return values of \code{fn} and \code{gr} is returned.
}
\description{
The function provides a parallel version of the gradient based \code{\link{optim}} methods
"L-BFGS-B", "BFGS", and "CG".
If the evaluation of the target function takes more that 0.5 seconds, \code{\link{optimParallel}} can reduce the optimization time significantly.
For "L-BFGS-B" the speed increase is between factor 2 in the case where \code{gr} is specified and
factor 2p+1 (p = number of parameters) in the case where \code{gr} is not specified.
The function provides parallel versions of the gradient-based \code{\link[stats]{optim}} methods
\code{"L-BFGS-B"}, \code{"BFGS"}, and \code{"CG"}.
If the evaluation of the function \code{fn} takes more than 0.05 seconds, \code{optimParallel} can significantly reduce the optimization time.
For a \eqn{p}-parameter optimization based on \code{"L-BFGS-B"}, the speed increase is about factor \eqn{1+2p} when no analytic gradient is specified and \eqn{1+2p} processor cores are available.
}
\details{
The R package parallel in combination with a reference class like construct is used
to evaluate the target function \code{fn} and the gradient \code{gr} in parallel.
}
\note{
Currently only the method "L-BFGS-B" is tested with unit tests.
\code{optimParallel} is a wrapper to \code{\link[stats]{optim}} and relies on the lexical scoping mechanism of R
and the R package \pkg{parallel} to evaluate \code{fn}
and its (approximate) gradient in parallel.\cr\cr
The default values of the argument \code{parallel} can be set via\cr\code{options("optimParallel.forward", "optimParallel.loginfo")}.
}
\examples{
\dontrun{
neg2ll <- function(par, sleep=0, verbose=FALSE){
if(verbose)
cat(par, "\\n")
negll <- function(par, x, sleep=0, verbose=TRUE){
if(verbose)
cat(par, "\\n")
Sys.sleep(sleep)
-sum(dnorm(x=x, mean=par[1], sd=par[2], log=TRUE))
}
set.seed(13); x <- rnorm(1000, 5, 2)
## works only on Linux like platforms:
## -----------------------------------
detectCores() # available cores
options(mc.cores=detectCores()) # set number of cores
options(optimParallel.lapply="mclapply") # used by default
cl <- makeCluster(2) # set the number of processor cores
setDefaultCluster(cl=cl) # set 'cl' as default cluster
optimParallel(par=c(1,1), fn=neg2ll,
optimParallel(par=c(1,1), fn=negll, x=x,
method = "L-BFGS-B", lower=c(-Inf, .0001))
optimParallel(par=c(1,1), fn=neg2ll,
verbose=TRUE, sleep=.5, # args to neg2ll()
method="L-BFGS-B", lower=c(-Inf, .0001),
control=list(factr=.01/.Machine$double.eps))
## each step invokes 5 parallel calls to neg2ll()
optimParallel(par=c(1,1), fn=neg2ll,
verbose=TRUE, sleep=.5,
method ="L-BFGS-B", lower=c(-Inf, .0001),
control=list(factr=.01/.Machine$double.eps),
parallel_args=list(one_sided=TRUE))
## each step invokes 3 parallel calls to neg2ll()
## For Linux and Windows platforms:
## --------------------------------
options(optimParallel.lapply="parLapply")
cl <- makeCluster(detectCores())
optimParallel(par=c(1,1), fn=neg2ll,
x=x, # it is required to pass all data used by fn
optimParallel(par=c(1,1), fn=negll, x=x,
method = "L-BFGS-B", lower=c(-Inf, .0001),
parallel_args=list(cl=cl))
parallel=list(loginfo=TRUE))
optimParallel(par=c(1,1), fn=neg2ll,
x=x, verbose=TRUE, sleep=.5,
method="L-BFGS-B", lower=c(-Inf, .0001),
control=list(factr=.01/.Machine$double.eps),
parallel_args=list(cl=cl))
## note: printing to screen does not work with clusters
setDefaultCluster(cl=NULL); stopCluster(cl)
optimParallel(par=c(1,1), fn=neg2ll,
x=x, verbose=TRUE, sleep=.5,
method ="L-BFGS-B", lower=c(-Inf, .0001),
control=list(factr=.01/.Machine$double.eps),
parallel_args=list(cl=cl, one_sided=TRUE))
## default values of the argument 'parallel':
options("optimParallel.forward", "optimParallel.loginfo")
stopCluster(cl)
\dontrun{
## - use all avilable processor cores
## - return cat() output to R prompt
## (may have issues on Windows)
if(tolower(.Platform$OS.type) != "windows"){
cl <- makeCluster(spec=detectCores(), type="FORK", outfile="")
} else
cl <- makeCluster(spec=detectCores(), outfile="")
setDefaultCluster(cl=cl)
## return log information
options(optimParallel.loginfo=TRUE)
## stop if change of f(x) is smaller than 0.01
control <- list(factr=.01/.Machine$double.eps)
optimParallel(par=c(1,1), fn=negll, x=x, sleep=.5,
verbose=TRUE, method="L-BFGS-B",
lower=c(-Inf, .0001), control=control)
## each step invokes 5 parallel calls to negll()
optimParallel(par=c(1,1), fn=negll, x=x, sleep=.5,
method ="L-BFGS-B", lower=c(-Inf, .0001),
control=control,
parallel=list(forward=TRUE))
## each step invokes 3 parallel calls to negll()
## to perform one sided derivatives by default set:
#options(optimParallel.one_sided=TRUE)
}
setDefaultCluster(cl=NULL); stopCluster(cl) }
}
\seealso{
\code{\link{optim}}
\code{\link[stats]{optim}},
\code{\link[parallel]{makeCluster}},
\code{\link[parallel]{setDefaultCluster}},
\code{\link[parallel]{stopCluster}},
\code{\link[parallel]{detectCores}}.
}
\author{
Florian Gerber, \email{florian.gerber@math.uzh.ch}.
Florian Gerber, \email{florian.gerber@math.uzh.ch}, \url{https://user.math.uzh.ch/gerber}.
}
\keyword{package}
optim_args <- list(par=c(2,1), fn=f1, method = "L-BFGS-B", lower=c(-Inf,0.001),
control=list(factr=factr))
optim_args <- list(par=c(2,1), fn=f1, method = "L-BFGS-B", lower=c(-Inf,0.001),
control=list(factr=factr))
optim_args <- list(par=c(2,1), fn=f1, method = "L-BFGS-B", lower=c(-Inf,0.001),
control=list(factr=factr))
str(ref)
str(o)
optim(c(2,1), f1, method = "L-BFGS-B", control=list(factr=factr, ndeps=c(1,1)))
optim(c(2,1), f1, method = "L-BFGS-B", lower=c(-Inf,0.001), control=list(factr=factr, ndeps=c(1,1)))
optimParallel(c(2,1), f1, method = "L-BFGS-B", lower=c(-Inf,0.001), control=list(factr=factr, ndeps=c(1,1)))
rep(1:2, 2)
rep(1:2, length.out=2)
rep(1:2, length.out=3)
optimParallel
## rm(list=ls())
## library("testthat")
## library("optimParallel", lib.loc = "../../../lib/")
context("test-evalParallel")
source("testsetup.R")
f1 <- function(x){
x
}
f2 <- function(x,y){
sum(10*x, y)
}
f3 <- function(x,y=1){
x+y
}
test_that("evalParallel: f1", {
expect_equal(optimParallel:::evalParallel(cl=cl, f=f1, args=NULL,
firstArg=c(1)),
list(1))
expect_equal(optimParallel:::evalParallel(cl=cl, f=f1, args=NULL,
firstArg=c(1,2)),
list(c(1,2)))
expect_equal(optimParallel:::evalParallel(cl=cl, f=f1, args=NULL,
firstArg=matrix(c(1,2), ncol=2)),
list(1,2))
expect_equal(optimParallel:::evalParallel(cl=cl, f=f1, args=NULL,