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/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.8 $ $Date: 2023/01/30 00:51:42 $ > # > > 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) + ## Pad image + Y <- padimage(Z, factor("b", levels=levels(Z))) + stopifnot(Y$type == "factor") + U <- padimage(Z, "b") + stopifnot(U$type == "factor") + ## Manipulate factor 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")) + ## Harmonise factor levels - cases not covered + Flat <- factor(sample(letters[1:3], 10, replace=TRUE)) + Image <- gorillas.extra$slopetype + oo <- harmoniseLevels() + oo <- harmoniseLevels(Flat) + oo <- harmoniseLevels(A=Image) + oo <- harmoniseLevels(A=Flat,B=Image) + }) + } > # > # 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) + f1b <- function(x, y) { sqrt(x^2 + y^2) } + f2a <- function(x, y) sin(x) + f2b <- function(x, y) { sin(x) } + f3a <- function(x, y) sin(x) + cos(x) + f3b <- function(x, y) { sin(x) + cos(x) } + f4a <- function(x, y) { z <- x + y ; z } + f4b <- function(x, y) { x + y } + F1b <- funxy(f1b, W) + F2a <- funxy(f2a, W) + F2b <- funxy(f2b, W) + F3a <- funxy(f3a, W) + F3b <- funxy(f3b, W) + F4a <- funxy(f4a, W) + F4b <- funxy(f4b, W) + stopifnot(identical(F1a(cells), F1b(cells))) + stopifnot(identical(F2a(cells), F2b(cells))) + stopifnot(identical(F3a(cells), F3b(cells))) + stopifnot(identical(F4a(cells), F4b(cells))) + ## check coordinate extraction from objects + X <- runifrect(9) + Q <- quadscheme(X) + a <- F1a(X) + d <- F1a(Q) + }) + } > > > > proc.time() user system elapsed 1.51 0.20 1.70