https://github.com/cran/spatstat
Tip revision: 50fc6248c86b647e7700593cbc852b12d7111616 authored by Adrian Baddeley on 23 September 2011, 00:00:00 UTC
version 1.23-5
version 1.23-5
Tip revision: 50fc624
envelopelpp.R
#
# envelopelpp.R
#
# $Revision: 1.10 $ $Date: 2011/07/21 08:50:17 $
#
# 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) {
cl <- match.call()
if(is.null(Yname)) Yname <- deparse(substitute(Y))
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
sY <- summary(Y)
Yintens <- sY$intensity
NETWORK <- Y$domain
NETLINES <- NETWORK$lines
# expression that will be evaluated
simexpr <-
if(!is.marked(Y)) {
# unmarked point pattern
expression(lpp(rpoisppOnLines(Yintens, NETLINES), NETWORK))
} else {
stop("Sorry, simulation of marked point patterns on a linear network is not yet implemented")
}
# 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)
}
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) {
cl <- match.call()
if(is.null(Yname)) Yname <- deparse(substitute(Y))
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
NETLINES <- NETWORK$lines
type <- "lppm"
lambdaFit <- predict(MODEL)
simexpr <- expression(lpp(rpoisppOnLines(lambdaFit, NETLINES), NETWORK))
# 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)
}