https://github.com/cran/spatstat
Raw File
Tip revision: 32c7daeb36b6e48fd0356bdcec9580ae124fee5e authored by Adrian Baddeley on 29 December 2015, 22:08:27 UTC
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)
}
back to top