https://github.com/cran/spatstat
Tip revision: 3aca716ce2576a0dab83f08052acd47afed8ee6a authored by Adrian Baddeley on 29 February 2012, 00:00:00 UTC
version 1.25-4
version 1.25-4
Tip revision: 3aca716
pointsonlines.R
#
# pointsonlines.R
#
# place points at regular intervals along line segments
#
# $Revision: 1.6 $ $Date: 2011/09/23 01:55:58 $
#
pointsOnLines <- function(X, eps=NULL, np=1000, shortok=TRUE) {
stopifnot(is.psp(X))
len <- lengths.psp(X)
nseg <- length(len)
if(is.null(eps)) {
stopifnot(is.numeric(np) && length(np) == 1)
stopifnot(is.finite(np) && np > 0)
eps <- sum(len)/np
} else {
stopifnot(is.numeric(eps) && length(eps) == 1)
stopifnot(is.finite(eps) && eps > 0)
}
# initialise
Xdf <- as.data.frame(X)
xmid <- with(Xdf, (x0+x1)/2)
ymid <- with(Xdf, (y0+y1)/2)
# handle very short segments
allsegs <- 1:nseg
if(any(short <- (len <= eps)) && shortok) {
# very short segments: use midpoints
Z <- data.frame(x = xmid[short], y = ymid[short])
} else Z <- data.frame(x=numeric(0), y=numeric(0))
# handle other segments
for(i in (1:nseg)[!short]) {
# divide segment into pieces of length eps
# with shorter bits at each end
leni <- len[i]
nwhole <- floor(leni/eps)
if(leni/eps - nwhole < 0.5 && nwhole > 2)
nwhole <- nwhole - 1
rump <- (leni - nwhole * eps)/2
brks <- c(0, rump + (0:nwhole) * eps, leni)
nbrks <- length(brks)
# points at middle of each piece
ss <- (brks[-1] + brks[-nbrks])/2
x <- with(Xdf, x0[i] + (ss/leni) * (x1[i]-x0[i]))
y <- with(Xdf, y0[i] + (ss/leni) * (y1[i]-y0[i]))
Z <- rbind(Z, data.frame(x=x, y=y))
}
Z <- as.ppp(Z, W=X$window)
return(Z)
}