Nothing
# test multi-parent population utilities
context("test MPP utilities")
g <- matrix(ncol=8, nrow=8)
cur <- 1
for(i in 1:8) {
for(j in 1:i) {
g[j,i] <- g[i,j] <- cur
cur <- cur + 1
}
}
test_that("mpp_encode_alleles works for 8 alleles, phase unknown", {
homg <- c(1,3,6,10,15,21,28,36)
for(i in seq(along=homg))
expect_equal(mpp_encode_alleles(i, i, 8, FALSE), homg[i])
for(i in 1:8) {
for(j in 1:8) {
expect_equal(mpp_encode_alleles(i, j, 8, FALSE), g[i,j])
}
}
for(i in 1:8) {
expect_equal(mpp_encode_alleles(NA, i, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(i, NA, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(0, i, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(9, i, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(i, 0, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(i, 9, 8, FALSE), as.integer(NA))
}
})
test_that("mpp_decode_geno works for 8 alleles, phase unknown", {
homg <- c(1,3,6,10,15,21,28,36)
for(i in seq(along=homg))
expect_equal(mpp_decode_geno(homg[i], 8, FALSE), c(i,i))
for(i in 1:8) {
for(j in 1:8) {
expect_equal(mpp_decode_geno(g[i, j], 8, FALSE), sort(c(i,j)))
}
}
expect_equal(mpp_decode_geno(NA, 8, FALSE), rep(as.integer(NA), 2))
expect_equal(mpp_decode_geno(0, 8, FALSE), rep(as.integer(NA), 2))
expect_equal(mpp_decode_geno(37, 8, FALSE), rep(as.integer(NA), 2))
})
test_that("mpp_is_het works for 8 alleles, phase unknown", {
homg <- c(1,3,6,10,15,21,28,36)
for(i in seq(along=homg))
expect_equal(mpp_is_het(homg[i], 8, FALSE), FALSE)
for(i in 1:8) {
for(j in 1:8) {
expect_equal(mpp_is_het(g[i, j], 8, FALSE), ifelse(i==j, FALSE, TRUE))
}
}
})
test_that("mpp_geno_names works for 8 alleles", {
a <- LETTERS[1:8]
# genotype names
gn <- paste0(a[row(g)], a[col(g)])[upper.tri(g, TRUE)]
expect_equal(mpp_geno_names(a, FALSE), gn)
expect_equal(mpp_geno_names(a, TRUE), c(gn, paste0(a, "Y")))
})
# phase-known case
cur <- 37
for(i in 2:8) {
for(j in 1:(i-1)) {
g[i,j] <- cur
cur <- cur + 1
}
}
test_that("mpp_encode_alleles works for 8 alleles, phase known", {
homg <- c(1,3,6,10,15,21,28,36)
for(i in seq(along=homg))
expect_equal(mpp_encode_alleles(i, i, 8, TRUE), homg[i])
for(i in 1:8) {
for(j in 1:8) {
expect_equal(mpp_encode_alleles(i, j, 8, TRUE), g[i,j])
}
}
for(i in 1:8) {
expect_equal(mpp_encode_alleles(NA, i, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(i, NA, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(0, i, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(9, i, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(i, 0, 8, FALSE), as.integer(NA))
expect_equal(mpp_encode_alleles(i, 9, 8, FALSE), as.integer(NA))
}
})
test_that("mpp_decode_geno works for 8 alleles, phase known", {
homg <- c(1,3,6,10,15,21,28,36)
for(i in seq(along=homg))
expect_equal(mpp_decode_geno(homg[i], 8, TRUE), c(i,i))
for(i in 1:8) {
for(j in 1:8) {
expect_equal(mpp_decode_geno(g[i, j], 8, TRUE), c(i,j))
}
}
expect_equal(mpp_decode_geno(NA, 8, TRUE), rep(as.integer(NA), 2))
expect_equal(mpp_decode_geno(0, 8, TRUE), rep(as.integer(NA), 2))
expect_equal(mpp_decode_geno(65, 8, TRUE), rep(as.integer(NA), 2))
})
test_that("mpp_is_het works for 8 alleles, phase known", {
homg <- c(1,3,6,10,15,21,28,36)
for(i in seq(along=homg))
expect_equal(mpp_is_het(homg[i], 8, TRUE), FALSE)
for(i in 1:8) {
for(j in 1:8) {
expect_equal(mpp_is_het(g[i, j], 8, TRUE), ifelse(i==j, FALSE, TRUE))
}
}
})
test_that("invert_founder_index works", {
expect_equal(invert_founder_index(c(2,3,1,4)), c(2,0,1,3))
expect_equal(invert_founder_index(c(2,4,3,1)), c(3,0,2,1))
expect_equal(invert_founder_index(c(7,8,3,5,4,1,6,2)), c(5,7,2,4,3,6,0,1))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.