R Under development (unstable) (2024-07-05 r86875 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.explore
> #'   Obtain environment variable controlling tests.
> #'
> #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
> 
> require(spatstat.explore)
Loading required package: spatstat.explore
Loading required package: spatstat.data
Loading required package: spatstat.univar
spatstat.univar 3.0-0
Loading required package: spatstat.geom
spatstat.geom 3.3-1
Loading required package: spatstat.random
spatstat.random 3.3-0
Loading required package: nlme
spatstat.explore 3.3-0
> 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/markcor.R
> ##
> ##   Tests of mark correlation code (etc)
> ##
> ## $Revision: 1.7 $ $Date: 2020/11/25 01:23:32 $
> 
> local({
+   if(ALWAYS) {
+     ## check.testfun checks equality of functions
+     ##  and is liable to break if the behaviour of all.equal is changed
+     fe <- function(m1, m2) {m1 == m2}
+     fm <- function(m1, m2) {m1 * m2}
+     fs <- function(m1, m2) {sqrt(m1)}
+     if(check.testfun(fe, X=amacrine)$ftype != "equ")
+       warning("check.testfun fails to recognise mark equality function")
+     if(check.testfun(fm, X=longleaf)$ftype != "mul")
+       warning("check.testfun fails to recognise mark product function")
+     check.testfun(fs, X=longleaf)
+     check.testfun("mul")
+     check.testfun("equ")
+   }
+ 
+   if(FULLTEST) {
+     ## test all is well in Kmark -> Kinhom 
+     MA <- Kmark(amacrine,function(m1,m2){m1==m2})
+     set.seed(42)
+     AR <- rlabel(amacrine)
+     MR <- Kmark(AR,function(m1,m2){m1==m2})
+     if(isTRUE(all.equal(MA,MR)))
+       stop("Kmark unexpectedly ignores marks")
+ 
+     ## cover code blocks in markcorr()
+     X <- runifpoint(100) %mark% runif(100)
+     Y <- X %mark% data.frame(u=runif(100), v=runif(100))
+     ww <- runif(100)
+     fone <- function(x) { x/2 }
+     ffff <- function(x,y) { fone(x) * fone(y) }
+     aa <- markcorr(Y)
+     bb <- markcorr(Y, ffff, weights=ww, normalise=TRUE)
+     bb <- markcorr(Y, ffff, weights=ww, normalise=FALSE)
+     bb <- markcorr(Y, f1=fone, weights=ww, normalise=TRUE)
+     bb <- markcorr(Y, f1=fone, weights=ww, normalise=FALSE)
+ 
+     ## markcrosscorr
+     a <- markcrosscorr(betacells, normalise=FALSE)
+     if(require(sm)) {
+       b <- markcrosscorr(betacells, method="sm")
+     }
+ 
+     ## Vmark with normalisation
+     v <- Vmark(spruces, normalise=TRUE)
+     v <- Vmark(finpines, normalise=TRUE)
+   }
+ })
Warning messages:
1: In eval(quote({ :
  check.testfun fails to recognise mark equality function
2: In eval(quote({ :
  check.testfun fails to recognise mark product function
> #' tests/mctests.R
> #' Monte Carlo tests
> #'        (mad.test, dclf.test, envelopeTest, hasenvelope)
> #' $Revision: 1.5 $ $Date: 2022/05/23 04:09:49 $
> 
> local({
+   if(FULLTEST) {
+     envelopeTest(cells, Lest, exponent=1, nsim=9, savepatterns=TRUE)
+     (a3 <- envelopeTest(cells, Lest, exponent=3, nsim=9, savepatterns=TRUE))
+     
+     envelopeTest(a3, Lest, exponent=3, nsim=9, alternative="less")
+     
+     envelopeTest(redwood, Lest, exponent=1, nsim=19,
+                  rinterval=c(0, 0.1), alternative="greater", clamp=TRUE)
+     envelopeTest(redwood, pcf, exponent=Inf, nsim=19,
+                  rinterval=c(0, 0.1), alternative="greater", clamp=TRUE)
+   }
+ })
> 
> 
> 
> proc.time()
   user  system elapsed 
   1.34    0.29    1.62