Raw File
rlabel.R
#
#   rlabel.R
#
#   random (re)labelling
#
#   $Revision: 1.12 $   $Date: 2019/04/25 02:59:12 $
#
#
rlabel <- function(X, labels=marks(X), permute=TRUE, nsim=1, drop=TRUE) {
  stopifnot(is.ppp(X) || is.lpp(X) || is.pp3(X) || is.ppx(X) || is.psp(X))
  if(is.null(labels))
    stop("labels not given and marks not present")
  nthings <- nobjects(X)
  things <- if(is.psp(X)) "segments" else "points"
  if(is.vector(labels) || is.factor(labels)) {
    nlabels <- length(labels)
    if(permute && (nlabels != nthings))
      stop(paste("length of labels vector does not match number of", things))
    Y <- replicate(nsim,
                   X %mark% sample(labels, nthings, replace=!permute),
                   simplify=FALSE)
  } else if(is.data.frame(labels) || is.hyperframe(labels)) {
    nlabels <- nrow(labels)
    if(permute && (nlabels != nthings))
      stop(paste("number of rows of data frame does not match number of",
                 things))
    Y <- replicate(nsim,
                   X %mark% labels[sample(1:nlabels, nthings, replace=!permute), ,drop=FALSE],
                   simplify=FALSE)
  } else stop("Format of labels argument is not understood")
  return(simulationresult(Y, nsim, drop))
}

back to top