From d1898c26b117cf555c73e66915a03e15f77f37c0 Mon Sep 17 00:00:00 2001 From: Claude Date: Sat, 31 Oct 2026 14:46:18 +0100 Subject: [PATCH] Review round 1: run tests in R CMD check, API response checks, safer rmGeoIdentity - tests were excluded by .Rbuildignore; outdated tests replaced with design-quality tests for randomise() and tests for rmGeoIdentity() - API tests read CLIMMOB_KEY from the environment - request bodies built with jsonlite; clear errors on HTTP error status - rmGeoIdentity(): seed no longer printed, caller's RNG restored, sf called by namespace, documentation warns that a known seed reveals the original locations - R CMD check workflow, AGENTS.md, NEWS Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01LpE9sTbGPftSMogW6KpkrT --- .Rbuildignore | 3 +- .github/workflows/R-CMD-check.yaml | 50 +++++++++ AGENTS.md | 47 ++++++++ DESCRIPTION | 3 +- NEWS.md | 31 ++++++ R/AAA-getDataCM.R | 7 +- R/getProjectProgress.R | 7 +- R/internal_functions.R | 27 +++++ R/rmGeoIdentity.R | 43 +++++--- man/rmGeoIdentity.Rd | 9 +- tests/testthat/helper-key.R | 8 ++ tests/testthat/test-getDataCM.R | 48 +++----- tests/testthat/test-getProjectsCM.R | 29 ++--- tests/testthat/test-randomise.R | 163 +++++++++------------------- tests/testthat/test-rmGeoIdentity.R | 26 +++++ tests/testthat/test-seed_need.R | 19 ---- 16 files changed, 316 insertions(+), 204 deletions(-) create mode 100644 .github/workflows/R-CMD-check.yaml create mode 100644 AGENTS.md create mode 100644 tests/testthat/helper-key.R create mode 100644 tests/testthat/test-rmGeoIdentity.R delete mode 100644 tests/testthat/test-seed_need.R diff --git a/.Rbuildignore b/.Rbuildignore index d511853..cf9a9f1 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,9 +8,10 @@ ^CODE_OF_CONDUCT\.md$ ^README\.md$ ^CONTRIBUTING\.md$ -^tests$ ^dev$ ^logo\.svg$ ^codemeta\.json$ ^tic\.R$ ^LICENSE\.md$ +^\.github$ +^AGENTS\.md$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..7a9ff31 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,50 @@ +# Standard R CMD check on Linux, macOS and Windows (r-lib/actions v2) +on: + push: + branches: [master] + pull_request: + workflow_dispatch: + +name: R-CMD-check + +permissions: read-all + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + strategy: + fail-fast: false + matrix: + config: + - {os: ubuntu-latest, r: 'release'} + - {os: macos-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + CLIMMOB_KEY: ${{ secrets.CLIMMOB_KEY }} + steps: + - uses: actions/checkout@v4 + - uses: r-lib/actions/setup-pandoc@v2 + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + use-public-rspm: true + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' + - name: Show check errors as annotations + if: failure() + shell: bash + run: | + for f in check/*.Rcheck/00check.log check/*.Rcheck/tests/testthat.Rout.fail; do + [ -f "$f" ] || continue + msg=$(tail -c 6000 "$f" | sed 's/%/%25/g' | sed ':a;N;$!ba;s/\n/%0A/g') + echo "::error title=$(basename "$f")::${msg}" + done diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..a0a82c5 --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,47 @@ +# Instructions for AI agents + +ClimMobTools is the R client for the ClimMob platform (https://climmob.net), which runs tricot trials. It downloads project data through the ClimMob API, designs the randomised packages for a trial, and prepares the data for analysis. People share this repository with an assistant either to **work with their ClimMob data** or to **change the package**. Find out which before you start. + +## Before you write any code + +1. Check the installed version with `packageVersion("ClimMobTools")` and read the help of every function you use. Arguments change between versions, so do not rely on memory. +2. The analysis of rankings happens in gosset and PlackettLuce, not here. For methods and evidence on tricot, read the knowledge base at https://github.com/AgrDataSci/tricot-knowledge-base (start with its `AGENTS.md`). + +## API keys and personal data + +- **Never write an API key in a script, a test, an issue or a message.** Ask the user to store it in the environment variable `CLIMMOB_KEY` and read it with `Sys.getenv("CLIMMOB_KEY")`. +- ClimMob data hold names, phone numbers and locations of participants. Never put real data in examples, tests or issues. Use simulated data. +- Before sharing coordinates, displace them with `rmGeoIdentity()` and **do not set or publish its seed**. With the seed, anyone can recover the exact locations. + +## Which function for which task + +| Task | Function | +|---|---| +| List the projects a key can access | `getProjectsCM()` | +| Download the data of a project | `getDataCM()`, then `as.data.frame()` options for wide or long format | +| Check how many submissions each data collection moment has | `getProjectProgress()` | +| List the traits assessed in a project | `getTraitList()` | +| Export tidy tables for analysis | `exportTricotRanks()`, `exportMeasuredTraits()`, `exportBlockData()`, `exportTrialMetadata()`, `exportVariablesDescription()` | +| Design the packages of a new trial (which items each participant receives) | `randomise()` or `randomize()` | +| Build Plackett-Luce rankings from tricot data | prefer `gosset::rank_tricot()`; `rankTricot()` here is a copy kept for compatibility | +| Displace coordinates before sharing | `rmGeoIdentity()` | + +The `server` argument selects the ClimMob instance (for example `"climmob3"`, `"1000farms"`, `"avisa"`, `"rtb"`). + +## Trial design + +`randomise()` allocates items to packages so that items appear about equally often, are spread across the positions A, B and C, and form a connected comparison network. `availability` caps how many packages each item can go to, and `props` sets unequal shares. Call `set.seed()` before it when the design must be reproducible, and keep the design with the project records. + +## Changing the package + +- Use `=` for assignment in new code. Use base R where possible. +- Document with roxygen and run `devtools::document()`. Never edit files in `man/` by hand. +- Every fix needs a test in `tests/testthat/` that fails before the fix and passes after it. Tests that call the API must use `skip_without_key()` (see `tests/testthat/helper-key.R`). Run `devtools::test()` and `devtools::check()`, and report what was actually run. +- Record changes in `NEWS.md`. Keep changes backwards compatible, or record the break and the reason. +- ClimMob-analysis (https://github.com/AgrDataSci/ClimMob-analysis) depends on this package. Check it when changing what a function returns. +- Work on a branch and open a pull request. Do not merge without review and passing checks. + +## Where to find more + +- Reference and vignettes: https://agrdatasci.github.io/ClimMobTools/ +- Issues: https://github.com/AgrDataSci/ClimMobTools/issues diff --git a/DESCRIPTION b/DESCRIPTION index 5f17737..dd37fc6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,7 +39,8 @@ Suggests: rmarkdown, sf, PlackettLuce, - testthat (>= 2.1.0) + testthat (>= 3.0.0) Language: en-US RoxygenNote: 7.3.2 VignetteBuilder: knitr +Config/testthat/edition: 3 diff --git a/NEWS.md b/NEWS.md index a356564..31b97ce 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,34 @@ +ClimMobTools (development version) +========================= + +### PRIVACY + +* Tests read the API key from the environment variable `CLIMMOB_KEY` + instead of a key written in the test files, and are skipped when it is + not set. +* `rmGeoIdentity()` no longer prints the seed it uses. The random + displacement does not depend on the original coordinates, so anyone who + knows the seed can recover the exact locations. Leave `seed = NULL` for + data that will be shared. A given seed no longer changes the caller's + random number stream. The function now calls 'sf' by namespace, so 'sf' + no longer needs to be attached. + +### BUG FIXES + +* `getDataCM()` and `getProjectProgress()` build the request body with + 'jsonlite', so quotes in project codes or user names no longer break the + request, and stop with a clear message when the server returns an error + status instead of failing while parsing the response. + +### TESTS + +* Tests now run under `R CMD check` (they were excluded in `.Rbuildignore`). + Outdated tests for removed functions and arguments were replaced by tests + of the current `randomise()` design: distinct items per package, equal + item counts, balance across positions, a connected comparison network, + availability limits and reproducibility. Added tests for `rmGeoIdentity()`. +* Added a standard R CMD check workflow for Linux, macOS and Windows. + ClimMobTools 1.8.2 (2025-11-26) ========================= diff --git a/R/AAA-getDataCM.R b/R/AAA-getDataCM.R index 6d977e3..617bdcf 100644 --- a/R/AAA-getDataCM.R +++ b/R/AAA-getDataCM.R @@ -59,13 +59,14 @@ getDataCM = function(key, cmdata = httr::RETRY(verb = "GET", url = url, - query = list(Body = paste0('{"project_cod":"', project, '", - "user_owner":"',userowner,'"}'), + query = list(Body = .request_body(project, userowner), Apikey = key), httr::accept_json(), terminate_on = c(403, 404)) - cmdata = httr::content(cmdata, as = "text") + .check_response(cmdata) + + cmdata = httr::content(cmdata, as = "text", encoding = "UTF-8") if (as.text) { return(cmdata) diff --git a/R/getProjectProgress.R b/R/getProjectProgress.R index f7b3e27..ef337a2 100644 --- a/R/getProjectProgress.R +++ b/R/getProjectProgress.R @@ -31,13 +31,14 @@ getProjectProgress = function(key, project, userowner, server = "climmob3"){ dat = httr::RETRY(verb = "GET", url = url, - query = list(Body = paste0('{"project_cod":"', project, '", - "user_owner":"',userowner,'"}'), + query = list(Body = .request_body(project, userowner), Apikey = key), httr::accept_json(), terminate_on = c(403, 404)) - dat = httr::content(dat, as = "text") + .check_response(dat) + + dat = httr::content(dat, as = "text", encoding = "UTF-8") dat = jsonlite::fromJSON(dat) diff --git a/R/internal_functions.R b/R/internal_functions.R index ee3de0d..dd6eba7 100644 --- a/R/internal_functions.R +++ b/R/internal_functions.R @@ -201,3 +201,30 @@ } +#' JSON body for project requests +#' Built with jsonlite so that quotes or other special characters in +#' project codes or user names cannot break the request +#' @noRd +.request_body = function(project, userowner) { + jsonlite::toJSON(list(project_cod = project, user_owner = userowner), + auto_unbox = TRUE) +} + +#' Stop with a clear message when the server does not return success +#' @noRd +.check_response = function(response) { + status = httr::status_code(response) + if (status == 401 || status == 403) { + stop("ClimMob refused the request (HTTP ", status, "). ", + "Check the API key and that you have access to this project.", call. = FALSE) + } + if (status == 404) { + stop("ClimMob could not find the project or user (HTTP 404). ", + "Check the project code and the user owner.", call. = FALSE) + } + if (status >= 400) { + stop("ClimMob returned HTTP ", status, ". Try again later or check the server name.", + call. = FALSE) + } + invisible(TRUE) +} diff --git a/R/rmGeoIdentity.R b/R/rmGeoIdentity.R index 2482e04..5a61cc8 100644 --- a/R/rmGeoIdentity.R +++ b/R/rmGeoIdentity.R @@ -8,8 +8,11 @@ #' @param longlat a data.frame or matrix with geographical coordinates long lat #' @param dist numeric, buffer distance for all \var{lonlat} #' @param nQuadSegs integer, number of segments per quadrant -#' @param seed integer, the seed for random number generation. -#' If NULL (the default), ClimMobTools will set the seed randomly +#' @param seed integer, the seed for random number generation. Leave it +#' \code{NULL} (the default) for data that will be shared. The random +#' displacement does not depend on the original coordinates, so anyone who +#' knows the seed can reproduce it and recover the exact locations. Use a +#' seed only for tests or internal reproducibility, and never publish it #' @param ... further arguments passed to \code{\link[sf]{sf}} methods #' @return A data frame with the random coordinates long lat within the buffer #' @examplesIf interactive() @@ -20,7 +23,7 @@ #' 11.254428, 60.822457), #' nrow = 3, ncol = 2, byrow = TRUE) #' -#' rmGeoIdentity(xy, seed = 1501) +#' rmGeoIdentity(xy) #' #' #' the function also handles NAs #' @@ -37,6 +40,10 @@ #' @export rmGeoIdentity = function(longlat, dist = 0.015, nQuadSegs = 2L, seed = NULL, ...){ + if (!requireNamespace("sf", quietly = TRUE)) { + stop("rmGeoIdentity() needs the package 'sf'; please install it") + } + longlat = as.matrix(longlat) n = nrow(longlat) @@ -53,36 +60,44 @@ rmGeoIdentity = function(longlat, dist = 0.015, nQuadSegs = 2L, seed = NULL, ... # transform into sf points longlat = lapply(longlat, function(l) { a = list(x = l) - do.call("st_point", a) + do.call(sf::st_point, a) }) # and then into a geometry list column - longlat = do.call("st_sfc", longlat) + longlat = do.call(sf::st_sfc, longlat) args = list(x = longlat, dist = dist, nQuadSegs = nQuadSegs) - lonlatb = do.call("st_buffer", args) + lonlatb = do.call(sf::st_buffer, args) result = split(lonlatb, seq_len(n)) - # check if a seed is provided - if (is.null(seed)) { - seed = as.integer(stats::runif(1, 0, 1000000)) - message("seed ", seed, " was used in the sampling \n") + # A seed makes the displacement reproducible, and anyone who knows it + # can recover the original points. Without a seed the current random + # stream is used and nothing is printed. With a seed, the caller's + # random number state is restored on exit + if (!is.null(seed)) { + if (exists(".Random.seed", envir = globalenv(), inherits = FALSE)) { + old_seed = get(".Random.seed", envir = globalenv(), inherits = FALSE) + on.exit(assign(".Random.seed", old_seed, envir = globalenv()), add = TRUE) + } else { + on.exit(if (exists(".Random.seed", envir = globalenv(), inherits = FALSE)) { + rm(".Random.seed", envir = globalenv()) + }, add = TRUE) + } + set.seed(seed) } - set.seed(seed) - result[!anyNAs] = lapply(result[!anyNAs], function(x){ a = list(x = x, size = 1, type = "random", by_polygon = TRUE) - do.call("st_sample", a) + do.call(sf::st_sample, a) }) result = do.call(rbind, result) - result = do.call("st_sfc", result) + result = do.call(sf::st_sfc, result) r = matrix(NA, nrow = n, ncol = 2) diff --git a/man/rmGeoIdentity.Rd b/man/rmGeoIdentity.Rd index c970b9b..f9e1905 100644 --- a/man/rmGeoIdentity.Rd +++ b/man/rmGeoIdentity.Rd @@ -13,8 +13,11 @@ rmGeoIdentity(longlat, dist = 0.015, nQuadSegs = 2L, seed = NULL, ...) \item{nQuadSegs}{integer, number of segments per quadrant} -\item{seed}{integer, the seed for random number generation. -If NULL (the default), ClimMobTools will set the seed randomly} +\item{seed}{integer, the seed for random number generation. Leave it +\code{NULL} (the default) for data that will be shared. The random +displacement does not depend on the original coordinates, so anyone who +knows the seed can reproduce it and recover the exact locations. Use a +seed only for tests or internal reproducibility, and never publish it} \item{...}{further arguments passed to \code{\link[sf]{sf}} methods} } @@ -36,7 +39,7 @@ xy = matrix(c(11.097799, 60.801090, 11.254428, 60.822457), nrow = 3, ncol = 2, byrow = TRUE) -rmGeoIdentity(xy, seed = 1501) +rmGeoIdentity(xy) #' the function also handles NAs diff --git a/tests/testthat/helper-key.R b/tests/testthat/helper-key.R new file mode 100644 index 0000000..a825b11 --- /dev/null +++ b/tests/testthat/helper-key.R @@ -0,0 +1,8 @@ +# API tests need a ClimMob key in the environment variable CLIMMOB_KEY. +# Never write a key in a test file: this repository is public. +climmob_key = function() Sys.getenv("CLIMMOB_KEY") + +skip_without_key = function() { + skip_on_cran() + skip_if(climmob_key() == "", "CLIMMOB_KEY is not set") +} diff --git a/tests/testthat/test-getDataCM.R b/tests/testthat/test-getDataCM.R index 57603cc..08c067b 100644 --- a/tests/testthat/test-getDataCM.R +++ b/tests/testthat/test-getDataCM.R @@ -1,36 +1,20 @@ -context("test-getDataCM") - -load("../test_data.rda") - -key <- "d39a3c66-5822-4930-a9d4-50e7da041e77" - -test_that("pivot.wider", { - - cm <- getDataCM(key, - "chocolates", - pivot.wider = TRUE, - tidynames = TRUE) - - cm <- all(cm == chocolates, na.rm = TRUE) - - expect_true(cm) - +test_that("data from the example project match the stored copy", { + skip_without_key() + load(test_path("..", "test_data.rda")) + cm = getDataCM(climmob_key(), "chocolates", + pivot.wider = TRUE, tidynames = TRUE) + expect_true(all(cm == chocolates, na.rm = TRUE)) }) -test_that("no API key", { - - expect_error(getDataCM("1234", "x")) - +test_that("an invalid key gives a clear error", { + skip_on_cran() + skip_if_offline("climmob.net") + expect_error(getDataCM("1234", "x", "y")) }) - -test_that("error no data", { - expect_error( - getDataCM(key, - "empty") - ) -} -) - - - +test_that("request bodies are valid JSON even with quotes in names", { + b = ClimMobTools:::.request_body('my "project"', "user") + parsed = jsonlite::fromJSON(b) + expect_equal(parsed$project_cod, 'my "project"') + expect_equal(parsed$user_owner, "user") +}) diff --git a/tests/testthat/test-getProjectsCM.R b/tests/testthat/test-getProjectsCM.R index b5aae49..f2a15e2 100644 --- a/tests/testthat/test-getProjectsCM.R +++ b/tests/testthat/test-getProjectsCM.R @@ -1,18 +1,11 @@ -context("test-getProjectsCM") - -library("ClimMobTools") - -test_that("error", { - - expect_error(getProjectsCM("1234")) - -}) - -p <- getProjectsCM("d39a3c66-5822-4930-a9d4-50e7da041e77") -p <- !is.null(p) - -test_that("api call", { - - expect_equal(p, TRUE) - -}) \ No newline at end of file +test_that("an invalid key gives an error", { + skip_on_cran() + skip_if_offline("climmob.net") + expect_error(getProjectsCM("1234")) +}) + +test_that("projects are listed with a valid key", { + skip_without_key() + p = getProjectsCM(climmob_key()) + expect_false(is.null(p)) +}) diff --git a/tests/testthat/test-randomise.R b/tests/testthat/test-randomise.R index c3fa8c1..bf2824b 100644 --- a/tests/testthat/test-randomise.R +++ b/tests/testthat/test-randomise.R @@ -1,123 +1,66 @@ -context("test-randomise") - -ni <- 3 -no <- 10 -nv <- 4 -inames <- paste("Var", 1:nv, sep="") - -r <- randomise(ncomp = ni, - nobservers = no, - nitems = nv, - itemnames = inames) - -test_that("returns a valid object", { - v <- as.vector(apply(r, 1, is.na)) - v <- !any(v) - - expect_true(v) -}) - -test_that("returns a balanced sample", { - - i <- c(7, 8) %in% summary(as.factor(unlist(r))) - i <- sum(i) - - expect_equal(i, 2) -}) - - -test_that("works with more than 3 comp", { - - r5 <- randomise(ncomp = 5, - nobservers = 20, - nitems = 10, - itemnames = paste("Var", 1:10, sep="")) - - v <- as.vector(apply(r5, 1, is.na)) - v <- !any(v) - - expect_true(v) - -}) - - - -test_that("different lenght in nitems and itemnames", { - expect_error( - randomise(ncomp = ni, - nobservers = no, - nitems = nv, - itemnames = inames[1:3]) - ) +design_counts = function(d) table(unlist(d)) + +test_that("every package holds distinct items and no missing values", { + set.seed(1) + d = randomise(npackages = 30, itemnames = paste0("Var", 1:6), ncomp = 3) + expect_equal(dim(d), c(30L, 3L)) + expect_false(anyNA(d)) + expect_true(all(apply(d, 1, function(z) !anyDuplicated(z)))) }) -test_that("missing nobservers", { - expect_error( - randomise(ncomp = ni, - nobservers = NULL, - nitems = nv, - itemnames = inames) - ) +test_that("items appear equally often when proportions are equal", { + set.seed(2) + d = randomise(npackages = 10, itemnames = paste0("Var", 1:4), ncomp = 3) + counts = design_counts(d) + # 30 slots over 4 items: 7 or 8 each + expect_true(all(counts %in% c(7, 8))) }) -test_that("missing nitems", { - expect_error( - randomise(ncomp = ni, - nobservers = no, - nitems = NULL, - itemnames = inames) - ) +test_that("each item is spread over the positions A, B and C", { + set.seed(3) + d = randomise(npackages = 60, itemnames = paste0("Var", 1:6), ncomp = 3) + pos = sapply(d, function(col) table(factor(col, levels = paste0("Var", 1:6)))) + # each item appears 30 times; positions should be close to 10 each + expect_true(all(apply(pos, 1, function(z) max(z) - min(z)) <= 2)) }) -test_that("missing itemnames", { - expect_error( - randomise(ncomp = ni, - nobservers = no, - nitems = nv, - itemnames = NULL) - ) +test_that("the comparison network connects all items", { + set.seed(4) + items = paste0("Var", 1:10) + d = randomise(npackages = 40, itemnames = items, ncomp = 3) + # union-find over the items compared in each package + parent = stats::setNames(items, items) + find = function(x) { while (parent[[x]] != x) x = parent[[x]]; x } + for (i in seq_len(nrow(d))) { + r = vapply(unlist(d[i, ]), find, character(1)) + parent[r] = r[1] + } + roots = unique(vapply(items, find, character(1))) + expect_length(roots, 1) }) -test_that("less than 3 items", { - expect_error( - randomise(ncomp = ni, - nobservers = no, - nitems = 2, - itemnames = c("A", "B")) - ) +test_that("more than three items per package works", { + set.seed(5) + d = randomise(npackages = 20, itemnames = paste0("Var", 1:10), ncomp = 5) + expect_equal(ncol(d), 5L) + expect_false(anyNA(d)) }) - -test_that("alias works", { - r <- randomize(ncomp = ni, - nobservers = no, - nitems = nv, - itemnames = inames) - - r <- as.vector(apply(r, 1, is.na)) - - r <- sum(r) == 0 - - expect_true(r) - +test_that("availability is respected and checked", { + set.seed(6) + avail = c(5, 8, 50, 50, 50) + d = randomise(npackages = 20, itemnames = c("a", "b", "c", "d", "e"), + ncomp = 3, availability = avail) + counts = design_counts(d)[c("a", "b", "c", "d", "e")] + expect_true(all(counts <= avail)) + expect_error(randomise(npackages = 20, itemnames = c("a", "b", "c"), + ncomp = 3, availability = c(5, 5, 5))) }) -test_that("alias works", { - - ni <- 3 - no <- 20 - nv <- 7 - inames <- paste("Var", 1:nv, sep="") - - r <- randomize(ncomp = ni, - nobservers = no, - nitems = nv, - itemnames = inames) - - - r <- is.data.frame(r) - - expect_true(r) - +test_that("the same seed gives the same design", { + set.seed(7) + d1 = randomise(npackages = 15, itemnames = paste0("Var", 1:5), ncomp = 3) + set.seed(7) + d2 = randomise(npackages = 15, itemnames = paste0("Var", 1:5), ncomp = 3) + expect_identical(d1, d2) }) - diff --git a/tests/testthat/test-rmGeoIdentity.R b/tests/testthat/test-rmGeoIdentity.R new file mode 100644 index 0000000..da93d77 --- /dev/null +++ b/tests/testthat/test-rmGeoIdentity.R @@ -0,0 +1,26 @@ +xy = matrix(c(11.097799, 60.801090, + NA, NA, + 11.161298, 60.804199, + 11.254428, 60.822457), + ncol = 2, byrow = TRUE) + +test_that("points move but stay within the buffer distance", { + skip_if_not_installed("sf") + suppressPackageStartupMessages(library(sf)) + r = rmGeoIdentity(xy, dist = 0.015) + ok = !is.na(xy[, 1]) + d = sqrt((r$long[ok] - xy[ok, 1])^2 + (r$lat[ok] - xy[ok, 2])^2) + expect_true(all(d <= 0.015 + 1e-9)) + expect_true(all(d > 0)) + expect_true(all(is.na(r[!ok, ]))) +}) + +test_that("no seed is printed and a given seed does not change the caller's stream", { + skip_if_not_installed("sf") + suppressPackageStartupMessages(library(sf)) + expect_silent(rmGeoIdentity(xy)) + set.seed(10) + before = .Random.seed + rmGeoIdentity(xy, seed = 99) + expect_identical(.Random.seed, before) +}) diff --git a/tests/testthat/test-seed_need.R b/tests/testthat/test-seed_need.R deleted file mode 100644 index 0ccc8db..0000000 --- a/tests/testthat/test-seed_need.R +++ /dev/null @@ -1,19 +0,0 @@ -context("test-seed_need") - -v <- c(32, 8, 2, 8) - -test_that("returns a valid object", { - s <- seed_need(nobservers = 10, - ncomp = 3, - nitems = 4, - nseeds = .2, - unit = "kg") - - s <- s$quant - - s <- all(s == v) - - expect_true(s) - -}) -