R Under development (unstable) (2024-06-16 r86763 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.

> #'   spatstat.utils/tests/numerical.R
> #'   Tests of numerical code
> 
> require(spatstat.utils)
Loading required package: spatstat.utils
> 
> #' validity of orderstats, orderwhich
> x <- unique(runif(100))
> if(!all(orderstats(x, 2:5) == sort(x)[2:5]))
+   stop("Incorrect result from orderstats()")
> if(!all(orderwhich(x, 2:5) == order(x)[2:5]))
+   stop("Incorrect result from orderwhich()")
> if(!all(orderstats(x, 2:5, decreasing=TRUE) == sort(x, decreasing=TRUE)[2:5]))
+   stop("Incorrect result from orderstats(decreasing=TRUE)")
> if(!all(orderwhich(x, 2:5, decreasing=TRUE) == order(x, decreasing=TRUE)[2:5]))
+   stop("Incorrect result from orderwhich(decreasing=TRUE)")
> y <- fave.order(x)
> 
> #' must handle NA's without exiting
> x[c(4, 7, 42)] <- NA
> aa <- orderstats(x, 2:5)
> aa <- orderstats(x, 2:5, decreasing=TRUE)
> bb <- orderwhich(x, 2:5)
> bb <- orderwhich(x, 2:5, decreasing=TRUE)
> x[] <- NA
> uu <- orderstats(x, 2:5)
> uu <- orderstats(x, 2:5, decreasing=TRUE)
> vv <- orderwhich(x, 2:5)
> vv <- orderwhich(x, 2:5, decreasing=TRUE)
> 
> #' validity of 'tapplysum'
> aa <- factor(letters[1:3])
> bb <- factor(letters[1:4])[c(1,2,2)]
> xx <- round(runif(3), 3)
> yy <- tapplysum(xx, list(A=aa, B=bb), do.names=TRUE)
> zz <- tapply(xx, list(A=aa, B=bb), sum)
> zz[is.na(zz)] <- 0
> if(any(yy != zz))
+   stop("tapplysum does not agree with tapply(, sum)")
> #' tapplysum with zero-length data
> tapplysum(xx[FALSE], list(A=aa[FALSE], B=bb[FALSE]), do.names=TRUE)
   B
A   a b c d
  a 0 0 0 0
  b 0 0 0 0
  c 0 0 0 0
> #' tapplysum with NA values in x
> xx <- runif(12)
> aa <- rep(aa, 4)
> bb <- rep(bb, 4)
> ee <- sample(aa)
> ff <- sample(bb)
> xx[2] <- NA
> uu1 <- tapplysum(xx, list(aa),             do.names=TRUE)
> uu2 <- tapplysum(xx, list(aa, bb),         do.names=TRUE)
> uu3 <- tapplysum(xx, list(aa, bb, ee),     do.names=TRUE)
> uu4 <- tapplysum(xx, list(aa, bb, ee, ff), do.names=TRUE)
> 
> #' validity of matchIntegerDataFrames
> #' 3 columns
> A <- data.frame(a=sample(1:5), b=sample(1:5, replace=TRUE), c=3)
> B <- data.frame(u=sample(1:3), w=3:1,                       v=1)
> A[4,] <- B[2,]
> a3code <- paste(A[,1], A[,2], A[,3])
> b3code <- paste(B[,1], B[,2], B[,3])
> stopifnot(identical(matchIntegerDataFrames(A,B,TRUE), match(a3code,b3code)))
> stopifnot(identical(matchIntegerDataFrames(A,B,FALSE), match(a3code,b3code)))
> #' 2 columns
> A <- A[,1:2]
> B <- B[,1:2]
> a2code <- paste(A[,1], A[,2])
> b2code <- paste(B[,1], B[,2])
> stopifnot(identical(matchIntegerDataFrames(A,B,TRUE), match(a2code,b2code)))
> stopifnot(identical(matchIntegerDataFrames(A,B,FALSE), match(a2code,b2code)))
> #' 1 column
> A <- A[,1, drop=FALSE]
> B <- B[,1, drop=FALSE]
> a1code <- paste(A[,1])
> b1code <- paste(B[,1])
> stopifnot(identical(matchIntegerDataFrames(A,B,TRUE), match(a1code,b1code)))
> stopifnot(identical(matchIntegerDataFrames(A,B,FALSE), match(a1code,b1code)))
> 
> #'  code in utilseq.R
> 
> dropifsingle(list(42))
[1] 42
> dropifsingle(1:2)
[1] 1 2
> 
> revcumsum(1:5 * (1 + 2i))
[1] 15+30i 14+28i 12+24i  9+18i  5+10i
> 
> as2vector(3:4)
[1] 3 4
> as2vector(list(x=1, y=1))
[1] 1 1
> ensure2vector(3:4)
[1] 3 4
> ensure2vector(3)
[1] 3 3
> 
> prolongseq(2:5, newrange=c(1,9))
[1] 1 2 3 4 5 6 7 8 9
attr(,"nleft")
[1] 1
attr(,"nright")
[1] 4
> 
> fillseq(c(1:3, 5:7, 9))
$xnew
[1] 1 2 3 4 5 6 7 8 9

$i
[1] 1 2 3 5 6 7 9

> 
> geomseq(0.5, 2, 10)
 [1] 0.5000000 0.5832645 0.6803950 0.7937005 0.9258747 1.0800597 1.2599210
 [8] 1.4697345 1.7144880 2.0000000
> 
> check.in.range(4, c(1,10))
[1] TRUE
> 
> startinrange(runif(1), 1, c(3, 7))
[1] 5.187081
> 
> prettyinside(runif(10,max=5))
[1] 1 2 3 4
> 
> prettydiscrete(letters)
 [1] "a" "c" "e" "g" "i" "k" "m" "o" "q" "s"
> 
> evenly.spaced(seq(0, 1, length.out=7))
[1] TRUE
> 
> equispaced(seq(0, 1, length.out=7))
[1] TRUE
Warning message:
In equispaced(seq(0, 1, length.out = 7)) : 'equispaced' is deprecated.
Use 'evenly.spaced' instead.
See help("Deprecated")
> 
> adjustthinrange(c(0.0000001, 0.999999), 1, c(0,1))
[1] 0 1
> 
> fastFindInterval(runif(100), seq(0,1,length.out=8), labels=TRUE, dig.lab=2)
  [1] [0.71,0.86) [0.43,0.57) [0,0.14)    [0.14,0.29) [0.14,0.29) [0,0.14)   
  [7] [0.43,0.57) [0.71,0.86) [0.43,0.57) [0.43,0.57) [0.14,0.29) [0.14,0.29)
 [13] [0.71,0.86) [0,0.14)    [0.71,0.86) [0,0.14)    [0,0.14)    [0.71,0.86)
 [19] [0,0.14)    [0.86,1]    [0.86,1]    [0.86,1]    [0.71,0.86) [0.29,0.43)
 [25] [0.57,0.71) [0.43,0.57) [0.43,0.57) [0.57,0.71) [0.71,0.86) [0.86,1]   
 [31] [0.43,0.57) [0.14,0.29) [0.14,0.29) [0.57,0.71) [0.14,0.29) [0.43,0.57)
 [37] [0.43,0.57) [0.29,0.43) [0.43,0.57) [0.57,0.71) [0.29,0.43) [0.71,0.86)
 [43] [0.71,0.86) [0.43,0.57) [0.86,1]    [0.71,0.86) [0.86,1]    [0.14,0.29)
 [49] [0.14,0.29) [0,0.14)    [0.29,0.43) [0.29,0.43) [0.71,0.86) [0.86,1]   
 [55] [0.14,0.29) [0.86,1]    [0.57,0.71) [0.14,0.29) [0.43,0.57) [0.71,0.86)
 [61] [0.86,1]    [0.57,0.71) [0,0.14)    [0.71,0.86) [0.43,0.57) [0.86,1]   
 [67] [0.71,0.86) [0.29,0.43) [0.14,0.29) [0.29,0.43) [0.57,0.71) [0.43,0.57)
 [73] [0.71,0.86) [0.14,0.29) [0.43,0.57) [0.29,0.43) [0.14,0.29) [0.86,1]   
 [79] [0.43,0.57) [0.14,0.29) [0.14,0.29) [0.43,0.57) [0.71,0.86) [0.14,0.29)
 [85] [0.14,0.29) [0.71,0.86) [0.43,0.57) [0.14,0.29) [0.14,0.29) [0.29,0.43)
 [91] [0.71,0.86) [0,0.14)    [0.43,0.57) [0,0.14)    [0.29,0.43) [0.71,0.86)
 [97] [0.86,1]    [0.57,0.71) [0.71,0.86) [0.14,0.29)
7 Levels: [0,0.14) [0.14,0.29) [0.29,0.43) [0.43,0.57) ... [0.86,1]
> 
> ifelseAB(pi > c(3, 3.5, 4), "less", "more")
[1] "less" "more" "more"
> ifelseXB(pi > c(3, 3.5, 4), rep("less", 3), "more")
[1] "less" "more" "more"
> ifelseXY(pi > c(3, 3.5, 4), rep("less", 3), rep("more",3))
[1] "less" "more" "more"
> ifelse1NA(pi > c(3, 3.5, 4))
[1]  1 NA NA
> ifelse0NA(pi > c(3, 3.5, 4))
[1]  0 NA NA
> ifelseNegPos(pi > c(3, 3.5, 4), 1:3)
[1] -1  2  3
> 
> ratiotweak(c(1,1,0,0), c(1,0,1,0), 42, 24)
[1]  1 42  0 24
> natozero(c(1,1,0,0)/c(1,0,1,0))
[1]   1 Inf   0   0
> 
> insertinlist(letters[1:5], 4, rep("hoppity", 3))
[1] "a"       "b"       "c"       "hoppity" "hoppity" "hoppity" "e"      
> 
> dround(pi)
[1] 3.141593
> niceround(pi)
[1] 2
> 
> ## prime numbers 
> 
> ## code coverage of special cases
> 
> eratosthenes(20)
[1]  2  3  5  7 11 13 17 19
> 
> primefactors(8209 * 3)
[1]    3 8209
> 
> stopifnot(identical(primefactors(42),
+                     primefactors(42, "interpreted")))
> 
> 
> proc.time()
   user  system elapsed 
   0.14    0.04    0.17