https://github.com/cran/spatstat
Tip revision: c9b2c621c3bff55aaa77646dc1ba7316765cd7e4 authored by Adrian Baddeley on 25 April 2013, 00:00:00 UTC
version 1.31-2
version 1.31-2
Tip revision: c9b2c62
envelopelpp.R
#
# envelopelpp.R
#
# $Revision: 1.15 $ $Date: 2013/04/25 06:37:43 $
#
# Envelopes for 'lpp' objects
#
#
envelope.lpp <-
function(Y, fun=linearK, nsim=99, nrank=1, ...,
simulate=NULL, verbose=TRUE,
transform=NULL, global=FALSE, ginterval=NULL,
savefuns=FALSE, savepatterns=FALSE, nsim2=nsim,
VARIANCE=FALSE, nSD=2,
Yname=NULL, do.pwrong=FALSE) {
cl <- short.deparse(sys.call())
if(is.null(Yname)) Yname <- short.deparse(substitute(Y))
if(is.null(fun)) fun <- linearK
if("clipdata" %in% names(list(...)))
stop(paste("The argument", sQuote("clipdata"),
"is not available for envelope.lpp"))
envir.user <- parent.frame()
envir.here <- sys.frame(sys.nframe())
if(is.null(simulate)) {
# ...................................................
# Realisations of complete spatial randomness
# will be generated by rpoisppOnLines
# Data pattern X is argument Y
# Data pattern determines intensity of Poisson process
X <- Y
nY <- if(!is.marked(Y)) npoints(Y) else table(marks(Y))
NETWORK <- Y$domain
totlen <- sum(lengths.psp(NETWORK$lines))
Yintens <- nY/totlen
# expression that will be evaluated
simexpr <- expression(rpoislpp(Yintens, NETWORK))
# evaluate in THIS environment
simrecipe <- simulrecipe(type = "csr",
expr = simexpr,
envir = envir.here,
csr = TRUE)
} else {
# ...................................................
# Simulations are determined by 'simulate' argument
# Processing is deferred to envelopeEngine
simrecipe <- simulate
# Data pattern is argument Y
X <- Y
}
envelopeEngine(X=X, fun=fun, simul=simrecipe,
nsim=nsim, nrank=nrank, ...,
verbose=verbose, clipdata=FALSE,
transform=transform, global=global, ginterval=ginterval,
savefuns=savefuns, savepatterns=savepatterns, nsim2=nsim2,
VARIANCE=VARIANCE, nSD=nSD,
Yname=Yname, cl=cl,
envir.user=envir.user, do.pwrong=do.pwrong)
}
envelope.lppm <-
function(Y, fun=linearK, nsim=99, nrank=1, ...,
simulate=NULL, verbose=TRUE,
transform=NULL, global=FALSE, ginterval=NULL,
savefuns=FALSE, savepatterns=FALSE, nsim2=nsim,
VARIANCE=FALSE, nSD=2,
Yname=NULL, do.pwrong=FALSE) {
cl <- short.deparse(sys.call())
if(is.null(Yname)) Yname <- short.deparse(substitute(Y))
if(is.null(fun)) fun <- linearK
if("clipdata" %in% names(list(...)))
stop(paste("The argument", sQuote("clipdata"),
"is not available for envelope.pp3"))
envir.user <- parent.frame()
envir.here <- sys.frame(sys.nframe())
if(is.null(simulate)) {
# ...................................................
# Simulated realisations of the fitted model Y
# will be generated using rpoisppOnLines
if(!is.poisson.ppm(Y$fit))
stop("Simulation of non-Poisson models is not yet implemented")
X <- Y$X
MODEL <- Y
NETWORK <- X$domain
type <- "lppm"
lambdaFit <- predict(MODEL)
LMAX <-
if(is.im(lambdaFit)) max(lambdaFit) else unlist(lapply(lambdaFit, max))
simexpr <- expression(rpoislpp(lambdaFit, NETWORK, lmax=LMAX))
# evaluate in THIS environment
simrecipe <- simulrecipe(type = "lppm",
expr = simexpr,
envir = envir.here,
csr = FALSE)
} else {
# ...................................................
# Simulations are determined by 'simulate' argument
# Processing is deferred to envelopeEngine
simrecipe <- simulate
# Data pattern is argument Y
X <- Y
}
envelopeEngine(X=X, fun=fun, simul=simrecipe,
nsim=nsim, nrank=nrank, ...,
verbose=verbose, clipdata=FALSE,
transform=transform, global=global, ginterval=ginterval,
savefuns=savefuns, savepatterns=savepatterns, nsim2=nsim2,
VARIANCE=VARIANCE, nSD=nSD,
Yname=Yname, cl=cl,
envir.user=envir.user, do.pwrong=do.pwrong)
}