Nothing
context("check cross")
test_that("check_crosstype works appropriately", {
good_types <- c("bc", "f2", "riself", "risib", "dh", "haploid")
for(type in good_types)
expect_true(check_crosstype(type))
expect_error(check_crosstype("f2pk"))
expect_false(check_crosstype("f2pk", FALSE))
expect_error(check_crosstype("bada1gakadsf"))
expect_false(check_crosstype("bada1gakadsf", FALSE))
})
test_that("count_invalid_genotypes works appropriately", {
grav2 <- read_cross2(system.file("extdata", "grav2.zip", package="qtl2"))
expect_true(check_cross2(grav2))
count <- count_invalid_genotypes(grav2)
expect_true(all(count==0))
iron <- read_cross2(system.file("extdata", "iron.zip", package="qtl2"))
expect_true(check_cross2(iron))
count <- count_invalid_genotypes(iron)
expect_true(all(count==0))
# add some errors
set.seed(79648025)
g <- grav2$geno[[1]]
err <- sample(0:5, prod(dim(g)), replace=TRUE, prob=c(0.95, rep(0.01, 5)))
grav2$geno[[1]] <- g+err
count <- count_invalid_genotypes(grav2)
expect_equivalent(count[,1] , rowSums(g+err > 2))
expect_true(all(count[,-1] == 0))
# add some errors to the other data
g <- iron$geno[[1]]
err <- sample(0:5, prod(dim(g)), replace=TRUE, prob=c(0.95, rep(0.01, 5)))
iron$geno[[1]] <- g+err
count <- count_invalid_genotypes(iron)
expect_equivalent(count[,1] , rowSums(g+err > 5))
expect_true(all(count[,-1] == 0))
})
test_that("check_cross2 gives proper warnings", {
iron <- read_cross2(system.file("extdata", "iron.zip", package="qtl2"))
# missing geno
iron_bad <- iron; iron_bad$geno <- NULL
expect_warning(check_cross2(iron_bad))
# missing gmap
iron_bad <- iron; iron_bad$gmap <- NULL
expect_warning(check_cross2(iron_bad))
# missing cross_info
iron_bad <- iron; iron_bad$cross_info <- NULL
expect_warning(check_cross2(iron_bad))
# missing is_female
iron_bad <- iron; iron_bad$is_female <- NULL
expect_warning(check_cross2(iron_bad))
# missing is_x_chr
iron_bad <- iron; iron_bad$is_x_chr <- NULL
expect_warning(check_cross2(iron_bad))
# missing alleles okay
iron_bad <- iron; iron_bad$alleles <- NULL
expect_true(check_cross2(iron_bad))
# missing pmap okay
iron_bad <- iron; iron_bad$pmap <- NULL
expect_true(check_cross2(iron_bad))
# gmap has no names()
iron_bad <- iron; names(iron_bad$gmap) <- NULL
expect_warning(check_cross2(iron_bad))
# pmap has no names()
iron_bad <- iron; names(iron_bad$pmap) <- NULL
expect_warning(check_cross2(iron_bad))
# gmap names != geno names
iron_bad <- iron; names(iron_bad$gmap) <- 1:20
expect_warning(check_cross2(iron_bad))
# pmap names != geno names
iron_bad <- iron; names(iron_bad$pmap) <- 1:20
expect_warning(check_cross2(iron_bad))
# founder genotypes included but not needed
iron_bad <- iron; iron_bad$founder_geno <- iron_bad$geno
expect_warning(check_cross2(iron_bad))
})
test_that("check_cross2 works for MPP data", {
skip_if(isnt_karl(), "this test only run locally")
do <- read_cross2("https://raw.githubusercontent.com/rqtl/qtl2data/main/DO_Recla/recla.zip")
expect_true(check_cross2(do))
# no founder genotypes
do_bad <- do
do_bad$founder_geno <- NULL
expect_warning(check_cross2(do_bad))
# no names in founder genotypes
do_bad <- do
names(do_bad$founder_geno) <- NULL
expect_warning(check_cross2(do_bad))
# mismatch in names of founder genotypes
do_bad <- do
names(do_bad$founder_geno) <- 1:20
expect_warning(check_cross2(do_bad))
# missing a founder in founder_geno
do_bad <- do
do_bad$founder_geno[[10]] <- do$founder_geno[[10]][-4,]
expect_warning(check_cross2(do_bad))
# missing a marker in founder_geno
do_bad <- do
do_bad$founder_geno[[12]] <- do$founder_geno[[12]][,-50]
expect_warning(check_cross2(do_bad))
# markers in founder_geno out of order
do_bad <- do
colnames(do_bad$founder_geno[[13]])[50:52] <- colnames(do$founder_geno[[13]])[52:50]
expect_warning(check_cross2(do_bad))
### HS need founder geno
hs <- do
hs$crosstype <- "hs"
expect_true(check_cross2(hs))
hs_bad <- hs
hs_bad$founder_geno <- NULL
expect_warning(check_cross2(hs_bad))
### AIL3
ail3 <- do
ail3$crosstype <- "ail3"
ail3$alleles <- ail3$alleles[1:3]
for(i in seq_along(ail3$founder_geno))
ail3$founder_geno[[i]] <- ail3$founder_geno[[i]][1:3,,drop=FALSE]
expect_true(check_cross2(ail3))
ail3_bad <- ail3
ail3_bad$founder_geno <- NULL
expect_warning(check_cross2(ail3_bad))
### riself4
riself4 <- do
riself4$crosstype <- "riself4"
riself4$alleles <- riself4$alleles[1:4]
for(x in c("geno", "founder_geno", "is_x_chr", "gmap", "pmap"))
riself4[[x]] <- riself4[[x]][1:19]
riself4$cross_info <- cbind(riself4$cross_info, 1L, 2L, 3L, 4L)[,-1,drop=FALSE]
for(i in seq_along(riself4$founder_geno)) {
riself4$founder_geno[[i]] <- riself4$founder_geno[[i]][1:4,,drop=FALSE]
riself4$geno[[i]][riself4$geno[[i]] == 2] <- 0
}
expect_true(check_cross2(riself4))
riself4_bad <- riself4
riself4_bad$founder_geno <- NULL
expect_warning(check_cross2(riself4_bad))
### riself8
riself8 <- do
riself8$crosstype <- "riself8"
for(x in c("geno", "founder_geno", "is_x_chr", "gmap", "pmap"))
riself8[[x]] <- riself8[[x]][1:19]
riself8$cross_info <- cbind(riself8$cross_info, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L)[,-1,drop=FALSE]
for(i in seq_along(riself8$founder_geno)) {
riself8$geno[[i]][riself8$geno[[i]] == 2] <- 0
}
expect_true(check_cross2(riself8))
riself8_bad <- riself8
riself8_bad$founder_geno <- NULL
expect_warning(check_cross2(riself8_bad))
### riself16
riself16 <- do
riself16$crosstype <- "riself16"
riself16$alleles <- LETTERS[1:16]
for(x in c("geno", "founder_geno", "is_x_chr", "gmap", "pmap"))
riself16[[x]] <- riself16[[x]][1:19]
riself16$cross_info <- cbind(riself16$cross_info, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L,
9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L)[,-1,drop=FALSE]
for(i in seq_along(riself16$founder_geno)) {
riself16$founder_geno[[i]] <- rbind(riself16$founder_geno[[i]], riself16$founder_geno[[i]])
riself16$geno[[i]][riself16$geno[[i]] == 2] <- 0
}
expect_true(check_cross2(riself16))
riself16_bad <- riself16
riself16_bad$founder_geno <- NULL
expect_warning(check_cross2(riself16_bad))
### risib4
risib4 <- do
risib4$crosstype <- "risib4"
risib4$alleles <- risib4$alleles[1:4]
risib4$cross_info <- cbind(risib4$cross_info, 1L, 2L, 3L, 4L)[,-1,drop=FALSE]
for(i in seq_along(risib4$founder_geno)) {
risib4$founder_geno[[i]] <- risib4$founder_geno[[i]][1:4,,drop=FALSE]
risib4$geno[[i]][risib4$geno[[i]] == 2] <- 0
}
expect_true(check_cross2(risib4))
risib4_bad <- risib4
risib4_bad$founder_geno <- NULL
expect_warning(check_cross2(risib4_bad))
### risib8
risib8 <- do
risib8$crosstype <- "risib8"
risib8$cross_info <- cbind(risib8$cross_info, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L)[,-1,drop=FALSE]
for(i in seq_along(risib8$founder_geno)) {
risib8$geno[[i]][risib8$geno[[i]] == 2] <- 0
}
expect_true(check_cross2(risib8))
risib8_bad <- risib8
risib8_bad$founder_geno <- NULL
expect_warning(check_cross2(risib8_bad))
### dh6
dh6 <- do
dh6$crosstype <- "dh6"
dh6$alleles <- dh6$alleles[1:6]
for(x in c("geno", "founder_geno", "is_x_chr", "gmap", "pmap"))
dh6[[x]] <- dh6[[x]][1:19]
for(i in seq_along(dh6$founder_geno)) {
dh6$founder_geno[[i]] <- dh6$founder_geno[[i]][1:6,]
dh6$geno[[i]][dh6$geno[[i]] == 2] <- 0
}
expect_true(check_cross2(dh6))
dh6_bad <- dh6
dh6_bad$founder_geno <- NULL
expect_warning(check_cross2(dh6_bad))
### dof1
dof1 <- do
dof1$crosstype <- "dof1"
for(i in seq_along(dof1$founder_geno)) {
dof1$founder_geno[[i]] <- dof1$founder_geno[[i]][c(1:8, 5),,drop=FALSE]
}
expect_true(check_cross2(dof1))
dof1_bad <- dof1
dof1_bad$founder_geno <- NULL
expect_warning(check_cross2(dof1_bad))
})
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.