tests/testthat/test-util.R

In qtlcharts: Interactive Graphics for QTL Experiments

context("utilities")

test_that("select phenotype columns works on small cases", {

    data(grav)
    phe <- phenames(grav)

    expect_equal( getPhename(grav, "T0"), "T0" )
    expect_equal( getPhename(grav, 1), "T0" )
    expect_equal( getPhename(grav, c(2, 5, 20)), phe[c(2,5,20)] )
    expect_equal( getPhename(grav, -(5:nphe(grav))), phe[1:4] )

})

test_that("selectMatrixColumns works with small cases", {

    n <- 5
    mat <- matrix(ncol=n, nrow=2)
    colnames(mat) <- paste0("col", 1:n)

    expect_equal( selectMatrixColumns(mat, "col1"), 1 )
    expect_equal( selectMatrixColumns(mat, c("col4", "col2")), c(4,2) )
    expect_equal( selectMatrixColumns(mat, colnames(mat)), 1:5 )

})

test_that("grabarg works in simple cases", {

    expect_equal( grabarg(list(map.function="c-f"), "method", "imp"), "imp" )
    expect_equal( grabarg(list(method="argmax", map.function="c-f"), "method", "imp"), "argmax" )

})

test_that("extractPheno works", {

    data(grav)
    expect_equivalent( extractPheno(grav, 1), as.matrix(grav$pheno[,1,drop=FALSE]) )
    expect_equivalent( extractPheno(grav, c(1, 5, 241)), as.matrix(grav$pheno[,c(1, 5, 241),drop=FALSE]) )

    expect_equivalent( extractPheno(grav, "T0"), as.matrix(grav$pheno[,"T0",drop=FALSE]) )
    expect_equivalent( extractPheno(grav, c("T0", "T10", "T480")), as.matrix(grav$pheno[,c("T0", "T10", "T480"),drop=FALSE]) )

    # vector of phenotypes
    x <- rnorm(nind(grav))
    expect_equivalent( extractPheno(grav, x), cbind(x) )

    # matrix of phenotypes
    x <- matrix(rnorm(nind(grav)*10), ncol=10)
    expect_equivalent( extractPheno(grav, x), x )

    expect_error( extractPheno(grav, "blah") )
    expect_error( extractPheno(grav, 0) )
    expect_error( extractPheno(grav, c(-1, 5)) )

    # negative indices
    expect_equivalent( extractPheno(grav, -(11:20)), as.matrix(grav$pheno[,-(11:20),drop=FALSE]) )

    # logical values
    expect_equivalent( extractPheno(grav, qtl::phenames(grav) == "T240"), as.matrix(grav$pheno[,"T240",drop=FALSE]) )

})

test_that("calcSignedLOD works", {

    scanout <- data.frame(chr=c("1", "2", "3"), pos=rep(0,3),
                          lod1=1:3, lod2=4:6, lod3=7:9)
    class(scanout) <- c("scanone", "data.frame")

    eff <- list(cbind("a"=c(1, -1,  0.0), "d"=c(0, 1, 0)),
                cbind("a"=c(-1, 1, -0.2)),
                cbind("a"=c(1, -1,  0.2)))

    signedscanout <- data.frame(chr=c("1", "2", "3"), pos=rep(0,3),
                                lod1=c(1,-2,3), lod2=c(-4,5,-6), lod3=c(7,-8,9))
    class(signedscanout) <- c("scanone", "data.frame")

    expect_equal( calcSignedLOD(scanout, eff), signedscanout )

})

test_that("test is_equally_spaced", {

    x <- seq(0, 8, length=241)
    expect_true( is_equally_spaced(x) )

    x <- 1:10
    expect_true( is_equally_spaced(x) )

    x <- c(1, 3, 4, 5)
    expect_false( is_equally_spaced(x) )

    x <- c(1, 3, 2, 4, 5)
    expect_warning( result <- is_equally_spaced(x), "vector is not monotonic")
    expect_false(result)

    x <- c(1, 3, NA, 4, 5)
    expect_warning( result <- is_equally_spaced(x), "vector contains missing values")
    expect_false(result)

    expect_warning( result <- is_equally_spaced(1), "vector has length < 2")
    expect_false(result)

    expect_warning( result <- is_equally_spaced(NULL), "vector has length < 2")
    expect_false(result)

    expect_warning( result <- is_equally_spaced(c("a", "b", "c")), "vector is not numeric")
    expect_false(result)

})