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

#### Documented in distanceMatrixdistanceMatrixUpdatedistanceMatrixWrapperdistanceRealEuclideandistanceVector

```###################################################################################
#' Calculate Distance Matrix
#'
#' Calculate the distance between all samples in a list, and return as matrix.
#'
#' @param X list of samples, where each list element is a suitable input for \code{distFun}
#' @param distFun Distance function of type f(x,y)=r, where r is a scalar and x and y are elements whose distance is evaluated.
#' @param ... further arguments passed to distFun
#'
#' @return The distance matrix
#'
#' @examples
#' x <- list(5:1,c(2,4,5,1,3),c(5,4,3,1,2), sample(5))
#' distanceMatrix(x,distancePermutationHamming)
#'
#' @export
###################################################################################
distanceMatrix <-function(X,distFun,...){
n <- length(X)
m <- matrix(0,nrow=n, ncol=n)
for(i in seq_len(n - 1)){
ids <- (i+1):n
m[ids,i] <- m[i,ids] <- distanceVector(X[[i]],X[ids],distFun,...)
}
m
}

###################################################################################
#' Calculate Distance Vector
#'
#' Calculate the distance between a single sample and all samples in a list.
#'
#' @param a A single sample which is a suitable input for \code{distFun}
#' @param X list of samples, where each list element is a suitable input for \code{distFun}
#' @param distFun Distance function of type f(x,y)=r, where r is a scalar and x and y are elements whose distance is evaluated.
#' @param ... further arguments passed to distFun
#'
#' @return A numerical vector of distances
#'
#' @examples
#' x <- 1:5
#' y <- list(5:1,c(2,4,5,1,3),c(5,4,3,1,2))
#' distanceVector(x,y,distancePermutationHamming)
#'
#' @export
###################################################################################
distanceVector <-function(a,X,distFun,...){
unlist(lapply(X,distFun,a,...))
}

###################################################################################
#' Update distance matrix
#'
#' Update an existing distance matrix \code{D_mat} by adding distances
#' of all previous candidate solutions to one new candidate solution, \code{d_vec= d(x_i,x_new)}.
#'
#' @param distanceMat original distance matrix \code{D_mat}
#' @param x list of candidate solutions, last in list is the new solution
#' @param distanceFunction Distance function of type f(x,y)=r, where r is a scalar and x and y are candidate solutions whose distance is evaluated.
#' @param ... further arguments passed to distanceFunction
#'
#' @return matrix of distances between all solutions x
#'
#' @examples
#' x <- list(5:1,c(2,4,5,1,3),c(5,4,3,1,2))
#' dm <- distanceMatrix(x,distancePermutationHamming)
#' x <- append(x,list(1:5))
#' dmUp <- distanceMatrixUpdate(dm,x,distancePermutationHamming)
#'
#' @export
#' @keywords internal
###################################################################################
distanceMatrixUpdate <- function(distanceMat,x,distanceFunction,...){
count <- length(x)
if(length(distanceFunction)==1){ # in case of a single distance function (all models)
newdist = distanceVector(x[[count]],x[-count],distanceFunction,...)
distanceMat = cbind(rbind(distanceMat,c(newdist)),c(newdist,0))
}else{	# in case of multiple distance functions (kriging only atm.)
for(i in 1:length(distanceFunction)){
newdist = distanceVector(x[[count]],x[-count],distanceFunction[[i]],...)
distanceMat[[i]] <- cbind(rbind(distanceMat[[i]],c(newdist)),c(newdist,0))
}
}
distanceMat
}

###################################################################################
#' Distance Matrix Wrapper
#'
#' Wrapper to calculate the distance matrix, with one or multiple distance functions.
#'
#' @param x list of candidate solutions whose distance is evaluated
#' @param distanceFunction Distance function of type f(x,y)=r, where r is a scalar and x and y are candidate solutions whose distance is evaluated.
#' @param ... further arguments passed to distanceFunction
#'
#' @return matrix of distances between all solutions in list x
#'
#' @examples
#' x <- list(5:1,c(2,4,5,1,3),c(5,4,3,1,2))
#' dm1 <- distanceMatrix(x,distancePermutationHamming)
#' dm2 <- distanceMatrix(x,distancePermutationInsert)
#' dmBoth <- distanceMatrixWrapper(x,list(distancePermutationHamming,distancePermutationInsert))
#'
#' @export
#' @keywords internal
###################################################################################
distanceMatrixWrapper <- function(x,distanceFunction,...){
if(length(distanceFunction)==1){ # in case of a single distance function (all models)
distances <- distanceMatrix(x,distanceFunction,...)
}else{	# in case of multiple distance functions (kriging only atm.)
distances <- list()
for(i in 1:length(distanceFunction)){
distances[[i]] <- distanceMatrix(x,distanceFunction[[i]],...)
}
}
distances
}

###################################################################################
#' Euclidean Distance
#'
#' The Euclidean distance for real vectors.
#'
#' @param x first real vector
#' @param y second real vector
#'
#' @return numeric distance value \deqn{d(x,y)}
#'
#' @examples
#' x <- runif(5)
#' y <- runif(5)
#' distanceRealEuclidean(x,y)
#'
#' @export
###################################################################################
distanceRealEuclidean <- function(x,y){
sqrt(sum((x-y)^2))
}
```

## Try the CEGO package in your browser

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

CEGO documentation built on May 29, 2024, 3:35 a.m.