tests/testthat/test-likelihood-outside.R

## SKG
## April 13, 2020
## Can't believe I've been home an entire month
## Testing likelihood for outside generator

test_that("like_inside_cond", {
    sampled_vars_list <- list(x0 = 1, n0 = 1,
                                   n_prime = 1,
                                   n_pos_prime = 1)
    sampled_trees_calc <- data.frame(n = c(1, 2),
                                     n_pos = c(1, 1),
                                     avg_like = c(.4, .2))
    p_plus <- .4
    p_neg <- .2
    w_pos <- .5
    out <- like_inside_cond(sampled_vars_list,
                            sampled_trees_calc,
                            p_plus, p_neg,
                            w_pos)
    expect_true(is.numeric(out))
    ## ############
    sampled_vars_list <- list(x0 = 1, n0 = 2,
                              n_prime = c(1, 1),
                              n_pos_prime = c(1, 0))
    sampled_trees_calc <- data.frame(n = c(1, 1),
                                     n_pos = c(1, 0),
                                     avg_like = c(.4, .2))
    p_plus <- .4
    p_neg <- .2
    w_pos <- .5
    out <- like_inside_cond(sampled_vars_list,
                            sampled_trees_calc,
                            p_plus, p_neg,
                            w_pos)
    expect_true(out > 0)
})

test_that("prob_n0", {
    p_plus <- .4
    p_neg <- .2
    x0 <- 1
    n0 <- 1
    n <- 1
    out <- prob_n0(p_plus, p_neg, x0, n0, n)
    expect_equal(out, 1)
    ## ##################
    p_plus <- .4
    p_neg <- .2
    x0 <- 0
    n0 <- 1
    n <- 1
    out <- prob_n0(p_plus, p_neg, x0, n0, n)
    expect_equal(out, 1)
    ## ##################
    p_plus <- .4
    p_neg <- .2
    x0 <- 0
    n0 <- 2
    n <- 2
    out <- prob_n0(p_plus, p_neg, x0, n0, n)
    expect_equal(out, .2^2 / (.2^2 + .2^1))
    ## ##################
    p_plus <- .4
    p_neg <- .2
    x0 <- 1
    n0 <- 2
    n <- 2
    out <- prob_n0(p_plus, p_neg, x0, n0, n)
    expect_equal(out, .4^2 / (.4^2 + .4^1))
    ## ##################

})



test_that("prob_x0", {
    w_pos <- .4
    x0 <- 1
    out <- prob_x0(x0, .4)
    expect_equal(out, w_pos)
    ## ##################
    w_pos <- .4
    x0 <- 0
    out <- prob_x0(x0, .4)
    expect_equal(out, 1-w_pos)
})



test_that("like_sampled_trees", {
    p_plus <- .6
    p_neg <- .3

    sampled_trees <- data.frame(n = 2,
                                n_pos = 1,
                                i_pos = 1,
                                i_neg = 0,
                                freq = 1)

    out <- like_sampled_trees(p_plus, p_neg, sampled_trees)

    avg_like <- (.4)^1 * (.7)^1 * .6^1
    expect_equal(out$avg_like, avg_like)
########################################
    p_plus <- .6
    p_neg <- .3

    sampled_trees <- data.frame(n = 2,
                                n_pos = 1,
                                i_pos = c(1, 0),
                                i_neg = c(0, 1),
                                freq = c(2,1))

    out <- like_sampled_trees(p_plus, p_neg, sampled_trees)

    avg_like <- ((.4)^1 * (.7)^1 * .6^1 * 2 +
        (.4)^1 * (.7)^1 * .3^1 * 1 )/ 3
    expect_equal(out$avg_like, avg_like)
    ########################################
    p_plus <- .6
    p_neg <- .3

    sampled_trees <- data.frame(n = c(2, 2, 3),
                                n_pos = c(1, 1, 0),
                                i_pos = c(1, 0, 0),
                                i_neg = c(0, 1, 2),
                                freq = c(2,1, 1))

    out <- like_sampled_trees(p_plus, p_neg, sampled_trees)

    avg_like <- c(((.4)^1 * (.7)^1 * .6^1 * 2 +
                   (.4)^1 * (.7)^1 * .3^1 * 1 )/ 3,
                  (.4)^0 * (.7)^3 * .3^2 * 1 )
    expect_equal(out$avg_like, avg_like)

}
skgallagher/TBornotTB documentation built on April 21, 2020, 1:19 p.m.