https://github.com/cran/spatstat
Tip revision: c2594d075d909d9c1d44757ab16f5d066d58537f authored by Adrian Baddeley on 18 April 2006, 00:00:00 UTC
version 1.8-9
version 1.8-9
Tip revision: c2594d0
rshift.psp.R
#
# rshift.psp.R
#
# $Revision: 1.1 $ $Date: 2006/02/28 01:36:31 $
#
rshift.psp <- function(X, ..., group=NULL, which=NULL) {
verifyclass(X, "psp")
# process arguments
W <- rescue.rectangle(X$window)
arglist <- handle.rshift.args(W, ..., edgedefault="erode")
radius <- arglist$radius
width <- arglist$width
height <- arglist$height
edge <- arglist$edge
clip <- arglist$clip
if(W$type != "rectangle")
stop("Not yet implemented for non-rectangular windows")
if(edge != "erode")
stop("Only implemented for edge=\"erode\"")
# split into groups
if(is.null(group))
Y <- list(X)
else {
stopifnot(is.factor(group))
stopifnot(length(group) == X$n)
Y <- lapply(levels(group),
function(l, X, group) {X[group == l]},
X=X, group=group)
}
############ loop ################
result <- psp(numeric(0), numeric(0), numeric(0), numeric(0),
X$window)
for(i in seq(Y)) {
Z <- Y[[i]]
# generate random translation vector
if(!is.null(radius))
jump <- runifdisc(1, r=radius)
else {
jump <- list(x=runif(1, min=0, max=width),
y=runif(1, min=0, max=height))
}
# translate segments
Zsh <- shift(Z, unlist(jump))
Zsh$window <- W
# append to result
result <- append.psp(result, Zsh)
}
# clip
if(!is.null(clip))
result <- result[, clip]
return(result)
}