Add tests for non-negative splits and sizes

bodkan · Mar 31, 2023 · e333732 · e333732
1 parent b2c44a1
commit e333732
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 5 deletions.
diff --git a/R/interface.R b/R/interface.R
@@ -55,7 +55,11 @@ population <- function(name, time, N, parent = NULL, map = FALSE,
   if (!is.character(name) || length(name) != 1)
     stop("A population name must be a character scalar value", call. = FALSE)
 
-  time <- as.integer(time)
+  N <- round(N)
+  time <- round(time)
+
+  if (time < 1) stop("Split time must be a non-negative number", call. = FALSE)
+  if (N < 1) stop("Population size must be a non-negative number", call. = FALSE)
 
   # if this population splits from a parental population, check that the parent
   # really exists and that the split time make sense given the time of appearance
@@ -73,9 +77,6 @@ population <- function(name, time, N, parent = NULL, map = FALSE,
   if (!is.null(parent) && is.logical(map) && map == FALSE)
     map <- attr(parent, "map")
 
-  if (time < 1) stop("Split time must be a non-negative integer number", call. = FALSE)
-  N <- as.integer(N)
-
   if (inherits(map, "slendr_map")) {
     # define the population range as a simple geometry object
     # and bind it with the annotation info into an sf object
@@ -1185,7 +1186,7 @@ schedule_sampling <- function(model, times, ..., locations = NULL, strict = FALS
   if (!inherits(model, "slendr_model"))
     stop("A slendr_model object must be specified", call. = FALSE)
 
-  times <- unique(as.integer(sort(times)))
+  times <- unique(as.integer(round(sort(times))))
 
   samples <- list(...)
   sample_pops <- purrr::map(samples, 1)

diff --git a/tests/testthat/test-msprime.R b/tests/testthat/test-msprime.R
@@ -340,3 +340,19 @@ test_that("ensure that a model reaches full coalescence", {
     "slendr_ts"
   )
 })
+
+test_that("population size must be a non-negative number", {
+  expect_error(pop <- population("asd", N = -1, time = 100),
+               "Population size must be a non-negative number")
+  expect_error(pop <- population("asd", N = 0, time = 100),
+               "Population size must be a non-negative number")
+  expect_s3_class(pop <- population("asd", N = 1, time = 100), "slendr_pop")
+})
+
+test_that("population time must be a non-negative number", {
+  expect_error(pop <- population("asd", N = 100, time = -1),
+               "Split time must be a non-negative number")
+  expect_error(pop <- population("asd", N = 100, time = 0),
+               "Split time must be a non-negative number")
+  expect_s3_class(pop <- population("asd", N = 1, time = 100), "slendr_pop")
+})