tests/testthat/test-genoprobs_col2drop.R

In rqtl/qtl2scan: Genome Scans for QTL Experiments

context("genoprobs columns to drop")

test_that("genoprobs_cols2drop works", {

    # load example data from R/qtl
    library(qtl)
    data(fake.f2)
    fake.f2 <- fake.f2[c(18,19,"X"),] # subset chromosomes
    library(qtl2geno)
    fake.f2 <- convert2cross2(fake.f2)

    # calculate genoprobs
    pr <- calc_genoprob(fake.f2)

    # just X chromosome
    expect_equal(genoprobs_col2drop(pr$X), numeric(0))

    # all chromosomes
    expected <- vector("list", length(pr))
    names(expected) <- names(pr)
    for(i in seq(along=expected)) expected[[i]] <- numeric(0)
    expect_equal(genoprobs_col2drop(pr), expected)
    expect_equal(genoprobs_col2drop(pr, FALSE), expected)

    #####
    # all males
    fake.f2$is_female[fake.f2$is_female] <- FALSE
    pr <- calc_genoprob(fake.f2)

    # just X chromosome
    expect_equal(genoprobs_col2drop(pr$X), 1:4)

    # all chromosomes
    expected$X <- 1:4
    expect_equal(genoprobs_col2drop(pr), expected)
    expect_equal(genoprobs_col2drop(pr, FALSE), expected)

    # test Xonly=FALSE
    expected2 <- expected;expected2$X <- numeric(0)
    prA <- pr
    attr(prA, "is_x_chr") <- rep(FALSE, length(prA))
    expect_equal(genoprobs_col2drop(prA), expected2)
    expect_equal(genoprobs_col2drop(prA, FALSE), expected)

    #####
    # all females
    fake.f2$is_female[!fake.f2$is_female] <- TRUE
    pr <- calc_genoprob(fake.f2)

    # just X chromosome
    expect_equal(genoprobs_col2drop(pr$X), 5:6)

    # all chromosomes
    expected$X <- 5:6
    expect_equal(genoprobs_col2drop(pr), expected)
    expect_equal(genoprobs_col2drop(pr, FALSE), expected)

    # test Xonly=FALSE
    expected2 <- expected;expected2$X <- numeric(0)
    prA <- pr
    attr(prA, "is_x_chr") <- rep(FALSE, length(prA))
    expect_equal(genoprobs_col2drop(prA), expected2)
    expect_equal(genoprobs_col2drop(prA, FALSE), expected)

})