# Function ---- test_that("rdca is valid function", { expect_function( rdca, args = c("n", "H_counts", "N", "S", "rho", "rho2", "U", "J") ) }) # H_counts = 1 ---- test_that("rdca works for H_counts=1, nn_max", { H_counts <- 2 N <- c(10, 20) S <- c(5, 9) rho <- 8 n <- 29 result <- rdca(n, H_counts, N, S, rho, rho^2) expected <- c(9, 20) expect_identical(result, expected) }) test_that("rdca works for H_counts=2, n=sum(N)", { H_counts <- 2 N <- c(10, 20) S <- c(5, 9) rho <- 8 n <- sum(N) result <- rdca(n, H_counts, N, S, rho, rho^2) expect_identical(result, N) }) # H_counts = c(1,1) ---- test_that("rdca works for H_counts=c(1,1), nn_max", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 43 result <- rdca(n, H_counts, N, S, rho, rho^2) expected <- c(9.477467, 18.522533, 15) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(1,2), n>n_max, U=1, J=2", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 43 result <- rdca(n, H_counts, N, S, rho, rho^2, 1, 2) expected <- c(N[1], 17.9999999999999964, 15) expect_equal(result, expected) }) test_that("rdca works for H_counts=c(1,2), n>n_max, U=2, J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 43 result <- rdca(n, H_counts, N, S, rho, rho^2, 2, 1) expected <- c(9.035355, N[2], 13.964645) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(1,2), n>n_max, U=3, J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 43 result <- rdca(n, H_counts, N, S, rho, rho^2, 3, 1) expected <- c(9.477467, 18.522533, N[3]) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(1,2), n>n_max, U=2:3, J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 43 result <- rdca(n, H_counts, N, S, rho, rho^2, 2:3, 1) expected <- c(8, N[2:3]) expect_identical(result, expected) }) test_that("rdca works for H_counts=c(1,2), n>n_max, J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 43 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 1) expected <- c(10, 14.66667, 18.33333) expect_equal(result, expected, tolerance = 10^-6) }) test_that("rdca works for H_counts=c(1,2), n>n_max, J=2", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 43 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 2) expected <- c(9.477467, 18.522533, 15) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(1,2), n=sum(N)", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 45 result <- rdca(n, H_counts, N, S, rho, rho^2) expect_identical(result, N) }) test_that("rdca works for H_counts=c(1,2), n=sum(N), U=1, J=2", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 45 result <- rdca(n, H_counts, N, S, rho, rho^2, 1, 2) expect_identical(result, N) }) test_that("rdca works for H_counts=c(1,2), n=sum(N), U=2, J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 45 result <- rdca(n, H_counts, N, S, rho, rho^2, 2, 1) expected <- c(9.9999999999999982, N[2], 15.0000000000000036) expect_equal(result, expected) }) test_that("rdca works for H_counts=c(1,2), n=sum(N), U=3, J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 45 result <- rdca(n, H_counts, N, S, rho, rho^2, 3, 1) expect_identical(result, N) }) test_that("rdca works for H_counts=c(1,2), n=sum(N), U=2:3, J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 45 result <- rdca(n, H_counts, N, S, rho, rho^2, 2:3, 1) expect_identical(result, N) }) test_that("rdca works for H_counts=c(1,2), n=sum(N), J=1", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 45 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 1) expected <- c(N[1], 15.55556, 19.44444) expect_equal(result, expected, tolerance = 10^-6) }) test_that("rdca works for H_counts=c(1,2), n=sum(N), J=2", { H_counts <- c(1, 2) N <- c(10, 20, 15) S <- c(5, 9, 15) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 45 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 2) expect_identical(result, N) }) # H_counts = c(2,2) ---- test_that("rdca works for H_counts=c(2,2), nn_max", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2) expected <- c(9.621571, 20, 15, 25.378429) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(2,2), n>n_max, U=1, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, 1, 2) expected <- c(N[1], 19.87602, 15, 25.12398) expect_equal(result, expected, tolerance = 10^-6) }) test_that("rdca works for H_counts=c(2,2), n>n_max, U=2, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, 2, 2) expected <- c(9.621571, N[2], 15, 25.378429) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(2,2), n>n_max, U=1:2, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, 1:2, 2) expected <- c(N[1:2], 15, 24.9999999999999964) expect_equal(result, expected) }) test_that("rdca works for H_counts=c(2,2), n>n_max, U=3, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, 3, 1) expected <- c(9.621571, 20, N[3], 25.378429) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(2,2), n>n_max, U=4, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, 4, 1) expected <- c(5.019114, 18.068809, 6.912078, N[4]) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(2,2), n>n_max, U=3:4, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, 3:4, 1) expected <- c(3.26087, 11.73913, N[3:4]) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(2,2), n>n_max, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 1) expected <- c(10, 20, 29.5082, 10.4918) expect_equal(result, expected, tolerance = 10^-6) }) test_that("rdca works for H_counts=c(2,2), n>n_max, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- 70 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 2) expected <- c(6.122328, 22.040379, 15, 26.837293) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(2,2), n=sum(N)", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2) expected <- c(N[1:3], 39.9999999999999929) expect_equal(result, expected) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), U=1, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, 1, 2) expect_identical(result, N) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), U=2, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, 2, 2) expect_identical(result, N) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), U=1:2, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, 1:2, 2) expected <- c(N[1:2], 15, 39.9999999999999929) expect_equal(result, expected) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), U=3, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, 3, 1) expected <- c(9.9999999999999982, 20, N[3], 40) expect_equal(result, expected) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), U=4, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, 4, 1) expected <- c(9.9999999999999982, 20, 15.0000000000000036, N[4]) expect_equal(result, expected) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), U=3:4, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, 3:4, 1) expect_identical(result, N) }) test_that("rdca errors for H_counts=c(2,2), n=sum(N), U=1:3, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 expect_error( rdca(n, H_counts, N, S, rho, rho^2, 1:3, 1), "U must contain no strata from domains in J" ) }) test_that("rdca errors for H_counts=c(2,2), n=sum(N), U=1:4, J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 expect_error( rdca(n, H_counts, N, S, rho, rho^2, 1:4, 1), "U must contain no strata from domains in J" ) }) test_that("rdca errors for H_counts=c(2,2), n=sum(N), U=1:3, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 expect_error( rdca(n, H_counts, N, S, rho, rho^2, 1:3, 1), "U must contain no strata from domains in J" ) }) test_that("rdca errors for H_counts=c(2,2), n=sum(N), U=1:4, J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 expect_error( rdca(n, H_counts, N, S, rho, rho^2, 1:4, 1), "U must contain no strata from domains in J" ) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), J=1", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 1) expected <- c(10, 20, 40.57377, 14.42623) expect_equal(result, expected, tolerance = 10^-7) }) test_that("rdca works for H_counts=c(2,2), n=sum(N), J=2", { H_counts <- c(2, 2) N <- c(10, 20, 15, 40) S <- c(5, 9, 15, 2) rho <- c(2, 5) * sqrt(c(0.4, 0.6)) n <- sum(N) # 85 result <- rdca(n, H_counts, N, S, rho, rho^2, J = 2) expected <- c(6.521739, 23.478261, 15, 40) expect_equal(result, expected, tolerance = 10^-8) }) # pop9d278s ---- test_that("rdca works for pop9d278s, nn_max", { p <- pop9d278s result <- rdca(20000, p$H_counts, p$N, p$S, p$rho, p$rho2) expect_snapshot(result) }) test_that("rdca works for pop9d278s, n>n_max, J=5", { p <- pop9d278s result <- rdca(20000, p$H_counts, p$N, p$S, p$rho, p$rho2, J = 5) expect_snapshot(result) }) # pop2d4s ---- test_that("rdca works for pop2d4s, n=sum(N)", { p <- pop2d4s result <- rdca(sum(p$N), p$H_counts, p$N, p$S, p$rho, p$rho2) expect_identical(result, pop2d4s$N) }) test_that("rdca works for pop2d4s, n=sum(N), J=1", { p <- pop2d4s result <- rdca(sum(p$N), p$H_counts, p$N, p$S, p$rho, p$rho2, J = 1) expect_equal(result, c(140, 110, 143.8802, 181.1198), tolerance = 10^-7) }) test_that("rdca works for pop2d4s, n=sum(N), J=2", { p <- pop2d4s result <- rdca(sum(p$N), p$H_counts, p$N, p$S, p$rho, p$rho2, J = 2) expect_equal(result, c(198.11321, 51.88679, 135, 190), tolerance = 10^-7) })