btoolbox: random toolbox

context("Test misc.R functions")

test_that("df_to_message generates right message", {
    
    # function to transform message output back to data.frame
    trans_back = function(z, with_colnames = F, with_rownames = F) {
        
        x = strsplit(z, "\\n")[[1]]
        
        if (with_colnames) n = x[1]; x = x[-1]
        n_col = if (with_rownames) 6 else 5
        
        res = x %>%
            strsplit("\\s+") %>%
            sapply(function(w) w[w != ""]) %>%
            t %>%
            as.numeric %>%
            matrix(ncol = n_col) %>%
            data.frame
        
        if (with_rownames) {
            
            rownames(res) = as.integer(res[, 1])
            res = res[, -1]
            
        }
    
        if (with_colnames) 
            names(res) = n %>% 
                strsplit("\\s+") %>% 
                unlist %>% 
                `[`(. != "")
    
        return(res)
        
    }

    x = data.frame(matrix(rnorm(50), ncol = 5))
    
    # no colnames
    out = trans_back(
        evaluate_promise(df_to_message(x, digits = 4, col_names = F))$messages
    )
        
    expect_identical(round(x, 4), out)
    
    # with colnames    
    y = x
    names(y) = letters[1:ncol(y)]
    
    out = trans_back(
        evaluate_promise(df_to_message(y, digits = 4))$message,
        with_colnames = T
    )
    
    expect_identical(round(y, 4), out)
    
    # with rownames & colnames
    y = x
    names(y) = letters[1:ncol(y)]
    out = trans_back(
        evaluate_promise(df_to_message(y, digits = 4, row_names = T))$message, 
        with_colnames = T, 
        with_rownames = T
    )
    
    expect_identical(round(y, 4), out)
    
})



test_that("reorder_labels chooses the right order", {
    
    # def function for test
    create_test_mat = function(y1, y2) {
        
        tmp_mat = as.matrix(table(y1, y2))
        class(tmp_mat) = "matrix"
        tmp_mat[1, 1] = tmp_mat[1, 3]
        tmp_mat[3, 3] = tmp_mat[3, 1]
        tmp_mat[1, 3] = tmp_mat[3, 1] = 0
        
        return(tmp_mat)
        
    }

    # integer
    x = sample.int(3, 50, T)
    
    while (sum(duplicated(table(x))) > 0)
        x = sample.int(3, 50, T)
    
    y1 = reorder_labels(x)
    y2 = reorder_labels(x, decreasing = FALSE)
    
    # check order
    expect_true(all(diff(table(y1)) <= 0))

    # should be TRUE if and only if tmp_mat is diagonal, implying that table(y1, y2) is anti-diagonal
    tmp_mat = create_test_mat(y1, y2)
    expect_equal(tmp_mat, diag(diag(tmp_mat)), check.attributes = F)
    
    # check that mapping is one-to-one
    m = table(x, y1) != 0
    expect_true(all(colSums(m) == 1))
    expect_true(all(rowSums(m) == 1))
    
    # character    
    x = sample(letters[1:3], 50, T)
    
    while (sum(duplicated(table(x))) > 0)
        x = sample(letters[1:3], 50, T)

    y1 = reorder_labels(x)
    y2 = reorder_labels(x, decreasing = FALSE)
    
    expect_true(all(diff(table(y1)) <= 0))

    tmp_mat = create_test_mat(y1, y2)
    expect_equal(tmp_mat, diag(diag(tmp_mat)), check.attributes = F)
    
    m = table(x, y1) != 0
    expect_true(all(colSums(m) == 1))
    expect_true(all(rowSums(m) == 1))
    
    # factor
    x = factor(x, levels = letters[3:1])
    y1 = reorder_labels(x)
    y2 = reorder_labels(x, decreasing = FALSE)
    
    expect_true(all(diff(table(y1)) <= 0))

    tmp_mat = create_test_mat(y1, y2)
    expect_equal(tmp_mat, diag(diag(tmp_mat)), check.attributes = F)
    
    m = table(x, y1) != 0
    expect_true(all(colSums(m) == 1))
    expect_true(all(rowSums(m) == 1))
    
})


test_that("round_to_char gives right results", {
    
    # scalar
    for (i in seq_len(10)) {
    
        x = abs(rnorm(1))
        expect_true(nchar(round_to_char(x, 3)) == 3 + 2)
        expect_true(nchar(round_to_char(-x, 3)) == 3 + 3)
        expect_true(as.numeric(round_to_char(x, 3)) == round(x, 3))
        
    }
    
    # vector
    x = abs(rnorm(10))
    expect_true(all(nchar(round_to_char(x, 3)) == 3 + 2))
    expect_true(all(nchar(round_to_char(-x, 3)) == 3 + 3))
    expect_true(all(as.numeric(round_to_char(x, 3)) == round(x, 3)))

})


test_that("upper_first_char gives right results", {
    
    tmp = paste0(
        c(letters[sample.int(26, 3)], LETTERS[sample.int(26, 3)]),
        collapse = ""
    )

    x = upper_first_char(tmp)
    expect_identical(nchar(x), nchar(tmp))
    expect_identical(substr(x, 1, 1), toupper(substr(tmp, 1, 1)))
    expect_identical(substr(x, 2, nchar(x)), substr(tmp, 2, nchar(tmp)))
    
    x = upper_first_char(tmp, rest_to_lower = TRUE)
    expect_identical(nchar(x), nchar(tmp))
    expect_identical(substr(x, 1, 1), toupper(substr(tmp, 1, 1)))
    expect_identical(substr(x, 2, nchar(x)), tolower(substr(tmp, 2, nchar(tmp))))

    tmp2 = paste0(
        c(LETTERS[sample.int(26, 3)],letters[sample.int(26, 3)]),
        collapse = ""
    )
    
    x = upper_first_char(tmp2)
    expect_identical(tmp2, x)
    
})


test_that("quantilize and find_interval", {
    
    n_q = rpois(1, 2) + 2L
    x = rnorm(n_q * 100)
    
    a = quantilize(x, n_q, TRUE)
    expect_true(is.factor(a))
    expect_equal(length(levels(a)), n_q)
    expect_equal(var(table(a)), 0)
    
    expect_error(quantilize(x, -1.0 * n_q))
    expect_error(quantilize(letters[1:20], n_q))
    expect_false(is.factor(quantilize(x = x, n = n_q, return_labels = F)))
    
    x = runif(5000)
    y = quantilize(x, 5)
    expect_equal(find_interval(y, .05), 1)
    expect_equal(find_interval(y, .25), 2)
    expect_equal(find_interval(y, .45), 3)
    expect_equal(find_interval(y, .65), 4)
    expect_equal(find_interval(y, .85), 5)
    expect_equal(find_interval(y, seq(.05, .85, .20)), 1:5)
    
    expect_error(find_interval(is.numeric(y), .05))
    expect_error(find_interval(y, "a"))
    
    expect_warning(find_interval(y, -1))
    expect_warning(find_interval(y, 2))
    expect_equal(suppressWarnings(find_interval(y, -1)), 1)
    expect_equal(suppressWarnings(find_interval(y, 2)), 5)
    
})