https://github.com/cran/spatstat
Tip revision: f01b7e924951b36fe49fd7c03173cf8b3aee0221 authored by Adrian Baddeley on 09 February 2005, 07:13:20 UTC
version 1.5-9
version 1.5-9
Tip revision: f01b7e9
distances.R
#
#
# distances.R
#
# $Revision: 1.3 $ $Date: 2004/03/08 21:08:30 $
#
#
# Interpoint distances
#
#
"pairdist"<-
function(x, y=NULL, method="C")
{
# extract x and y coordinate vectors
if(verifyclass(x, "ppp", fatal=FALSE))
xy <- list(x=x$x, y=x$y)
else
xy <- xy.coords(x,y)[c("x","y")]
x <- xy$x
y <- xy$y
n <- length(x)
if(length(y) != n)
stop("lengths of x and y do not match")
# special cases
if(n == 0)
return(numeric(0))
else if(n == 1)
return(matrix(1,nrow=1,ncol=1))
switch(method,
interpreted={
xx <- matrix(rep(x, n), nrow = n)
yy <- matrix(rep(y, n), nrow = n)
d <- sqrt((xx - t(xx))^2 + (yy - t(yy))^2)
},
C={
d <- numeric( n * n)
z<- .C("pairdist", n = as.integer(n),
x= as.double(x), y= as.double(y), d= as.double(d),
PACKAGE="spatstat")
d <- matrix(z$d, nrow=n, ncol=n)
},
stop(paste("Unrecognised method \"", method, "\"", sep=""))
)
invisible(d)
}
"nndist"<-
function(x, y=NULL, method="C")
{
# computes the vector of nearest-neighbour distances
# for the pattern of points (x[i],y[i])
#
# extract x and y coordinate vectors
if(verifyclass(x, "ppp", fatal=FALSE))
xy <- list(x=x$x, y=x$y)
else
xy <- xy.coords(x,y)[c("x","y")]
x <- xy$x
y <- xy$y
# validate
n <- length(x)
if(length(y) != n)
stop("lengths of x and y do not match")
# special cases
if(n == 0)
return(numeric(0))
else if(n == 1)
return(Inf)
switch(method,
interpreted={
# matrix of squared distances between all pairs of points
sq <- function(a, b) { (a-b)^2 }
squd <- outer(x, x, sq) + outer(y, y, sq)
# reset diagonal to a large value so it is excluded from minimum
diag(squd) <- Inf
# nearest neighbour distances
nnd <- sqrt(apply(squd,1,min))
},
C={
n <- length(x)
nnd<-numeric(n)
o <- order(y)
big <- sqrt(.Machine$double.xmax)
z<- .C("nndistsort",
n= as.integer(n),
x= as.double(x[o]), y= as.double(y[o]), nnd= as.double(nnd),
as.double(big),
PACKAGE="spatstat")
nnd[o] <- z$nnd
},
stop(paste("Unrecognised method \"", method, "\"", sep=""))
)
invisible(nnd)
}