Prevent resize right at the time of the split

bodkan · Jun 30, 2023 · f181a29 · f181a29
1 parent aea2319
commit f181a29
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 0 deletions.
diff --git a/R/interface.R b/R/interface.R
@@ -493,6 +493,9 @@ resize <- function(pop, N, how, time, end = NULL) {
   time <- as.integer(round(time))
   if (!is.null(end)) end <- as.integer(round(end))
 
+  if (time == attr(pop, "history")[[1]]$time)
+    stop("Population resize cannot happen at the time the population is created", call. = FALSE)
+
   if (!how %in% c("step", "exponential"))
     stop("resize(): Only 'step' or 'exponential' are allowed as arguments for the 'how' parameter", call. = FALSE)
 

diff --git a/tests/testthat/test-resizes.R b/tests/testthat/test-resizes.R
@@ -105,3 +105,43 @@ test_that("Multiple resize event types are allowed (forward model)", {
   # sizes match expectations
   expect_true(dplyr::filter(res, time <= t1 & time >= t2) %>% { all(.$N == expected_N) })
 })
+
+test_that("Resize cannot happen at the same time as population split (forward)", {
+  error_msg <- "Population resize cannot happen at the time the population is created"
+
+  anc <- population("anc", time = 1, N = 1000)
+  pop <- population("pop", time = 10, N = 1000, parent = anc)
+
+  expect_error(resize(pop, time = 10, N = 100, how = "step"), error_msg)
+  expect_error(resize(pop, time = 10, end = 20, N = 100, how = "exponential"), error_msg)
+
+  expect_s3_class(resize(pop, time = 11, N = 100, how = "step"), "slendr_pop")
+  resized_step <- resize(pop, time = 11, N = 100, how = "step")
+  expect_true(attr(resized_step, "history")[[2]]$event == "resize")
+  expect_true(is.na(attr(resized_step, "history")[[2]]$tend))
+
+  expect_s3_class(resize(pop, time = 11, end = 20, N = 100, how = "exponential"), "slendr_pop")
+  resized_exp <- resize(pop, time = 11, end = 20, N = 100, how = "exponential")
+  expect_true(attr(resized_exp, "history")[[2]]$event == "resize")
+  expect_true(attr(resized_exp, "history")[[2]]$tend == 20)
+})
+
+test_that("Resize cannot happen at the same time as population split (backward)", {
+  error_msg <- "Population resize cannot happen at the time the population is created"
+
+  anc <- population("anc", time = 1000, N = 1000)
+  pop <- population("pop", time = 100, N = 1000, parent = anc)
+
+  expect_error(resize(pop, time = 100, N = 100, how = "step"), error_msg)
+  expect_error(resize(pop, time = 100, end = 20, N = 100, how = "exponential"), error_msg)
+
+  expect_s3_class(resize(pop, time = 99, N = 100, how = "step"), "slendr_pop")
+  resized_step <- resize(pop, time = 99, N = 100, how = "step")
+  expect_true(attr(resized_step, "history")[[2]]$event == "resize")
+  expect_true(is.na(attr(resized_step, "history")[[2]]$tend))
+
+  expect_s3_class(resize(pop, time = 99, end = 20, N = 100, how = "exponential"), "slendr_pop")
+  resized_exp <- resize(pop, time = 99, end = 20, N = 100, how = "exponential")
+  expect_true(attr(resized_exp, "history")[[2]]$event == "resize")
+  expect_true(attr(resized_exp, "history")[[2]]$tend == 20)
+})