tests/testthat/test_utils.R

In baruuum/btoolbox: random toolbox

context("Test utility functions")


test_that("log_sum_exp & log_accu_exp functions work", {
    
    for (i in seq.int(50)) {
        
        # numeric
        x = rnorm(100)
        mat = matrix(x, nrow = 20)
        
        # integer
        y = sample.int(50, 100, replace = T) 
        mat_y = matrix(y, nrow = 20)
        
        expect_equal(log(sum(exp(x))), log_sum_exp(x))
        expect_equal(log(sum(exp(mat))), log_sum_exp(mat))
        expect_equal(log_sum_exp(matrix(x, nrow = 10)),
                     log_sum_exp(x))
        
        expect_equal(log(sum(exp(y))), log_sum_exp(y))
        expect_equal(log(sum(exp(mat_y))), log_sum_exp(mat_y))
        expect_equal(log_sum_exp(matrix(y, nrow = 10)),
                     log_sum_exp(y))

        expect_equal(log(cumsum(exp(x))), log_accu_exp(x))
        expect_equal(log(cumsum(exp(mat))), 
                     as.vector(log_accu_exp(mat)))
        expect_equal(log(cumsum(exp(matrix(x, nrow = 10)))),
                     as.vector(log_accu_exp(matrix(x, nrow = 10))))
        
        expect_equal(log(cumsum(exp(y))), log_accu_exp(y))
        expect_equal(log(cumsum(exp(mat_y))), 
                     as.vector(log_accu_exp(mat_y)))
        expect_equal(log(cumsum(exp(matrix(y, nrow = 10)))),
                     as.vector(log_accu_exp(matrix(y, nrow = 10))))
        
    }

    # testing charactes
    expect_error(log_sum_exp(letters[1:10]))
    expect_error(log_accu_exp(letters[1:10]))
    
    # check whether original object remains unchaged (numeric)
    x = runif(100, -20, 20)
    x_old = x
    mat = matrix(x, nrow = 20)
    mat_old = mat
    
    tmp = log_accu_exp(x)
    expect_identical(x, x_old)
    tmp = log_accu_exp(mat)
    expect_identical(mat, mat_old)
    
    # check whether original object remains unchaged (integer)
    x = sample.int(1000, 100, replace = T) 
    x_old = x
    mat = matrix(x, nrow = 20)
    mat_old = mat
    
    tmp = log_accu_exp(x)
    expect_identical(x, x_old)
    tmp = log_accu_exp(mat)
    expect_identical(mat, mat_old)

})
    
test_that("log_add_exp function works", {
    
    for (i in seq.int(50)) {
        
        x = runif(1)
        y = runif(1)
        
        expect_equal(log_add_exp(x, y), log(exp(x) + exp(y)))
        
    }
    
    expect_error(log_add_exp(x, "a"))
    
})


test_that("softmax and log-softmax works", {
    
    for (i in seq.int(50)) {
        
        x = runif(10)

        expect_equal(sum(softmax(x)), 1.0)
        expect_equal(sum(exp(log_softmax(x))), 1.0)
        
    }
    
})

test_that("test logit/inv_logit for under/overflow", {
    
    # should be fine as all reals are stored in double
    expect_equal(inv_logit(-1e10), 0.)
    expect_equal(inv_logit(1e10), 1.)
    
    # check numbers
    x = rnorm(20)
    expect_equal(inv_logit(x), plogis(x))
    
    # check logit 
    x = runif(20)
    expect_equal(logit(x), qlogis(x))
    

})

test_that("run_mean function works", {
    
    x = rnorm(50)
    
    for (i in seq.int(50)) {
        
        # check window = 1
        expect_identical(run_mean(x, 1), x)
        
        # odd-sized windows
        mid = sample(10:40, 1L)
        w   = sample(c(3,5,9), 1L)
        
        y = run_mean(x, w, T)    
        expect_equal(y[mid], mean(x[(mid - (w - 1)/2):(mid + (w - 1)/2)]))
        
        # even-sized windows
        mid = sample(10:40, 1L)
        w   = sample(c(2,6,8), 1L)
        
        y = run_mean(x, w, T)    

        expect_equal(y[mid], mean(x[(mid - w/2):(mid + w/2 - 1)]))

    }
    
})

test_that("col/row medians are accurately calculated", {
    
    n = 100
    k = 50
    
    for (rr in 1:5) {
        
        x = matrix(runif(n * k), ncol = k)
        expect_equal(apply(x, 2, median), colMedians(x))
        expect_equal(apply(x, 1, median), rowMedians(x))
        
    }
})