Running 'testsAtoC.R' [2s]
  Running 'testsD.R' [9s]
  Running 'testsEtoF.R' [167s]
  Running 'testsGtoJ.R' [2s]
  Running 'testsK.R' [4s]
  Running 'testsL.R' [37s]
  Running 'testsM.R' [4s]
  Running 'testsNtoO.R' [165s]
  Running 'testsP1.R' [149s]
  Running 'testsP2.R' [156s]
  Running 'testsQ.R' [171s]
  Running 'testsR1.R' [2s]
  Running 'testsR2.R' [183s]
  Running 'testsS.R' [2s]
  Running 'testsT.R' [166s]
  Running 'testsUtoZ.R' [5s]
Running the tests in 'tests/testsEtoF.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/envelopes.R
  > #
  > #  Test validity of envelope data
  > #
  > #  $Revision: 1.29 $  $Date: 2024/01/10 13:45:29 $
  > #
  > 
  > local({
  +   
  + 
  + checktheo <- function(fit) {
  +   fitname <- deparse(substitute(fit))
  +   en <- envelope(fit, nsim=4, verbose=FALSE, nrep=1e3)
  +   nama <- names(en)
  +   expecttheo <- is.poisson(fit) && is.stationary(fit)
  +   context <- paste("Envelope of", fitname)
  +   if(expecttheo) {
  +     if(!("theo" %in% nama))
  +       stop(paste(context, "did not contain", sQuote("theo")))
  +     if("mmean" %in% nama)
  +       stop(paste(context, "unexpectedly contained", sQuote("mmean")))
  +   } else {
  +     if("theo" %in% nama)
  +       stop(paste(context, "unexpectedly contained", sQuote("theo")))
  +     if(!("mmean" %in% nama))
  +       stop(paste(context, "did not contain", sQuote("mmean")))
  +   }
  +   cat(paste(context, "has correct format\n"))
  + }
  + 
  + if(ALWAYS) {
  +   checktheo(ppm(cells ~x))
  + }
  + if(FULLTEST) {
  +   checktheo(ppm(cells))
  +   checktheo(ppm(cells ~1, Strauss(0.1)))
  + }
  + 
  + 
  + #' check savefuns/savepatterns with global 
  + fit <- ppm(cells~x)
  + if(ALWAYS) Ef <- envelope(fit, Kest, nsim=4, savefuns=TRUE, global=TRUE)
  + if(FULLTEST) Ep <- envelope(fit, Kest, nsim=4, savepatterns=TRUE, global=TRUE)
  + #' check handling of 'dangerous' cases
  + if(FULLTEST) {
  +   fut <- ppm(redwood ~ x)
  +   Ek <- envelope(fut, Kinhom, update=FALSE, nsim=4)
  +   kfut <- kppm(redwood3 ~ x)
  +   Ekk <- envelope(kfut, Kinhom, lambda=density(redwood3), nsim=7)
  + }
  + 
  + 
  + if(ALWAYS) { # invokes C code
  +   fit <- ppm(japanesepines ~ 1, Strauss(0.04))
  +   e6 <- envelope(fit, Kest, nsim=4, fix.n=TRUE)
  +   fit2 <- ppm(amacrine ~ 1, Strauss(0.03))
  +   e7 <- envelope(fit2, Gcross, nsim=4, fix.marks=TRUE)
  + }
  + 
  + 
  + if(FULLTEST) {
  +     fit <- ppm(cells ~ 1, Strauss(0.07))
  +     U <- envelope(fit, nsim=3, simulate=expression(runifpoint(20)))
  +     kfit <- kppm(redwood3 ~ x)
  +     UU <- envelope(kfit, nsim=7, simulate=expression(simulate(kfit, drop=TRUE)))
  +     VV <- envelope(kfit, nsim=7, weights=1:7)
  +     MM <- envelope(kfit, nsim=7, Kinhom, lambda=density(redwood3))
  + }
  + 
  + if(FULLTEST) {
  +   ## from Marcelino de la Cruz - scoping in update.ppm
  +   X <- cells
  +   Z <- density(X)
  +   pfit <- ppm(X ~ Z)
  +   cat("Fitted ppm(X~Z)", fill=TRUE)
  +   penv <- envelope(pfit, Kinhom, lambda=pfit, nsim=3)
  +   RX <- rotate(X, pi/3, centre="centroid")
  +   RZ <- density(RX)
  +   Rpfit <- ppm(RX ~ RZ)
  +   cat("Fitted ppm(RX~RZ)", fill=TRUE)
  +   Rpenv <- envelope(Rpfit, Kinhom, lambda=Rpfit, nsim=3)
  + }
  + 
  + if(FULLTEST) {
  +   #' envelope computations in other functions
  +   P <- lurking(cells, expression(x), envelope=TRUE, nsim=9)
  +   print(P)
  +   #' re-using envelope objects in other functions
  +   A <- envelope(cells, nsim=9, savepatterns=TRUE, savefuns=TRUE)
  +   S <- lurking(cells, expression(x), envelope=A, nsim=9)
  +   #' envelope.envelope
  +   B <- envelope(cells, nsim=5, savepatterns=TRUE, savefuns=FALSE)
  +   envelope(B)
  + }
  + 
  + 
  + 
  + ## close 'local'
  + })
  Envelope of ppm(cells ~ x) has correct format
  Generating 8 simulated realisations of fitted Poisson model (4 to estimate the 
  mean and 4 to calculate envelopes) ...
  1, 2, 3, 4, 5, 6, 7, 
  8.
  
  Done.
  Generating 4 simulated realisations of fitted Gibbs model with fixed number of 
  points  ...
  1, 2, 3, 
  4.
  
  Done.
  Generating 4 simulated realisations of fitted Gibbs model with fixed number of 
  points of each type  ...
  1, 2, 3, 
  4.
  
  Done.
  > #'  tests/enveltest.R
  > #'     Envelope tests (dclf.test, mad.test)
  > #'     and two-stage tests (bits.test, dg.test, bits.envelope, dg.envelope)
  > #' 
  > #'     $Revision: 1.3 $  $Date: 2020/04/28 12:58:26 $ 
  > #'
  > if(FULLTEST) {
  + local({
  +   #' handling of NA function values (due to empty point patterns)
  +   set.seed(1234)
  +   X <- rThomas(5, 0.05, 10) 
  +   fit <- kppm(X ~ 1, "Thomas")
  +   set.seed(100000)
  +   dclf.test(fit)
  +   set.seed(909)
  +   dg.test(fit, nsim=9)
  +   #' other code blocks
  +   dclf.test(fit, rinterval=c(0, 3), nsim=9)
  +   envelopeTest(X, exponent=3, clamp=TRUE, nsim=9)
  + })
  + }
  > #
  > #    tests/fastgeyer.R
  > #
  > # checks validity of fast C implementation of Geyer interaction
  > #
  > #    $Revision: 1.4 $  $Date: 2020/04/28 12:58:26 $
  > #
  > if(FULLTEST) {  # depends on hardware
  + local({
  +   X <- redwood
  +   Q <- quadscheme(X)
  +   U <- union.quad(Q)
  +   EP <- equalpairs.quad(Q)
  +   G <- Geyer(0.11, 2)
  + # The value r=0.11 is chosen to avoid hardware numerical effects (gcc bug 323).
  + # It avoids being close any value of pairdist(redwood).
  + # The nearest such values are 0.1077.. and 0.1131..
  + # By contrast if r = 0.1 there are values differing from 0.1 by 3e-17
  +   a <- pairsat.family$eval(X,U,EP,G$pot,G$par,"border")
  +   b <-          G$fasteval(X,U,EP,G$pot,G$par,"border")
  +   if(!all(a==b))
  +     stop("Results of Geyer()$fasteval and pairsat.family$eval do not match")
  + # ...
  + # and again for a non-integer value of 'sat'
  + # (spotted by Thordis Linda Thorarinsdottir)  
  +   G <- Geyer(0.11, 2.5)
  +   a <- pairsat.family$eval(X,U,EP,G$pot,G$par,"border")
  +   b <-          G$fasteval(X,U,EP,G$pot,G$par,"border")
  +   if(!all(a==b))
  +     stop("Results of Geyer()$fasteval and pairsat.family$eval do not match when sat is not an integer")
  + # and again for sat < 1
  + # (spotted by Rolf)  
  +   G <- Geyer(0.11, 0.5)
  +   a <- pairsat.family$eval(X,U,EP,G$pot,G$par,"border")
  +   b <-          G$fasteval(X,U,EP,G$pot,G$par,"border")
  +   if(!all(a==b))
  +     stop("Results of Geyer()$fasteval and pairsat.family$eval do not match when sat < 1")
  + })
  + }
  > 
  > #' tests/formuli.R
  > #'
  > #'  Test machinery for manipulating formulae
  > #' 
  > #' $Revision: 1.7 $  $Date: 2020/04/28 12:58:26 $
  > 
  > local({
  + 
  +   ff <- function(A, deletevar, B) {
  +     D <- reduceformula(A, deletevar)
  +     if(!spatstat.utils::identical.formulae(D, B)) {
  +       AD <- as.expression(substitute(reduceformula(A,d),
  +                                      list(A=A, d=deletevar)))
  +       stop(paste(AD, "\n\tyields ", spatstat.utils::pasteFormula(D),
  +                  " instead of ", spatstat.utils::pasteFormula(B)),
  +            call.=FALSE)
  +     }
  +     invisible(NULL)
  +   }
  + 
  +   ff(~ x + z, "x", ~z)
  + 
  +   ff(y ~ x + z, "x", y~z)
  + 
  +   ff(~ I(x^2) + z, "x",  ~z)
  + 
  +   ff(y ~ poly(x,2) + poly(z,3), "x", y ~poly(z,3))
  + 
  +   ff(y ~ x + z, "g", y ~ x + z)
  + 
  +   reduceformula(y ~ x+z, "g", verbose=TRUE)
  +   reduceformula(y ~ sin(x-z), "z", verbose=TRUE)
  +   
  +   illegal.iformula(~str*g, itags="str", dfvarnames=c("marks", "g", "x", "y"))
  + })
  The formula does not involve "g" and is therefore unchanged
  Don't know how to reduce the term "sin(x - z)"
  NULL
  > 
  > 
  > 
  > ##  
  > ##     tests/funnymarks.R
  > ##
  > ## tests involving strange mark values
  > ## $Revision: 1.7 $ $Date: 2020/04/28 12:58:26 $
  > 
  > if(ALWAYS) { # depends on locale
  + local({
  +   ## ppm() where mark levels contain illegal characters
  +   hyphenated <- c("a", "not-a")
  +   spaced <- c("U", "non U")
  +   suffixed <- c("a+", "a*")
  +   charred <- c("+", "*")
  + 
  +   irad <- matrix(0.1, 2,2)
  +   hrad <- matrix(0.005, 2, 2)
  + 
  +   tryit <- function(types, X, irad, hrad) { 
  +     levels(marks(X)) <- types
  +     fit <- ppm(X ~marks + polynom(x,y,2),
  +                MultiStraussHard(types=types,iradii=irad,hradii=hrad))
  +     print(fit)
  +     print(coef(fit))
  +     val <- fitted(fit)
  +     pred <- predict(fit)
  +     return(invisible(NULL))
  +   }
  + 
  +   tryit(hyphenated, amacrine, irad, hrad)
  +   tryit(spaced, amacrine, irad, hrad)
  +   tryit(suffixed, amacrine, irad, hrad)
  +   tryit(charred, amacrine, irad, hrad)
  + 
  +   ## marks which are dates
  +   X <- cells
  +   n <- npoints(X)
  +   endoftime <- rep(ISOdate(2001,1,1), n)
  +   eotDate   <- rep(as.Date("2001-01-01"), n)
  +   markformat(endoftime)
  +   markformat(eotDate)
  +   marks(X) <- endoftime
  +   print(X)
  +   Y <- X %mark% data.frame(id=1:42, date=endoftime, dd=eotDate)
  +   print(Y)
  +   md <- markformat(endoftime)
  +   
  +   ## mark formats
  +   Z <- Y
  +   marks(Z) <- marks(Z)[1,,drop=FALSE]
  +   ms <- markformat(solist(cells, redwood))
  +   marks(Z) <- factor(1:npoints(Z))
  +   marks(Z)[12] <- NA
  +   mz <- is.multitype(Z)
  +   cZ <- coerce.marks.numeric(Z)
  +   marks(Z) <- data.frame(n=1:npoints(Z),
  +                          a=factor(sample(letters, npoints(Z), replace=TRUE)))
  +   cZ <- coerce.marks.numeric(Z)
  +   stopifnot(is.multitype(cells %mark% data.frame(a=factor(1:npoints(cells)))))
  + 
  +   a <- numeric.columns(finpines)
  +   b1 <- numeric.columns(amacrine)
  +   b2 <- coerce.marks.numeric(amacrine)
  +   d <- numeric.columns(cells)
  +   f <- numeric.columns(longleaf)
  +   ff <- data.frame(a=factor(letters[1:10]), y=factor(sample(letters, 10)))
  +   numeric.columns(ff)
  + 
  +   ## mark operations
  +   df <- data.frame(x=1:2, y=sample(letters, 2))
  +   h <- hyperframe(z=1:2, p=solist(cells, cells))
  +   a <- NULL %mrep% 3
  +   a <- 1:4 %mrep% 3
  +   a <- df %mrep% 3
  +   a <- h %mrep% 3
  +   b <- markcbind(df, h)
  +   b <- markcbind(h, df)
  + })
  + }
  Nonstationary Multitype Strauss Hardcore process
  Fitted to point pattern dataset 'X'
  
  Possible marks: 'a' and 'not-a'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)  marksnot-a           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] a     not-a
  Interaction radii:
          a not-a
  a     0.1   0.1
  not-a 0.1   0.1
  Hardcore radii:
            a not-a
  a     0.005 0.005
  not-a 0.005 0.005
  Fitted interaction parameters gamma_ij
                a     not-a
  a     0.2699920 0.8920719
  not-a 0.8920719 0.2694374
  
  Relevant coefficients:
          markaxa     markaxnot.a marknot.axnot.a 
       -1.3093629      -0.1142086      -1.3114192 
  
  For standard errors, type coef(summary(x))
      (Intercept)      marksnot-a               x               y          I(x^2) 
        7.3741600       0.1223023       1.2302865       0.2403500      -0.7560707 
         I(x * y)          I(y^2)         markaxa     markaxnot.a marknot.axnot.a 
        0.3384324      -0.5425654      -1.3093629      -0.1142086      -1.3114192 
  Nonstationary Multitype Strauss Hardcore process
  Fitted to point pattern dataset 'X'
  
  Possible marks: 'U' and 'non U'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)  marksnon U           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] U     non U
  Interaction radii:
          U non U
  U     0.1   0.1
  non U 0.1   0.1
  Hardcore radii:
            U non U
  U     0.005 0.005
  non U 0.005 0.005
  Fitted interaction parameters gamma_ij
                U     non U
  U     0.2699920 0.8920719
  non U 0.8920719 0.2694374
  
  Relevant coefficients:
          markUxU     markUxnon.U marknon.Uxnon.U 
       -1.3093629      -0.1142086      -1.3114192 
  
  For standard errors, type coef(summary(x))
      (Intercept)      marksnon U               x               y          I(x^2) 
        7.3741600       0.1223023       1.2302865       0.2403500      -0.7560707 
         I(x * y)          I(y^2)         markUxU     markUxnon.U marknon.Uxnon.U 
        0.3384324      -0.5425654      -1.3093629      -0.1142086      -1.3114192 
  Nonstationary Multitype Strauss Hardcore process
  Fitted to point pattern dataset 'X'
  
  Possible marks: 'a+' and 'a*'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)     marksa*           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] a+ a*
  Interaction radii:
      a+  a*
  a+ 0.1 0.1
  a* 0.1 0.1
  Hardcore radii:
        a+    a*
  a+ 0.005 0.005
  a* 0.005 0.005
  Fitted interaction parameters gamma_ij
            a+        a*
  a+ 0.2699920 0.8920719
  a* 0.8920719 0.2694374
  
  Relevant coefficients:
      marka.xa.   marka.xa..1 marka..1xa..1 
     -1.3093629    -0.1142086    -1.3114192 
  
  For standard errors, type coef(summary(x))
    (Intercept)       marksa*             x             y        I(x^2) 
      7.3741600     0.1223023     1.2302865     0.2403500    -0.7560707 
       I(x * y)        I(y^2)     marka.xa.   marka.xa..1 marka..1xa..1 
      0.3384324    -0.5425654    -1.3093629    -0.1142086    -1.3114192 
  Nonstationary Multitype Strauss Hardcore process
  Fitted to point pattern dataset 'X'
  
  Possible marks: '+' and '*'
  
  Log trend:  ~marks + (x + y + I(x^2) + I(x * y) + I(y^2))
  
  Fitted trend coefficients:
  (Intercept)      marks*           x           y      I(x^2)    I(x * y) 
    7.3741600   0.1223023   1.2302865   0.2403500  -0.7560707   0.3384324 
       I(y^2) 
   -0.5425654 
  
  2 types of points
  Possible types:
  [1] + *
  Interaction radii:
      +   *
  + 0.1 0.1
  * 0.1 0.1
  Hardcore radii:
        +     *
  + 0.005 0.005
  * 0.005 0.005
  Fitted interaction parameters gamma_ij
            +         *
  + 0.2699920 0.8920719
  * 0.8920719 0.2694374
  
  Relevant coefficients:
      markX.xX.   markX.xX..1 markX..1xX..1 
     -1.3093629    -0.1142086    -1.3114192 
  
  For standard errors, type coef(summary(x))
    (Intercept)        marks*             x             y        I(x^2) 
      7.3741600     0.1223023     1.2302865     0.2403500    -0.7560707 
       I(x * y)        I(y^2)     markX.xX.   markX.xX..1 markX..1xX..1 
      0.3384324    -0.5425654    -1.3093629    -0.1142086    -1.3114192 
  Marked planar point pattern: 42 points
  marks are dates, of class 'POSIXt'
  window: rectangle = [0, 1] x [0, 1] units
  Marked planar point pattern: 42 points
  Mark variables: id, date, dd 
  window: rectangle = [0, 1] x [0, 1] units
  Warning messages:
  1: In is.multitype.ppp(Z) : some mark values are NA in the point pattern Z
  2: Factor-valued marks were converted to integer codes 
  3: Factor-valued mark variable 'a' was converted to integer codes 
  4: Factor-valued marks were converted to integer codes 
  > 
  > proc.time()
     user  system elapsed 
     3.95    0.81    4.75 
Running the tests in 'tests/testsNtoO.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/NAinCov.R
  > #
  > # Testing the response to the presence of NA's in covariates
  > #
  > # $Revision: 1.9 $ $Date: 2023/11/05 01:45:36 $
  > 
  > if(FULLTEST) {
  + local({
  +   X <- runifpoint(42)
  +   Y <- as.im(function(x,y) { x+y }, owin())
  +   Y[owin(c(0.2,0.4),c(0.2,0.4))] <- NA
  +   # fit model: should produce a warning but no failure
  +   misfit <- ppm(X ~Y, covariates=list(Y=Y))
  +   # prediction 
  +   Z <- predict(misfit, type="trend", se=TRUE)
  +   # covariance matrix: all should be silent
  +   v <- vcov(misfit)
  +   ss <- vcov(misfit, what="internals")
  + })
  + }
  > 
  > proc.time()
     user  system elapsed 
     1.56    0.14    1.70 
Running the tests in 'tests/testsP1.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/percy.R
  > ##
  > ## Tests of Percus-Yevick approximations
  > ##
  > ##    $Revision: 1.3 $ $Date: 2020/04/30 05:23:52 $
  > 
  > if(FULLTEST) {
  + local({
  +   fit <- ppm(swedishpines ~1, DiggleGatesStibbard(6))
  +   K <- Kmodel(fit)
  + })
  + }
  > 
  > ##
  > ## tests/pixelgripes.R
  > ##     Problems related to pixellation of windows
  > ##
  > ## $Revision: 1.8 $ $Date: 2022/10/23 06:21:10 $
  > 
  > if(FULLTEST) {
  +   local({
  +     
  +   ## From Philipp Hunziker: bug in rNeymanScott (etc)
  +   ## Create an irregular window
  +   PM <- matrix(c(1,0,0.5,1,0,0), 3, 2, byrow=TRUE)
  +   P <- owin(poly=PM)
  +   ## Generate Matern points
  +   X <- rMatClust(50, 0.05, 5, win=P)
  +   ## Some distance function as a covariate
  +   distorigin <- function(x, y) { sqrt(x^2 + y^2) }
  +   ## No covariates: works fine
  +   fit0 <- kppm(X ~ 1, clusters="MatClust")
  +   Y0 <- simulate(fit0, retry=0)
  +   ## Covariates: Simulation fails
  +   fit1 <- kppm(X ~ distorigin, clusters="MatClust")
  +   Y1 <- simulate(fit1, retry=0)
  + 
  + })
  + }
  > 
  > proc.time()
     user  system elapsed 
     1.45    0.35    1.79 
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: 0x0000020f6bb58f40>
  <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 
     7.06    1.92    8.96 
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.42    0.34    1.73 
Running the tests in 'tests/testsR2.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/rmhExpand.R
  > #
  > # test decisions about expansion of simulation window
  > #
  > #  $Revision: 1.9 $  $Date: 2022/10/23 01:17:33 $
  > #
  > 
  > local({
  +   if(FULLTEST) {
  +     ## check expansion in rmhmodel.ppm
  +     fit <- ppm(cells ~x)
  +     mod <- rmhmodel(fit)
  +     is.expandable(mod)
  +     wsim <- as.rectangle(mod$trend)
  +     ## work around changes in 'unitname'
  +     wcel <- as.owin(cells)
  +     unitname(wcel) <- unitname(cells)
  +     ## test
  +     if(!identical(wsim, wcel))
  +       stop("Expansion occurred improperly in rmhmodel.ppm")
  +   }
  + })
  > 
  > 
  > 
  > #
  > # tests/rmhTrend.R
  > #
  > #  Problems with trend images (rmhmodel.ppm or rmhEngine)
  > #
  > 
  > if(ALWAYS) {
  + local({
  +   set.seed(42)
  + 
  +   # Bug folder 37 of 8 feb 2011
  +   # rmhmodel.ppm -> predict.ppm
  +   # + rmhResolveTypes -> is.subset.owin
  + 
  +   Z <- rescale(demopat, 7000)
  +   X <- unmark(Z)
  +   X1 <- split(Z)[[1]]
  +   Int  <- density(X,dimyx=200)
  +   Lint <- eval.im(log(npoints(X1)*Int/npoints(X)))
  +   M    <- as.owin(Int)
  +   MR   <- intersect.owin(M,scalardilate(M,0.5,origin="midpoint"))
  +   X1 <- X1[MR]
  +   Fut  <- ppm(X1~offset(Lint),covariates=list(Lint=Lint),
  +               inter=BadGey(r=c(0.03,0.05),sat=3))
  +   Y   <- rmh(Fut,control=list(expand=M,nrep=1e3), verbose=FALSE)
  + 
  + })
  + }
  > #
  > #      tests/rmhmodel.ppm.R
  > #
  > #    $Revision: 1.10 $  $Date: 2020/05/01 05:29:42 $
  > #
  > # Case-by-case tests of rmhmodel.ppm
  > #
  > 
  > if(FULLTEST) {
  + local({
  + f <- ppm(cells)
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~x)
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, Strauss(0.1))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, StraussHard(r=0.1,hc=0.05))
  + m <- rmhmodel(f)
  + print(m)
  + 
  + f <- ppm(cells ~1, Hardcore(0.07))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, DiggleGratton(0.05,0.1))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, Softcore(0.5), correction="isotropic")
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, Geyer(0.07,2))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, BadGey(c(0.07,0.1,0.13),2))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, PairPiece(r = c(0.05, 0.1, 0.2)))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~1, AreaInter(r=0.06))
  + m <- rmhmodel(f)
  + print(m)
  + 
  + # multitype
  + 
  + r <- matrix(0.07, 2, 2)
  + f <- ppm(amacrine ~1, MultiStrauss(c("off","on"),r))
  + m <- rmhmodel(f)
  + print(m)
  + 
  + h <- matrix(min(nndist(amacrine))/2, 2, 2)
  + f <- ppm(amacrine ~1, MultiStraussHard(c("off","on"),r, h))
  + m <- rmhmodel(f)
  + 
  + diag(r) <- NA
  + diag(h) <- NA
  + f <- ppm(amacrine ~1, MultiStrauss(c("off","on"),r))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(amacrine ~1, MultiStraussHard(c("off","on"),r, h))
  + m <- rmhmodel(f)
  + 
  + # multitype data, interaction not dependent on type
  + 
  + f <- ppm(amacrine ~marks, Strauss(0.05))
  + m <- rmhmodel(f)
  + print(m)
  + 
  + # trends
  + 
  + f <- ppm(cells ~x, Strauss(0.1))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~y, StraussHard(r=0.1,hc=0.05))
  + m <- rmhmodel(f)
  + 
  + f <- ppm(cells ~x+y, Hardcore(0.07))
  + m <- rmhmodel(f)
  + print(m)
  + 
  + f <- ppm(cells ~polynom(x,y,2), Softcore(0.5), correction="isotropic")
  + m <- rmhmodel(f)
  + 
  + # covariates
  + 
  + Z <- as.im(function(x,y){ x^2+y^2 }, as.owin(cells))
  + f <- ppm(cells ~z, covariates=list(z=Z))
  + m <- rmhmodel(f)
  + m <- rmhmodel(f, control=list(p=1))
  + print(m)
  + 
  + Zim <- as.im(Z, as.owin(cells))
  + f <- ppm(cells ~z, covariates=list(z=Zim))
  + m <- rmhmodel(f)
  + 
  + Z <- as.im(function(x,y){ x^2+y }, as.owin(amacrine))
  + f <- ppm(amacrine ~z + marks, covariates=list(z=Z))
  + m <- rmhmodel(f)
  + print(m)
  + m <- rmhmodel(f, control=list(p=1))
  + m <- rmhmodel(f, control=list(p=1,fixall=TRUE))
  + print(m)
  + 
  + Zim <- as.im(Z, as.owin(amacrine))
  + f <- ppm(amacrine ~z + marks, covariates=list(z=Zim))
  + m <- rmhmodel(f)
  + print(m)
  + 
  + })
  + }
  > #
  > #    tests/rmhmodelHybrids.R
  > #
  > #  Test that rmhmodel.ppm and rmhmodel.default
  > #  work on Hybrid interaction models
  > #
  > #   $Revision: 1.6 $  $Date: 2022/10/23 01:17:56 $
  > #
  > 
  > if(ALWAYS) { # involves C code
  + local({
  +     
  +     ## ......... rmhmodel.ppm .......................
  +     fit1 <- ppm(redwood ~1,
  +                 Hybrid(A=Strauss(0.02), B=Geyer(0.1, 2), C=Geyer(0.15, 1)))
  +     m1 <- rmhmodel(fit1)
  +     m1
  +     reach(m1)
  + 
  +     ## Test of handling 'IsOffset' 
  +     fit2 <- ppm(cells ~1, Hybrid(H=Hardcore(0.05), G=Geyer(0.15, 2)))
  +     m2 <- rmhmodel(fit2)
  +     ## also test C code for hybrid interaction with hard core
  +     fakecells <- rmh(fit2, nrep=1e4)
  + 
  +     ## Test of handling Poisson components
  +     fit3 <- ppm(cells ~1, Hybrid(P=Poisson(), S=Strauss(0.05)))
  +     X3 <- rmh(fit3, control=list(nrep=1e3,expand=1), verbose=FALSE)
  + 
  + 
  + })
  + }
  Extracting model information...Evaluating trend...done.
  Extracting model information...Evaluating trend...done.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  > 
  > #
  > #  tests/rmh.ppm.R
  > #
  > #  $Revision: 1.5 $ $Date: 2020/05/01 05:29:42 $
  > #
  > #  Examples removed from rmh.ppm.Rd
  > #  stripped down to minimal tests of validity
  > #
  > 
  > local({
  +    op <- spatstat.options()
  +    spatstat.options(rmh.nrep=10, npixel=10, ndummy.min=10)
  +    spatstat.options(project.fast=TRUE)
  +    Nrep <- 10
  + 
  +    X <- swedishpines
  +    if(FULLTEST) {
  +      ## Poisson process
  +      fit <- ppm(X ~1, Poisson())
  +      Xsim <- rmh(fit)
  +    }
  +    if(ALWAYS) { # Gibbs model => C code
  +      ## Strauss process   
  +      fit <- ppm(X ~1, Strauss(r=7))
  +      Xsim <- rmh(fit)
  + 
  +      ## Strauss process simulated on a larger window
  +      ## then clipped to original window
  +      Xsim <- rmh(fit, control=list(nrep=Nrep, expand=1.1, periodic=TRUE))
  + 
  +      ## Extension of model to another window (thanks to Tuomas Rajala)
  +      Xsim <- rmh(fit, w=square(2))
  +      Xsim <- simulate(fit, w=square(2))
  +    
  +      ## Strauss - hard core process
  +      ##   fit <- ppm(X ~1, StraussHard(r=7,hc=2))
  +      ##   Xsim <- rmh(fit, start=list(n.start=X$n))
  + 
  +      ## Geyer saturation process
  +      ##   fit <- ppm(X ~1, Geyer(r=7,sat=2))
  +      ##   Xsim <- rmh(fit, start=list(n.start=X$n))
  + 
  +      ## Area-interaction process
  +      fit <- ppm(X ~1, AreaInter(r=7))
  +      Xsim <- rmh(fit, start=list(n.start=X$n))
  +   
  +      ## Penttinen process
  +      fit <- ppm(X ~1, Penttinen(r=7))
  +      Xsim <- rmh(fit, start=list(n.start=X$n))
  +   
  +      ## soft core interaction process
  +      ##     X <- quadscheme(X, nd=50)
  +      ##     fit <- ppm(X ~1, Softcore(kappa=0.1), correction="isotropic")
  +      ##     Xsim <- rmh(fit, start=list(n.start=X$n))
  + 
  +      ## Diggle-Gratton pairwise interaction model
  +      ##     fit <- ppm(cells ~1, DiggleGratton(0.05, 0.1))
  +      ##     Xsim <- rmh(fit, start=list(n.start=cells$n))
  +      ##     plot(Xsim, main="simulation from fitted Diggle-Gratton model")
  +    
  + 
  +      ## piecewise-constant pairwise interaction function
  +      X <- rSSI(0.05, 100)
  +      fit <- ppm(X ~1, PairPiece(seq(0.02, 0.1, by=0.01)))
  +      Xsim <- rmh(fit)
  +    }
  +    
  +    ## marked point pattern
  +    Y <- amacrine
  + 
  +    if(FULLTEST) {
  +      #' marked Poisson models
  +      fit <- ppm(Y)
  +      Ysim <- rmh(fit)
  + 
  +      fit <- ppm(Y~marks)
  +      Ysim <- rmh(fit)
  + 
  +      fit <- ppm(Y~x)
  +      Ysim <- rmh(fit)
  +      
  +      fit <- ppm(Y~marks+x)
  +      Ysim <- rmh(fit)
  +    }
  + 
  +    if(ALWAYS) {
  +      #' multitype Strauss
  +      typ <- levels(Y$marks)
  +      MS <- MultiStrauss(types = typ,
  +                         radii=matrix(0.07, ncol=2, nrow=2))
  + 
  +      fit <- ppm(Y~marks*x, MS)
  +      Ysim <- rmh(fit)
  + 
  +      #' multitype Hardcore
  +      h0 <- minnndist(unmark(Y)) * 0.95
  +      MH <- MultiHard(types = typ,
  +                      hradii=matrix(h0, ncol=2, nrow=2))
  +      fit <- ppm(Y ~ marks+x, MH)
  +      Ysim <- rmh(fit)
  +      #' other code blocks
  +      Ysim <- rmh(fit, control=list(periodic=TRUE, expand=1))
  +      Ysim <- rmh(fit, control=list(periodic=FALSE, expand=1))
  +      #' multihard core with invalid initial state
  +      Ydouble <- superimpose(Y, rjitter(Y, h0/10))
  +      Ysim <- rmh(fit, start=list(x.start=Ydouble))
  + 
  +      #' Lennard-Jones
  +      fut <- ppm(unmark(longleaf) ~ 1, LennardJones(), rbord=1)
  +      Ysim <- rmh(fut)
  +      Ysim <- rmh(fut, control=list(periodic=TRUE, expand=1))
  +    }
  +    
  +    spatstat.options(op)
  +  })
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Model is invalid - projecting it
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Evaluating trend integral...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Evaluating trend integral...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Evaluating trend integral...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Evaluating trend integral...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Evaluating trend integral...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  > 
  > 
  > reset.spatstat.options()
  > #'
  > #'   tests/rmhsnoopy.R
  > #'
  > #'   Test the rmh interactive debugger
  > #' 
  > #'   $Revision: 1.11 $  $Date: 2022/10/23 01:19:00 $
  > 
  > if(ALWAYS) { # may depend on platform
  + local({
  +   R <- 0.1
  +   ## fit a model and prepare to simulate
  +   model <- ppm(amacrine ~ marks + x, Strauss(R))
  +   siminfo <- rmh(model, preponly=TRUE)
  +   Wsim <- siminfo$control$internal$w.sim
  +   Wclip <- siminfo$control$internal$w.clip
  +   if(is.null(Wclip)) Wclip <- Window(cells)
  + 
  +   ## determine debugger interface panel geometry
  +   Xinit <- runifpoint(ex=amacrine)[1:40]
  +   P <- rmhsnoop(Wsim=Wsim, Wclip=Wclip, R=R,
  +                 xcoords=Xinit$x,
  +                 ycoords=Xinit$y,
  +                 mlevels=levels(marks(Xinit)),
  +                 mcodes=as.integer(marks(Xinit)) - 1L,
  +                 irep=3L, itype=1L,
  +                 proptype=1, proplocn=c(0.5, 0.5), propmark=0, propindx=0,
  +                 numerator=42, denominator=24,
  +                 panel.only=TRUE)
  +   boxes <- P$boxes
  +   clicknames <- names(P$clicks)
  +   boxcentres <- do.call(concatxy, lapply(boxes, centroid.owin))
  + 
  +   ## design a sequence of clicks
  +   actionsequence <- c("Up", "Down", "Left", "Right",
  +                       "At Proposal", "Zoom Out", "Zoom In", "Reset",
  +                       "Accept", "Reject", "Print Info",
  +                       "Next Iteration", "Next Shift", "Next Death",
  +                       "Skip 10", "Skip 100", "Skip 1000", "Skip 10,000",
  +                       "Skip 100,000", "Exit Debugger")
  +   actionsequence <- match(actionsequence, clicknames)
  +   actionsequence <- actionsequence[!is.na(actionsequence)]
  +   xy <- lapply(boxcentres, "[", actionsequence)
  + 
  +   ## queue the click sequence
  +   spatstat.utils::queueSpatstatLocator(xy$x,xy$y)
  + 
  +   ## go
  +   rmh(model, snoop=TRUE)
  + })
  + }
  Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Evaluating trend integral...Extracting model information...Evaluating trend...done.
  Checking arguments..determining simulation windows...Evaluating trend integral...Starting simulation.
  Initial state...
  Creating debugger environment..Done.
  Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  
  
  ------------------- 
  Iteration 0
  Simulation window:
  window: rectangle = [0, 1.6012085] x [0, 1] units (one unit = 662 microns)
  Clipping window:
  window: rectangle = [0, 1.6012085] x [0, 1] units (one unit = 662 microns)
  Current state:
  Marked planar point pattern: 72 points
  Multitype, with levels = off, on 
  window: rectangle = [0, 1.6012085] x [0, 1] units (one unit = 662 microns)
  Proposal type: Shift
  Shift data point 18 from current location (0.290108, 0.0160037, "off") to new 
  location (0.620599, 0.378428, "off")
  Hastings ratio =  6831.92992943083 / 14545.6615344214 = 0.469688498750194
  Fate of proposal: Rejected
  Marked planar point pattern: 350 points
  Multitype, with levels = off, on 
  window: rectangle = [0, 1.6012085] x [0, 1] units (one unit = 662 microns)
  Pattern was generated by Metropolis-Hastings simulation.
  > 
  > proc.time()
     user  system elapsed 
    11.68    1.00   12.68 
Running the tests in 'tests/testsT.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/testaddvar.R
  > #
  > # test addvar options
  > #
  > #   $Revision: 1.3 $  $Date: 2020/05/02 01:32:58 $
  > 
  > if(FULLTEST) {
  + local({
  +   X <-  rpoispp(function(x,y){exp(3+3*x)})
  +   model <- ppm(X ~y)
  +   addvar(model, "x", crosscheck=TRUE)
  +   addvar(model, "x", bw.input="quad")
  +   w <- square(0.5)
  +   addvar(model, "x", subregion=w)
  +   addvar(model, "x", subregion=w, bw.input="points")
  +   Z <- as.im(function(x,y) { x }, Window(X))
  +   addvar(model, Z)
  + })
  + }
  > #
  > #   tests/testparres.R
  > #
  > # additional test of parres
  > #
  > #  $Revision: 1.8 $  $Date: 2022/05/20 06:59:59 $
  > #
  > 
  > if(FULLTEST) {
  + local({
  + X <-  rpoispp(function(x,y){exp(3+x+2*x^2)})
  + model <- ppm(X ~x+y)
  + 
  + # options in parres (and code blocks in print.parres)
  + parres(model, "x")
  + parres(model, "x", smooth.effect=TRUE)
  + parres(model, "x", bw.input="quad")
  + w <- square(0.5)
  + parres(model, "x", subregion=w)
  + parres(model, "x", subregion=w, bw.input="quad")
  + f <- function(x,y) { x + y }
  + parres(model, f)
  + 
  + # check whether 'update.ppm' has messed up internals
  + mod2 <- update(model, ~x)
  + parres(mod2, "x")
  + 
  + #' other kinds of covariates
  + mod3 <- ppm(X ~ x + offset(y))
  + parres(mod3, "offset(y)")
  + Z <- distmap(runifpoint(3))
  + parres(mod3, Z)
  + mod4 <- ppm(X ~ sin(x), data=solist(B=Z))
  + parres(mod4, "sin(x)")
  + parres(mod4, "B")
  + 
  + #' models with interaction
  + mod5 <- ppm(cells ~ x, AreaInter(0.06))
  + parres(mod5, "x")
  + dlin <- distfun(copper$SouthLines)
  + copfit <- ppm(copper$SouthPoints ~ dlin, Geyer(1,1))
  + parres(copfit, "dlin")
  + 
  + #' covariate need not be specified if there is only one.
  + parres(mod5)
  + parres(copfit)
  + 
  + #' infrastructure
  + ltuae <- evaluateCovariate(42, cells)
  + LTUAE <- evaluateCovariate(ltuae, cells)
  + 
  + fit <- ppm(amacrine ~ x * marks, nd=16)
  + dmat <- model.depends(fit)
  + check.separable(dmat, "x", c(x=FALSE, marks=FALSE), FALSE)
  + check.separable(dmat, "x", c(FALSE, FALSE), FALSE)
  + check.separable(dmat, "x", c(x=FALSE, marks=TRUE), FALSE)
  + })
  + }
  > #'
  > #'     tests/threedee.R
  > #'
  > #'     Tests of 3D code 
  > #'
  > #'      $Revision: 1.8 $ $Date: 2020/05/02 01:32:58 $
  > #'
  > 
  > local({
  +   X <- runifpoint3(30)
  +   Y <- runifpoint3(20)
  +   if(FULLTEST) {
  +     A <- runifpoint3(10, nsim=2)
  +     Z <- ppsubset(X, 2:4)
  +   }
  +   ##
  +   if(ALWAYS) { # includes C code
  +     d <- pairdist(X, periodic=TRUE, squared=TRUE)
  +     d <- crossdist(X, Y, squared=TRUE)
  +     d <- crossdist(X, Y, squared=TRUE, periodic=TRUE)
  +     #' 
  +     h <- has.close(X, 0.2)
  +     h <- has.close(X, 0.2, periodic=TRUE)
  +     h <- has.close(X, 0.2, Y=Y)
  +     h <- has.close(X, 0.2, Y=Y, periodic=TRUE)
  +     #' code blocks not otherwise reached
  +     rmax <- 0.6 * max(nndist(X))
  +     g <- G3est(X, rmax=rmax, correction="rs")
  +     g <- G3est(X, rmax=rmax, correction="km")
  +     g <- G3est(X, rmax=rmax, correction="Hanisch")
  +     g <- G3est(X, rmax=rmax, sphere="ideal")
  +     g <- G3est(X, rmax=rmax, sphere="digital")
  +     v <- sphere.volume()
  +     v <- digital.volume()
  +     #' older code
  +     co <- coords(X)
  +     xx <- co$x
  +     yy <- co$y
  +     zz <- co$z
  +     gg1 <- g3engine(xx, yy, zz, correction="Hanisch G3")
  +     gg2 <- g3engine(xx, yy, zz, correction="minus sampling")
  +     ff1 <- f3engine(xx, yy, zz, correction="no")
  +     ff2 <- f3engine(xx, yy, zz, correction="minus sampling")
  +   }
  +   ##
  +   if(ALWAYS) {
  +     #'class support
  +     X <- runifpoint3(10)
  +     print(X)
  +     print(X %mark% runif(10))
  +     print(X %mark% factor(letters[c(1:5,5:1)]))
  +     print(X %mark% data.frame(a=1:10, b=runif(10)))
  +     da <- as.Date(paste0("2020-01-0", c(1:5,5:1)))
  +     print(X %mark% da)
  +     print(X %mark% data.frame(a=1:10, b=da))
  +   }
  + })
  Three-dimensional point pattern: 10 points
  Box: [0, 1] x [0, 1] x [0, 1] units
  Marked three-dimensional point pattern: 10 points
  marks are numeric, of storage type  'double'
  Box: [0, 1] x [0, 1] x [0, 1] units
  Marked three-dimensional point pattern: 10 points
  Multitype, with levels = a, b, c, d, e 
  Box: [0, 1] x [0, 1] x [0, 1] units
  Marked three-dimensional point pattern: 10 points
  Mark variables: a, b 
  Box: [0, 1] x [0, 1] x [0, 1] units
  Marked three-dimensional point pattern: 10 points
  marks are dates, of class 'Date'
  Box: [0, 1] x [0, 1] x [0, 1] units
  Marked three-dimensional point pattern: 10 points
  Mark variables: a, b 
  Box: [0, 1] x [0, 1] x [0, 1] units
  Warning messages:
  1: In G3est: unrecognised argument 'sphere' was ignored 
  2: In G3est: unrecognised argument 'sphere' was ignored 
  > #
  > # tests/triplets.R
  > #
  > # test code for triplet interaction 
  > #
  > # $Revision: 1.9 $ $Date: 2022/05/22 08:45:38 $
  > #
  > if(ALWAYS) { # C code, platform dependence
  + local({
  +   #' valid model
  +   fit <- ppm(cells ~1, Triplets(0.1))
  +   fit
  +   suffstat(fit)
  +   #' invalid model 
  +   fitR <- ppm(redwood ~1, Triplets(0.1))
  +   fitR
  +   suffstat(fitR)
  +   #' hard core (zero triangles, coefficient is NA)
  +   fit0 <- ppm(cells ~1, Triplets(0.05))
  +   fit0
  +   suffstat(fit0)
  +   #' bug case (1 triangle in data)
  +   fit1 <- ppm(cells ~1, Triplets(0.15))
  +   fit1
  +   suffstat(fit1)
  +   #' simulation
  +   X <- simulate(fit)
  +   mod <- list(cif="triplets",par=list(beta=50,gamma=0.2,r=0.07), w=square(1))
  +   Xm <- rmh(model=mod,start=list(n.start=5), control=list(nrep=1e5))
  +   #' hard core
  +   mod$par$gamma <- 0
  +   XmHard <- rmh(model=mod,start=list(n.start=5), control=list(nrep=1e5))
  + })
  + }
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  Checking arguments..determining simulation windows...Starting simulation.
  Initial state...Ready to simulate. Generating proposal points...Running Metropolis-Hastings.
  > 
  > proc.time()
     user  system elapsed 
     3.68    0.31    3.98