https://github.com/cran/spatstat
Raw File
Tip revision: df59a11a9f01d134433fa83046eb2d8561aa3b73 authored by Adrian Baddeley on 19 April 2012, 08:14:28 UTC
version 1.26-1
Tip revision: df59a11
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)
}
back to top