tests/testthat/test_ms.R

test_that("redist_mergesplit works", {
    set.seed(1, kind = "Mersenne-Twister", normal.kind = "Inversion")

    nsims <- 10
    out <- redist_mergesplit(fl_map, nsims, nsims %/% 2, init_plan = plans_10[, 1], silent = TRUE)
    par <- redist.parity(as.matrix(out), total_pop = pop)

    expect_equal(range(as.matrix(out)), c(1, 3))
    expect_true(all(par <= 0.1))

    out <- redist_mergesplit(fl_map, 20, 5, thin = 4, init_plan = plans_10[, 1], silent = TRUE)
    expect_equal(ncol(as.matrix(out)), 5L)
})

test_that("Additional constraints work", {
    skip_on_cran()
    iowa_map <- redist_map(iowa, ndists = 4, pop_tol = 0.05)

    constr <- redist_constr(iowa_map) %>%
        add_constr_grp_hinge(5, dem_08, tot_08, c(0.5, 0.6)) %>%
        add_constr_grp_hinge(5, bvap + hvap, vap, c(0.5, 0)) %>%
        add_constr_custom(1e6, function(plan, distr) plan[7] == 2)

    plans <- redist_mergesplit(iowa_map, 100, 20, init_plan = iowa$cd_2010,
                               constraints = constr, silent = TRUE)
    skip = seq(1, which.max(by_plan(plans$mcmc_accept, 4)) - 1) # skip to first acceptance
    expect_false(any(as.matrix(plans)[7, -skip] == 2))
})

test_that("redist_mergesplit_parallel works", {
    skip_on_os("windows")
    data(fl25)
    fl_map <- redist_map(fl25, ndists = 3, pop_tol = 0.1) %>% suppressMessages()

    N <- 20
    chains <- 2

    pl1 <- redist_mergesplit_parallel(fl_map, nsims = N, warmup = N/2, chains = chains,
        ncores = 2, silent = TRUE)
    pl2 <- redist_mergesplit_parallel(fl_map, nsims = N, chains = chains,
        ncores = 2, warmup = 0, init_name = F, silent = TRUE)
    pl3 <- redist_mergesplit_parallel(fl_map, nsims = N, warmup = N/2, chains = chains,
        ncores = 2, return_all = F, init_name = F, silent = TRUE)

    expect_equal(get_n_ref(pl1), chains)
    expect_equal(get_n_ref(pl2), 0)
    expect_equal(get_n_ref(pl3), 0)

    expect_equal(nrow(pl1), 3*chains*(N/2 + 1))
    expect_equal(nrow(pl2), 3*chains*N)
    expect_equal(nrow(pl3), 3*chains)
})

test_that("Parallel runs are reproducible", {
    set.seed(5118)
    pl1 <- redist_mergesplit_parallel(fl_map, 100, warmup = 50, chains = 2, silent = TRUE)
    set.seed(5118)
    pl2 <- redist_mergesplit_parallel(fl_map, 100, warmup = 50, chains = 2, silent = TRUE)

    # runtime is the only thing that shouldn't be identical
    for (i in 1:2) {
        attr(pl1, "diagnostics")[[i]]$runtime <- NULL
        attr(pl2, "diagnostics")[[i]]$runtime <- NULL
    }

    expect_identical(pl1, pl2)
})

Try the redist package in your browser

Any scripts or data that you put into this service are public.

redist documentation built on April 3, 2023, 5:46 p.m.