R Under development (unstable) (2024-09-18 r87177 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> #'
> #'   Header for all (concatenated) test files
> #'
> #'   Require spatstat.linnet
> #'   Obtain environment variable controlling tests.
> #'
> #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
> 
> require(spatstat.linnet)
Loading required package: spatstat.linnet
Loading required package: spatstat.data
Loading required package: spatstat.univar
spatstat.univar 3.0-1
Loading required package: spatstat.geom
spatstat.geom 3.3-3
Loading required package: spatstat.random
spatstat.random 3.3-2
Loading required package: spatstat.explore
Loading required package: nlme
spatstat.explore 3.3-2
Loading required package: spatstat.model
Loading required package: rpart
spatstat.model 3.3-2
spatstat.linnet 3.2-2
> 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/aucroc.R
> #'
> #'  AUC and ROC code
> #'
> #'  $Revision: 1.6 $ $Date: 2020/11/02 06:26:45 $
> 
> local({
+   if(FULLTEST) {
+     A <- roc(spiders, "x")
+     B <- auc(spiders, "y")
+     fut <- lppm(spiders ~ I(y-x))
+     f <- roc(fut)
+     g <- auc(fut)
+   }
+ })
> ## tests/cdf.test.R
> 
> 
> local({
+   NSIM <- 9
+   op <- spatstat.options(ndummy.min=16, npixel=32)
+   op <- spatstat.options(ndummy.min=16, npixel=32)
+   if(ALWAYS) {
+     ## (3) linear networks
+     set.seed(42)
+     X <- runiflpp(20, simplenet)
+     cdf.test(X, "x")
+     if(FULLTEST) {
+       cdf.test(X, "x", "cvm")
+       cdf.test(X %mark% runif(20), "x")
+     }
+     fit <- lppm(X ~1)
+     cdf.test(fit, "y", "cvm", nsim=NSIM)
+     if(FULLTEST) {
+       cdf.test(fit, "y", nsim=NSIM)
+       cdf.test(fit, "y", "ad", nsim=NSIM)
+     }
+     if(FULLTEST) {
+       ## marked
+       cdf.test(chicago, "y")
+       cdf.test(subset(chicago, marks != "assault"), "y")
+     }
+   }
+   reset.spatstat.options()
+ })
> 
> 
> #'
> #'   tests/cluck.R
> #'
> #'   Tests of "click*" functions
> #'   using queueing feature of spatstatLocator
> #'
> #'   $Revision: 1.8 $ $Date: 2022/10/23 00:45:36 $
> 
> local({
+   Y <- coords(runiflpp(6, simplenet))
+   if(FULLTEST) {
+     #' clicklpp
+     spatstat.utils::queueSpatstatLocator(Y)
+     XL <- clicklpp(simplenet)
+   }
+   if(ALWAYS) {
+     spatstat.utils::queueSpatstatLocator(Y)
+     XM <- clicklpp(simplenet, n=3, types=c("a", "b"))
+   }
+   if(ALWAYS) {
+     #' lineardisc
+     plot(simplenet)
+     spatstat.utils::queueSpatstatLocator(as.ppp(runiflpp(1, simplenet)))
+     V <- lineardisc(simplenet, r=0.3)
+   }
+ })
Ready to click..
> #'
> #'   tests/disconnected.R
> #'
> #'   disconnected linear networks
> #'
> #'    $Revision: 1.4 $ $Date: 2020/04/28 12:58:26 $
> 
> 
> local({
+ 
+   #'   disconnected network
+   m <- simplenet$m
+   m[4,5] <- m[5,4] <- m[6,10] <- m[10,6] <- m[4,6] <- m[6,4] <- FALSE
+   L <- linnet(vertices(simplenet), m)
+   if(FULLTEST) {
+     L
+     summary(L)
+     is.connected(L)
+     Z <- connected(L, what="components")
+   }
+ 
+   #' point pattern with no points in one connected component
+   set.seed(42)
+   X <- rpoislpp(lambda=function(x,y) { 10 * (x < 0.5)}, L)
+   B <- lineardirichlet(X)
+   if(FULLTEST) {
+     plot(B)
+     summary(B)
+   }
+   if(ALWAYS) {
+     D <- pairdist(X)
+     A <- nndist(X)
+   }
+   if(FULLTEST) {
+     H <- nnwhich(X)
+     Y <- rpoislpp(lambda=function(x,y) { 10 * (x < 0.5)}, L)
+     G <- nncross(X, Y)
+     J <- crossdist(X, Y)
+     plot(distfun(X))  # includes evaluation of nncross(what="dist")
+   }
+   
+   #' K functions in disconnected network
+   if(ALWAYS) {
+     K <- linearK(X)
+     lamX <- intensity(X)
+     nX <- npoints(X)
+     KI <- linearKinhom(X, lambda=rep(lamX, nX))
+     P <- linearpcf(X)
+     PJ <- linearpcfinhom(X, lambda=rep(lamX, nX))
+   }
+   Y <- X %mark% factor(rep(1:2, nX)[1:nX])
+   if(FULLTEST) {
+     Y1 <- split(Y)[[1]]
+     Y2 <- split(Y)[[2]]
+     KY <- linearKcross(Y)
+     PY <- linearpcfcross(Y)
+     KYI <- linearKcross.inhom(Y, lambdaI=rep(intensity(Y1), npoints(Y1)),
+                               lambdaJ=rep(intensity(Y2), npoints(Y2)))
+     PYI <- linearpcfcross.inhom(Y, lambdaI=rep(intensity(Y1), npoints(Y1)),
+                                 lambdaJ=rep(intensity(Y2), npoints(Y2)))
+   }
+ 
+   #' internal utilities
+   if(FULLTEST) {
+     K <- ApplyConnected(X, linearK, rule=function(...) list())
+   }
+ })
Warning message:
Network is not connected 
> 
> 
> #
> #  tests/envelopes.R
> #
> #  Test validity of envelope data
> #
> #  $Revision: 1.29 $  $Date: 2024/01/10 13:45:29 $
> #
> 
> local({
+   
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ if(FULLTEST) {
+   X <- runiflpp(10, simplenet)
+   Xr <- X %mark% runif(10)
+   Xc <- X %mark% factor(letters[c(1:4,3,2,4:1)])
+   X2 <- X %mark% data.frame(height=runif(10), width=runif(10))
+ 
+   E  <- envelope(X,  linearK, nsim=9)
+   Er <- envelope(Xr, linearK, nsim=9)
+   Ec <- envelope(Xc, linearK, nsim=9)
+   E2 <- envelope(X2, linearK, nsim=9)
+   
+   Erf <- envelope(Xr, linearK, nsim=9, fix.n=TRUE)
+   E2f <- envelope(X2, linearK, nsim=9, fix.n=TRUE)
+ 
+   Ecf <- envelope(Xc, linearK,      nsim=9, fix.n=TRUE)
+   Ecm <- envelope(Xc, linearKcross, nsim=9, fix.n=TRUE, fix.marks=TRUE)
+ 
+   fut <- lppm(Xc ~ marks)
+   EEf <- envelope(fut, linearK,      fix.n=TRUE)
+   EEm <- envelope(fut, linearKcross, fix.n=TRUE, fix.marks=TRUE)
+ }
+ 
+ ## close 'local'
+ })
> #
> #  tests/func.R
> #
> #   $Revision: 1.9 $   $Date: 2022/10/23 00:48:40 $
> #
> #  Tests of 'funxy' infrastructure etc
> 
> if(FULLTEST) {
+ local({
+   ## Check the peculiar function-building code in funxy
+   W <- square(1)
+   f1a <- function(x, y) sqrt(x^2 + y^2)
+   F1a <- funxy(f1a, W)
+   Y <- runiflpp(5, simplenet)
+   b <- F1a(Y)
+ })
+ }
> 
> 
> #'     tests/hypotests.R
> #'     Hypothesis tests
> #' 
> #'  $Revision: 1.10 $ $Date: 2023/07/17 07:30:48 $
> 
> if(FULLTEST) {
+ local({
+   berman.test(spiders, "x")
+   berman.test(lppm(spiders ~ x), "y")
+ 
+ })
+ }
> #
> #  tests/imageops.R
> #
> #   $Revision: 1.43 $   $Date: 2023/08/29 01:03:59 $
> #
> 
> 
> 
> if(FULLTEST) {
+   local({
+     d <- distmap(cells, dimyx=32)
+     ## linear networks
+     ee  <- d[simplenet, drop=FALSE]
+     eev <- d[simplenet]
+   })
+ }
> 
> proc.time()
   user  system elapsed 
   2.62    0.48    3.07