https://github.com/cran/spatstat
Tip revision: 32c7daeb36b6e48fd0356bdcec9580ae124fee5e authored by Adrian Baddeley on 29 December 2015, 22:08:27 UTC
version 1.44-1
version 1.44-1
Tip revision: 32c7dae
envelopelpp.R
#
# envelopelpp.R
#
# $Revision: 1.19 $ $Date: 2015/10/21 09:06:57 $
#
# Envelopes for 'lpp' objects
#
#
envelope.lpp <-
function(Y, fun=linearK, nsim=99, nrank=1, ...,
funargs=list(),
simulate=NULL, verbose=TRUE,
transform=NULL, global=FALSE, ginterval=NULL, use.theory=NULL,
alternative=c("two.sided", "less", "greater"),
scale=NULL, clamp=FALSE,
savefuns=FALSE, savepatterns=FALSE, nsim2=nsim,
VARIANCE=FALSE, nSD=2,
Yname=NULL, do.pwrong=FALSE, envir.simul=NULL) {
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 <- if(!is.null(envir.simul)) envir.simul else 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, ..., funargs=funargs,
verbose=verbose, clipdata=FALSE,
transform=transform,
global=global, ginterval=ginterval, use.theory=use.theory,
alternative=alternative, scale=scale, clamp=clamp,
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, ...,
funargs=list(), simulate=NULL, verbose=TRUE,
transform=NULL, global=FALSE, ginterval=NULL, use.theory=NULL,
alternative=c("two.sided", "less", "greater"),
scale=NULL, clamp=FALSE,
savefuns=FALSE, savepatterns=FALSE, nsim2=nsim,
VARIANCE=FALSE, nSD=2,
Yname=NULL, do.pwrong=FALSE, envir.simul=NULL) {
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 <- if(!is.null(envir.simul)) envir.simul else 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
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, ..., funargs=funargs,
verbose=verbose, clipdata=FALSE,
transform=transform,
global=global, ginterval=ginterval, use.theory=use.theory,
alternative=alternative, scale=scale, clamp=clamp,
savefuns=savefuns, savepatterns=savepatterns, nsim2=nsim2,
VARIANCE=VARIANCE, nSD=nSD,
Yname=Yname, cl=cl,
envir.user=envir.user, do.pwrong=do.pwrong)
}