test_functions.R

# Part of the hydroPSO package, http://www.rforge.net/hydroPSO/
# Copyright 2008-2012 Mauricio Zambrano-Bigiarini & Rodrigo Rojas
# Distributed under GPL 2 or later

# All these function were started on 2008, with updates on:                    #
# 13-Dec-2010 ; 20-Dec-2010; 21-Dec-2010                                       #
# 24-Jan-2011 ; 02-Feb-2011                                                    #
# 14-Nov-2011 ; 21-Sep-2012 ; 25-Sep-2012

# MZB, 21-Jun-2011
# 3D sinc function: f(1,..,1)=1. Maximization
sinc <- function(x) {
    n <- length(x)
    return( prod (sin( pi*(x-seq(1:n)) ) / ( pi*(x-seq(1:n)) ), na.rm=TRUE) )
} # 'sinc' END

# MZB, RR, 21-Jun-2011,  14-Nov-2011
# Rosenbrock function: f(1,..,1)=0. Minimization. In [-30, 30]^n. AcceptableError < 100
rosenbrock <- function(x) {  
  n <- length(x)
  return( sum( ( 1- x[1:(n-1)] )^2 + 100*( x[2:n] - x[1:(n-1)]^2 )^2 ) )
} # 'rosenbrock' END


# MZB, RR, 21-Jun-2011
# Sphere function: f(1,..,1)=0. Minimization. In [-100, 100]^n. AcceptableError < 0.01
sphere <- function(x) {
  return(sum(x^2))  
} # 'sphere' END


# MZB, RR, 21-Jun-2011,  14-Nov-2011. Keep only for backward compatibility
# Rastrigrin function: f(0,..,0)=0. Minimization. In [-5.12, 5.12]^n. AcceptableError < 100
rastrigrin <- function(x) { 
  n <- length(x) 
  return( 10*n + sum( x^2 - 10*cos(2*pi*x) ) )
} # 'rastrigrin' END

# MZB, RR, 17-Jul-2012. The correct name of the function is 'Rastrigin' and NOT 'Rastrigrin' !!!
# Rastrigin function: f(0,..,0)=0. Minimization. In [-5.12, 5.12]^n. AcceptableError < 100
rastrigin <- function(x) { 
  n <- length(x) 
  return( 10*n + sum( x^2 - 10*cos(2*pi*x) ) )
} # 'rastrigin' END


# MZB, RR, 21-Jun-2011
# Griewank function: f(0,..,0)=0. Minimization. In [-600, 600]^n. AcceptableError < 0.05
griewank <- function(x) {  
  n <- length(x)
  return( 1 + (1/4000)*sum( x^2 ) - prod( cos( x/sqrt(seq(1:n)) ) ) )
} # 'griewank' END


# MZB, RR, 21-Jun-2011,  14-Nov-2011,  13-Sep-2012
# Schaffer's f6 function: f(0,..,0)=0. Minimization. In [-100, 100]^n. AcceptableError < 1E-4
schafferF6 <- function(x) {  
  return( 0.5 + ( ( sin( sqrt( sum( x^2 ) ) ) )^2 - 0.5) / ( ( 1 + 0.001*sum(x^2) )^2 ) )
} # 'schafferF6' END


# MZB, RR, 14-Nov-2011
# Ackley function: f(0,..,0)=0. Minimization. In [-32.768, 32.768]^n. AcceptableError < 0.01, a=20 ; b=0.2 ; c=2*pi
ackley <- function(x) {  
  n <- length(x)
  return( -20*exp( -0.2*sqrt((1/n)*sum(x^2)) ) - exp( (1/n)*sum(cos(2*pi*x)) ) + 20 + exp(1) )
} # 'schafferF6' END


# MZB, 25-Sep-2012. Schwefel: f(xi,..,xi)=0, with xi= 420.968746
# Minimization. In [-500, 500]^n. AcceptableError < 0.01
# Properties: Multimodal, Additively separable 
#             This function is deceptive in that the global minimum is geometrically 
#             distant, over the parameter space, from the next best local minima. 
# Ref: http://www.scribd.com/doc/74351406/7/Schwefel%E2%80%99s-function
schwefel <- function(x) { 
  n <- length(x) 
  return( 418.98288727433799*n + sum( -x*sin( sqrt(abs(x)) ) ) )
} # 'schwefel' END


################################################################################
########################### Shifted Functions ##################################
################################################################################

# MZB, 21-Sep-2012. Shifted Sphere (CEC 2005): f(o,..,o)=-450. 
# Minimization. In [-100, 100]^n. AcceptableError < 0.01.
# Properties: Unimodal, Shifted, Separable, Scalable 
ssphere <- function (x, o=-100+200*runif(length(x)), fbias=-450) {
 n <- length(x)
 if (n != length(o)) stop("length(x) != length(o)")
 z <- x - o
 return(sum(z^2) + fbias)
} # 'ssphere'

# MZB, RR, 21-Jun-2011. Properties: Unimodal, Shifted, Separable, Scalable
# Shifted Griewank : f(o,..,o)=-180. Minimization. In [-600, 600]^n. AcceptableError < 0.05
sgriewank <- function (x, o=-600+1200*runif(length(x)), fbias=-180) {
  n <- length(x)
  if (n != length(o)) stop("length(x) != length(o)")
  z <- x - o
  return(1 + (1/4000) * sum(z^2) - prod(cos(z/sqrt(seq(1:n)))) + fbias)
} # 'sgriewank'


# MZB, 21-Sep-2012. # Shifted Rosenbrock (CEC 2005): f(o,..,o)=390. 
# Minimization. In [-100, 100]^n. AcceptableError < 100
# Properties: Multi-modal, Shifted, Non-separable, Scalable, Having a very narrow 
#             valley from local optimum to  global optimum
srosenbrock <- function(x, o=-100+200*runif(length(x)), fbias=390) {  
  n <- length(x)
  if (n != length(o)) stop("length(x) != length(o)")
  z <- x - o
  return( sum( ( 1- z[1:(n-1)] )^2 + 100*( z[2:n] - z[1:(n-1)]^2 )^2 ) + fbias )
} # 'srosenbrock' END


# MZB, 21-Sep-2012. Shifted Ackley: f(o,..,o)=-140. 
# Minimization. In [-32.768, 32.768]^n. AcceptableError < 0.01, a=20 ; b=0.2 ; c=2*pi
sackley <- function (x, o=-32+64*runif(length(x)), fbias=-140) {
  n <- length(x)
  if (n != length(o)) stop("length(x) != length(o)")
  z <- x - o
  return(-20 * exp(-0.2 * sqrt((1/n) * sum(z^2))) - exp((1/n) * sum(cos(2 * pi * z))) + 20 + exp(1) + fbias )
} # 'sackley'


# MZB, 21-Sep-2012. Shifted Rastrigin (CEC 2005): f(o,..,o)=-330. 
# Minimization. In [-5.12, 5.12]^n. AcceptableError < 100
# Properties: Multi-modal, Shifted, Separable, Scalable, Huge number of local optima
srastrigin <- function(x, o=-5+10*runif(length(x)), fbias=-330) { 
  n <- length(x) 
  if (n != length(o)) stop("length(x) != length(o)")
  z <- x - o
  return( 10*n + sum( z^2 - 10*cos(2*pi*z) ) + fbias )
} # 'srastrigin' END


# MZB, 25-Sep-2012. Shifted Schwefel's Problem 1.2 (CEC 2005): f(o,..,o)=-450. 
# Minimization. In [-100, 100]^n. AcceptableError < 100
# Properties: Unimodal, Shifted, Non-separable, Scalable
sschwefel1_2 <- function(x, o=-100+200*runif(length(x)), fbias=-450) { 
  n <- length(x) 
  if (n != length(o)) stop("length(x) != length(o)")
  z <- x - o
  return( sum( (cumsum(z))^2 ) + fbias )
} # 'sschwefel1_2' END


#### TODO: find the definition of the rotation matrix M:
## MZB, 21-Sep-2012. Shifted Rotated Rastrigin (CEC 2005): f(o,..,o)=-330. 
## Minimization. In [-5.12, 5.12]^n. AcceptableError < 100
## Properties: Multi-modal, Shifted, Rotated, Non-separable, Scalable, Huge number of local optima
#srrastrigin <- function(x, o=-5+10*runif(length(x)), fbias=-330) { 
#  n <- length(x) 
#  if (n != length(o)) stop("length(x) != length(o)")
#  z <- x - o
#  return( 10*n + sum( z^2 - 10*cos(2*pi*z) ) + fbias )
#} # 'srrastrigin' END