R/utils.R

In jakobbossek/ecr3: Evolutionary Computation in R - Version 3

# @title
#  Assert same dimensions.
#
# @description
#   We frequently need to check whether the dimension of an approximation set is
#   equal to the dimension of the ideal point and/or nadir point. This does exactly
#   that assertion for an arbitrary number of arguments.
#
# @param ... [any]
#   Vectors or matrizes.
# @return Nothing. Stops if not all dimensions are equal.
assertSameDimensions = function(...) {
  xs = list(...)
  dims = sapply(xs, function(x) {
    # we store vectors one per column
    return(if (is.matrix(x)) nrow(x) else length(x))
  })
  if (!hasAllEqualElements(dims)) {
    stopf("All point sets and points need to be of the same dimension.")
  }
}

# @title
#   Check whether all elements of an vector are equal.
#
# @param x [vector]
#   Input vector.
# @return [logical(1)]
hasAllEqualElements = function(x) {
  return(nunique(x) == 1L)
}

#' @title Random Samples
#'
#' @details Basically delegates to \code{\link[base]{sample}}, but with different
#' behaviour if \code{x} has length 1. Function \code{\link[base]{sample}} sample
#' from \code{1:x} if \code{x} is numeric and greater or equal to 1. This produces
#' undesired and hard to locate behaviour if \code{x} varies in length when called
#' repeatedly. Function \code{sample2} instead samples from \code{rep(x, size)}.
#' @param x [\code{integer}]\cr
#'   A vector of length one or more elements from which to choose.
#' @param size [\code{integer(1)}]\cr
#'   Number of items to choose.
#' @param ... [any]\cr
#'   Further parameters passed down to \code{\link[base]{sample}}.
#' @export
sample2 = function(x, size, ...) {
  if (length(x) == 1L)
    x = rep(x, size)
  sample(x, size, ...)
}

#' @title Combine indices and elements of a list as tuples.
#'
#' @description Given a list this function returns a list of two-element lists with
#' names \dQuote{index} for the index (starting at one) and \dQuote{element}
#' containing the element.
#' @param x [\code{list}]\cr
#'   Input list.
#' @return [\code{list}]
#' @export
zipList = function(x) {
  checkmate::assertList(x)
  n = length(x)
  lapply(seq_len(n), function(i) list(index = i, element = x[[i]]))
}

nunique = function(x) {
  length(unique(x))
}

paramsToString = function(x) {
  ns = names(x)
  y = paste(ns, unname(as.character(x)), sep = " = ")
  return(y)
}

dropAttributes = function(x) {
  attributes(x) = NULL
  x
}

# faster cbind if list of vectors is given
fastCBind = function(x) {
  ny = length(x[[1L]])
  if (ny < 10) {
    matrix(unlist(x), ncol = length(x), byrow = FALSE)
  } else {
    do.call(cbind, x)
  }
}