tests/testthat/test-sim_sample.R

In wahani/saeSim: Simulation Tools for Small Area Estimation

context("sim_sample")
test_that("Attributes are preserved", {
  setup <- sim_base(base_id(nDomains=3, nUnits = 4)) %>%
    sim_gen_x(mean=50, sd=20, name = "x") %>%
    sim_gen_e(0, 1, name = "e") %>%
    sim_comp_pop(function(dat) {attr(dat, "x") <- 2; dat})

  setup %>%
    sim_sample(sample_number(2)) %>%
    as.data.frame %>%
    attr("x") %>%
    expect_equal(2)

  setup %>%
    sim_sample(sample_fraction(0.2)) %>%
    as.data.frame %>%
    attr("x") %>%
    expect_equal(2)

  setup %>%
    sim_sample(sample_number(2, groupVars = "idD")) %>%
    as.data.frame %>%
    attr("x") %>%
    expect_equal(2)

  setup %>%
    sim_sample(sample_fraction(0.2, groupVars = "idD")) %>%
    as.data.frame %>%
    attr("x") %>%
    expect_equal(2)

})

test_that("Basic sampling functionality", {
  setup <- sim_base(base_id(nDomains=3, nUnits = 4))
  
  setup %>% sim_sample(sample_fraction(size = 0.05)) %>% as.data.frame %>% 
    nrow %>% expect_equal(1)
  
  setup %>% sim_sample(sample_number(size = 5L)) %>% as.data.frame %>% 
    nrow %>% expect_equal(5)
  
  setup %>% sim_sample(sample_number(size = 2L, groupVars = "idD")) %>% as.data.frame %>% 
    nrow %>% expect_equal(6)
  
  setup <- base_id(3, 100)
  setup %>% sim_sample(sample_fraction(size = 0.01, groupVars = "idD")) %>% as.data.frame %>% 
    nrow %>% expect_equal(3)
})

test_that("applying the sampling functions correctly", {
  setup <- sim_base(base_id(nDomains=3, nUnits = 10)) %>%
    sim_gen_x(mean=50, sd=20, name = "x")
  
  expect_equal(nrow(sim(setup %>% sim_sample())[[1]]), 15)
  expect_equal(nrow(sim(setup %>% sim_sample(sample_fraction(0.05)))[[1]]), (2))
  
  expect_equal(nrow(sim(setup %>% sim_sample(sample_number(5L)))[[1]]), (5))
  expect_equal(nrow(sim(setup %>% sim_sample(sample_number(c(3), groupVars = "idD")))[[1]]), (9))
})

test_that("more sampling", {
  setup <- sim_base()
  result1 <- setup %>% sim_sample(sample_number(1)) %>% as.data.frame
  result2 <- setup %>% sim_sample(sample_fraction(0.5)) %>% as.data.frame
  result3 <- setup %>% sim_sample(sample_number(5.5)) %>% as.data.frame
  result4 <- setup %>% sim_sample(sample_number(1L)) %>% as.data.frame
  expect_equal(nrow(result1), (1))
  expect_equal(nrow(result2), (5000))
  expect_equal(nrow(result3), (5))
  expect_equal(nrow(result4), (1))
})

test_that("vectorized versions of sample_number", {
  setup <- sim_base()
  result1 <- setup %>% sim_sample(sample_numbers(1, groupVars = "idD")) %>% as.data.frame
  result2 <- setup %>% sim_sample(sample_numbers(rep(c(1, 2), 50), groupVars = "idD")) %>% as.data.frame  
  expect_equal(nrow(result1), 100)
  expect_equal(nrow(result2), 150)
})

test_that("sampling of clusters", {
  dat <- addAttr(base_id())
  
  dat1 <- sample_cluster_number(2, groupVars = "idD")(dat)
  expect_is(dat1, "data.frame")
  expect_equal(attr(dat1, "x"), 1)
  expect_equal(nrow(dat1), 20)
  expect_equal(length(unique(dat1$idD)), 2)
  
  dat2 <- sample_cluster_fraction(0.2, groupVars = "idD")(dat)
  expect_is(dat2, "data.frame")
  expect_equal(attr(dat2, "x"), 1)
  expect_equal(nrow(dat2), 20)
  expect_equal(length(unique(dat2$idD)), 2)
})