R Under development (unstable) (2023-10-18 r85349 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2023 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.geom
> #'   Obtain environment variable controlling tests.
> #'
> #'   $Revision: 1.5 $ $Date: 2020/04/30 05:31:37 $
> 
> require(spatstat.geom)
Loading required package: spatstat.geom
Loading required package: spatstat.data
spatstat.geom 3.2-7
> 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/dominic.R
> #'
> #'   Additional tests for Dominic Schuhmacher's code
> #'
> #'   $Revision: 1.5 $  $Date: 2020/12/03 03:23:25 $
> 
> if(ALWAYS) {   # tests C code
+ local({
+   X <- runifrect(10)
+   Y <- runifrect(10)
+ 
+   d  <- pppdist(X, Y, type="ace", show.rprimal=TRUE)
+   a <- matchingdist(d, type="ace")
+   b <- matchingdist(d, type="mat")
+ 
+   d2 <- pppdist(X, Y, type="spa", ccode=FALSE)
+   d2 <- pppdist(X, Y, type="spa", ccode=TRUE, auction=FALSE)
+   d3 <- pppdist(X, Y, type="mat", ccode=TRUE, auction=FALSE)
+   d4 <- pppdist(X[FALSE], Y[FALSE], matching=TRUE, type="spa")
+   d4 <- pppdist(X[FALSE], Y[FALSE], matching=FALSE, type="spa")
+   d4 <- pppdist(X[FALSE], Y[FALSE], matching=TRUE, type="ace")
+   d4 <- pppdist(X[FALSE], Y[FALSE], matching=FALSE, type="ace")
+ 
+   m  <- pppdist.mat(X, Y, q=Inf, cutoff=0.001)
+   m2 <- pppdist.mat(X[FALSE], Y[FALSE], q=Inf, cutoff=0.001)
+   m3 <- pppdist.mat(X[FALSE], Y[FALSE], q=2, cutoff=0.001)
+ 
+ })
+ }
Warning message:
In pppdist.mat(X, Y, q = Inf, cutoff = 0.001) :
  distance with parameter q = Inf is approximated by distance with parameter q = 10
> 
> 
> 
> #'
> #'   tests/duplicity.R
> #'
> #'  Tests of duplicated/multiplicity code
> #'
> #' $Revision: 1.8 $ $Date: 2020/04/28 12:58:26 $
> 
> if(ALWAYS) {
+ local({
+    X <- ppp(c(1,1,0.5,1), c(2,2,1,2), window=square(3), check=FALSE)
+    Y <- X %mark% factor(letters[c(3,2,4,3)])
+    ZC <- X %mark% letters[c(3,2,4,3)]
+    ZM <- Y %mark% matrix(c(3,2,4,3), 4, 2)
+    ZD <- Y %mark% as.data.frame(marks(ZM))
+ 
+    #' multiplicity
+    m <- multiplicity(X)
+    mf <- multiplicity(Y)
+    mm <- multiplicity(ZM)
+    mz <- multiplicity(ZD)
+    mc <- multiplicity(ZC)
+    ## default method
+    kk <- c(1,2,3,1,1,2)
+    mk <- multiplicity(kk)
+    ml <- multiplicity(list(sin, cos, tan)[kk])
+    mc <- multiplicity(c("sin", "cos", "tan")[kk])
+    if(!identical(ml, mk))
+      stop("multiplicity.default(<list>) disagrees with multiplicityNumeric")
+    if(!identical(mc, mk))
+      stop("multiplicity(<character>) disagrees with multiplicity(<numeric>)")
+    ## data frame method
+    df <- data.frame(x=c(1:4, 1,3,2,4, 0,0, 3,4),
+                     y=factor(rep(letters[1:4], 3)))
+    md <- multiplicity(df)
+ 
+    ## uniquemap.ppp
+    checkum <- function(X, blurb) {
+      a <- uniquemap(X)
+      if(any(a > seq_along(a)))
+        stop(paste("uniquemap", blurb,
+                   "does not respect sequential ordering"))
+      return(invisible(NULL))
+    }
+    checkum(X, "<unmarked point pattern>")
+    checkum(Y, "<multitype point pattern>")
+    checkum(ZC, "<point pattern with character marks>")
+    checkum(ZM, "<point pattern with matrix of marks>")
+    checkum(ZD, "<point pattern with several columns of marks>")
+ 
+    ## uniquemap.data.frame
+    dfbase <- as.data.frame(replicate(3, sample(1:20, 10), simplify=FALSE))
+    df <- dfbase[sample(1:10, 30, replace=TRUE), , drop=FALSE]
+    #' faster algorithm for numeric values
+    checkum(df, "<numeric data frame>")
+    a <- uniquemap(df)
+    #' general algorithm using 'duplicated' and 'match'
+    dfletters <- as.data.frame(matrix(letters[as.matrix(df)], nrow=nrow(df)))
+    checkum(dfletters, "<character data frame>")
+    b <- uniquemap(dfletters)
+    if(!isTRUE(all.equal(a,b)))
+      stop("inconsistency between algorithms in uniquemap.data.frame")
+ 
+    ## uniquemap.matrix
+    M0 <- matrix(1:12, 3, 4)
+    ii <- sample(1:3, 5, replace=TRUE)
+    M4 <- M0[ii, , drop=FALSE]
+    checkum(M4, "<integer matrix>")
+    u4 <- uniquemap(M4)
+    C4 <- matrix(letters[M4], 5, 4)
+    uc4 <- uniquemap(C4)
+    checkum(C4, "<character matrix>")
+    if(!isTRUE(all.equal(u4, uc4)))
+      stop("Inconsistency between algorithms in uniquemap.matrix")
+    
+    ## uniquemap.default
+    a <- letters[c(1, 1:4, 3:2)]
+    checkum(a, "<character>")
+    checkum(as.list(a), "<list>")
+    u1 <- uniquemap(a)
+    u2 <- uniquemap(as.list(a))
+    if(!isTRUE(all.equal(u1, u2)))
+      stop("Inconsistency between algorithms in uniquemap.default")
+ })
+ }
> 
> proc.time()
   user  system elapsed 
   1.96    0.28    2.21