R/labsimplex.R

In labsimplex: Simplex Optimization Algorithms for Laboratory and Manufacturing Processes

#' Generates a simplex object
#'
#' The simplex (a list with class \code{smplx}) contains the coordinates
#' of the n+1 vertices that define a simplex in an \emph{n}-dimensional space.
#' By default, the function produces a regular simplex centered at the origin.
#' The coordinates of the regular simplex are transformed into the real
#' variables space by using the information of the start or centroid and
#' step-size. The only non-optional parameter is \code{n} that relates the
#' simplex dimensionality. Once the simplex
#' is generated, the experiments under the conditions indicated for each
#' variable at each vertex must be carried and the response obtained.
#' Those responses are assigned to the \code{smplx} object at the moment of
#' generating the new vertex (see \code{\link{generateVertex}}).
#'
#' The regular simplex coordinates are generated following the general
#' algorithm for the cartesian coordinates of a regular n-dimensional simplex.
#' This algorithm considers that all vertices must be equally distanced from
#' simplex centroid and all angles subtended between any two vertexes and the
#' centroid of a simplex are equal to \emph{arccos(-1/n)}.\cr
#' If the vertexes coordinates are manually given (in \code{usr.def}
#' parameter), the function checks if the faces produced belong to different
#' hyperplanes. This avoids the generation of a degenerated simplex.
#'
#' @param  n         dimensionality of the simplex (i.e. number of variables)
#' @param  start     numeric vector of size \code{n} with coordinates of the
#'                   first vertex
#' @param  centroid  numeric vector of size \code{n} with coordinates of the
#'                   centroid
#' @param  stepsize  numeric vector of size \code{n} with the step-sizes for
#'                   each coordinate
#' @param  usrdef    \code{(n+1)xn} matrix containig in (n+1) rows the n
#'                   coordinates for each vertex
#' @param  var.name  vector containing the names for the variables
#' @return  An object of class \code{smplx} with the information of the new
#'   simplex.
#' @examples
#'   simplex <- labsimplex(n = 3)
#'   simplex <- labsimplex(n = 3, centroid = c(350, 7, 0.4),
#'                         stepsize = c(35, 2, 0.3),
#'                         var.name = c('temperature', 'pH', 'concentration'))
#'   simplex <- labsimplex(n = 3, usrdef = rbind(c(390, 8, 0.2), c(330, 8, 0.2),
#'                                    c(330, 6, 0.6), c(330, 6, 0.1)))
#'   \dontrun{
#'     ## User defined coordinates may define a degenerated simplex:
#'     simplex <- labsimplex(n = 3,
#'                           usrdef = rbind(c(390, 8, 0.3), c(340, 8, 0.3),
#'                                          c(355, 8, 0.3), c(340, 5, 0.1)))
#'   }
#' @author Cristhian Paredes, \email{craparedesca@@unal.edu.co}
#' @author Jesús Ágreda, \email{jagreda@@unal.edu.co}
#' @references Nelder, J. A., and R. Mead. 1965. “A Simplex Method for Function
#' Minimization.” The Computer Journal 7 (4): 308–13.
#' @references Spendley, W., G. R. Hext, and F. R0. Himsworth. 1962. “Sequential
#' Application of Simplex Designs in Optimization and Evolutionary Operation.”
#' Technometrics 4 (4): 441–61.
#' @export
labsimplex <- function(n, start = NULL, centroid = NULL, stepsize = NULL,
                       usrdef = NULL, var.name = NULL){

  main.list <- list(dim = n, coords = NULL, centroid = NULL,
                    qual.fun = NULL, vertex.label = NULL, tim.ret = NULL,
                    vertex.nat = NULL, P.eval = FALSE)
  class(main.list) <- 'smplx'

  # Error handling
  # Checks for redundant parameters definition
  if (!missing(centroid) && !missing(start)) {
    stop("Redundant definition: start and centroid parameters are incompatible.",
         " Only one must be defined")
  }
  # Possible errors when usrdef is provided
  if (!missing(usrdef)) {
    # If provided, usrdef must be an appropiate matrix
    if (ncol(usrdef) != nrow(usrdef) - 1) {
      stop("Parameter usrdef must be a N+1 x N matrix containig in each row",
            " the N coordinates for each vertex.")
    }

    if (ncol(usrdef) != n) {
      stop("Number of coordinates in user defined matrix differs from",
           " dimensionality: ", n, " and ", ncol(usrdef), ".")
    }
    # Checking if points define a simplex
    if (abs(det(cbind(usrdef, rep(1, nrow(usrdef))))) < 1e-9) {
      stop("Given coordinates of vertex define hyperfaces that share at least",
           " one hyperplane!")
    } else {
      message("Provided points define a simplex:")
    }
    # Some parameters must not be provided if the coordinates are given
    if (!missing(stepsize) || !missing(start) || !missing(centroid)) {
      stop("Parameters such as start, centroid, and stepsize must not",
           " be provided when simplex coordinates are provided in usrdef.")
    }
  }
  # Possible errors when N is provided
  if (!missing(n)) {
    # If provided, stepsize must have appropiated format
    if (!missing(stepsize)) {
      if (length(stepsize) == 1) {
        message("Vector for stepsize is length 1, the same step size will be",
                " used in all dimensions.")
        stepsize <- rep(stepsize, n)
      } else {
        if (length(stepsize) != n){
          stop("Vector stepsize is expected to be of length 1 or equal to the",
               " dimensionality: ", n)
        }
      }
    }
    # If provided, centroid vector must have appropiated format
    if (!missing(centroid)) {
      if (length(centroid) == 1) {
        message("Vector for centroid is length 1, the same center will be used",
                " in all dimensions.")
        centroid <- rep(centroid, n)
      } else {
        if (length(centroid) != n) {
          stop("Vector centroid is expected to be of length 1 or equal to the",
               " dimensionality: ", n)
        }
      }
    }
    # If provided, start vector must have appropiated format
    if (!missing(start)) {
      if (length(start) == 1) {
        message("Vector for start is length 1, the same starting point will be",
                " used in all dimensions.")
        start <- rep(start, n)
      } else {
        if (length(start) != n) {
          stop("Vector start is expected to be of length 1 or equal to the",
               "dimensionality: ", n)
        }
      }
    }
  }
  # If provided the variable names, there must be a value for each dimension
  if (!missing(var.name)) {
    if (length(var.name) != n) {
      stop("Vector containing names for variables does not coincide in length",
           " with dimensionality")
    }
  }

  # Start of functions --------------------------------------------------------
  main.list$dim <- n
  main.list$lsimplex <- 1
  # Set vertex coordinates
  if (!missing(usrdef)) {
    V <- t(usrdef)
  } else {
    V <- matrix(0, nrow = n, ncol = n + 1)
    for (nc in 1:n) {
      V[nc, nc] <- sqrt(1 - sum(V[1:(nc - 1), nc] ** 2))
      for (nc1 in (nc + 1):(n + 1)) {
        V[nc, nc1] <- - (sum(V[1:nc, nc] * V[1:nc, nc1]) + 1 / n) / V[nc, nc]
      }
    }
  }

  coords <- t(V)

  if (missing(var.name)) var.name <- paste0("Var.", 1:ncol(coords))

  if (!missing(stepsize)) {
    s.size0  <- apply(coords, 2, max) - apply(coords, 2, min)
    c.factor <- stepsize / s.size0
    for (ii in 2:nrow(coords)) {
      coords[ii, ] <- coords[1, ]  + (coords[ii, ] - coords[1, ]) * c.factor
    }
  }

  if (!missing(start)) coords <- sweep(coords, 2, - (start - coords[1, ]))

  if (!missing(centroid)) {
    coords <- sweep(coords, 2, - (centroid - (colSums(coords) / (n + 1))))
  }

  main.list$coords            <- coords
  colnames(main.list$coords)  <- var.name
  row.names(main.list$coords) <- paste0("Vertex.", 1:nrow(coords))
  main.list$vertex.nat        <- rep("S", nrow(coords))
  main.list$vertex.his        <- rep("1.", nrow(coords))

  main.list$families <- list(1:(n + 1))

  main.list$centroid <- colSums(main.list$coords) / (n + 1)
  main.list$tim.ret  <- rep(1, (n + 1))

  return(main.list)
}