# ========================================================================= # 1. Structural Sanity Tests (The Happy Path) # ========================================================================= test_that("SimulatePop yields correct dimensions with default options", { # Keep test parameters tiny for speed N_test <- 5L M_test <- 12L K_test <- 2L C_test <- 3L res <- SimulatePop(K = K_test, N = N_test, M = M_test, C = C_test, Seed = 42L) # Structural Checks expect_type(res, "list") expect_named(res, c("Geno", "Ancestry", "Prop", "Freq", "GeneticMap")) # Check Output Matrix / List Dimensional Consistency expect_length(res$Geno, M_test) expect_length(res$Ancestry, N_test) expect_length(res$Freq, M_test) expect_equal(dim(res$Prop), c(N_test, K_test)) expect_equal(nrow(res$GeneticMap), M_test) # Check item metadata bindings expect_equal(unname(rownames(res$Prop)), paste0("Ind", 1:N_test)) expect_equal(unname(colnames(res$Prop)), paste0("K", 1:K_test)) }) # ========================================================================= # 2. Input Overrides (Testing Your 'If Informed' Blocks) # ========================================================================= test_that("SimulatePop respects user-supplied matrices and dataframes", { # Scenario A: User provides an explicit Prop matrix custom_prop <- matrix(c(0.8, 0.2, 0.3, 0.7), nrow = 2, ncol = 2) rownames(custom_prop) <- c("CustomInd1", "CustomInd2") colnames(custom_prop) <- c("Anc1", "Anc2") res_prop <- SimulatePop(Prop = custom_prop, M = 10L, C = 2L) expect_equal(rownames(res_prop$Prop), c("CustomInd1", "CustomInd2")) expect_equal(colnames(res_prop$Prop), c("Anc1", "Anc2")) # Scenario B: User provides an explicit Freq list custom_freq <- list(rs1=matrix(c(0.8, 0.2, 0.3, 0.7), nrow = 2, ncol = 2, dimnames = list(c("Anc1", "Anc2"),c("A", "T"))), rs2=matrix(c(0.5, 0.3, 0.2, 0.3, 0.3, 0.4), nrow = 2, ncol = 3, dimnames = list(c("Anc1", "Anc2"),c("G", "T", "C")))) res_freq <- SimulatePop(Freq = custom_freq, N = 3L, C = 1L) expect_equal(names(res_freq$Freq), c("rs1", "rs2")) expect_equal(rownames(res_freq$Freq$rs1), c("Anc1", "Anc2")) expect_equal(colnames(res_freq$Freq$rs1), c("A", "T")) # Scenario C: User provides a custom GeneticMap custom_map <- data.frame( Marker = c("rs1", "rs2", "rs3", "rs4"), Chromosome = c("ChrA", "ChrA", "ChrB", "ChrB"), Distance = c(0, 50, 0, 100) ) res_map <- SimulatePop(GeneticMap = custom_map, N = 3L, K = 2L) expect_equal(nrow(res_map$GeneticMap), 4) expect_equal(unique(res_map$GeneticMap$Chromosome), c("ChrA", "ChrB")) expect_equal(res_map$GeneticMap$Marker, c("rs1", "rs2", "rs3", "rs4")) }) # ========================================================================= # 3. Sequencing Depth Branches (Testing Optional Output Appendix) # ========================================================================= test_that("Sequencing read depth additions trigger correctly", { N_test <- 4L M_test <- 10L D_test <- 10L # Scalar Depth res_scalar <- SimulatePop(N = N_test, M = M_test, Depth = D_test) expect_true("AlleleDepth" %in% names(res_scalar)) expect_length(res_scalar$AlleleDepth, M_test) expect_true(all(sapply(res_scalar$AlleleDepth,rowSums)==D_test)) # Matrix Depth depth_mat <- matrix(rep(seq(D_test,D_test*5,10),8), nrow = N_test, ncol = M_test) res_matrix <- SimulatePop(N = N_test, M = M_test, Depth = depth_mat) expect_true("AlleleDepth" %in% names(res_matrix)) expect_true(all(sapply(res_matrix$AlleleDepth,rowSums)==seq(D_test,D_test*5,10))) }) # ========================================================================= # 4. Input Constraints and Error Raising (Stopifnot Check Verification) # ========================================================================= test_that("SimulatePop throws clean errors when input restrictions are crossed", { # Invalid number of ancestral groups (K < 2) expect_error(SimulatePop(K = 1L), regexp = "K must be an integer superior or equal to 2") # Invalid number of individuals (N < 2) expect_error(SimulatePop(N = 1L), regexp = "N must be an integer superior or equal to 2") # Invalid ploidy (P < 1) expect_error(SimulatePop(P = 0L), regexp = "P must be positive integers, either as single value or as a vector") # Invalid number of chromosomes (C < 1) expect_error(SimulatePop(C = 0L), regexp = "C must be a positive integer") # Invalid number of alleles (L < 2) expect_error(SimulatePop(L = 1L), regexp = "L must be integers superior or equal to 2, either as single value or as a vector") # Invalid Number of markers relative to chromosome number (M < 2*C) expect_error(SimulatePop(M = 9L, C = 5L), regexp = "M must be an integer superior or equal to 2C") # Out of bounds SmoothParam expect_error(SimulatePop(SmoothParam = 0), regexp = "SmoothParam must be a positive numeric value") # Out of bounds AlphaProp expect_error(SimulatePop(AlphaProp = 0), regexp = "AlphaProp must be a positive numeric value") # Out of bounds AlphaFreq expect_error(SimulatePop(AlphaFreq = 0), regexp = "AlphaFreq must be a positive numeric value") # Out of bounds Error Rate boundaries expect_error(SimulatePop(SeqError = 1.05), regexp = "SeqError must be a positive numeric value") expect_error(SimulatePop(SeqError = -0.01), regexp = "SeqError must be a positive numeric value") # Ill-formed user data structures bad_map <- data.frame(BadCol1 = 1, BadCol2 = 2) expect_error(SimulatePop(GeneticMap = bad_map), regexp = "When informed, GeneticMap must be a dataframe") # Mismatched Matrix constraints custom_prop <- matrix(0.5, nrow = 3, ncol = 3) # Mocking Freq map where columns don't equal dimensions of Prop matrix bad_freq <- list(matrix(0.5, nrow = 5, ncol = 2),matrix(0.5, nrow = 5, ncol = 2)) expect_error(SimulatePop(Prop = custom_prop, Freq = bad_freq, C=1L), regexp = "same number of rows as Prop") # Mismatched Depth Dimensions bad_depth_mat <- matrix(10L, nrow = 2, ncol = 2) # Supposed to be N x M expect_error(SimulatePop(N = 5, M = 10, Depth = bad_depth_mat), regexp = "matrix of size N x M") }) # ========================================================================= # 5. Reproducibility Assurance (Deterministic Seeds) # ========================================================================= test_that("Simulation instances remain stable under static seed injections", { # Run identical setups with matching seeds sim1 <- SimulatePop(K = 2L, N = 5L, M = 10L, Seed = 777L) sim2 <- SimulatePop(K = 2L, N = 5L, M = 10L, Seed = 777L) expect_equal(sim1$Prop, sim2$Prop) expect_equal(sim1$Geno, sim2$Geno) # Verify a modified seed alters outputs sim_different <- SimulatePop(K = 2L, N = 5L, M = 10L, Seed = 888L) expect_false(identical(sim1$Prop, sim_different$Prop)) })