# R/smco.R In smco: A simple Monte Carlo optimizer using adaptive coordinate sampling

#### Documented in smco

```####################################################################################
#                                                                                  #
# smco                                                                             #
#                                                                                  #
# A simple Monte Carlo optimizer using adaptive coordinate sampling                #
# Prof. Juan David Velasquez H.                                                    #
#                                                                                  #
####################################################################################
smco <-
function(par = NULL, fn, gr = NULL, ..., N = length(par), LB, UB, maxiter = 1000,
Co = 0.01, Cmin = 0.0001, Cmax = 0.5, trc = FALSE, lambda = 20,
useBFGS = FALSE, control = list(), hessian = FALSE)
{
#-------------------------------------------------------------------------------
#
# Local improvement using gradient-based optimization
#
runBFGS <- function( u )
{
z.curr[idim.curr] = u
x.curr = LB + z.curr * (UB - LB)
return (fn( x.curr ))
}
#-------------------------------------------------------------------------------
#
# Optimization algorithm
#
if (trc) { print( match.call() ) }
#
#-------------------------------------------------------------------------------
#
if(is.null(par)) { z.curr = runif(N) } else	{ z.curr = (par - LB) / (UB - LB) }
#
z.min       = z.curr                   # optimo local  en [0, 1]^n
z.opt       = z.curr
x.min       = LB + z.curr * (UB - LB)  # optimo local  en [L, U]^n
#
f.min       = rep(0, maxiter);  f.min[1]  = fn( x.min ) # f evaluada en el optimo local
f.curr      = rep(0, maxiter);  f.curr[1] = f.min[1]    # f evaluada en el punto actual
f.opt       = rep(0, maxiter);  f.opt[1]  = f.min[1]    # f evaluada en el optimo global
#
idim.curr   = 1
C           = Co
#
#-------------------------------------------------------------------------------
#
# Cycle
#
for (iter in 2:maxiter)
{
z.curr = z.min
u = z.min[idim.curr]
C =  max(Cmin, min(C * exp( 0.0001 + rnorm(1) / sqrt(2 * sqrt(N)+ 2 * N) ), Cmax))
z.curr[idim.curr] = u + C * qnorm(runif(1) * (pnorm((1 - u) / C) - pnorm((0 - u) / C)) + pnorm((0 - u) / C))
#
x.curr = LB + z.curr * (UB - LB)
f.curr[iter] = fn( x.curr )
#
#--------------------------------------------------------------------------
#
if (useBFGS)
{
result = optim(par = z.curr[idim.curr], fn = runBFGS,
gr = NULL, method='L-BFGS-B', lower = 0, upper = 1,
control = control, hessian = hessian)
#
if (result\$value < f.curr[iter])
{
z.curr[idim.curr] = result\$par
x.curr = LB + z.curr * (UB - LB)
f.curr[iter] = fn( x.curr )
}
}
#
#--------------------------------------------------------------------------
#
if (f.curr[iter] < f.min[iter - 1])
{
x.min       = x.curr
f.min[iter] = f.curr[iter]
z.min       = z.curr
}
else
{
f.min[iter] = f.min[iter - 1]
}
#
#--------------------------------------------------------------------------
#
# Restart
#
if (bad.counter > lambda * N)
{
for (idim.curr in 1:N) {
u = z.min[idim.curr]
z.min[idim.curr] = u + Co * qnorm(runif(1) * (pnorm((1 - u) / Co) - pnorm((0 - u) / Cmax)) + pnorm((0 - u) / Co))
}
z.min = runif(N)
f.curr[iter] = fn( LB + z.min * (UB - LB) )
f.min[iter] = f.curr[iter]
C = Co
if (trc) cat("Restarting ...", "\n")
}
#
#--------------------------------------------------------------------------
#
if (f.curr[iter] < f.opt[iter - 1])
{
x.opt       = x.curr
f.opt[iter] = f.curr[iter]
z.opt       = z.curr
}
else
{
f.opt[iter] = f.opt[iter - 1]
}
#
idim.curr = idim.curr + 1
if (idim.curr > N)
{
idim.curr = 1
if (trc)
{
cat(iter, f.curr[iter], f.min[iter], f.opt[iter], "\n")
}
}
#
}
#
return (list(par = x.opt, value = f.opt[maxiter],
f.opt = f.opt, f.min = f.min, f.curr=f.curr,
call = match.call()))
#
}

#
###########################################################
#                                                         #
#                                                         #
###########################################################
#
.onAttach <-
function(...)
{
version = library(help = smco)\$info[[1]]
version = version[pmatch("Version",version)]
um = strsplit(version, " ")[[1]]
version = um[nchar(um) > 0][2]
#
cat(paste("This is smco package", version, "\n"))
}
```

## Try the smco package in your browser

Any scripts or data that you put into this service are public.

smco documentation built on May 2, 2019, 7:38 a.m.