R Under development (unstable) (2024-05-12 r86534 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. > ### oecosimu-tests: unit tests for vegan functions > > ### This file contains basic unit tests for simulating null > ### models. Currently we just test the marginal properties of null > ### models using example(commsim). > > ### We had more extensive tests that also displayed heads of simulated > ### matrices (not only the marginal sums), but these were unstable > ### when R was compiled as ./configure --disable-long-double because > ### some tests used R functions stats::rmultinom() which used long > ### doubles and gave different results when long double was not > ### available. > > ### We also had specific permatfull/permatswap tests, but these only > ### tested the simple cases and were nothing but an alternative > ### interface to commsim nullmodels tested here. > > ### <-- oecosimu/permat specifics --> > > ###<--- BEGIN TESTS ---> > suppressPackageStartupMessages(require(vegan)) > set.seed(4711) > example(commsim) commsm> ## write the r00 algorithm commsm> f <- function(x, n, ...) commsm+ array(replicate(n, sample(x)), c(dim(x), n)) commsm> (cs <- commsim("r00", fun=f, binary=TRUE, commsm+ isSeq=FALSE, mode="integer")) An object of class "commsim" 'r00' method (binary, non-sequential, integer mode) commsm> ## retrieving the sequential swap algorithm commsm> (cs <- make.commsim("swap")) An object of class "commsim" 'swap' method (binary, sequential, integer mode) commsm> ## feeding a commsim object as argument commsm> make.commsim(cs) An object of class "commsim" 'swap' method (binary, sequential, integer mode) commsm> ## making the missing c1 model using r1 as a template commsm> ## non-sequential algorithm for binary matrices commsm> ## that preserves the species (column) frequencies, commsm> ## but uses row marginal frequencies commsm> ## as probabilities of selecting sites commsm> f <- function (x, n, nr, nc, rs, cs, ...) { commsm+ out <- array(0L, c(nr, nc, n)) commsm+ J <- seq_len(nc) commsm+ storage.mode(rs) <- "double" commsm+ for (k in seq_len(n)) commsm+ for (j in J) commsm+ out[sample.int(nr, cs[j], prob = rs), j, k] <- 1L commsm+ out commsm+ } commsm> cs <- make.commsim("r1") commsm> cs$method <- "c1" commsm> cs$fun <- f commsm> ## structural constraints commsm> diagfun <- function(x, y) { commsm+ c(sum = sum(y) == sum(x), commsm+ fill = sum(y > 0) == sum(x > 0), commsm+ rowSums = all(rowSums(y) == rowSums(x)), commsm+ colSums = all(colSums(y) == colSums(x)), commsm+ rowFreq = all(rowSums(y > 0) == rowSums(x > 0)), commsm+ colFreq = all(colSums(y > 0) == colSums(x > 0))) commsm+ } commsm> evalfun <- function(meth, x, n) { commsm+ m <- nullmodel(x, meth) commsm+ y <- simulate(m, nsim=n) commsm+ out <- rowMeans(sapply(1:dim(y)[3], commsm+ function(i) diagfun(attr(y, "data"), y[,,i]))) commsm+ z <- as.numeric(c(attr(y, "binary"), attr(y, "isSeq"), commsm+ attr(y, "mode") == "double")) commsm+ names(z) <- c("binary", "isSeq", "double") commsm+ c(z, out) commsm+ } commsm> x <- matrix(rbinom(10*12, 1, 0.5)*rpois(10*12, 3), 12, 10) commsm> algos <- make.commsim() commsm> a <- t(sapply(algos, evalfun, x=x, n=10)) commsm> print(as.table(ifelse(a==1,1,0)), zero.print = ".") binary isSeq double sum fill rowSums colSums rowFreq colFreq r00 1 . . 1 1 . . . . c0 1 . . 1 1 . 1 . 1 r0 1 . . 1 1 1 . 1 . r1 1 . . 1 1 1 . 1 . r2 1 . . 1 1 1 . 1 . quasiswap 1 . . 1 1 1 1 1 1 greedyqswap 1 . . 1 1 1 1 1 1 swap 1 1 . 1 1 1 1 1 1 tswap 1 1 . 1 1 1 1 1 1 curveball 1 1 . 1 1 1 1 1 1 backtrack 1 . . 1 1 1 1 1 1 r2dtable . . . 1 . 1 1 . . swap_count . 1 . 1 1 1 1 . . quasiswap_count . . . 1 1 1 1 . . swsh_samp . . 1 1 1 . . 1 1 swsh_both . . . 1 1 . . 1 1 swsh_samp_r . . 1 1 1 1 . 1 1 swsh_samp_c . . 1 1 1 . 1 1 1 swsh_both_r . . . 1 1 1 . 1 1 swsh_both_c . . . 1 1 . 1 1 1 abuswap_r . 1 1 1 1 1 . 1 1 abuswap_c . 1 1 1 1 . 1 1 1 r00_samp . . 1 1 1 . . . . c0_samp . . 1 1 1 . 1 . 1 r0_samp . . 1 1 1 1 . 1 . r00_ind . . . 1 . . . . . c0_ind . . . 1 . . 1 . . r0_ind . . . 1 . 1 . . . r00_both . . . 1 1 . . . . c0_both . . . 1 1 . 1 . 1 r0_both . . . 1 1 1 . 1 . > > ### clean > rm(list = ls()) > > ## end permatfull/swap > > ## The following vegan functions depend on *oecosimu*: adipart > ## hiersimu multipart raupcrick. The following functions directly > ## depend on *commsimulator*: permatfull1 permatswap1. All these have > ## derived and/or method functions. These should not be broken. > > ## Do not break raupcrick: > set.seed(4711) > data(sipoo) > as.numeric(raupcrick(sipoo, nsimul = 99)) [1] 0.09 0.03 0.29 0.02 0.63 0.48 0.15 0.70 0.76 0.64 0.10 0.20 0.26 0.79 0.80 [16] 0.87 0.90 0.02 0.37 0.04 0.03 0.44 0.16 0.26 0.36 0.25 0.15 0.22 0.30 0.47 [31] 0.85 0.46 0.57 0.40 0.02 0.26 0.62 0.06 0.71 0.82 0.35 0.06 0.13 0.02 0.59 [46] 0.63 0.32 0.93 0.04 0.06 0.05 0.17 0.05 0.11 0.20 0.13 0.14 0.67 0.34 0.33 [61] 0.63 0.79 0.02 0.06 0.16 0.44 0.18 0.06 0.01 0.01 0.09 0.15 0.18 0.29 0.40 [76] 0.08 0.12 0.01 0.01 0.01 0.08 0.04 0.58 0.02 0.10 0.26 0.37 0.53 0.23 0.11 [91] 0.26 0.15 0.16 0.68 0.37 0.35 0.85 0.53 0.01 0.29 0.05 0.10 0.16 0.25 0.39 [106] 0.79 0.37 0.98 0.02 0.04 0.12 0.04 0.91 0.02 0.12 0.27 0.38 0.07 0.31 0.43 [121] 0.60 0.34 0.74 0.80 0.99 0.19 0.15 0.60 0.18 0.37 0.69 0.97 0.01 0.07 0.18 [136] 0.20 0.08 0.55 0.27 0.01 0.01 0.25 0.18 0.63 0.65 0.61 1.00 0.09 0.49 0.15 [151] 0.15 0.48 0.90 > rm(list = ls()) > ## end raupcrick > > proc.time() user system elapsed 1.17 0.10 1.28