Running ‘testsAtoC.R’ [4s/5s]
  Running ‘testsD.R’ [17s/23s]
  Running ‘testsEtoF.R’ [8s/10s]
  Running ‘testsGtoJ.R’ [3s/3s]
  Running ‘testsK.R’ [4s/5s]
  Running ‘testsL.R’ [50s/63s]
  Running ‘testsM.R’ [8s/11s]
  Running ‘testsNtoO.R’ [3s/3s]
  Running ‘testsP1.R’ [3s/3s]
  Running ‘testsP2.R’ [13s/15s]
  Running ‘testsQ.R’ [3s/3s]
  Running ‘testsR1.R’ [4s/5s]
  Running ‘testsR2.R’ [18s/19s]
  Running ‘testsS.R’ [3s/4s]
  Running ‘testsT.R’ [6s/7s]
  Running ‘testsUtoZ.R’ [20m/26m]
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-1
  Loading required package: spatstat.random
  spatstat.random 3.1-5
  Loading required package: spatstat.explore
  Loading required package: nlme
  spatstat.explore 3.2-1
  Loading required package: rpart
  spatstat.model 3.2-4
  > 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: 0x5620dc0aae88>
  >   
  > 
  > ##
  > ##  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 
    7.745   0.647   9.719 
  Assertion failure at kmp_runtime.cpp(6918): temp_reg_status_file_name.
  OMP: Error #13: Assertion failure at kmp_runtime.cpp(6918).
  OMP: Hint Please submit a bug report with this message, compile and run commands used, and machine configuration info including native compiler and operating system versions. Faster response will be obtained by including all program sources. For information on submitting this issue, please see https://bugs.llvm.org/.
  Assertion failure at kmp_runtime.cpp(6918): temp_reg_status_file_name.
  OMP: Error #13: Assertion failure at kmp_runtime.cpp(6918).
  OMP: Hint Please submit a bug report with this message, compile and run commands used, and machine configuration info including native compiler and operating system versions. Faster response will be obtained by including all program sources. For information on submitting this issue, please see https://bugs.llvm.org/.
  Killed