Nothing
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)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.