#
#  envelopelpp.R
#
#  $Revision: 1.16 $   $Date: 2014/06/11 09:41:10 $
#
#  Envelopes for 'lpp' objects
#
#

envelope.lpp <-
  function(Y, fun=linearK, nsim=99, nrank=1, ..., 
           simulate=NULL, verbose=TRUE, 
           transform=NULL, global=FALSE, ginterval=NULL,
           alternative=c("two.sided", "less", "greater"),
           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, ..., 
                 verbose=verbose, clipdata=FALSE,
                 transform=transform, global=global, ginterval=ginterval,
                 alternative=alternative,
                 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,
           alternative=c("two.sided", "less", "greater"),
           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
    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,
                 alternative=alternative,
                 savefuns=savefuns, savepatterns=savepatterns, nsim2=nsim2,
                 VARIANCE=VARIANCE, nSD=nSD,
                 Yname=Yname, cl=cl,
                 envir.user=envir.user, do.pwrong=do.pwrong)
}