CRAN Package Check Results for Package spatstat.geom

Last updated on 2021-12-03 05:52:14 CET.

Flavor Version Tinstall Tcheck Ttotal Status Flags
r-devel-linux-x86_64-debian-clang 2.3-0 60.20 342.25 402.45 OK
r-devel-linux-x86_64-debian-gcc 2.3-0 47.11 233.12 280.23 ERROR
r-devel-linux-x86_64-fedora-clang 2.3-0 477.51 ERROR
r-devel-linux-x86_64-fedora-gcc 2.3-0 452.07 ERROR
r-devel-windows-x86_64-new-UL 2.3-0 166.00 502.00 668.00 OK
r-devel-windows-x86_64-new-TK 2.3-0 OK
r-devel-windows-x86_64-old 2.3-0 98.00 351.00 449.00 OK
r-patched-linux-x86_64 2.3-0 73.56 331.73 405.29 OK
r-patched-solaris-x86 2.3-0 593.60 OK
r-release-linux-x86_64 2.3-0 57.63 332.91 390.54 OK
r-release-macos-arm64 2.3-0 NOTE
r-release-macos-x86_64 2.3-0 OK
r-release-windows-ix86+x86_64 2.3-0 137.00 652.00 789.00 OK
r-oldrel-macos-x86_64 2.3-0 OK
r-oldrel-windows-ix86+x86_64 2.3-0 133.00 656.00 789.00 OK

Check Details

Version: 2.3-0
Check: examples
Result: ERROR
    Running examples in ‘spatstat.geom-Ex.R’ failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: by.ppp
    > ### Title: Apply a Function to a Point Pattern Broken Down by Factor
    > ### Aliases: by.ppp
    > ### Keywords: spatial methods manip
    >
    > ### ** Examples
    >
    > # multitype point pattern, broken down by type
    > data(amacrine)
    > by(amacrine, FUN=minnndist)
    off:
    [1] 0.02486202
    
    on:
    [1] 0.03218897
    > by(amacrine, FUN=function(x) { intensity(unmark(x)) })
    off:
    [1] 88.68302
    
    on:
    [1] 94.9283
    >
    > if(require(spatstat.core)) {
    + # how to pass additional arguments to FUN
    + by(amacrine, FUN=clarkevans, correction=c("Donnelly","cdf"))
    + }
    Loading required package: spatstat.core
    Loading required package: nlme
    Loading required package: rpart
    spatstat.core 2.3-2
    off:
    Donnelly cdf
    1.476458 1.465373
    
    on:
    Donnelly cdf
    1.406853 1.427163
    >
    > # point pattern broken down by tessellation
    > data(swedishpines)
    > tes <- quadrats(swedishpines, 4,4)
    > ## compute minimum nearest neighbour distance for points in each tile
    > B <- by(swedishpines, tes, minnndist)
    Error in cut.ppp(x, fsplit) : length(z) == npoints(x) is not TRUE
    Calls: by ... split -> split.ppp -> marks -> cut -> cut.ppp -> stopifnot
    Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 2.3-0
Check: tests
Result: ERROR
     Running ‘testsAtoC.R’ [3s/6s]
     Running ‘testsD.R’ [2s/4s]
     Running ‘testsEtoF.R’ [2s/3s]
     Running ‘testsGtoJ.R’ [2s/3s]
     Running ‘testsK.R’ [2s/4s]
     Running ‘testsL.R’ [2s/3s]
     Running ‘testsM.R’ [2s/4s]
     Running ‘testsNtoO.R’ [2s/4s]
     Running ‘testsP1.R’ [2s/3s]
     Running ‘testsP2.R’ [2s/3s]
     Running ‘testsQ.R’ [2s/3s]
     Running ‘testsR.R’ [2s/3s]
     Running ‘testsS.R’ [2s/4s]
     Running ‘testsT.R’ [2s/3s]
     Running ‘testsUtoZ.R’ [2s/4s]
    Running the tests in ‘tests/testsEtoF.R’ failed.
    Complete output:
     > #'
     > #' 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 2.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/emptymarks.R
     > #
     > # test cases where there are no (rows or columns of) marks
     > #
     > # $Revision: 1.4 $ $Date: 2020/04/28 12:58:26 $
     >
     > if(ALWAYS) {
     + local({
     + n <- npoints(cells)
     + df <- data.frame(x=1:n, y=factor(sample(letters, n, replace=TRUE)))
     + nocolumns <- c(FALSE, FALSE)
     + norows <- rep(FALSE, n)
     + X <- cells
     + marks(X) <- df
     + marks(X) <- df[,1]
     + marks(X) <- df[,nocolumns]
     + Z <- Y <- X[integer(0)]
     + marks(Y) <- df[norows,]
     + stopifnot(is.marked(Y))
     + marks(Z) <- df[norows,nocolumns]
     + stopifnot(!is.marked(Z))
     + })
     + }
     > #
     > # tests/factorbugs.R
     > #
     > # check for various bugs related to factor conversions
     > #
     > # $Revision: 1.6 $ $Date: 2020/12/03 03:26:25 $
     > #
     >
     > if(ALWAYS) {
     + local({
     + ## make a factor image
     + m <- factor(rep(letters[1:4], 4))
     + Z <- im(m, xcol=1:4, yrow=1:4)
     + ## make a point pattern
     + set.seed(42)
     + X <- runifrect(20, win=as.owin(Z))
     + ## look up the image at the points of X
     + ## (a) internal
     + ans1 <- lookup.im(Z, X$x, X$y)
     + stopifnot(is.factor(ans1))
     + ## (b) user level
     + ans2 <- Z[X]
     + stopifnot(is.factor(ans2))
     + ## (c) turn the image into a tessellation
     + ## and apply quadratcount
     + V <- tess(image = Z)
     + quadratcount(X, tess=V)
     + ## (d) pad image
     + Y <- padimage(Z, factor("b", levels=levels(Z)))
     + stopifnot(Y$type == "factor")
     + U <- padimage(Z, "b")
     + stopifnot(U$type == "factor")
     + ## (e) manipulate levels
     + Zb <- relevel(Z, "b")
     + Zv <- mergeLevels(Z, vowel="a", consonant=c("b","c","d"))
     + P <- X %mark% Z[X]
     + Pv <- mergeLevels(P, vowel="a", consonant=c("b","c","d"))
     + })
     + }
     Error in cut.ppp(X, tess) : length(z) == npoints(x) is not TRUE
     Calls: local ... quadratcount -> quadratcount.ppp -> cut -> cut.ppp -> stopifnot
     Execution halted
    Running the tests in ‘tests/testsS.R’ failed.
    Complete output:
     > #'
     > #' 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 2.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/segments.R
     > ## Tests of psp class and related code
     > ## [SEE ALSO: tests/xysegment.R]
     > ##
     > ## $Revision: 1.32 $ $Date: 2020/12/04 05:26:31 $
     >
     >
     > local({
     +
     + if(ALWAYS) { # depends on platform
     + ## pointed out by Jeff Laake
     + W <- owin()
     + X <- psp(x0=.25,x1=.25,y0=0,y1=1,window=W)
     + X[W]
     + }
     +
     + X <- psp(runif(10),runif(10),runif(10),runif(10), window=owin())
     +
     + if(FULLTEST) {
     + Z <- as.mask.psp(X)
     + Z <- pixellate(X)
     + }
     +
     + if(ALWAYS) { # platform dependent
     + ## add short segment
     + Shorty <- psp(0.5, 0.6, 0.5001, 0.6001, window=Window(X))
     + XX <- superimpose(X[1:5], Shorty, X[6:10])
     + ZZ <- as.mask.psp(XX)
     + ZZ <- pixellate(XX)
     + }
     +
     + if(FULLTEST) {
     + #' misc
     + PX <- periodify(X, 2)
     + }
     +
     + if(ALWAYS) { # C code
     + ## tests of pixellate.psp -> seg2pixL
     + ns <- 50
     + out <- numeric(ns)
     + for(i in 1:ns) {
     + X <- psp(runif(1), runif(1), runif(1), runif(1), window=owin())
     + len <- lengths_psp(X)
     + dlen <- sum(pixellate(X)$v)
     + out[i] <- if(len > 1e-7) dlen/len else 1
     + }
     + if(diff(range(out)) > 0.01) stop(paste(
     + "pixellate.psp test 1: relative error [",
     + paste(diff(range(out)), collapse=", "),
     + "]"))
     +
     + ## Michael Sumner's test examples
     + set.seed(33)
     + n <- 2001
     + co <- cbind(runif(n), runif(n))
     + ow <- owin()
     + X <- psp(co[-n,1], co[-n,2], co[-1,1], co[-1,2], window=ow)
     + s1 <- sum(pixellate(X))
     + s2 <- sum(lengths_psp(X))
     + if(abs(s1 - s2)/s2 > 0.01) {
     + stop(paste("pixellate.psp test 2:",
     + "sum(pixellate(X)) = ", s1,
     + "!=", s2, "= sum(lengths_psp(X))"))
     + }
     +
     + wts <- 1/(lengths_psp(X) * X$n)
     + s1 <- sum(pixellate(X, weights=wts))
     + if(abs(s1-1) > 0.01) {
     + stop(paste("pixellate.psp test 3:",
     + "sum(pixellate(X, weights))=", s1,
     + " (should be 1)"))
     + }
     +
     + X <- psp(0, 0, 0.01, 0.001, window=owin())
     + s1 <- sum(pixellate(X))
     + s2 <- sum(lengths_psp(X))
     + if(abs(s1 - s2)/s2 > 0.01) {
     + stop(paste("pixellate.psp test 4:",
     + "sum(pixellate(X)) = ", s1,
     + "!=", s2, "= sum(lengths_psp(X))"))
     + }
     +
     + X <- psp(0, 0, 0.001, 0.001, window=owin())
     + s1 <- sum(pixellate(X))
     + s2 <- sum(lengths_psp(X))
     + if(abs(s1 - s2)/s2 > 0.01) {
     + stop(paste("pixellate.psp test 5:",
     + "sum(pixellate(X)) = ", s1,
     + "!=", s2, "= sum(lengths_psp(X))"))
     + }
     + }
     +
     + if(FULLTEST) {
     + #' cases of superimpose.psp
     + A <- as.psp(matrix(runif(40), 10, 4), window=owin())
     + B <- as.psp(matrix(runif(40), 10, 4), window=owin())
     + superimpose(A, B, W=ripras)
     + superimpose(A, B, W="convex")
     + }
     +
     + if(FULLTEST) {
     + #' as.psp.data.frame
     + df <- as.data.frame(matrix(runif(40), ncol=4))
     + A <- as.psp(df, window=square(1))
     + colnames(df) <- c("x0","y0","x1","y1")
     + df <- cbind(df, data.frame(marks=1:nrow(df)))
     + B <- as.psp(df, window=square(1))
     + colnames(df) <- c("xmid", "ymid", "length", "angle", "marks")
     + E <- as.psp(df, window=square(c(-1,2)))
     + G <- E %mark% factor(sample(letters[1:3], nsegments(E), replace=TRUE))
     + H <- E %mark% runif(nsegments(E))
     +
     + #' print and summary methods
     + A
     + B
     + E
     + G
     + H
     + summary(B)
     + summary(G)
     + summary(H)
     + M <- B
     + marks(M) <- data.frame(id=marks(B), len=lengths_psp(B))
     + M
     + summary(M)
     + subset(M, select=len)
     +
     + #' plot method cases
     + spatstat.options(monochrome=TRUE)
     + plot(B)
     + plot(G)
     + plot(M)
     + spatstat.options(monochrome=FALSE)
     + plot(B)
     + plot(G)
     + plot(M)
     + #' misuse of 'col' argument - several cases
     + plot(G, col="grey") # discrete
     + plot(B, col="grey")
     + plot(unmark(B), col="grey")
     + plot(M, col="grey")
     +
     + #' miscellaneous class support cases
     + marks(M) <- marks(M)[1,,drop=FALSE]
     +
     + #' undocumented
     + as.ppp(B)
     + }
     +
     + if(ALWAYS) { # C code
     + #' segment crossing code
     + X <- psp(runif(30),runif(30),runif(30),runif(30), window=owin())
     + A <- selfcut.psp(X, eps=1e-11)
     + B <- selfcut.psp(X[1])
     + #'
     + Y <- psp(runif(30),runif(30),runif(30),runif(30), window=owin())
     + Z <- edges(letterR)[c(FALSE,TRUE)]
     + spatstat.options(selfcrossing.psp.useCall=FALSE, crossing.psp.useCall=FALSE)
     + A <- selfcrossing.psp(X)
     + B <- selfcrossing.psp(Z)
     + D <- crossing.psp(X,Y,details=TRUE)
     + spatstat.options(selfcrossing.psp.useCall=TRUE, crossing.psp.useCall=TRUE)
     + A <- selfcrossing.psp(X)
     + B <- selfcrossing.psp(Z)
     + D <- crossing.psp(X,Y,details=TRUE)
     + reset.spatstat.options()
     + }
     +
     + if(FULLTEST) {
     + #' geometry
     + m <- data.frame(A=1:10, B=letters[1:10])
     + X <- psp(runif(10), runif(10), runif(10), runif(10), window=owin(), marks=m)
     + Z <- rotate(X, angle=pi/3, centre=c(0.5, 0.5))
     + Y <- endpoints.psp(X, which="lower")
     + Y <- endpoints.psp(X, which="upper")
     + Y <- endpoints.psp(X, which="right")
     + U <- flipxy(X)
     + }
     +
     + if(ALWAYS) {
     + ## nnfun.psp
     + P <- psp(runif(10), runif(10), runif(10), runif(10),
     + window=square(1), marks=runif(10))
     + f <- nnfun(P)
     + f <- nnfun(P, value="mark")
     + d <- domain(f)
     + Z <- as.im(f)
     + }
     +
     + })
     >
     > reset.spatstat.options()
     >
     >
     >
     >
     >
     > #'
     > #' tests/simplepan.R
     > #'
     > #' Tests of user interaction in simplepanel
     > #' Handled by spatstatLocator()
     > #'
     > #' $Revision: 1.3 $ $Date: 2020/05/01 09:59:59 $
     > #'
     >
     > if(ALWAYS) { # may depend on platform
     + local({
     + ## Adapted from example(simplepanel)
     + ## make boxes
     + outerbox <- owin(c(0,4), c(0,1))
     + buttonboxes <- layout.boxes(outerbox, 4, horizontal=TRUE, aspect=1)
     + ## make environment containing an integer count
     + myenv <- new.env()
     + assign("answer", 0, envir=myenv)
     + ## what to do when finished: return the count.
     + myexit <- function(e) { return(get("answer", envir=e)) }
     + ## button clicks
     + ## decrement the count
     + Cminus <- function(e, xy) {
     + ans <- get("answer", envir=e)
     + assign("answer", ans - 1, envir=e)
     + return(TRUE)
     + }
     + ## display the count (clicking does nothing)
     + Cvalue <- function(...) { TRUE }
     + ## increment the count
     + Cplus <- function(e, xy) {
     + ans <- get("answer", envir=e)
     + assign("answer", ans + 1, envir=e)
     + return(TRUE)
     + }
     + ## 'Clear' button
     + Cclear <- function(e, xy) {
     + assign("answer", 0, envir=e)
     + return(TRUE)
     + }
     + ## quit button
     + Cdone <- function(e, xy) { return(FALSE) }
     +
     + myclicks <- list("-"=Cminus,
     + value=Cvalue,
     + "+"=Cplus,
     + done=Cdone)
     + ## redraw the button that displays the current value of the count
     + Rvalue <- function(button, nam, e) {
     + plot(button, add=TRUE)
     + ans <- get("answer", envir=e)
     + text(centroid.owin(button), labels=ans)
     + return(TRUE)
     + }
     + ## make the panel
     + P <- simplepanel("Counter",
     + B=outerbox, boxes=buttonboxes,
     + clicks=myclicks,
     + redraws = list(NULL, Rvalue, NULL, NULL),
     + exit=myexit, env=myenv)
     + ## queue up a sequence of inputs
     + boxcentres <- do.call(concatxy, unname(lapply(buttonboxes[c(3,3,1,3,2,4)],
     + centroid.owin)))
     + spatstat.utils::queueSpatstatLocator(boxcentres$x, boxcentres$y)
     + ## go
     + run.simplepanel(P)
     + })
     + }
     dev.new(): using pdf(file="Rplots1.pdf")
     [1] 2
     > #
     > # tests/splitpea.R
     > #
     > # Check behaviour of split.ppp etc
     > #
     > # Thanks to Marcelino de la Cruz
     > #
     > # $Revision: 1.17 $ $Date: 2021/04/15 06:19:51 $
     > #
     >
     > local({
     + W <- square(8)
     + X <- ppp(c(2.98, 4.58, 7.27, 1.61, 7.19),
     + c(7.56, 5.29, 5.03, 0.49, 1.65),
     + window=W, check=FALSE)
     + Z <- quadrats(W, 4, 4)
     + Yall <- split(X, Z, drop=FALSE)
     + Ydrop <- split(X, Z, drop=TRUE)
     +
     + if(ALWAYS) { # may depend on platform
     + P <- Yall[[1]]
     + if(!all(inside.owin(P$x, P$y, P$window)))
     + stop("Black hole detected when drop=FALSE")
     + P <- Ydrop[[1]]
     + if(!all(inside.owin(P$x, P$y, P$window)))
     + stop("Black hole detected when drop=TRUE")
     + Ydrop[[1]] <- P[1]
     + split(X, Z, drop=TRUE) <- Ydrop
     + }
     +
     + ## test NA handling
     + Zbad <- quadrats(square(4), 2, 2)
     + Ybdrop <- split(X, Zbad, drop=TRUE)
     + Yball <- split(X, Zbad, drop=FALSE)
     +
     + if(FULLTEST) {
     + ## other bugs/ code blocks in split.ppp, split<-.ppp, [<-.splitppp
     + flog <- rep(c(TRUE,FALSE), 21)
     + fimg <- as.im(dirichlet(runifrect(5, Window(cells))), dimyx=32)
     + A <- split(cells, flog)
     + B <- split(cells, square(0.5))
     + D <- split(cells, fimg)
     + E <- split(cells, logical(42), drop=TRUE)
     + Cellules <- cells
     + split(Cellules, flog) <- solapply(A, rjitter)
     + split(Cellules, fimg) <- solapply(D, rjitter)
     + D[[2]] <- rjitter(D[[2]])
     + Funpines <- finpines
     + marks(Funpines)[,"diameter"] <- factor(marks(Funpines)[,"diameter"])
     + G <- split(Funpines)
     + H <- split(Funpines, "diameter")
     + split(Funpines) <- solapply(G, rjitter)
     + split(Funpines, "diameter") <- solapply(H, rjitter)
     +
     + ## From Marcelino
     + set.seed(1)
     + W<- square(10) # the big window
     + ## puntos<- rpoispp(0.5, win=W)
     + puntos<- runifrect(rpois(1, 0.5 * area(W)), win=W)
     + r00 <- letterR
     + r05 <- shift(letterR,c(0,5))
     + r50 <- shift(letterR,c(5,0))
     + r55 <- shift(letterR,c(5,5))
     + tessr4 <- tess(tiles=list(r00, r05,r50,r55))
     + puntosr4 <- split(puntos, tessr4, drop=TRUE)
     + split(puntos, tessr4, drop=TRUE) <- puntosr4
     +
     + ## More headaches with mark format
     + A <- runifrect(10)
     + B <- runifrect(10)
     + AB <- split(superimpose(A=A, B=B))
     +
     + #' check that split<- respects ordering where possible
     + X <- amacrine
     + Y <- split(X)
     + split(X) <- Y
     + stopifnot(identical(X, amacrine))
     +
     + #' split.ppx
     + df <- data.frame(x=runif(4),y=runif(4),t=runif(4),
     + age=rep(c("old", "new"), 2),
     + mineral=factor(rep(c("Au","Cu"), each=2),
     + levels=c("Au", "Cu", "Pb")),
     + size=runif(4))
     + X <- ppx(data=df, coord.type=c("s","s","t","m", "m","m"))
     + Y <- split(X, "age")
     + Y <- split(X, "mineral", drop=TRUE)
     + Y <- split(X, "mineral")
     + print(Y)
     + print(summary(Y))
     + Y[c(TRUE,FALSE,TRUE)]
     + Y[1:2]
     + Y[3] <- Y[1]
     + }
     + })
     Error in order(y) : unimplemented type 'list' in 'orderVector1'
     Calls: local ... split.ppp -> marks -> cut -> cut.ppp -> factor -> order
     Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 2.3-0
Check: examples
Result: ERROR
    Running examples in ‘spatstat.geom-Ex.R’ failed
    The error most likely occurred in:
    
    > ### Name: by.ppp
    > ### Title: Apply a Function to a Point Pattern Broken Down by Factor
    > ### Aliases: by.ppp
    > ### Keywords: spatial methods manip
    >
    > ### ** Examples
    >
    > # multitype point pattern, broken down by type
    > data(amacrine)
    > by(amacrine, FUN=minnndist)
    off:
    [1] 0.02486202
    
    on:
    [1] 0.03218897
    > by(amacrine, FUN=function(x) { intensity(unmark(x)) })
    off:
    [1] 88.68302
    
    on:
    [1] 94.9283
    >
    > if(require(spatstat.core)) {
    + # how to pass additional arguments to FUN
    + by(amacrine, FUN=clarkevans, correction=c("Donnelly","cdf"))
    + }
    Loading required package: spatstat.core
    Loading required package: nlme
    Loading required package: rpart
    spatstat.core 2.3-2
    off:
    Donnelly cdf
    1.476458 1.465373
    
    on:
    Donnelly cdf
    1.406853 1.427163
    >
    > # point pattern broken down by tessellation
    > data(swedishpines)
    > tes <- quadrats(swedishpines, 4,4)
    > ## compute minimum nearest neighbour distance for points in each tile
    > B <- by(swedishpines, tes, minnndist)
    Error in cut.ppp(x, fsplit) : length(z) == npoints(x) is not TRUE
    Calls: by ... split -> split.ppp -> marks -> cut -> cut.ppp -> stopifnot
    Execution halted
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc

Version: 2.3-0
Check: tests
Result: ERROR
     Running ‘testsAtoC.R’
     Running ‘testsD.R’
     Running ‘testsEtoF.R’
     Running ‘testsGtoJ.R’
     Running ‘testsK.R’
     Running ‘testsL.R’
     Running ‘testsM.R’
     Running ‘testsNtoO.R’
     Running ‘testsP1.R’
     Running ‘testsP2.R’
     Running ‘testsQ.R’
     Running ‘testsR.R’
     Running ‘testsS.R’
     Running ‘testsT.R’
     Running ‘testsUtoZ.R’
    Running the tests in ‘tests/testsEtoF.R’ failed.
    Complete output:
     > #'
     > #' 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 2.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/emptymarks.R
     > #
     > # test cases where there are no (rows or columns of) marks
     > #
     > # $Revision: 1.4 $ $Date: 2020/04/28 12:58:26 $
     >
     > if(ALWAYS) {
     + local({
     + n <- npoints(cells)
     + df <- data.frame(x=1:n, y=factor(sample(letters, n, replace=TRUE)))
     + nocolumns <- c(FALSE, FALSE)
     + norows <- rep(FALSE, n)
     + X <- cells
     + marks(X) <- df
     + marks(X) <- df[,1]
     + marks(X) <- df[,nocolumns]
     + Z <- Y <- X[integer(0)]
     + marks(Y) <- df[norows,]
     + stopifnot(is.marked(Y))
     + marks(Z) <- df[norows,nocolumns]
     + stopifnot(!is.marked(Z))
     + })
     + }
     > #
     > # tests/factorbugs.R
     > #
     > # check for various bugs related to factor conversions
     > #
     > # $Revision: 1.6 $ $Date: 2020/12/03 03:26:25 $
     > #
     >
     > if(ALWAYS) {
     + local({
     + ## make a factor image
     + m <- factor(rep(letters[1:4], 4))
     + Z <- im(m, xcol=1:4, yrow=1:4)
     + ## make a point pattern
     + set.seed(42)
     + X <- runifrect(20, win=as.owin(Z))
     + ## look up the image at the points of X
     + ## (a) internal
     + ans1 <- lookup.im(Z, X$x, X$y)
     + stopifnot(is.factor(ans1))
     + ## (b) user level
     + ans2 <- Z[X]
     + stopifnot(is.factor(ans2))
     + ## (c) turn the image into a tessellation
     + ## and apply quadratcount
     + V <- tess(image = Z)
     + quadratcount(X, tess=V)
     + ## (d) pad image
     + Y <- padimage(Z, factor("b", levels=levels(Z)))
     + stopifnot(Y$type == "factor")
     + U <- padimage(Z, "b")
     + stopifnot(U$type == "factor")
     + ## (e) manipulate levels
     + Zb <- relevel(Z, "b")
     + Zv <- mergeLevels(Z, vowel="a", consonant=c("b","c","d"))
     + P <- X %mark% Z[X]
     + Pv <- mergeLevels(P, vowel="a", consonant=c("b","c","d"))
     + })
     + }
     Error in cut.ppp(X, tess) : length(z) == npoints(x) is not TRUE
     Calls: local ... quadratcount -> quadratcount.ppp -> cut -> cut.ppp -> stopifnot
     Execution halted
    Running the tests in ‘tests/testsS.R’ failed.
    Complete output:
     > #'
     > #' 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 2.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/segments.R
     > ## Tests of psp class and related code
     > ## [SEE ALSO: tests/xysegment.R]
     > ##
     > ## $Revision: 1.32 $ $Date: 2020/12/04 05:26:31 $
     >
     >
     > local({
     +
     + if(ALWAYS) { # depends on platform
     + ## pointed out by Jeff Laake
     + W <- owin()
     + X <- psp(x0=.25,x1=.25,y0=0,y1=1,window=W)
     + X[W]
     + }
     +
     + X <- psp(runif(10),runif(10),runif(10),runif(10), window=owin())
     +
     + if(FULLTEST) {
     + Z <- as.mask.psp(X)
     + Z <- pixellate(X)
     + }
     +
     + if(ALWAYS) { # platform dependent
     + ## add short segment
     + Shorty <- psp(0.5, 0.6, 0.5001, 0.6001, window=Window(X))
     + XX <- superimpose(X[1:5], Shorty, X[6:10])
     + ZZ <- as.mask.psp(XX)
     + ZZ <- pixellate(XX)
     + }
     +
     + if(FULLTEST) {
     + #' misc
     + PX <- periodify(X, 2)
     + }
     +
     + if(ALWAYS) { # C code
     + ## tests of pixellate.psp -> seg2pixL
     + ns <- 50
     + out <- numeric(ns)
     + for(i in 1:ns) {
     + X <- psp(runif(1), runif(1), runif(1), runif(1), window=owin())
     + len <- lengths_psp(X)
     + dlen <- sum(pixellate(X)$v)
     + out[i] <- if(len > 1e-7) dlen/len else 1
     + }
     + if(diff(range(out)) > 0.01) stop(paste(
     + "pixellate.psp test 1: relative error [",
     + paste(diff(range(out)), collapse=", "),
     + "]"))
     +
     + ## Michael Sumner's test examples
     + set.seed(33)
     + n <- 2001
     + co <- cbind(runif(n), runif(n))
     + ow <- owin()
     + X <- psp(co[-n,1], co[-n,2], co[-1,1], co[-1,2], window=ow)
     + s1 <- sum(pixellate(X))
     + s2 <- sum(lengths_psp(X))
     + if(abs(s1 - s2)/s2 > 0.01) {
     + stop(paste("pixellate.psp test 2:",
     + "sum(pixellate(X)) = ", s1,
     + "!=", s2, "= sum(lengths_psp(X))"))
     + }
     +
     + wts <- 1/(lengths_psp(X) * X$n)
     + s1 <- sum(pixellate(X, weights=wts))
     + if(abs(s1-1) > 0.01) {
     + stop(paste("pixellate.psp test 3:",
     + "sum(pixellate(X, weights))=", s1,
     + " (should be 1)"))
     + }
     +
     + X <- psp(0, 0, 0.01, 0.001, window=owin())
     + s1 <- sum(pixellate(X))
     + s2 <- sum(lengths_psp(X))
     + if(abs(s1 - s2)/s2 > 0.01) {
     + stop(paste("pixellate.psp test 4:",
     + "sum(pixellate(X)) = ", s1,
     + "!=", s2, "= sum(lengths_psp(X))"))
     + }
     +
     + X <- psp(0, 0, 0.001, 0.001, window=owin())
     + s1 <- sum(pixellate(X))
     + s2 <- sum(lengths_psp(X))
     + if(abs(s1 - s2)/s2 > 0.01) {
     + stop(paste("pixellate.psp test 5:",
     + "sum(pixellate(X)) = ", s1,
     + "!=", s2, "= sum(lengths_psp(X))"))
     + }
     + }
     +
     + if(FULLTEST) {
     + #' cases of superimpose.psp
     + A <- as.psp(matrix(runif(40), 10, 4), window=owin())
     + B <- as.psp(matrix(runif(40), 10, 4), window=owin())
     + superimpose(A, B, W=ripras)
     + superimpose(A, B, W="convex")
     + }
     +
     + if(FULLTEST) {
     + #' as.psp.data.frame
     + df <- as.data.frame(matrix(runif(40), ncol=4))
     + A <- as.psp(df, window=square(1))
     + colnames(df) <- c("x0","y0","x1","y1")
     + df <- cbind(df, data.frame(marks=1:nrow(df)))
     + B <- as.psp(df, window=square(1))
     + colnames(df) <- c("xmid", "ymid", "length", "angle", "marks")
     + E <- as.psp(df, window=square(c(-1,2)))
     + G <- E %mark% factor(sample(letters[1:3], nsegments(E), replace=TRUE))
     + H <- E %mark% runif(nsegments(E))
     +
     + #' print and summary methods
     + A
     + B
     + E
     + G
     + H
     + summary(B)
     + summary(G)
     + summary(H)
     + M <- B
     + marks(M) <- data.frame(id=marks(B), len=lengths_psp(B))
     + M
     + summary(M)
     + subset(M, select=len)
     +
     + #' plot method cases
     + spatstat.options(monochrome=TRUE)
     + plot(B)
     + plot(G)
     + plot(M)
     + spatstat.options(monochrome=FALSE)
     + plot(B)
     + plot(G)
     + plot(M)
     + #' misuse of 'col' argument - several cases
     + plot(G, col="grey") # discrete
     + plot(B, col="grey")
     + plot(unmark(B), col="grey")
     + plot(M, col="grey")
     +
     + #' miscellaneous class support cases
     + marks(M) <- marks(M)[1,,drop=FALSE]
     +
     + #' undocumented
     + as.ppp(B)
     + }
     +
     + if(ALWAYS) { # C code
     + #' segment crossing code
     + X <- psp(runif(30),runif(30),runif(30),runif(30), window=owin())
     + A <- selfcut.psp(X, eps=1e-11)
     + B <- selfcut.psp(X[1])
     + #'
     + Y <- psp(runif(30),runif(30),runif(30),runif(30), window=owin())
     + Z <- edges(letterR)[c(FALSE,TRUE)]
     + spatstat.options(selfcrossing.psp.useCall=FALSE, crossing.psp.useCall=FALSE)
     + A <- selfcrossing.psp(X)
     + B <- selfcrossing.psp(Z)
     + D <- crossing.psp(X,Y,details=TRUE)
     + spatstat.options(selfcrossing.psp.useCall=TRUE, crossing.psp.useCall=TRUE)
     + A <- selfcrossing.psp(X)
     + B <- selfcrossing.psp(Z)
     + D <- crossing.psp(X,Y,details=TRUE)
     + reset.spatstat.options()
     + }
     +
     + if(FULLTEST) {
     + #' geometry
     + m <- data.frame(A=1:10, B=letters[1:10])
     + X <- psp(runif(10), runif(10), runif(10), runif(10), window=owin(), marks=m)
     + Z <- rotate(X, angle=pi/3, centre=c(0.5, 0.5))
     + Y <- endpoints.psp(X, which="lower")
     + Y <- endpoints.psp(X, which="upper")
     + Y <- endpoints.psp(X, which="right")
     + U <- flipxy(X)
     + }
     +
     + if(ALWAYS) {
     + ## nnfun.psp
     + P <- psp(runif(10), runif(10), runif(10), runif(10),
     + window=square(1), marks=runif(10))
     + f <- nnfun(P)
     + f <- nnfun(P, value="mark")
     + d <- domain(f)
     + Z <- as.im(f)
     + }
     +
     + })
     >
     > reset.spatstat.options()
     >
     >
     >
     >
     >
     > #'
     > #' tests/simplepan.R
     > #'
     > #' Tests of user interaction in simplepanel
     > #' Handled by spatstatLocator()
     > #'
     > #' $Revision: 1.3 $ $Date: 2020/05/01 09:59:59 $
     > #'
     >
     > if(ALWAYS) { # may depend on platform
     + local({
     + ## Adapted from example(simplepanel)
     + ## make boxes
     + outerbox <- owin(c(0,4), c(0,1))
     + buttonboxes <- layout.boxes(outerbox, 4, horizontal=TRUE, aspect=1)
     + ## make environment containing an integer count
     + myenv <- new.env()
     + assign("answer", 0, envir=myenv)
     + ## what to do when finished: return the count.
     + myexit <- function(e) { return(get("answer", envir=e)) }
     + ## button clicks
     + ## decrement the count
     + Cminus <- function(e, xy) {
     + ans <- get("answer", envir=e)
     + assign("answer", ans - 1, envir=e)
     + return(TRUE)
     + }
     + ## display the count (clicking does nothing)
     + Cvalue <- function(...) { TRUE }
     + ## increment the count
     + Cplus <- function(e, xy) {
     + ans <- get("answer", envir=e)
     + assign("answer", ans + 1, envir=e)
     + return(TRUE)
     + }
     + ## 'Clear' button
     + Cclear <- function(e, xy) {
     + assign("answer", 0, envir=e)
     + return(TRUE)
     + }
     + ## quit button
     + Cdone <- function(e, xy) { return(FALSE) }
     +
     + myclicks <- list("-"=Cminus,
     + value=Cvalue,
     + "+"=Cplus,
     + done=Cdone)
     + ## redraw the button that displays the current value of the count
     + Rvalue <- function(button, nam, e) {
     + plot(button, add=TRUE)
     + ans <- get("answer", envir=e)
     + text(centroid.owin(button), labels=ans)
     + return(TRUE)
     + }
     + ## make the panel
     + P <- simplepanel("Counter",
     + B=outerbox, boxes=buttonboxes,
     + clicks=myclicks,
     + redraws = list(NULL, Rvalue, NULL, NULL),
     + exit=myexit, env=myenv)
     + ## queue up a sequence of inputs
     + boxcentres <- do.call(concatxy, unname(lapply(buttonboxes[c(3,3,1,3,2,4)],
     + centroid.owin)))
     + spatstat.utils::queueSpatstatLocator(boxcentres$x, boxcentres$y)
     + ## go
     + run.simplepanel(P)
     + })
     + }
     dev.new(): using pdf(file="Rplots1.pdf")
     [1] 2
     > #
     > # tests/splitpea.R
     > #
     > # Check behaviour of split.ppp etc
     > #
     > # Thanks to Marcelino de la Cruz
     > #
     > # $Revision: 1.17 $ $Date: 2021/04/15 06:19:51 $
     > #
     >
     > local({
     + W <- square(8)
     + X <- ppp(c(2.98, 4.58, 7.27, 1.61, 7.19),
     + c(7.56, 5.29, 5.03, 0.49, 1.65),
     + window=W, check=FALSE)
     + Z <- quadrats(W, 4, 4)
     + Yall <- split(X, Z, drop=FALSE)
     + Ydrop <- split(X, Z, drop=TRUE)
     +
     + if(ALWAYS) { # may depend on platform
     + P <- Yall[[1]]
     + if(!all(inside.owin(P$x, P$y, P$window)))
     + stop("Black hole detected when drop=FALSE")
     + P <- Ydrop[[1]]
     + if(!all(inside.owin(P$x, P$y, P$window)))
     + stop("Black hole detected when drop=TRUE")
     + Ydrop[[1]] <- P[1]
     + split(X, Z, drop=TRUE) <- Ydrop
     + }
     +
     + ## test NA handling
     + Zbad <- quadrats(square(4), 2, 2)
     + Ybdrop <- split(X, Zbad, drop=TRUE)
     + Yball <- split(X, Zbad, drop=FALSE)
     +
     + if(FULLTEST) {
     + ## other bugs/ code blocks in split.ppp, split<-.ppp, [<-.splitppp
     + flog <- rep(c(TRUE,FALSE), 21)
     + fimg <- as.im(dirichlet(runifrect(5, Window(cells))), dimyx=32)
     + A <- split(cells, flog)
     + B <- split(cells, square(0.5))
     + D <- split(cells, fimg)
     + E <- split(cells, logical(42), drop=TRUE)
     + Cellules <- cells
     + split(Cellules, flog) <- solapply(A, rjitter)
     + split(Cellules, fimg) <- solapply(D, rjitter)
     + D[[2]] <- rjitter(D[[2]])
     + Funpines <- finpines
     + marks(Funpines)[,"diameter"] <- factor(marks(Funpines)[,"diameter"])
     + G <- split(Funpines)
     + H <- split(Funpines, "diameter")
     + split(Funpines) <- solapply(G, rjitter)
     + split(Funpines, "diameter") <- solapply(H, rjitter)
     +
     + ## From Marcelino
     + set.seed(1)
     + W<- square(10) # the big window
     + ## puntos<- rpoispp(0.5, win=W)
     + puntos<- runifrect(rpois(1, 0.5 * area(W)), win=W)
     + r00 <- letterR
     + r05 <- shift(letterR,c(0,5))
     + r50 <- shift(letterR,c(5,0))
     + r55 <- shift(letterR,c(5,5))
     + tessr4 <- tess(tiles=list(r00, r05,r50,r55))
     + puntosr4 <- split(puntos, tessr4, drop=TRUE)
     + split(puntos, tessr4, drop=TRUE) <- puntosr4
     +
     + ## More headaches with mark format
     + A <- runifrect(10)
     + B <- runifrect(10)
     + AB <- split(superimpose(A=A, B=B))
     +
     + #' check that split<- respects ordering where possible
     + X <- amacrine
     + Y <- split(X)
     + split(X) <- Y
     + stopifnot(identical(X, amacrine))
     +
     + #' split.ppx
     + df <- data.frame(x=runif(4),y=runif(4),t=runif(4),
     + age=rep(c("old", "new"), 2),
     + mineral=factor(rep(c("Au","Cu"), each=2),
     + levels=c("Au", "Cu", "Pb")),
     + size=runif(4))
     + X <- ppx(data=df, coord.type=c("s","s","t","m", "m","m"))
     + Y <- split(X, "age")
     + Y <- split(X, "mineral", drop=TRUE)
     + Y <- split(X, "mineral")
     + print(Y)
     + print(summary(Y))
     + Y[c(TRUE,FALSE,TRUE)]
     + Y[1:2]
     + Y[3] <- Y[1]
     + }
     + })
     Error in order(y) : unimplemented type 'list' in 'orderVector1'
     Calls: local ... split.ppp -> marks -> cut -> cut.ppp -> factor -> order
     Execution halted
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc

Version: 2.3-0
Check: installed package size
Result: NOTE
     installed size is 5.9Mb
     sub-directories of 1Mb or more:
     R 2.1Mb
     help 2.7Mb
Flavor: r-release-macos-arm64