Running 'testsAtoC.R' [2s]
  Running 'testsD.R' [9s]
  Running 'testsEtoF.R' [5s]
  Running 'testsGtoJ.R' [153s]
  Running 'testsK.R' [123s]
  Running 'testsL.R' [33s]
  Running 'testsM.R' [3s]
  Running 'testsNtoO.R' [1s]
  Running 'testsP1.R' [2s]
  Running 'testsP2.R' [111s]
  Running 'testsQ.R' [81s]
  Running 'testsR1.R' [101s]
  Running 'testsR2.R' [10s]
  Running 'testsS.R' [2s]
  Running 'testsT.R' [3s]
  Running 'testsUtoZ.R' [110s]
Running the tests in 'tests/testsGtoJ.R' failed.
Complete output:
  > #'
  > #'   Header for all (concatenated) test files
  > #'
  > #'   Require spatstat.model
  > #'   Obtain environment variable controlling tests.
  > #'
  > #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
  > 
  > require(spatstat.model)
  Loading required package: spatstat.model
  Loading required package: spatstat.data
  Loading required package: spatstat.geom
  spatstat.geom 3.2-9
  Loading required package: spatstat.random
  spatstat.random 3.2-3
  Loading required package: spatstat.explore
  Loading required package: nlme
  spatstat.explore 3.2-7
  Loading required package: rpart
  spatstat.model 3.2-11
  > FULLTEST <- (nchar(Sys.getenv("SPATSTAT_TEST", unset="")) > 0)
  > ALWAYS   <- TRUE
  > cat(paste("--------- Executing",
  +           if(FULLTEST) "** ALL **" else "**RESTRICTED** subset of",
  +           "test code -----------\n"))
  --------- Executing **RESTRICTED** subset of test code -----------
  > #'       
  > #'        tests/hobjects.R
  > #'
  > #'   Validity of methods for ppm(... method="ho")
  > #'
  > #'   $Revision: 1.4 $ $Date: 2022/06/18 10:14:44 $
  > 
  > 
  > if(FULLTEST) {
  + local({
  +   set.seed(42)
  +   fit  <- ppm(cells ~1,         Strauss(0.1), improve.type="ho", nsim=10)
  +   fitx <- ppm(cells ~offset(x), Strauss(0.1), improve.type="ho", nsim=10)
  + 
  +   a  <- AIC(fit)
  +   ax <- AIC(fitx)
  + 
  +   f  <- fitted(fit)
  +   fx <- fitted(fitx)
  + 
  +   p  <- predict(fit)
  +   px <- predict(fitx)
  + })
  + }
  > 
  > 
  > #'     tests/hypotests.R
  > #'     Hypothesis tests
  > #' 
  > #'  $Revision: 1.10 $ $Date: 2023/07/17 07:30:48 $
  > 
  > if(FULLTEST) {
  + local({
  + 
  +   #' scan test with baseline
  +   fit <- ppm(cells ~ x)
  +   lam <- predict(fit)
  +   rr <- c(0.05, 1)
  +   scan.test(cells, rr, nsim=5,
  +             method="poisson", baseline=fit, alternative="less")
  +   scan.test(cells, rr, nsim=5,
  +             method="poisson", baseline=lam, alternative="less")
  + })
  + }
  > #'
  > #'  tests/interact.R
  > #'
  > #'  Support for interaction objects
  > #'
  > #'  $Revision: 1.2 $ $Date: 2020/04/28 12:58:26 $
  > 
  > if(FULLTEST) {
  + local({
  +   #' print.intermaker
  +   Strauss
  +   Geyer
  +   Ord
  +   #' intermaker
  +   BS <- get("BlankStrauss", envir=environment(Strauss))
  +   BD <- function(r) { instantiate.interact(BS, list(r=r)) }
  +   BlueDanube <- intermaker(BD, BS) 
  + })
  + }
  > 
  > #'   tests/ippm.R
  > #'   Tests of 'ippm' class
  > #'   $Revision: 1.6 $ $Date: 2020/04/28 12:58:26 $
  > 
  > if(FULLTEST) {
  + local({
  +   # .......... set up example from help file .................
  +   nd <- 10
  +   gamma0 <- 3
  +   delta0 <- 5
  +   POW <- 3
  +   # Terms in intensity
  +   Z <- function(x,y) { -2*y }
  +   f <- function(x,y,gamma,delta) { 1 + exp(gamma - delta * x^POW) }
  +   # True intensity
  +   lamb <- function(x,y,gamma,delta) { 200 * exp(Z(x,y)) * f(x,y,gamma,delta) }
  +   # Simulate realisation
  +   lmax <- max(lamb(0,0,gamma0,delta0), lamb(1,1,gamma0,delta0))
  +   set.seed(42)
  +   X <- rpoispp(lamb, lmax=lmax, win=owin(), gamma=gamma0, delta=delta0)
  +   # Partial derivatives of log f
  +   DlogfDgamma <- function(x,y, gamma, delta) {
  +     topbit <- exp(gamma - delta * x^POW)
  +     topbit/(1 + topbit)
  +   }
  +   DlogfDdelta <- function(x,y, gamma, delta) {
  +     topbit <- exp(gamma - delta * x^POW)
  +     - (x^POW) * topbit/(1 + topbit)
  +   }
  +   # irregular score
  +   Dlogf <- list(gamma=DlogfDgamma, delta=DlogfDdelta)
  +   # fit model
  +   fit <- ippm(X ~Z + offset(log(f)),
  +               covariates=list(Z=Z, f=f),
  +               iScore=Dlogf,
  +               start=list(gamma=1, delta=1),
  +               nd=nd)
  +   # fit model with logistic likelihood but without iScore
  +   fitlo <- ippm(X ~Z + offset(log(f)),
  +                 method="logi",
  +                 covariates=list(Z=Z, f=f),
  +                 start=list(gamma=1, delta=1),
  +                 nd=nd)
  + 
  +   ## ............. test ippm class support ......................
  +   Ar <- model.matrix(fit)
  +   Ai <- model.matrix(fit, irregular=TRUE)
  +   An <- model.matrix(fit, irregular=TRUE, keepNA=FALSE)
  +   AS <- model.matrix(fit, irregular=TRUE, subset=(abs(Z) < 0.5))
  + 
  +   Zr <- model.images(fit)
  +   Zi <- model.images(fit, irregular=TRUE)
  +   ## update.ippm
  +   fit2 <- update(fit, . ~ . + I(Z^2))
  +   fit0 <- update(fit,
  +                  . ~ . - Z,
  +                  start=list(gamma=2, delta=4))
  +   oldfit <- ippm(X,
  +               ~Z + offset(log(f)),
  +               covariates=list(Z=Z, f=f),
  +               iScore=Dlogf,
  +               start=list(gamma=1, delta=1),
  +               nd=nd)
  +   oldfit2 <- update(oldfit, . ~ . + I(Z^2))
  +   oldfit0 <- update(oldfit,
  +                     . ~ . - Z,
  +                     start=list(gamma=2, delta=4))
  +   ## again with logistic
  +   fitlo2 <- update(fitlo, . ~ . + I(Z^2))
  +   fitlo0 <- update(fitlo,
  +                    . ~ . - Z,
  +                    start=list(gamma=2, delta=4))
  +   oldfitlo <- ippm(X,
  +                    ~Z + offset(log(f)),
  +                    method="logi",
  +                    covariates=list(Z=Z, f=f),
  +                    start=list(gamma=1, delta=1),
  +                    nd=nd)
  +   oldfitlo2 <- update(oldfitlo, . ~ . + I(Z^2))
  +   oldfitlo0 <- update(oldfitlo,
  +                       . ~ . - Z,
  +                       start=list(gamma=2, delta=4))
  +   ## anova.ppm including ippm objects
  +   fit0 <- update(fit, . ~ Z)
  +   fit0lo <- update(fitlo, . ~ Z)
  +   A <- anova(fit0, fit)
  +   Alo <- anova(fit0lo, fitlo)
  + })
  + }
  > 
  > proc.time()
     user  system elapsed 
     1.40    0.29    1.68 
Running the tests in 'tests/testsK.R' failed.
Complete output:
  > #'
  > #'   Header for all (concatenated) test files
  > #'
  > #'   Require spatstat.model
  > #'   Obtain environment variable controlling tests.
  > #'
  > #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
  > 
  > require(spatstat.model)
  Loading required package: spatstat.model
  Loading required package: spatstat.data
  Loading required package: spatstat.geom
  spatstat.geom 3.2-9
  Loading required package: spatstat.random
  spatstat.random 3.2-3
  Loading required package: spatstat.explore
  Loading required package: nlme
  spatstat.explore 3.2-7
  Loading required package: rpart
  spatstat.model 3.2-11
  > FULLTEST <- (nchar(Sys.getenv("SPATSTAT_TEST", unset="")) > 0)
  > ALWAYS   <- TRUE
  > cat(paste("--------- Executing",
  +           if(FULLTEST) "** ALL **" else "**RESTRICTED** subset of",
  +           "test code -----------\n"))
  --------- Executing **RESTRICTED** subset of test code -----------
  > #
  > # tests/kppm.R
  > #
  > # $Revision: 1.40 $ $Date: 2024/02/26 05:44:02 $
  > #
  > # Test functionality of kppm that once depended on RandomFields
  > # Test update.kppm for old style kppm objects
  > 
  > if(!FULLTEST)
  +   spatstat.options(npixel=32, ndummy.min=16)
  > 
  > local({
  + 
  +  fit <- kppm(redwood ~1, "Thomas") # sic
  +  fitx <- kppm(redwood ~x, "Thomas", verbose=TRUE)
  +  if(FULLTEST) {
  +    fitx <- update(fit, ~ . + x)
  +    fitM <- update(fit, clusters="MatClust")
  +    fitC <- update(fit, cells)
  +    fitCx <- update(fit, cells ~ x)
  +    #'
  +    Wsub <- owin(c(0, 0.5), c(-0.5, 0))
  +    Zsub <- (bdist.pixels(Window(redwood)) > 0.1)
  +    fitWsub <- kppm(redwood ~1, "Thomas", subset=Wsub)
  +    fitZsub <- kppm(redwood ~1, "Thomas", subset=Zsub)
  +    fitWsub
  +  
  +    #' various methods
  +    ff <- as.fv(fitx)
  +    uu <- unitname(fitx)
  +    unitname(fitCx) <- "furlong"
  +    mo <- model.images(fitCx)
  +    p <- psib(fit)
  +    px <- psib(fitx)
  +  }
  +  if(ALWAYS) {
  +    Y <- simulate(fitx, seed=42, saveLambda=TRUE)[[1]]
  +  }
  + 
  +  if(FULLTEST) {
  +    #' vcov.kppm different algorithms
  +    vc  <- vcov(fitx)
  +    vc2 <- vcov(fitx, fast=TRUE)
  +    vc3 <- vcov(fitx, fast=TRUE, splitup=TRUE)
  +    vc4 <- vcov(fitx,            splitup=TRUE)
  + 
  +    ## other code blocks
  +    a <- varcount(fitx, function(x,y){x+1}) # always positive
  +    a <- varcount(fitx, function(x,y){y-1}) # always negative
  +    a <- varcount(fitx, function(x,y){x+y}) # positive or negative
  + 
  +    #' improve.kppm
  +    fitI <- update(fit, improve.type="quasi")
  +    fitxI <- update(fitx, improve.type="quasi")
  +    fitxIs <- update(fitx, improve.type="quasi", fast=FALSE) 
  +    #' vcov.kppm
  +    vcI <- vcov(fitxI)
  +  }
  + 
  +   ## plot.kppm including predict.kppm
  +  if(ALWAYS) {
  +    fitMC <- kppm(redwood ~ x, "Thomas")
  +    plot(fitMC)
  +  }
  +  if(FULLTEST) {
  +    fitCL <- kppm(redwood ~ x, "Thomas", method="c")
  +    fitPA <- kppm(redwood ~ x, "Thomas", method="p")
  +    plot(fitCL)
  +    plot(fitPA)
  + 
  +    ## fit with composite likelihood method [thanks to Abdollah Jalilian]
  +    fut <- kppm(redwood ~ x, "VarGamma", method="clik2", nu.ker=-3/8)
  +    kfut <- as.fv(fut)
  +  }
  +  
  +  if(ALWAYS) {
  +    fit0 <- kppm(redwood ~1, "LGCP")
  +    is.poisson(fit0)
  +    Y0 <- simulate(fit0, saveLambda=TRUE)[[1]]
  +    stopifnot(is.ppp(Y0))
  +    p0 <- psib(fit0) # issues a warning
  + 
  +    if(FULLTEST) {
  +      ## fit LGCP using K function: slow
  +      fit1 <- kppm(redwood ~x, "LGCP",
  +                   covmodel=list(model="matern", nu=0.3),
  +                   control=list(maxit=3))
  +      Y1 <- simulate(fit1, saveLambda=TRUE)[[1]]
  +      stopifnot(is.ppp(Y1))
  +    }
  + 
  +    ## fit LGCP using pcf
  +    fit1p <- kppm(redwood ~x, "LGCP",
  +                  covmodel=list(model="matern", nu=0.3),
  +                  statistic="pcf")
  +    Y1p <- simulate(fit1p, saveLambda=TRUE)[[1]]
  +    stopifnot(is.ppp(Y1p))
  + 
  +    ## .. and using different fitting methods
  +    if(FULLTEST) {
  +      fit1pClik <- update(fit1p, method="clik")
  +      fit1pPalm <- update(fit1p, method="palm")
  +    }
  + 
  +    ## shortcut evaluation of pcf
  +    ##  (the code being tested is in spatstat.random::clusterinfo.R)
  +    if(FULLTEST) {
  +      putSpatstatVariable("RFshortcut", TRUE)
  +      fitGshort <- kppm(redwood ~ 1, "LGCP", covmodel=list(model="gauss"))
  +      fitSshort <- kppm(redwood ~ 1, "LGCP", covmodel=list(model="stable", alpha=1))
  +      putSpatstatVariable("RFshortcut", FALSE)
  +      fitGlong <-  kppm(redwood ~ 1, "LGCP", covmodel=list(model="gauss"))
  +      fitSlong <-  kppm(redwood ~ 1, "LGCP", covmodel=list(model="stable", alpha=1))
  +      discrepG <- unlist(parameters(fitGshort)) - unlist(parameters(fitGlong))
  +      discrepS <- unlist(parameters(fitSshort)) - unlist(parameters(fitSlong))
  +      print(discrepG)
  +      print(discrepS)
  +      if(max(abs(discrepG) > 0.01))
  +        stop("Discrepancy in short-cut fitting of Gaussian LGCP")
  +      if(max(abs(discrepS) > 0.01))
  +        stop("Discrepancy in short-cut fitting of stable LGCP")
  +    }
  +    
  +    ## image covariate (a different code block) 
  +    xx <- as.im(function(x,y) x, Window(redwood))
  +    fit1xx <- update(fit1p, . ~ xx, data=solist(xx=xx))
  +    Y1xx <- simulate(fit1xx, saveLambda=TRUE)[[1]]
  +    stopifnot(is.ppp(Y1xx))
  +    if(FULLTEST) {
  +      fit1xxVG <- update(fit1xx, clusters="VarGamma", nu=-1/4)
  +      Y1xxVG <- simulate(fit1xxVG, saveLambda=TRUE)[[1]]
  +      stopifnot(is.ppp(Y1xxVG))
  +    }
  +    fit1xxLG <- update(fit1xx, clusters="LGCP",
  +                       covmodel=list(model="matern", nu=0.3),
  +                       statistic="pcf")
  +    Y1xxLG <- simulate(fit1xxLG, saveLambda=TRUE, drop=TRUE)
  +    stopifnot(is.ppp(Y1xxLG))
  +    
  +    # ... and Abdollah's code
  +    if(FULLTEST) {
  +      fit2 <- kppm(redwood ~x, cluster="Cauchy", statistic="K")
  +      Y2 <- simulate(fit2, saveLambda=TRUE)[[1]]
  +      stopifnot(is.ppp(Y2))
  +    }
  +  }
  + 
  + })
  Fitting cluster model
  Retrieved cluster model information
  Algorithm parameters:
  $rmax
  NULL
  
  $q
  [1] 0.25
  
  $p
  [1] 2
  
  $rmin
  NULL
  
  Using point pattern data
  Starting parameters:
         kappa       sigma2 
  62.000000000  0.006173033 
  Calculating summary function...Done.
  Starting minimum contrast fit
  Returned from minimum contrast fit
  Returning from clusterfit
  Warning messages:
  1: Internal error: fvlabels truncated the function name 
  2: Internal error: fvlabels truncated the function name 
  3: Internal error: fvlabels truncated the function name 
  4: In psib.kppm(fit0) : The model is not a cluster process
  5: The value of the empirical function 'pcf' for r= 0 was Inf. Range of r values was reset to [0.00048828125, 0.25] 
  6: The value of the empirical function 'pcf' for r= 0 was Inf. Range of r values was reset to [0.00048828125, 0.25] 
  7: The value of the empirical function 'pcf' for r= 0 was Inf. Range of r values was reset to [0.00048828125, 0.25] 
  > 
  > if(FULLTEST) {
  + local({
  +   #' various code blocks
  +   fut <- kppm(redwood, ~x)
  +   fet <- update(fut, redwood3)
  +   fot <- update(fut, trend=~y)
  +   fit <- kppm(redwoodfull ~ x)
  +   Y <- simulate(fit, window=redwoodfull.extra$regionII, saveLambda=TRUE)
  +   gut <- improve.kppm(fit, type="wclik1")
  +   gut <- improve.kppm(fit, vcov=TRUE, fast.vcov=TRUE, save.internals=TRUE)
  +   hut <- kppm(redwood ~ x, method="clik", weightfun=NULL)
  +   hut <- kppm(redwood ~ x, method="palm", weightfun=NULL)
  +   mut <- kppm(redwood)
  +   nut <- update(mut, Y)
  + })
  + }
  > 
  > if(FULLTEST) {
  + local({
  +   #' minimum contrast code
  +   K <- Kest(redwood)
  +   a <- matclust.estK(K)
  +   a <- thomas.estK(K)
  +   a <- cauchy.estK(K)
  +   a <- vargamma.estK(K)
  +   a <- lgcp.estK(K)
  + 
  +   print(a)
  +   u <- unitname(a)
  +   
  +   g <- pcf(redwood)
  +   a <- matclust.estpcf(g)
  +   a <- thomas.estpcf(g)
  +   a <- cauchy.estpcf(g)
  +   a <- vargamma.estpcf(g)
  +   a <- lgcp.estpcf(g)
  + 
  +   #' auxiliary functions
  +   b <- resolve.vargamma.shape(nu.pcf=1.5)
  +   Z <- clusterfield("Thomas", kappa=1, scale=0.2)
  +   
  +   aa <- NULL
  +   aa <- accumulateStatus(simpleMessage("Woof"), aa)
  +   aa <- accumulateStatus(simpleMessage("Sit"),  aa)
  +   aa <- accumulateStatus(simpleMessage("Woof"), aa)
  +   printStatusList(aa)
  + 
  +   RMIN <- 0.01
  +   fit <- kppm(redwood ~ 1, ctrl=list(rmin=RMIN,q=1/2))
  +   if(fit$Fit$mcfit$ctrl$rmin != RMIN)
  +     stop("kppm did not handle parameter 'rmin' in argument 'ctrl' ")
  +   fit <- kppm(redwood ~ 1, ctrl=list(rmin=0,q=1/2), rmin=RMIN)
  +   if(fit$Fit$mcfit$ctrl$rmin != RMIN)
  +     stop("kppm did not handle parameter 'rmin' in argument 'ctrl'")
  + 
  +   RMIN <- 2
  +   fit <- dppm(swedishpines~1, dppGauss(), ctrl=list(rmin=RMIN,q=1))
  +   if(fit$Fit$mcfit$ctrl$rmin != RMIN)
  +     stop("dppm did not handle parameter 'rmin' in argument 'ctrl'")
  +   fit <- dppm(swedishpines~1, dppGauss(), ctrl=list(rmin=0,q=1), rmin=RMIN)
  +   if(fit$Fit$mcfit$ctrl$rmin != RMIN)
  +     stop("dppm did not handle argument 'rmin'")
  + })
  + }
  > 
  > 
  > 
  > if(FULLTEST) {
  + local({
  +   #' cover a few code blocks
  +   fut <- kppm(redwood ~ x, method="clik")
  +   print(summary(fut))
  +   a <- residuals(fut)
  +   fut2 <- kppm(redwood ~ x, "LGCP", method="palm")
  +   print(summary(fut2))
  +   b <- residuals(fut2)
  +   #'
  +   po <- ppm(redwood ~ 1)
  +   A <- kppmComLik(redwood, Xname="redwood", po=po, clusters="Thomas",
  +                   statistic="pcf", statargs=list(), control=list(),
  +                   weightfun=NULL, rmax=0.1)
  +   A <- kppmPalmLik(redwood, Xname="redwood", po=po, clusters="Thomas",
  +                    statistic="pcf", statargs=list(), control=list(),
  +                    weightfun=NULL, rmax=0.1)
  + })
  + }
  > 
  > reset.spatstat.options()
  >   
  > #'
  > #'   tests/Kfuns.R
  > #'
  > #'   Various K and L functions and pcf
  > #'
  > #'   $Revision: 1.43 $  $Date: 2022/06/17 01:47:08 $
  > #'
  > #'   Assumes 'EveryStart.R' was run
  > 
  > if(FULLTEST) {
  +   Cells <- cells
  +   Amacrine <- amacrine
  +   Redwood <- redwood
  + } else {
  +   ## reduce numbers of data + dummy points
  +   spatstat.options(npixel=32, ndummy.min=16)
  +   Cells <- cells[c(FALSE, TRUE)]
  +   Amacrine <- amacrine[c(FALSE, TRUE)]
  +   Redwood <- redwood[c(FALSE, TRUE)]
  + }
  > 
  > 
  > if(FULLTEST) {
  +   local({
  +     #' code blocks using fitted model to determine intensity
  +     #' Kinhom
  +     X <- rpoispp(function(x,y) { 100 * x }, 100, square(1))
  +     fut <- ppm(X ~ x)
  +     Kio <- Kinhom(X, fut, update=FALSE)
  +     Kiu <- Kinhom(X, fut, update=TRUE, diagonal=FALSE)
  +     fit <- ppm(Amacrine ~ marks)
  +     #' lohboot Linhom
  +     Zred <- predict(ppm(Redwood ~ x+y))
  +     Lred <- lohboot(Redwood, Linhom, lambda=Zred)
  +     #' Kmulti.inhom
  +     K1 <- Kcross.inhom(Amacrine, lambdaX=fit)
  +     On <- split(Amacrine)$on
  +     Off <- split(Amacrine)$off
  +     K4 <- Kcross.inhom(Amacrine, lambdaI=ppm(On), lambdaJ=ppm(Off))
  +     #' local K functions
  +     fut <- ppm(swedishpines ~ polynom(x,y,2))
  +     Z <- predict(fut)
  +     Lam <- fitted(fut, dataonly=TRUE)
  +     a <- localLinhom(swedishpines, lambda=fut)
  +     a <- localLinhom(swedishpines, lambda=Z)
  +     a <- localLinhom(swedishpines, lambda=Lam)
  +     a <- localLinhom(swedishpines, lambda=Z, correction="none")
  +     a <- localLinhom(swedishpines, lambda=Z, correction="translate")
  +     #' local cross K functions
  +     fat <- ppm(Amacrine ~ x * marks)
  +     Zed <- predict(fat)
  +     Lum <- fitted(fat, dataonly=TRUE)
  +     moff <- (marks(Amacrine) == "off")
  +     a <- localLcross.inhom(Amacrine, from="off", to="on", lambdaX=Zed)
  +     a <- localLcross.inhom(Amacrine, from="off", to="on", lambdaX=Lum)
  +     a <- localLcross.inhom(Amacrine, from="off", to="on", lambdaX=fat)
  +     a <- localLcross.inhom(Amacrine, from="off", to="on",
  +                            lambdaFrom=Lum[moff], lambdaTo=Lum[!moff])
  +     a <- localLcross.inhom(Amacrine, from="off", to="on", lambdaX=Zed,
  +                            correction="none")
  +     a <- localLcross.inhom(Amacrine, from="off", to="on", lambdaX=Zed,
  +                            correction="translate")
  +     #' cases of resolve.lambdacross
  +     h <- resolve.lambdacross(Amacrine, moff, !moff, lambdaX=fat)
  +     h <- resolve.lambdacross(Amacrine, moff, !moff, lambdaX=fat, update=FALSE)
  +     h <- resolve.lambdacross(Amacrine, moff, !moff,
  +                               lambdaI=fat, lambdaJ=fat)
  +     h <- resolve.lambdacross(Amacrine, moff, !moff,
  +                               lambdaI=fat, lambdaJ=fat,
  +                               update=FALSE)
  +     #' lohboot
  +     b <- lohboot(Amacrine, Lcross.inhom, from="off", to="on", lambdaX=Zed)
  +     b <- lohboot(Amacrine, Lcross.inhom, from="off", to="on", lambdaX=Lum)
  +     b <- lohboot(Amacrine, Lcross.inhom, from="off", to="on", lambdaX=fat)
  +     b <- lohboot(Amacrine, Lcross.inhom, from="off", to="on", 
  +                  lambdaFrom=Lum[moff], lambdaTo=Lum[!moff])
  +     #'
  +     #'  residual K functions etc
  +     #'
  +     rco <- compareFit(Cells, Kcom,
  +                       interaction=anylist(P=Poisson(), S=Strauss(0.08)),
  +                       same="trans", different="tcom")
  +     fit <- ppm(Cells ~ x, Strauss(0.07))
  +     K <- Kcom(Cells, model=fit, restrict=TRUE)
  +   })
  + }
  > 
  > reset.spatstat.options()
  > 
  > proc.time()
     user  system elapsed 
     3.28    0.48    3.71 
Running the tests in 'tests/testsP2.R' failed.
Complete output:
  > #'
  > #'   Header for all (concatenated) test files
  > #'
  > #'   Require spatstat.model
  > #'   Obtain environment variable controlling tests.
  > #'
  > #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
  > 
  > require(spatstat.model)
  Loading required package: spatstat.model
  Loading required package: spatstat.data
  Loading required package: spatstat.geom
  spatstat.geom 3.2-9
  Loading required package: spatstat.random
  spatstat.random 3.2-3
  Loading required package: spatstat.explore
  Loading required package: nlme
  spatstat.explore 3.2-7
  Loading required package: rpart
  spatstat.model 3.2-11
  > FULLTEST <- (nchar(Sys.getenv("SPATSTAT_TEST", unset="")) > 0)
  > ALWAYS   <- TRUE
  > cat(paste("--------- Executing",
  +           if(FULLTEST) "** ALL **" else "**RESTRICTED** subset of",
  +           "test code -----------\n"))
  --------- Executing **RESTRICTED** subset of test code -----------
  > # 
  > #   tests/ppmBadData.R
  > #
  > # $Revision: 1.6 $ $Date: 2020/04/30 05:23:52 $
  > 
  > # Testing robustness of ppm and support functions
  > # when data are rubbish
  > 
  > local({
  +   if(ALWAYS) {
  +     ## from Rolf: very large proportion of data is NA
  +     SEED <- 42
  +     K <- 101
  +     A <- 500
  +     X <- seq(0, A, length=K)
  +     G <- expand.grid(x=X, y=X)
  +     FOO <- function(x,y) { sin(x)^2 + cos(y)^2 }
  +     M1 <- im(matrix(FOO(G$x, G$y), K, K), xcol=X, yrow=X)
  +     M <- im(matrix(FOO(G$x, G$y), K, K))
  +     BAR <- function(x) { exp(-6.618913 + 5.855337 * x - 8.432483 * x^2) }
  +     V <- im(BAR(M$v), xcol=X, yrow=X)
  +     # V <- eval.im(exp(-6.618913 + 5.855337 * M - 8.432483 * M^2))
  +     set.seed(SEED)
  +     Y <- rpoispp(V)
  +     fY <- ppm(Y ~cv + I(cv^2), data=list(cv=M), correction="translate")
  +     diagnose.ppm(fY)
  +     lurking(fY, covariate=as.im(function(x,y){x}, square(A)), type="raw")
  +   }
  + 
  +   if(ALWAYS) {
  +     ## from Andrew Bevan: numerical overflow, ill-conditioned Fisher information
  +   SEED <- 42
  +     nongranite<- owin(poly = list(x = c(0, 8500, 7000, 6400, 6400, 6700, 7000, 7200, 7300, 8000, 8100, 8800, 9500, 10000, 10000, 0), y = c(0, 0, 2000, 3800, 4000, 5000, 6500, 7400, 7500, 8000, 8100, 9000, 9500, 9600, 10000, 10000)))
  +     ## Trend on raster grid
  +     rain <- as.im(X=function(x,y) { x^2 + y^2 }, W=nongranite, dimyx=100)
  +     ## Generate a point pattern via a Lennard-Jones process
  +     set.seed(SEED)
  +     mod4<- rmhmodel(cif="lennard",
  +                     par=list(beta=1, sigma=250, epsilon=2.2),
  +                     trend=rain, w=nongranite)
  +     ljtr<- rmh(mod4, start=list(n.start=80), control=list(p=1, nrep=1e5))
  + 
  +     ## Fit a point process model to the pattern with rain as a covariate
  +     ## NOTE INCORRECT TREND FORMULA
  +     ljtrmod <- ppm(ljtr, trend= ~ Z, interaction=NULL, data=list(Z=rain))
  +     ss <- summary(ljtrmod)
  +   }
  +   
  +   if(FULLTEST) {
  +     ## From Ege
  +     ## Degenerate but non-null argument 'covariates'
  +     xx <- list()
  +     names(xx) <- character(0)
  +     fit <- ppm(cells ~x, covariates = xx)
  +     st <- summary(fit) 
  +   }
  + 
  + })
  Checking arguments..determining simulation windows...Evaluating trend integral...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Error in solve.default(M) : 
    system is computationally singular: reciprocal condition number = 5.72218e-18
  In addition: Warning messages:
  1: Values of the covariate 'cv' were NA or undefined at 96% (1774 out of 1845) of the quadrature points. Occurred while executing: ppm.ppp(Q = Y, trend = ~cv + I(cv^2), data = list(list(c(1, 1.91953576453823,  
  2: Some infinite, NA or NaN increments were removed 
  3: Numerical underflow detected: sigma is probably too small 
  4: Some infinite, NA or NaN increments were removed 
  Error in solve.default(M) : 
    system is computationally singular: reciprocal condition number = 5.72218e-18
  In addition: Warning message:
  Cannot compute variance: Fisher information matrix is singular 
  Warning message:
  Cannot compute variance: Fisher information matrix is singular 
  > 
  > 
  > 
  > #'   tests/ppmclass.R
  > #'
  > #'   Class support for ppm
  > #'
  > #'   $Revision: 1.9 $ $Date: 2022/03/07 03:26:09 $
  > 
  > if(FULLTEST) {
  + local({
  +   #' (1) print.ppm, summary.ppm, print.summary.ppm
  +   Z <- as.im(function(x,y){x}, Window(cells))
  +   fitZ <- ppm(cells ~ Z)
  +   print(fitZ)
  +   print(summary(fitZ))
  +   #' logistic
  +   fitl <- ppm(swedishpines ~ x+y, method="logi")
  +   print(fitl)
  +   print(summary(fitl))
  +   #' Model with covariate arguments
  +   f <- function(x,y,b) { x+b }
  +   fitf <- ppm(cells ~ f, covfunargs=list(b=1))
  +   print(fitf)
  +   print(summary(fitf))
  +   #' Invalid model
  +   fitN <- ppm(redwood ~ 1, Strauss(0.1))
  +   print(fitN)
  +   print(summary(fitN))
  +   #' standard errors in output
  +   fat <- ppm(cells ~ x, Strauss(0.12))
  +   op <- spatstat.options(print.ppm.SE='always')
  +   print(fat)
  +   spatstat.options(print.ppm.SE='never')
  +   print(fat)
  +   print(fitZ)
  +   spatstat.options(op)
  + 
  +   ## (2) plot.ppm
  +   plot(fitZ)
  +   plot(fat, trend=FALSE, cif=FALSE, se=FALSE)
  + 
  +   ## (3) emend.ppm
  +   fitZe <- emend(fitZ, trace=TRUE)
  +   ZZ <- Z
  +   fitZZ <- ppm(cells ~ Z + ZZ)
  +   fitZZe <- emend(fitZZ, trace=TRUE)
  +   fitOK  <- ppm(redwood ~1, Strauss(0.1), emend=TRUE)
  +   print(fitOK)
  +   fitNot <- ppm(redwood ~1, Strauss(0.1))
  +   fitSlow <- emend(fitNot, trace=TRUE)
  +   print(fitSlow)
  +   op <- spatstat.options(project.fast=TRUE)
  +   fitFast <- emend(fitNot, trace=TRUE)
  +   print(fitFast)
  +   fitZZe <- emend(fitZZ, trace=TRUE)
  +   spatstat.options(op)
  +   
  +   #' (4) methods for other generics
  +   logLik(fitZ, absolute=TRUE)
  +   unitname(fitZ)
  +   unitname(fat) <- c("metre", "metres")
  +   is.expandable(fitf)
  +   fit0 <- update(fitZ, . ~ 1)
  +   anova(fit0, fitZ, override=TRUE)
  +   interactionfamilyname(fat)
  +   interactionorder(fat)
  +   hardcoredist(fat)
  +   
  +   #' (5) miscellaneous
  +   
  +   ## example from Robert Aue - handling offsets
  +   X <- demohyper$Points[[1]]
  +   GH <- Hybrid(G=Geyer(r=0.1, sat=3), H=Hardcore(0.01))
  +   fit <- ppm(X ~ 1, GH)
  +   valid.ppm(fit)
  + 
  +   #' hard core distance of hybrid
  +   hardcoredist(fit)
  +   #' interaction order of hybrid
  +   interactionorder(fit)
  +   
  +   #' case of boundingbox
  +   boundingbox(cells, ppm(cells ~ 1))
  + })
  + 
  + reset.spatstat.options()
  + }
  > #
  > #   tests/ppmgam.R
  > #
  > #   Test ppm with use.gam=TRUE
  > #
  > #   $Revision: 1.4 $  $Date: 2020/04/30 05:23:52 $
  > #
  > 
  > if(FULLTEST) {
  + local({
  +   fit <- ppm(nztrees ~s(x,y), use.gam=TRUE)
  +   mm <- model.matrix(fit)
  +   mf <- model.frame(fit)
  +   v <- vcov(fit)
  +   prd <- predict(fit)
  + })
  + }
  > #'
  > #'  tests/ppmlogi.R
  > #'
  > #' Tests of ppm(method='logi')
  > #'    and related code (predict, leverage etc)
  > #'
  > #' $Revision: 1.15 $  $Date: 2020/04/30 05:23:52 $
  > #'
  > 
  > local({
  +   if(FULLTEST) {
  +     fit <- ppm(cells ~x, method="logi")
  +     f <- fitted(fit)
  +     p <- predict(fit)
  +     u <- summary(fit)
  +     fitS <- ppm(cells ~x, Strauss(0.12), method="logi")
  +     fS <- fitted(fitS)
  +     pS <- predict(fitS)
  +     uS <- summary(fitS)
  +     print(uS)
  + 
  +     plot(leverage(fit))
  +     plot(influence(fit))
  +     plot(dfbetas(fit))
  +     plot(leverage(fitS))
  +     plot(influence(fitS))
  +     plot(dfbetas(fitS))
  +   }
  + 
  +   if(FULLTEST) {
  +     #' same with hard core - A1 is singular
  +     fitH <- ppm(cells ~x, Strauss(0.08), method="logi")
  +     print(fitH)
  +     fH <- fitted(fitH)
  +     pH <- predict(fitH)
  +     uH <- summary(fitH)
  +     print(uH)
  +     plot(leverage(fitH))
  +     plot(influence(fitH))
  +     plot(dfbetas(fitH))
  +   }
  +   
  +   if(FULLTEST) {
  +     #' logistic fit to data frame of covariates
  +     z <- c(rep(TRUE, 5), rep(FALSE, 5))
  +     df <- data.frame(A=z + 2* runif(10),
  +                      B=runif(10))
  +     Y <- quadscheme.logi(runifpoint(5), runifpoint(5))
  +     fut <- ppm(Y ~ A+B, data=df, method="logi")
  +     sf <- summary(fut)
  +     print(sf)
  +   }
  + 
  +   if(FULLTEST) {
  +     #' vblogit code, just to check that it runs.
  +     fee <- ppm(cells ~ x, method="VBlogi", nd=21)
  +     print(fee)
  +     summary(fee)
  +     logLik(fee)
  +     AIC(fee)
  +     extractAIC(fee)
  +     Z <- predict(fee)
  +     summary(Z)
  +     print(fee$internal$glmfit) # print.vblogit
  +   }
  + })
  > 
  > #
  > #   tests/ppmmarkorder.R
  > #
  > # $Revision: 1.4 $  $Date: 2020/04/30 05:23:52 $
  > #
  > # Test that predict.ppm, plot.ppm and plot.fitin
  > # tolerate marks with levels that are not in alpha order
  > #
  > if(ALWAYS) { # locale-dependent?
  + local({
  +   X <- amacrine
  +   levels(marks(X)) <- c("ZZZ", "AAA")
  +   fit <- ppm(X ~marks, MultiStrauss(c("ZZZ","AAA"), matrix(0.06, 2, 2)))
  +   aa <- predict(fit, type="trend")
  +   bb <- predict(fit, type="cif")
  +   plot(fit)
  +   plot(fitin(fit))
  + })
  + }
  > 
  > 
  > #
  > #   tests/ppmscope.R
  > #
  > #   Test things that might corrupt the internal format of ppm objects
  > #
  > #   $Revision: 1.7 $  $Date: 2022/01/19 09:18:20 $
  > #
  > 
  > if(ALWAYS) {  # dependent on R version?
  + local({
  + 
  +   ##   (1) Scoping problem that can arise when ppm splits the data
  +   fit <- ppm(bei ~elev, data=bei.extra)
  +   mm <- model.matrix(fit)
  + 
  +   ##   (2) Fast update mechanism
  +   fit1 <- ppm(cells ~x+y, Strauss(0.07))
  +   fit2 <- update(fit1, ~y)
  +   fit3 <- update(fit2, ~x)
  + 
  +   ## (3) New formula-based syntax
  +   attach(bei.extra)
  +   slfit <- ppm(bei ~ grad)
  +   sl2fit <- update(slfit, ~grad + I(grad^2))
  +   slfitup <- update(slfit, use.internal=TRUE)
  +   sl2fitup <- update(sl2fit, use.internal=TRUE)
  + 
  +   ## (4) anova.ppm
  +   fut1  <- ppm(cells ~ 1, Strauss(0.1))
  +   futx  <- ppm(cells ~ x, Strauss(0.1))
  +   anova(fut1, test="Chi")
  +   anova(futx, test="Chi")
  +   fut1a <- ppm(cells ~ 1, Strauss(0.1), rbord=0)
  +   anova(fut1a, futx, test="Chi")
  +   fut1d <- ppm(cells ~ 1, Strauss(0.1), nd=23)
  +   anova(fut1d, futx, test="Chi")
  +   ## This now works!
  +   futxyg <- ppm(cells ~ x + s(y), Strauss(0.1), use.gam=TRUE)
  +   anova(futx, futxyg)
  +   ## marked
  +   fatP <- ppm(amacrine ~ marks)
  +   fatM <- ppm(amacrine ~ marks, MultiStrauss(matrix(0.07, 2, 2)))
  +   anova(fatP, fatM, test="Chi")
  + 
  +   ## (5) expansion of "." in update.ppm
  +   fitb <- ppm(bei ~ . , data=bei.extra)
  +   step(fitb)
  + })
  + }
  Start:  AIC=42295.11
  ~elev + grad
  
         Df   AIC
  <none>    42295
  - elev  1 42383
  - grad  1 42760
  Nonstationary Poisson process
  Fitted to point pattern dataset 'bei'
  
  Log intensity:  ~elev + grad
  
  Fitted trend coefficients:
  (Intercept)        elev        grad 
  -8.56355220  0.02143995  5.84646680 
  
                 Estimate        S.E.     CI95.lo     CI95.hi Ztest       Zval
  (Intercept) -8.56355220 0.341113849 -9.23212306 -7.89498134   *** -25.104675
  elev         0.02143995 0.002287866  0.01695581  0.02592408   ***   9.371155
  grad         5.84646680 0.255781018  5.34514522  6.34778838   ***  22.857313
  Warning messages:
  1: anova.ppm now computes the *adjusted* deviances when the models are not Poisson processes. 
  2: Models were re-fitted using a common value of 'rbord' 
  3: Models were re-fitted using a common quadrature scheme 
  4: Models were re-fitted with use.gam=TRUE 
  5: Deviance adjustment is not available for gam fits; unadjusted composite deviance calculated. 
  6: Models were re-fitted using a common value of 'rbord' 
  > grep#
  function (pattern, x, ignore.case = FALSE, perl = FALSE, value = FALSE, 
      fixed = FALSE, useBytes = FALSE, invert = FALSE) 
  {
      pattern <- as.character(pattern)
      if (is.factor(x) && length(levx <- levels(x)) < length(x) && 
          !is.na(pattern[1L])) {
          value <- is.character(idxna <- suppressWarnings(grep(pattern, 
              NA_character_, ignore.case, perl, value, fixed, useBytes, 
              invert)))
          idx <- logical(length(levx))
          idx[grep(pattern, levx, ignore.case, perl, FALSE, fixed, 
              useBytes, invert)] <- TRUE
          idx <- idx[x]
          if (length(idxna)) 
              idx[is.na(x)] <- TRUE
          idx <- which(idx)
          if (value) {
              idx <- x[idx]
              structure(as.character(idx), names = names(idx))
          }
          else idx
      }
      else {
          if (!is.character(x)) 
              x <- structure(as.character(x), names = names(x))
          .Internal(grep(pattern, x, ignore.case, value, perl, 
              fixed, useBytes, invert))
      }
  }
  <bytecode: 0x000001f29ef50f40>
  <environment: namespace:base>
  > #   tests/ppmtricks.R
  > #
  > #   Test backdoor exits, hidden options, internals and tricks in ppm
  > #
  > #   $Revision: 1.19 $  $Date: 2020/04/30 05:23:52 $
  > #
  > local({
  + 
  +   ## (1) skip.border
  +   if(ALWAYS) { # needed below
  +     fit <- ppm(cells, ~1, Strauss(0.1), skip.border=TRUE)
  +   }
  +   
  +   ## (2) subset arguments of different kinds
  +   if(FULLTEST) {
  +     fut <- ppm(cells ~ x, subset=(x > 0.5))
  +     fot <- ppm(cells ~ x, subset=(x > 0.5), method="logi")
  +     W <- owin(c(0.4, 0.8), c(0.2, 0.7))
  +     fut <- ppm(cells ~ x, subset=W)
  +     fot <- ppm(cells ~ x, subset=W, method="logi")
  +     V <- as.im(inside.owin, Window(cells), w=W)
  +     fet <- ppm(cells ~ x, subset=V)
  +     fet <- ppm(cells ~ x, subset=V, method="logi")
  +   }
  + 
  +   ## (3) profilepl -> ppm
  +   ##     uses 'skip.border' and 'precomputed'
  +   ##     also tests scoping for covariates
  +   if(FULLTEST) {
  +     splants <- split(ants)
  +     mess    <- splants[["Messor"]]
  +     cats    <- splants[["Cataglyphis"]]
  +     ss      <- data.frame(r=seq(60,120,by=20),hc=29/6)
  +     dM      <- distmap(mess,dimyx=256)
  +     mungf    <- profilepl(ss, StraussHard, cats ~ dM)
  +     mungp   <- profilepl(ss, StraussHard, trend=~dM, Q=cats)
  +   }
  +   
  +   ## (4) splitting large quadschemes into blocks
  +   if(FULLTEST) {
  +     mop <- spatstat.options(maxmatrix=5000)
  +     qr <- quadBlockSizes(quadscheme(cells))
  +     pr <- predict(ppm(cells ~ x, AreaInter(0.05)))
  +     spatstat.options(mop)
  +     qr <- quadBlockSizes(quadscheme(cells))
  +   }
  +   
  +   ## (5) shortcuts in summary.ppm
  +   ## and corresponding behaviour of print.summary.ppm
  +   if(FULLTEST) {
  +     print(summary(fit, quick=TRUE))
  +     print(summary(fit, quick="entries"))
  +     print(summary(fit, quick="no prediction"))
  +     print(summary(fit, quick="no variances"))
  +   }
  + 
  +   ## (6) suffstat.R
  +   if(ALWAYS) {
  +     fitP <- update(fit, Poisson())
  +     suffstat.poisson(fitP, cells)
  +     fit0 <- killinteraction(fit)
  +     suffstat.poisson(fit0, cells)
  +   }
  + 
  +   ## (7) various support for class ppm
  +   if(FULLTEST) {
  +     fut <- kppm(redwood ~ x)
  +     A <- quad.ppm(fut)
  +     Z <- as.im(function(x,y){x}, Window(cells))
  +     fitZ <- ppm(cells ~ Z)
  +     U <- getppmOriginalCovariates(fitZ)
  +   }
  +   
  +   ## (8) support for class profilepl
  +   if(FULLTEST) {
  +     rr <- data.frame(r=seq(0.05, 0.15, by=0.02))
  +     ps <- profilepl(rr, Strauss, cells)
  +     ##  plot(ps) ## covered in plot.profilepl.Rd
  +     simulate(ps, nrep=1e4)
  +     parameters(ps)
  +     fitin(ps)
  +     predict(ps, type="cif")
  +   }
  +                     
  +   ## (9) class 'plotppm'
  +   if(FULLTEST) {
  +     fut <- ppm(amacrine ~ marks + polynom(x,y,2), Strauss(0.07))
  +     p <- plot(fut, plot.it=FALSE)
  +     print(p)
  +     plot(p, how="contour")
  +     plot(p, how="persp")
  +   }
  + 
  +   ## (10) ppm -> mpl.engine -> mpl.prepare
  +   if(ALWAYS) { # includes C code
  +     fit <- ppm(cells, NULL)
  +     fit <- ppm(cells ~ x, clipwin=square(0.7))
  +     fit <- ppm(cells ~ x, subset=square(0.7))
  +     DG <- as.im(function(x,y){x+y < 1}, square(1))
  +     fit <- ppm(cells ~ x, subset=DG)
  +     fit <- ppm(cells ~ x, GLM=glm)
  +     fit <- ppm(cells ~ x, famille=quasi(link='log', variance='mu'))
  +     fit <- ppm(cells ~ x, Hardcore(0.07), skip.border=TRUE, splitInf=TRUE)
  +   }
  +   
  +   ## (11) unidentifiable model (triggers an error in ppm)
  +   if(FULLTEST) {
  +     Q <- quadscheme(cells)
  +     M <- mpl.prepare(Q, cells, as.ppp(Q), trend=~1, covariates=NULL,
  +                      interaction=Hardcore(0.3), correction="none")
  +   }
  + })
  > 
  > reset.spatstat.options()
  > #
  > # tests/prediction.R
  > #
  > # Things that might go wrong with predict()
  > #
  > #  $Revision: 1.20 $ $Date: 2020/04/30 05:41:59 $
  > #
  > 
  > local({
  +   if(ALWAYS) {
  +     ## test of 'covfunargs' - platform dependent?
  +     f <- function(x,y,a){ y - a }
  +     fit <- ppm(cells ~x + f, covariates=list(f=f), covfunargs=list(a=1/2))
  +     p <- predict(fit)
  + 
  +     ## prediction involving 0 * NA
  +     qc <- quadscheme(cells, nd=10)
  +     r <- minnndist(as.ppp(qc))/10
  +     fit <- ppm(qc ~ 1, Strauss(r)) # model has NA for interaction coefficient
  +     p1 <- predict(fit)
  +     p2 <- predict(fit, type="cif", ngrid=10)
  +     stopifnot(all(is.finite(as.matrix(p1))))
  +     stopifnot(all(is.finite(as.matrix(p2))))
  +   }
  + 
  +   if(FULLTEST) {
  +     ## test of 'new.coef' mechanism
  +     fut <- ppm(cells ~ x, Strauss(0.15), rbord=0)
  +     p0 <- predict(fut, type="cif")
  +     pe <- predict(fut, type="cif", new.coef=coef(fut))
  +     pn <- predict(fut, type="cif", new.coef=unname(coef(fut)))
  +     if(max(abs(pe-p0)) > 0.01)
  +       stop("new.coef mechanism is broken!")
  +     if(max(abs(pn-p0)) > 0.01)
  +       stop("new.coef mechanism gives wrong answer, for unnamed vectors")
  +     #' adaptcoef     
  +     a <- c(A=1,B=2,Z=42)
  +     b <- c(B=41,A=0)
  +     ab <- adaptcoef(a, b, drop=TRUE)
  +   }
  + 
  +   if(FULLTEST) {
  +     ## tests of relrisk.ppm
  +     fut <- ppm(amacrine ~ x * marks)
  +     a <- relrisk(fut, control=2, relative=TRUE)
  +     a <- relrisk(fut, se=TRUE)
  +     a <- relrisk(fut, relative=TRUE, se=TRUE)
  +     fut <- ppm(sporophores ~ marks + x)
  +     a <- relrisk(fut, control=2, relative=TRUE)
  +     a <- relrisk(fut, se=TRUE)
  +     a <- relrisk(fut, relative=TRUE, se=TRUE)
  + 
  +     ## untested cases of predict.ppm
  +     fit0 <- ppm(cells)
  +     a <- predict(fit0, interval="confidence")
  +     a <- predict(fit0, interval="confidence", type="count")
  +     fit  <- ppm(cells ~ x)
  +     b <- predict(fit, se=TRUE, locations=cells)
  +     b <- predict(fit, se=TRUE, interval="confidence")
  +     b <- predict(fit, type="count",                            se=TRUE)
  +     b <- predict(fit, type="count", window=square(0.5),        se=TRUE)
  +     b <- predict(fit, type="count", window=quadrats(cells, 3), se=TRUE)
  +     d <- predict(fit, type="count", interval="prediction", se=TRUE)
  +     d <- predict(fit, type="count", interval="confidence", se=TRUE)
  +     d <- predict(fit,               interval="confidence", se=TRUE)
  +     foot <- ppm(cells ~ x, StraussHard(0.12))
  +     d <- predict(foot, ignore.hardcore=TRUE)
  +     dX <- predict(foot, ignore.hardcore=TRUE, locations=cells)
  +   
  +     ## superseded usages
  +     b <- predict(fit, type="se", getoutofjail=TRUE)
  +     b <- predict(fit, type="se", locations=cells) # warning
  +     b <- predict(fit, total=TRUE)
  +     b <- predict(fit, total=square(0.5))
  +     b <- predict(fit, total=quadrats(cells, 3))
  + 
  +     ## supporting code
  +     u <- model.se.image(fit, square(0.5))
  +     u <- model.se.image(fit, square(0.5), what="cv")
  +     u <- model.se.image(fit, square(0.5), what="ce")
  +     co <- c(Intercept=5, slope=3, kink=2)
  +     re <- c("Intercept", "slope")
  +     a <- fill.coefs(co, re) # warning
  +     b <- fill.coefs(co, rev(names(co)))
  +     d <- fill.coefs(co, letters[1:3])
  +     ## model matrix etc
  +     v <- model.frame(ppm(cells))
  +     fut <- ppm(cells ~ x, Strauss(0.1))
  +     v <- model.matrix(fut, subset=(x<0.5), keepNA=FALSE)
  +     df <- data.frame(x=runif(10), y=runif(10),
  +                      Interaction=sample(0:1, 10, TRUE))
  +     m10 <- PPMmodelmatrix(fut, data=df)
  +     mmm <- PPMmodelmatrix(fut, Q=quad.ppm(fut))
  +     #' effectfun for Gibbs
  +     effectfun(fut, "x")
  +     effectfun(fut, "x", se.fit=TRUE)
  +     #' implicit covariate when there is only one
  +     effectfun(fut)
  +     effectfun(fut, se.fit=TRUE)
  +     #' given covariate
  +     dlin <- distfun(copper$SouthLines)
  +     copfit <- ppm(copper$SouthPoints ~ dlin, Geyer(1,1))
  +     effectfun(copfit, "dlin")
  +     effectfun(copfit)
  +     #' covariate that is not used in model
  +     effectfun(fut, "y", x=0)
  +     futS <- ppm(cells ~ 1, Strauss(0.1))
  +     effectfun(futS, "x")
  +     effectfun(futS, "y")
  +     #' factor covariate
  +     fot <- ppm(amacrine~x+marks)
  +     effectfun(fot, "marks", x=0.5, se.fit=TRUE)
  +     #' covariate retained but not used
  +     W <- Window(swedishpines)
  +     a <- solist(A=funxy(function(x,y){x < 20}, W),
  +                 B=funxy(function(x,y){factor(x < 20)}, W))
  +     fvt <- ppm(swedishpines ~ A, data=a, allcovar=TRUE)
  +     effectfun(fvt, "A",         se.fit=TRUE)
  +     effectfun(fvt, "B", A=TRUE, se.fit=TRUE)
  +               
  +     ## ppm with covariate values in data frame
  +     X <- rpoispp(42)
  +     Q <- quadscheme(X)
  +     weirdfunction <- function(x,y){ 10 * x^2 + 5 * sin(10 * y) }
  +     Zvalues <- weirdfunction(x.quad(Q), y.quad(Q))
  +     fot <- ppm(Q ~ y + Z, data=data.frame(Z=Zvalues))
  +     effectfun(fot, "y", Z=0)
  +     effectfun(fot, "Z", y=0)
  + 
  +     #' multitype
  +     modX <- ppm(amacrine ~ polynom(x,2))
  +     effectfun(modX)
  +     effectfun(modX, "x")
  +     modXM <- ppm(amacrine ~ marks*polynom(x,2))
  +     effectfun(modXM, "x", marks="on")
  +     modXYM <- ppm(amacrine ~ marks*polynom(x,y,2))
  +     effectfun(modXYM, "x", y=0, marks="on")
  +   
  +     df <- as.data.frame(simulate(modXM, drop=TRUE))
  +     df$marks <- as.character(df$marks)
  +     dfpr <- predict(modXM, locations=df)
  +   }
  + })
  > 
  > #
  > #     tests/project.ppm.R
  > #
  > #      $Revision: 1.7 $  $Date: 2020/04/30 05:41:59 $
  > #
  > #     Tests of projection mechanism
  > #
  > 
  > local({
  +   chk <- function(m) {
  +     if(!valid.ppm(m)) stop("Projected model was still not valid")
  +     return(invisible(NULL))
  +   }
  +   
  +   if(FULLTEST) {
  +     ## a very unidentifiable model
  +     fit <- ppm(cells ~Z, Strauss(1e-06), covariates=list(Z=0))
  +     chk(emend(fit))
  +     ## multitype
  +     r <- matrix(1e-06, 2, 2)
  +     fit2 <- ppm(amacrine ~1, MultiStrauss(types=c("off", "on"), radii=r))
  +     chk(emend(fit2))
  +     ## complicated multitype 
  +     fit3 <- ppm(amacrine ~1, MultiStraussHard(types=c("off", "on"),
  +                                               iradii=r, hradii=r/5))
  +     chk(emend(fit3))
  + 
  +     #' code coverage
  +     op <- spatstat.options(project.fast=TRUE)
  +     fut <- emend(fit, trace=TRUE)
  +     chk(fut)
  +     spatstat.options(op)
  + 
  +     #' hierarchical
  +     ra <- r
  +     r[2,1] <- NA
  +     fit4 <- ppm(amacrine ~1, HierStrauss(types=c("off", "on"), radii=r))
  +     chk(emend(fit4))
  +     #' complicated hierarchical
  +     fit5 <- ppm(amacrine ~1, HierStraussHard(types=c("off", "on"),
  +                                              iradii=r, hradii=r/5))
  +     chk(emend(fit5))
  +   
  +     ## hybrids
  +     r0 <- min(nndist(redwood))
  +     ra <- 1.25 * r0
  +     rb <- 0.8 * r0
  +     f1 <- ppm(redwood ~1, Hybrid(A=Strauss(ra), B=Geyer(0.1, 2)), project=TRUE)
  +     chk(f1)
  +     f2 <- ppm(redwood ~1, Hybrid(A=Strauss(rb), B=Geyer(0.1, 2)), project=TRUE)
  +     chk(f2)
  +     f3 <- ppm(redwood ~1, Hybrid(A=Strauss(ra), B=Strauss(0.1)), project=TRUE)
  +     chk(f3)
  +     f4 <- ppm(redwood ~1, Hybrid(A=Strauss(rb), B=Strauss(0.1)), project=TRUE)
  +     chk(f4)
  +     f5 <- ppm(redwood ~1, Hybrid(A=Hardcore(rb), B=Strauss(0.1)), project=TRUE)
  +     chk(f5)
  +     f6 <- ppm(redwood ~1, Hybrid(A=Hardcore(rb), B=Geyer(0.1, 2)), project=TRUE)
  +     chk(f6)
  +     f7 <- ppm(redwood ~1, Hybrid(A=Geyer(rb, 1), B=Strauss(0.1)), project=TRUE)
  +     chk(f7)
  +   }
  + })
  > 
  > reset.spatstat.options()
  > 
  > proc.time()
     user  system elapsed 
     5.92    0.81    6.71 
Running the tests in 'tests/testsQ.R' failed.
Complete output:
  > #'
  > #'   Header for all (concatenated) test files
  > #'
  > #'   Require spatstat.model
  > #'   Obtain environment variable controlling tests.
  > #'
  > #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
  > 
  > require(spatstat.model)
  Loading required package: spatstat.model
  Loading required package: spatstat.data
  Loading required package: spatstat.geom
  spatstat.geom 3.2-9
  Loading required package: spatstat.random
  spatstat.random 3.2-3
  Loading required package: spatstat.explore
  Loading required package: nlme
  spatstat.explore 3.2-7
  Loading required package: rpart
  spatstat.model 3.2-11
  > FULLTEST <- (nchar(Sys.getenv("SPATSTAT_TEST", unset="")) > 0)
  > ALWAYS   <- TRUE
  > cat(paste("--------- Executing",
  +           if(FULLTEST) "** ALL **" else "**RESTRICTED** subset of",
  +           "test code -----------\n"))
  --------- Executing **RESTRICTED** subset of test code -----------
  > 
  > proc.time()
     user  system elapsed 
     1.06    0.14    1.18 
Running the tests in 'tests/testsR1.R' failed.
Complete output:
  > #'
  > #'   Header for all (concatenated) test files
  > #'
  > #'   Require spatstat.model
  > #'   Obtain environment variable controlling tests.
  > #'
  > #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
  > 
  > require(spatstat.model)
  Loading required package: spatstat.model
  Loading required package: spatstat.data
  Loading required package: spatstat.geom
  spatstat.geom 3.2-9
  Loading required package: spatstat.random
  spatstat.random 3.2-3
  Loading required package: spatstat.explore
  Loading required package: nlme
  spatstat.explore 3.2-7
  Loading required package: rpart
  spatstat.model 3.2-11
  > FULLTEST <- (nchar(Sys.getenv("SPATSTAT_TEST", unset="")) > 0)
  > ALWAYS   <- TRUE
  > cat(paste("--------- Executing",
  +           if(FULLTEST) "** ALL **" else "**RESTRICTED** subset of",
  +           "test code -----------\n"))
  --------- Executing **RESTRICTED** subset of test code -----------
  > #'  tests/resid.R
  > #'
  > #'  Stuff related to residuals and residual diagnostics
  > #'           including residual summary functions
  > #'
  > #'   $Revision: 1.7 $  $Date: 2022/05/22 08:43:31 $
  > #'
  > 
  > local({
  +   fit <- ppm(cells ~x, Strauss(r=0.15))
  +   rr <- residuals(fit, quad=quadscheme(cells, nd=128))
  +   diagnose.ppm(fit, cumulative=FALSE, type="pearson")
  + 
  +   if(FULLTEST) {
  +     diagnose.ppm(fit, cumulative=FALSE)
  + 
  +     fitoff <- ppm(cells ~ sin(x) + offset(y))
  +     plot(a <- parres(fitoff, "x"))
  +     plot(b <- parres(fitoff, "y"))
  +     print(a)
  +     print(b)
  +   
  +     d <- diagnose.ppm(fit, which="marks")
  +     plot(d, plot.neg="discrete")
  +     plot(d, plot.neg="imagecontour")
  + 
  +     d <- diagnose.ppm(fit, type="pearson", which="smooth")
  +     plot(d, plot.smooth="image")
  +     plot(d, plot.smooth="contour")
  +     plot(d, plot.smooth="imagecontour")
  +   
  +     d <- diagnose.ppm(fit, type="pearson", which="x")
  +     plot(d)
  +     d <- diagnose.ppm(fit, type="pearson", which="y")
  +     plot(d)
  +   
  +     diagnose.ppm(fit, type="pearson", which="x", cumulative=FALSE)
  +     diagnose.ppm(fit, type="pearson", which="x", cumulative=FALSE)
  +     diagnose.ppm(fit, type="raw", plot.neg="discrete", plot.smooth="image")
  +     diagnose.ppm(fit, type="pearson", plot.neg="contour", plot.smooth="contour")
  + 
  +     diagnose.ppm(fitoff, type="raw", which="smooth", plot.smooth="persp")
  +     diagnose.ppm(fitoff, type="pearson", plot.neg="imagecontour")
  + 
  +     plot(Frame(letterR), main="")
  +     ploterodewin(letterR, erosion(letterR, 0.05), main="jeans")
  +     W <- as.mask(letterR)
  +     plot(Frame(W), main="")
  +     ploterodewin(W, erosion(W, 0.05), main="JeAnS")
  + 
  +     #' entangled terms in model
  +     U <- as.im(1, owin())
  +     Z <- as.im(function(x,y) x, owin())
  +     X <- runifpoint(40)
  +     fut <- ppm(X ~ Z:U)
  +     a <- parres(fut, "Z")
  +     futoff <- ppm(X ~ offset(Z*U))
  +     a <- parres(futoff, "Z")
  + 
  +     #' residual summary functions
  +     pt <- psst(cells, interaction=Strauss(0.1), fun=nndcumfun)
  +   }
  + })
  > 
  > 
  > 
  > ##
  > ## tests/rhohat.R
  > ##
  > ## Test all combinations of options for rhohatCalc
  > ##
  > ## $Revision: 1.6 $ $Date: 2022/05/22 08:03:48 $
  > 
  > local({
  +   if(FULLTEST) {
  +     X <-  rpoispp(function(x,y){exp(3+3*x)})
  +     Z <- as.im(function(x,y) { x }, Window(X))
  +     f <- funxy(function(x,y) { y + 1 }, Window(X))
  +     
  +     
  +     ## rhohat.ppm
  +     fit <- ppm(X ~x)
  +     rhofitA <- rhohat(fit, "x")
  +     rhofitB <- rhohat(fit, "x", method="reweight")
  +     rhofitC <- rhohat(fit, "x", method="transform")
  +     rhofitD <- rhohat(fit, Z)
  +     rhofitD <- rhohat(fit, Z, positiveCI=TRUE)
  +     lam <- predict(fit)
  + 
  + 
  +     ## Horvitz-Thompson
  +     rhofitAH <- rhohat(fit, "x", horvitz=TRUE)
  +     rhofitBH <- rhohat(fit, "x", method="reweight", horvitz=TRUE)
  +     rhofitCH <- rhohat(fit, "x", method="transform", horvitz=TRUE)
  + 
  +     r2myx <- rho2hat(fit, "y", "x")
  +     r2myxw <- rho2hat(fit, "y", "x", method="reweight")
  +     plot(r2myx)
  +     plot(r2myxw)
  +     print(r2myxw)
  +     predict(r2myxw)
  +     predict(r2myxw, relative=TRUE)
  +   }
  + })
  > 
  > proc.time()
     user  system elapsed 
     2.06    0.25    2.29 
Running the tests in 'tests/testsUtoZ.R' failed.
Complete output:
  > #'
  > #'   Header for all (concatenated) test files
  > #'
  > #'   Require spatstat.model
  > #'   Obtain environment variable controlling tests.
  > #'
  > #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
  > 
  > require(spatstat.model)
  Loading required package: spatstat.model
  Loading required package: spatstat.data
  Loading required package: spatstat.geom
  spatstat.geom 3.2-9
  Loading required package: spatstat.random
  spatstat.random 3.2-3
  Loading required package: spatstat.explore
  Loading required package: nlme
  spatstat.explore 3.2-7
  Loading required package: rpart
  spatstat.model 3.2-11
  > FULLTEST <- (nchar(Sys.getenv("SPATSTAT_TEST", unset="")) > 0)
  > ALWAYS   <- TRUE
  > cat(paste("--------- Executing",
  +           if(FULLTEST) "** ALL **" else "**RESTRICTED** subset of",
  +           "test code -----------\n"))
  --------- Executing **RESTRICTED** subset of test code -----------
  > #
  > #  tests/undoc.R
  > #
  > #   $Revision: 1.16 $   $Date: 2020/11/02 07:06:49 $
  > #
  > #  Test undocumented hacks, experimental code, etc
  > 
  > 
  > local({
  +   if(FULLTEST) {
  +     ## cases of 'pickoption'
  +     aliases <- c(Lenin="Ulyanov", Stalin="Djugashvili", Trotsky="Bronstein")
  +     surname <- "Trot"
  +     pickoption("leader", surname,  aliases)
  +     pickoption("leader", surname,  aliases, exact=TRUE, die=FALSE)
  +   }
  +   if(ALWAYS) {
  +     ## pixellate.ppp accepts a data frame of weights
  +     pixellate(cells, weights=data.frame(a=1:42, b=42:1))
  +     ## test parts of 'rmhsnoop' that don't require interaction with user
  +     rmhSnoopEnv(cells, Window(cells), 0.1)
  +   }
  +   if(FULLTEST) {
  +     ## Berman-Turner frame
  +     A <- bt.frame(quadscheme(cells), ~x, Strauss(0.07), rbord=0.07)
  +     print(A)
  +     ## digestCovariates
  +     D <- distfun(cells)
  +     Z <- distmap(cells)
  +     U <- dirichlet(cells)
  +     stopifnot(is.scov(D))
  +     stopifnot(is.scov(Z))
  +     stopifnot(is.scov(U))
  +     stopifnot(is.scov("x"))
  +     dg <- digestCovariates(D=D,Z=Z,U=U,"x",list(A="x", B=D))
  +     ##
  +     a <- getfields(dg, c("A", "D", "niets"), fatal=FALSE)
  +     ## util.R
  +     gg <- pointgrid(owin(), 7)
  +     checkbigmatrix(1000000L, 1000000L, FALSE, TRUE)
  +     spatstatDiagnostic("whatever")
  +     M <- list(list(a=2, b=FALSE),
  +               list(a=2, b=TRUE))
  +     stopifnot(!allElementsIdentical(M))
  +     stopifnot(allElementsIdentical(M, "a"))
  +     ##
  +     A <- Strauss(0.1)
  +     A <- reincarnate.interact(A)
  +     ##
  +     ## special lists
  +     B <- solist(a=cells, b=redwood, c=japanesepines)
  +     BB <- as.ppplist(B)
  +     BL <- as.layered(B)
  +     DB <- as.imlist(lapply(B, density))
  +     is.solist(B)
  +     is.ppplist(B)
  +     is.imlist(DB)
  +     ## case of density.ppplist 
  +     DEB <- density(BB, se=TRUE)
  +   }
  + 
  +   if(ALWAYS) {
  +     ## fft
  +     z <- matrix(1:16, 4, 4)
  +     a <- fft2D(z, west=FALSE)
  +     if(fftwAvailable())
  +       b <- fft2D(z, west=TRUE)
  +   }
  + 
  +   if(ALWAYS) {
  +     ## experimental interactions
  +     pot <- function(d, par) { d <= 0.1 }
  +     A <- Saturated(pot)
  +     print(A)
  +     A <- update(A, name="something")
  +     ppm(amacrine ~ x, A, rbord=0.1)
  +   }
  + 
  +   if(ALWAYS) { # platform dependent
  +     #' version-checking
  +     now <- Sys.Date()
  +     versioncurrency.spatstat(now + 80, FALSE)
  +     versioncurrency.spatstat(now + 140, FALSE)
  +     versioncurrency.spatstat(now + 400, FALSE)
  +     versioncurrency.spatstat(now + 1000)
  +   }
  + 
  +   if(FULLTEST) {
  +     #' general Ord interaction
  +     gradual <- function(d, pars) {
  +       y <- pmax(0, 0.005 - d)/0.005
  +       if(is.matrix(d)) y <- matrix(y, nrow(d), ncol(d))
  +       return(y)
  +     }
  +     B <- Ord(gradual, "gradual Ord process")
  +   }
  + })
  Saturated pairwise interaction family
  Interaction:Saturated process with user-defined potential
  Potential function:
  function (d, par) 
  {
      d <= 0.1
  }
  <environment: 0x0000027e4ef89c48>
  >   
  > 
  > ##
  > ##  tests/updateppm.R
  > ##
  > ##  Check validity of update.ppm
  > ##
  > ##  $Revision: 1.8 $ $Date: 2022/10/23 01:19:19 $
  > 
  > local({
  +   if(ALWAYS) {
  +     require(spatstat.utils)
  +     h <- function(m1, m2) {
  +       mc <- short.deparse(sys.call())
  +       cat(paste(mc, "\t... "))
  +       m1name <- short.deparse(substitute(m1))
  +       m2name <- short.deparse(substitute(m2))
  +       if(!identical(names(coef(m1)), names(coef(m2))))
  +         stop(paste("Differing results for", m1name, "and", m2name,
  +                    "in updateppm.R"),
  +              call.=FALSE)
  +       cat("OK\n")
  +     }
  +     
  +     X <- redwood[c(TRUE,FALSE)]
  +     Y <- redwood[c(FALSE,TRUE)]
  +     fit0f <- ppm(X ~ 1, nd=8)
  +     fit0p <- ppm(X, ~1, nd=8)
  +     fitxf <- ppm(X ~ x, nd=8)
  +     fitxp <- ppm(X, ~x, nd=8)
  + 
  +     cat("Basic consistency ...\n")
  +     h(fit0f, fit0p)
  +     h(fitxf, fitxp)
  +   
  +     cat("\nTest correct handling of model formulas ...\n")
  +     h(update(fitxf, Y), fitxf)
  +     h(update(fitxf, Q=Y), fitxf)
  +     h(update(fitxf, Y~x), fitxf)
  +     h(update(fitxf, Q=Y~x), fitxf)
  +     h(update(fitxf, ~x), fitxf)
  +   }
  + 
  +   if(FULLTEST) {
  +     h(update(fitxf, Y~1), fit0f)
  +     h(update(fitxf, ~1), fit0f)
  +     h(update(fit0f, Y~x), fitxf)
  +     h(update(fit0f, ~x), fitxf)
  + 
  +     h(update(fitxp, Y), fitxp)
  +     h(update(fitxp, Q=Y), fitxp)
  +     h(update(fitxp, Y~x), fitxp)
  +     h(update(fitxp, Q=Y~x), fitxp)
  +     h(update(fitxp, ~x), fitxp)
  + 
  +     h(update(fitxp, Y~1), fit0p)
  +     h(update(fitxp, ~1), fit0p)
  +     h(update(fit0p, Y~x), fitxp)
  +     h(update(fit0p, ~x), fitxp)
  +   }
  + 
  +   if(ALWAYS) {
  +     cat("\nTest scope handling for left hand side ...\n")
  +     X <- Y
  +     h(update(fitxf), fitxf)
  +   }
  + 
  +   if(ALWAYS) {
  +     cat("\nTest scope handling for right hand side ...\n")
  +     Z <- distmap(X)
  +     fitZf <- ppm(X ~ Z)
  +     fitZp <- ppm(X, ~ Z)
  +     h(update(fitxf, X ~ Z), fitZf)
  +   }
  +   if(FULLTEST) {
  +     h(update(fitxp, X ~ Z), fitZp)
  +     h(update(fitxf, . ~ Z), fitZf)
  +     h(update(fitZf, . ~ x), fitxf)
  +     h(update(fitZf, . ~ . - Z), fit0f)
  +     h(update(fitxp, . ~ Z), fitZp)
  +     h(update(fitZp, . ~ . - Z), fit0p)
  +     h(update(fit0p, . ~ . + Z), fitZp)
  +     h(update(fitZf, . ~ . ), fitZf)
  +     h(update(fitZp, . ~ . ), fitZp)
  +   }
  +   if(ALWAYS) {
  +     cat("\nTest use of internal data ...\n")
  +     h(update(fitZf, ~ x, use.internal=TRUE), fitxf)
  +     fitsin <- update(fitZf, X~sin(Z))
  +     h(update(fitZf, ~ sin(Z), use.internal=TRUE), fitsin)
  +   }
  +   if(FULLTEST) {
  +     cat("\nTest step() ... ")
  +     fut <- ppm(X ~ Z + x + y, nd=8)
  +     fut0 <- step(fut, trace=0)
  +     cat("OK\n")
  +   }
  +   
  + })
  Loading required package: spatstat.utils
  Basic consistency ...
  h(fit0f, fit0p) 	... OK
  h(fitxf, fitxp) 	... OK
  
  Test correct handling of model formulas ...
  h(update(fitxf, Y), fitxf) 	... OK
  h(update(fitxf, Q = Y), fitxf) 	... OK
  h(update(fitxf, Y ~ x), fitxf) 	... OK
  h(update(fitxf, Q = Y ~ x), fitxf) 	... OK
  h(update(fitxf, ~x), fitxf) 	... OK
  
  Test scope handling for left hand side ...
  h(update(fitxf), fitxf) 	... OK
  
  Test scope handling for right hand side ...
  h(update(fitxf, X ~ Z), fitZf) 	... OK
  
  Test use of internal data ...
  h(update(fitZf, ~x, use.internal = TRUE), fitxf) 	... OK
  h(update(fitZf, ~sin(Z), use.internal = TRUE), fitsin) 	... OK
  > #
  > #  tests/vcovppm.R
  > #
  > #  Check validity of vcov.ppm algorithms
  > #
  > #  Thanks to Ege Rubak
  > #
  > #  $Revision: 1.12 $  $Date: 2020/05/02 01:32:58 $
  > #
  > 
  > local({
  + 
  +   set.seed(42)
  +   X <- rStrauss(200, .5, .05)
  +   model <- ppm(X, inter = Strauss(.05))
  + 
  +   if(ALWAYS) {
  +     b  <- vcov(model, generic = TRUE, algorithm = "basic")
  +     v  <- vcov(model, generic = TRUE, algorithm = "vector")
  +     vc <- vcov(model, generic = TRUE, algorithm = "vectorclip")
  +     vn <- vcov(model, generic = FALSE)
  + 
  +     disagree <- function(x, y, tol=1e-7) { max(abs(x-y)) > tol }
  +     asymmetric <- function(x) { disagree(x, t(x)) }
  + 
  +     if(asymmetric(b))
  +       stop("Non-symmetric matrix produced by vcov.ppm 'basic' algorithm")
  +     if(asymmetric(v))
  +       stop("Non-symmetric matrix produced by vcov.ppm 'vector' algorithm")
  +     if(asymmetric(vc))
  +       stop("Non-symmetric matrix produced by vcov.ppm 'vectorclip' algorithm")
  +     if(asymmetric(vn))
  +       stop("Non-symmetric matrix produced by vcov.ppm Strauss algorithm")
  +     
  +     if(disagree(v, b))
  +       stop("Disagreement between vcov.ppm algorithms 'vector' and 'basic' ")
  +     if(disagree(v, vc))
  +       stop("Disagreement between vcov.ppm algorithms 'vector' and 'vectorclip' ")
  +     if(disagree(vn, vc))
  +       stop("Disagreement between vcov.ppm generic and Strauss algorithms")
  +   }
  + 
  +   if(ALWAYS) { # C code
  +     ## Geyer code
  +     xx <- c(0.7375956, 0.6851697, 0.6399788, 0.6188382)
  +     yy <- c(0.5816040, 0.6456319, 0.5150633, 0.6191592)
  +     Y <- ppp(xx, yy, window=square(1))
  +     modelY <- ppm(Y ~1, Geyer(0.1, 1))
  +     
  +     b  <- vcov(modelY, generic = TRUE, algorithm = "basic")
  +     v  <- vcov(modelY, generic = TRUE, algorithm = "vector")
  +     vc <- vcov(modelY, generic = TRUE, algorithm = "vectorclip")
  +     
  +     if(asymmetric(b))
  +       stop("Non-symmetric matrix produced by vcov.ppm 'basic' algorithm for Geyer model")
  +     if(asymmetric(v))
  +       stop("Non-symmetric matrix produced by vcov.ppm 'vector' algorithm for Geyer model")
  +     if(asymmetric(vc))
  +       stop("Non-symmetric matrix produced by vcov.ppm 'vectorclip' algorithm for Geyer model")
  +   
  +     if(disagree(v, b))
  +       stop("Disagreement between vcov.ppm algorithms 'vector' and 'basic' for Geyer model")
  +     if(disagree(v, vc))
  +       stop("Disagreement between vcov.ppm algorithms 'vector' and 'vectorclip' for Geyer model")
  +   }
  + 
  +   if(ALWAYS) { # C code
  +     ## tests of 'deltasuffstat' code
  +     ##     Handling of offset terms
  +     modelH <- ppm(cells ~x, Hardcore(0.05))
  +     a <- vcov(modelH, generic=TRUE) ## may fall over
  +     b <- vcov(modelH, generic=FALSE)
  +     if(disagree(a, b))
  +       stop("Disagreement between vcov.ppm algorithms for Hardcore model")
  +   
  +     ##     Correctness of pairwise.family$delta2
  +     modelZ <- ppm(amacrine ~1, MultiStrauss(radii=matrix(0.1, 2, 2)))
  +     b <- vcov(modelZ, generic=FALSE)
  +     g <- vcov(modelZ, generic=TRUE)
  +     if(disagree(b, g))
  +       stop("Disagreement between vcov.ppm algorithms for MultiStrauss model")
  + 
  +     ## Test that 'deltasuffstat' works for Hybrids
  +     modelHyb <- ppm(japanesepines ~ 1, Hybrid(Strauss(0.05), Strauss(0.1)))
  +     vHyb <- vcov(modelHyb)
  +   }
  + 
  +   if(FULLTEST) {
  +     ## Code blocks for other choices of 'what'
  +     model <- ppm(X ~ 1, Strauss(.05))
  +     cG <- vcov(model, what="corr")
  +     cP <- vcov(update(model, Poisson()), what="corr")
  +     ## outdated usage
  +     cX <- vcov(model, A1dummy=TRUE)
  + 
  +     ## Model with zero-length coefficient vector
  +     lam <- intensity(X)
  +     f <- function(x,y) { rep(lam, length(x)) }
  +     model0 <- ppm(X ~ offset(log(f)) - 1)
  +     dd <- vcov(model0)
  +     cc <- vcov(model0, what="corr")
  +   
  +     ## Model with NA coefficients
  +     fit <- ppm(X ~ log(f))
  +     vcov(fit)
  +     fitE <- emend(fit, trace=TRUE)
  +   
  +     ## Other weird stuff
  +     su <- suffloc(ppm(X ~ x))
  +   }
  + })
  > 
  > proc.time()
     user  system elapsed 
     3.89    0.23    4.11