https://github.com/cran/spatstat
Revision e575bb3736f6d70d2bd2b23ea2e4474cdbae00be authored by Adrian Baddeley on 11 November 2010, 13:09:43 UTC, committed by cran-robot on 11 November 2010, 13:09:43 UTC
1 parent cafe44b
Tip revision: e575bb3736f6d70d2bd2b23ea2e4474cdbae00be authored by Adrian Baddeley on 11 November 2010, 13:09:43 UTC
version 1.21-1
version 1.21-1
Tip revision: e575bb3
sharpen.R
#
# sharpen.R
#
# $Revision: 1.4 $ $Date: 2010/10/25 02:30:23 $
#
sharpen <- function(X, ...) {
UseMethod("sharpen")
}
sharpen.ppp <- function(X, sigma=NULL, ..., varcov=NULL,
edgecorrect=FALSE) {
stopifnot(is.ppp(X))
Yx <- smooth.ppp(X %mark% X$x,
at="points", sigma=sigma, varcov=varcov, edge=TRUE)
Yy <- smooth.ppp(X %mark% X$y,
at="points", sigma=sigma, varcov=varcov, edge=TRUE)
W <- as.owin(X)
if(edgecorrect) {
# convolve x and y coordinate functions with kernel
xim <- as.im(function(x,y){x}, W)
yim <- as.im(function(x,y){y}, W)
xblur <- blur(xim, sigma=sigma, varcov=varcov, normalise=TRUE, ...)
yblur <- blur(yim, sigma=sigma, varcov=varcov, normalise=TRUE, ...)
# evaluate at data locations
xx <- safelookup(xblur, X, warn=FALSE)
yy <- safelookup(yblur, X, warn=FALSE)
# estimated vector bias of sharpening procedure
xbias <- xx - X$x
ybias <- yy - X$y
# adjust
Yx <- Yx - xbias
Yy <- Yy - ybias
# check this does not place points outside window
if(any(uhoh <- !inside.owin(Yx, Yy, W))) {
# determine mass of edge effect
edgeim <- blur(as.im(W), sigma=sigma, varcov=varcov, normalise=FALSE, ...)
edg <- safelookup(edgeim, X[uhoh], warn=FALSE)
# contract bias correction
Yx[uhoh] <- (1 - edg) * X$x[uhoh] + edg * Yx[uhoh]
Yy[uhoh] <- (1 - edg) * X$y[uhoh] + edg * Yy[uhoh]
}
# check again
if(any(nbg <- !inside.owin(Yx, Yy, W))) {
# give up
Yx[nbg] <- X$x[nbg]
Yy[nbg] <- X$y[nbg]
}
}
# make point pattern
Y <- ppp(Yx, Yy, marks=marks(X), window=W)
# tack on smoothing information
attr(Y, "sigma") <- sigma
attr(Y, "varcov") <- varcov
attr(Y, "edgecorrected") <- edgecorrect
return(Y)
}
Computing file changes ...