tests/testthat/test_sample_logp.R

In baruuum/btoolbox: random toolbox

context("testing sample_logp")

test_that("function throws the right errors", {

    K = rpois(1, 3) + 1
    N = 1e3
    lqvec = log(rexp(K))
    
    # match between x and lpvec
    expect_error(sample_logp(1:(K+1), N, lqvec))
    
    # infinite values in prob vector
    expect_error(sample_logp(1:(K+1), N, c(lqvec, Inf)))
    expect_error(sample_logp(1:(K+1), N, c(lqvec, -Inf)))
    
    # integer valued size
    expect_error(sample_logp(1:K, 10 + runif(1), lqvec))

})

test_that("function samples according to probs", {
    
    n_test = 100
    test_res = numeric(n_test)
    
    for (ii in 1:n_test) {    
        
        K = rpois(1, 2) + 2
        N = 1e3
    
        K1 = 0
        while (K1 != K) {
            
            qvec = rexp(K)
            lqvec = log(qvec)
            pvec = qvec / sum(qvec)
            lpvec = log(pvec)
            
            x = table(sample_logp(1:K, N, lqvec))
            K1 = length(x)
            
        }
        
        p = x / sum(x)
        test_res[ii] = suppressWarnings(
            stats::chisq.test(p, p = pvec)$p.value
        )
        
    }
    
    expect_true(
        sum(test_res > .95)/length(test_res) > .95
    )
        
})