tests/testthat/test-likelihood-sampler.R

In skgallagher/TBornotTB: Analyze Tuberculosis Patients in Maryland

## April 13, 2020
## Test the likelihood sampling functions

test_that("sample_unique_perms0", {
    g <- 1
    n <- 1
    B <- 1
    out <- sample_unique_perms0(g, n, B)
    expect_equal(dim(out), c(1,1))
###########
    g <- 1
    n <- 1
    B <- 2
    out <- sample_unique_perms0(g, n, B)
    expect_equal(dim(out), c(1,B))
###########
    g <- 2
    n <- 1
    B <- 1
    out <- sample_unique_perms0(g, n, B)
    expect_equal(dim(out), c(g,B))
###########
    g <- 2
    n <- 1
    B <- 10
    out <- sample_unique_perms0(g, n, B)
    expect_equal(dim(out), c(g,B))
    ###########
    g <- 2
    n <- 5
    B <- 4
    out <- sample_unique_perms0(g, n, B)
    expect_equal(dim(out), c(g,B))
    expect_true(all(colSums(out) == n))
###########
      ###########
    g <- 3
    n <- 5
    B <- 4
    out <- sample_unique_perms0(g, n, B)
    expect_equal(dim(out), c(g,B))
    expect_true(all(colSums(out) == n))
    ###########
    

})


test_that("sample_outside_gen_vars", {
    n <- 1
    n_pos <- 1
    B <- 1
    out <- sample_outside_gen_vars(n, n_pos, B)
    expect_equal(length(out), B)
    expect_equal(out[[1]]$x0, n_pos)
    expect_equal(length(out[[1]]$n_prime), out[[1]]$n0)
    ## #
    n <- 1
    n_pos <- 0
    B <- 1
    out <- sample_outside_gen_vars(n, n_pos, B)
    expect_equal(length(out), B)
    expect_equal(out[[1]]$x0, n_pos)
    expect_equal(length(out[[1]]$n_prime), out[[1]]$n0)
    expect_equal(length(out[[1]]$n_pos_prime), out[[1]]$n0)
    ## ###############################
    n <- 2
    n_pos <- 0
    B <- 1
    out <- sample_outside_gen_vars(n, n_pos, B)
    expect_equal(length(out), B)
    expect_equal(out[[1]]$x0, n_pos)
    ## ###############################



})


test_that("sample_RUP0", {

    g <- 1
    n_prime <- 1
    n_pos <- 1
    B <- 1
    out <- sample_RUP0(g, n_prime, n_pos, B)
    expect_equal(out, 1)
    expect_equal(length(out), length(n_prime))
    ## ###########3
    g <- 1
    n_prime <- 1
    n_pos <- 0
    B <- 1
    out <- sample_RUP0(g, n_prime, n_pos, B)
    expect_equal(out, 0)
    expect_equal(length(out), length(n_prime))
       ## ###########3
    g <- 3
    n_prime <- c(1, 1, 1)
    n_pos <- 3
    B <- 1
    out <- sample_RUP0(g, n_prime, n_pos, B)
    expect_equal(out, c(1, 1, 1))
    expect_equal(length(out), length(n_prime))


})