tests/testthat/test-check_rdca.R

In stratallo: Optimum Sample Allocation in Stratified Sampling

# rdca_obj_cnstr ----

test_that("rdca_obj_cnstr works as expected)", {
  d <- pop2d4s
  x <- c(140, 104.57, 113.08, 142.35)

  result <- rdca_obj_cnstr(x, 500, d$H_counts, d$N, d$S, d$rho2)
  expected <- list(
    Topt = 71.35512,
    h = 0,
    h_d = c(`1` = 0.04442545, `2` = -0.01316309)
  )

  expect_equal(result, expected, tolerance = 10^-6)
})

test_that("rdca_obj_cnstr works as expected for custom J)", {
  d <- pop2d4s
  x <- c(140, 104.57, 113.08, 142.35)

  result <- rdca_obj_cnstr(x, 500, d$H_counts, d$N, d$S, d$rho2, 1)
  expected <- list(
    Topt = 71.35512,
    h = 0,
    h_d = c(`1` = 0.04442545, `2` = -0.01316309),
    g_dh = c(`(1,1)` = 0, `(1,2)` = -5.43)
  )

  expect_equal(result, expected, tolerance = 10^-6)
})

# rdca_cnstr_check ----

test_that("rdca_cnstr_check works as expected)", {
  d <- pop2d4s
  x <- c(140, 104.57, 113.08, 142.35)

  result <- rdca_cnstr_check(x, 500, d$H_counts, d$N, d$S, d$rho2)
  expected <- list(
    h = c(`tol=1e-19` = TRUE),
    h_d = c(`tol=1e-01` = TRUE, `tol=1e-01` = TRUE)
  )

  expect_identical(result, expected)
})

test_that("rdca_cnstr_check works as expected for custom J)", {
  d <- pop2d4s
  x <- c(140, 104.57, 113.08, 142.35)

  result <- rdca_cnstr_check(x, 500, d$H_counts, d$N, d$S, d$rho2, 1)
  expected <- list(
    h = c(`tol=1e-19` = TRUE),
    h_d = c(`tol=1e-01` = TRUE, `tol=1e-01` = TRUE),
    g_dh = c(`(1,1)` = TRUE, `(1,2)` = TRUE)
  )

  expect_identical(result, expected)
})

# rdca_optcond_sU ----

test_that("rdca_optcond_sU works as expected (U=1)", {
  s <- c(0.2749514, 0.9614205)
  d <- pop2d4s

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 1)
  expect_identical(result, TRUE)

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 1, TRUE)
  expect_equal(result, 0.1806705, tolerance = 10^-7)
})

test_that("rdca_optcond_sU works as expected (U=2)", {
  s <- c(0.09402774, 0.95224251)
  d <- pop2d4s

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 2)
  expect_identical(result, FALSE)

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 2, TRUE)
  expect_equal(result, -0.188815, tolerance = 10^-6)
})

test_that("rdca_optcond_sU works as expected (U=3)", {
  s <- c(0.1094162, 1.1558573)
  d <- pop2d4s

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 3)
  expect_identical(result, TRUE)

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 3, TRUE)
  expect_equal(result, 0.1166268, tolerance = 10^-6)
})

test_that("rdca_optcond_sU works as expected (U=1:2)", {
  s <- 0.9509614
  d <- pop2d4s

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 1:2)
  expect_identical(result, logical(0))

  result <- rdca_optcond_sU(d$H_counts, d$S, d$rho, s, 1:2, TRUE)
  expect_identical(result, double(0))
})

test_that("rdca_optcond_sU works as expected for 5 domains (U=5:9)", {
  H_counts <- c(3, 2, 3, 2, 2)
  S <- 1:12
  rho <- c(11, 12, 13, 14, 15)
  U <- c(9, 5, 7, 6, 8)
  s <- c(10, 20, 40, 50)

  result <- rdca_optcond_sU(H_counts, S, rho, s, U)
  expect_identical(result, c(TRUE, TRUE))

  result <- rdca_optcond_sU(H_counts, S, rho, s, U, TRUE)
  expect_equal(result, c(17.60000, 38.44444), tolerance = 10^-6)
})

test_that("rdca_optcond_sU works as expected for 5 domains (U=1)", {
  H_counts <- c(3, 2, 3, 2, 2)
  S <- 1:12
  rho <- c(11, 12, 13, 14, 15)
  U <- 1
  s <- c(10, 20, 30, 40, 50)

  result <- rdca_optcond_sU(H_counts, S, rho, s, U)
  expect_identical(result, FALSE)

  result <- rdca_optcond_sU(H_counts, S, rho, s, U, TRUE)
  expect_identical(result, -1)
})

test_that("rdca_optcond_sU works as expected for 5 domains (U=1:11)", {
  H_counts <- c(3, 2, 3, 2, 2)
  S <- 1:12
  rho <- c(11, 12, 13, 14, 15)
  U <- 1:11
  s <- 50

  result <- rdca_optcond_sU(H_counts, S, rho, s, U)
  expect_identical(result, TRUE)

  result <- rdca_optcond_sU(H_counts, S, rho, s, U, TRUE)
  expect_equal(result, 48.63636, tolerance = 10^-7)
})