# R/permutationBenchmarkFunctions.R In CEGO: Combinatorial Efficient Global Optimization

#### Documented in benchmarkGeneratorFSPbenchmarkGeneratorQAPbenchmarkGeneratorTSPbenchmarkGeneratorWT

```#   Copyright (c) 2014-2015 by Martin Zaefferer, Cologne University of Applied Sciences

###################################################################################
#' Create Quadratic Assignment Problem (QAP) Benchmark
#'
#' Creates a benchmark function for the Quadratic Assignment Problem.
#'
#' @param a distance matrix
#' @param b flow matrix
#'
#' @return the function of type cost=f(permutation)
#'
#' @examples
#' set.seed(1)
#' n=5
#' #ceate a flow matrix
#' A <- matrix(0,n,n)
#' for(i in 1:n){
#' 	for(j in i:n){
#' 		if(i!=j){
#' 			A[i,j] <- sample(100,1)
#' 			A[j,i] <- A[i,j]
#'	 	}
#' 	}
#' }
#' #create a distance matrix
#' locations <- matrix(runif(n*2)*10,,2)
#' B <- as.matrix(dist(locations))
#' #create QAP objective function
#' fun <- benchmarkGeneratorQAP(A,B)
#' #evaluate
#' fun(1:n)
#' fun(n:1)
#'
#' @export
###################################################################################
benchmarkGeneratorQAP <- function(a, b) { # Generator function.
a
b #lazy evaluation fix, faster than force()
function(x){
bx<-b[x,x]
sum(a*bx) # divide by 2 if exact cost required
}
}

###################################################################################
#' Create Flow shop Scheduling Problem (FSP) Benchmark
#'
#' Creates a benchmark function for the Flow shop Scheduling Problem.
#'
#' @param a matrix of processing times for each step and each machine
#' @param n number of jobs
#' @param m number of machines
#'
#' @return the function of type cost=f(permutation)
#'
#' @examples
#' n=10
#' m=4
#' #ceate a matrix of processing times
#' A <- matrix(sample(n*m,replace=TRUE),n,m)
#' #create FSP objective function
#' fun <- benchmarkGeneratorFSP(A,n,m)
#' #evaluate
#' fun(1:n)
#' fun(n:1)
#'
#' @export
###################################################################################
benchmarkGeneratorFSP <- function(a, n, m) { # Generator function. see Reeves1995
a
n #lazy evaluation fix, faster than force()
m
function(x){
C=matrix(NA,n,m)
ax <- a[x,]
C[,1]<-as.numeric(cumsum(ax[,1]))
C[1,]<-as.numeric(cumsum(ax[1,]))
for(i in 2:n){
for(j in 2:m){
C[i,j]=max(C[i-1,j],C[i,j-1])+ax[i,j]
}
}
C[n,m]
}
}

###################################################################################
#' Create (Asymmetric) Travelling Salesperson Problem (TSP) Benchmark
#'
#' Creates a benchmark function for the (Asymmetric) Travelling Salesperson Problem.
#' Path (Do not return to start of tour. Start and end of tour not fixed.)
#' or Cycle (Return to start of tour). Symmetry depends on supplied distance matrix.
#'
#' @param distanceMatrix Matrix that collects the distances between travelled locations.
#'
#' @return the function of type cost=f(permutation)
#'
#' @examples
#' set.seed(1)
#' #create 5 random locations to be part of a tour
#' n=5
#' cities <- matrix(runif(2*n),,2)
#' #calculate distances between cities
#' cdist <- as.matrix(dist(cities))
#' #create objective functions (for path or cycle)
#' fun1 <- benchmarkGeneratorTSP(cdist, "Path")
#' fun2 <- benchmarkGeneratorTSP(cdist, "Cycle")
#' #evaluate
#' fun1(1:n)
#' fun1(n:1)
#' fun2(n:1)
#' fun2(1:n)
#'
#' @export
###################################################################################
benchmarkGeneratorTSP <- function(distanceMatrix, type="Cycle") { # Generator function
distanceMatrix #lazy evaluation fix, faster than force()

if(type=="Path"){
f <- function (x){
x <- x[-length(x)]
sum(distanceMatrix[cbind(x,x1)])
}
}else{
f <- function (x){
sum(distanceMatrix[cbind(x,x1)])
}
}
return(f)
}

###################################################################################
#' Create single-machine total Weighted Tardiness (WT) Problem Benchmark
#'
#' Creates a benchmark function for the single-machine total Weighted Tardiness Problem.
#'
#' @param p processing times
#' @param w weights
#' @param d due dates
#'
#' @return the function of type cost=f(permutation)
#'
#' @examples
#' n=6
#' #processing times
#' p <- sample(100,n,replace=TRUE)
#' #weights
#' w <- sample(10,n,replace=TRUE)
#' #due dates
#' RDD <- c(0.2, 0.4, 0.6,0.8,1.0)
#' TF <- c(0.2, 0.4, 0.6,0.8,1.0)
#' i <- 1
#' j <- 1
#' P <- sum(p)
#' d <- runif(n,min=P*(1-TF[i]-RDD[j]/2),max=P*(1-TF[i]+RDD[j]/2))
#' #create WT objective function
#' fun <- benchmarkGeneratorWT(p,w,d)
#' fun(1:n)
#' fun(n:1)
#'
#' @export
###################################################################################
benchmarkGeneratorWT <- function(p, w, d) { # Generator function
p
w #lazy evaluation fix, faster than force()
d
n= length(p)
function(x){
px <- p[x]
dx <- d[x]
wx <- w[x]
s=c(0,cumsum(px[-n]))
Ti=pmax(s+px-dx,0)*wx
return(sum(Ti))
}
}
```

## Try the CEGO package in your browser

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

CEGO documentation built on May 14, 2021, 1:08 a.m.