examples/sms_emoa.r

In olafmersmann/emoa: Evolutionary Multiobjective Optimization Algorithms

##
## sms_emoa.r - Straight forward SMS-EMOA implementation
##
## Author:
##  Olaf Mersmann (OME) <olafm@statistik.tu-dortmund.de>
##

require("emoa")

sms_emoa <- function(f, lower, upper, ...,
                     control=list(mu=100L,
                       sbx.n=15, sbx.p=0.7,
                       pm.n=25, pm.p=0.3
                       )) {
  ## Extract control parameters:
  default <- formals(sys.function())$control
  control <- steady_state_emoa_control(f, lower, upper, ..., control=control, default=default)
  control <- sbx_control(f, upper, lower, ..., control=control, default=default)
  control <- pm_control(f, upper, lower, ..., control=control, default=default)  
  control$ref <- emoa:::coalesce(control[["ref"]], rep(11, control$d))

  ## Tracking variables:
  X <- matrix(0, nrow=control$n, ncol=control$maxeval)
  Y <- matrix(0, nrow=control$d, ncol=control$maxeval)
  dob <- rep(-1L, control$maxeval)
  eol <- rep(-1L, control$maxeval)
  
  ## Random inital population:
  X[, 1:control$mu] <- replicate(control$mu, runif(control$n, lower, upper))
  Y[, 1:control$mu] <- sapply(1:control$mu, function(i) f(X[,i]))

  neval <- control$mu       ## Count the number of function evaluations
  active <- 1:control$mu    ## Indices of individuals that are in the current pop.

  ## Save some common control parameters into the current
  ## environment. This saves a few msec of execution time...
  crossover <- control$crossover
  mutate <- control$mutate
  maxeval <- control$maxeval
  logger <- control$logger
  
  logger$start("sms_emoa")
  while(neval < maxeval) {
    ############################################################
    ## Variation:
    parents <- sample(active, 2)
    child <- crossover(X[, parents])[,sample(c(1, 2), 1)]
    x <- mutate(child)

    ## Add new individual:
    neval <- neval + 1
    X[, neval] <- x
    Y[, neval] <- f(x)
    dob[neval] <- neval ## For a steady state emoa this is trivial...
    active <- c(active, neval)

    ############################################################
    ## Selection:
    i <- nds_hv_selection(Y[, active])

    ## Remove the i-th active individual:
    eol[active[i]] <- neval
    active <- active[-i]

    ############################################################
    ## Logging:    
    logger$step()
  }
  logger$stop()
  
  res <- structure(list(X=X, Y=Y,
                        dob=dob,
                        eol=eol,
                        par=X[,active], value=Y[,active]),
                   class="emoa_result")
  return(res)
}