Nothing
context("est_map")
suppressMessages(library(qtl))
test_that("est_map for backcross autosome matches R/qtl", {
data(hyper)
chr <- c(3, 4, 17, 19)
hyper <- hyper[chr,]
newmap <- est.map(hyper, err=0.002, tol=1e-8)
newmap <- lapply(newmap, unclass)
hyper2 <- convert2cross2(hyper)
newmap2 <- est_map(hyper2, err=0.002, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map for intercross autosome matches R/qtl", {
skip_on_cran()
data(listeria)
chr <- c(4, 14, 18)
listeria <- listeria[chr,]
newmap <- est.map(listeria, err=0.01, tol=1e-8)
newmap <- lapply(newmap, unclass)
listeria2 <- convert2cross2(listeria)
newmap2 <- est_map(listeria2, err=0.01, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("f2 X chr est_map matches R/qtl", {
skip_on_cran()
data(fake.f2)
fake.f2 <- fake.f2["X",]
newmap <- est.map(fake.f2, err=0.01, tol=1e-8)
newmap <- lapply(newmap, unclass)
fake.f2.2 <- convert2cross2(fake.f2)
newmap2 <- est_map(fake.f2.2, err=0.01, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("bc X chr calc_genoprob matches R/qtl", {
skip_on_cran()
set.seed(19115167)
xmap <- sim.map(100, n.mar=11, anchor.tel=TRUE, include.x=TRUE, eq.spacing=TRUE)
n.ind <- 100
cross <- sim.cross(xmap, n.ind=n.ind, type="bc",
error.prob=0.01, missing.prob=0.05)
cross$pheno$sex <- rep(c(0,1), n.ind/2)
sexpgm <- getsex(cross)
newmap <- est.map(cross, err=0.01, tol=1e-8)
newmap <- lapply(newmap, unclass)
cross2 <- convert2cross2(cross)
newmap2 <- est_map(cross2, err=0.01, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map for RIself matches R/qtl", {
skip_on_cran()
data(hyper)
chr <- c(3, 4, 17, 19)
hyper <- hyper[chr,]
class(hyper)[1] <- "riself"
newmap <- est.map(hyper, err=0.002, tol=1e-8)
newmap <- lapply(newmap, unclass)
hyper2 <- convert2cross2(hyper)
newmap2 <- est_map(hyper2, err=0.002, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map for RIsib matches R/qtl", {
skip_on_cran()
data(hyper)
chr <- c(3, 4, 17, 19)
hyper <- hyper[chr,]
class(hyper)[1] <- "risib"
newmap <- est.map(hyper, err=0.002, tol=1e-8)
newmap <- lapply(newmap, unclass)
hyper2 <- convert2cross2(hyper)
newmap2 <- est_map(hyper2, err=0.002, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map for doubled haploids matches R/qtl", {
skip_on_cran()
data(hyper)
hyper <- hyper[3,]
hyper$pheno <- hyper$pheno[,1,drop=FALSE]
class(hyper)[1] <- "dh"
newmap <- est.map(hyper, err=0.002, tol=1e-8)
newmap <- lapply(newmap, unclass)
hyper2 <- convert2cross2(hyper)
newmap2 <- est_map(hyper2, err=0.002, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map for haploids matches R/qtl", {
skip_on_cran()
data(hyper)
hyper <- hyper[4,]
hyper$pheno <- hyper$pheno[,1,drop=FALSE]
class(hyper)[1] <- "haploid"
newmap <- est.map(hyper, err=0.002, tol=1e-8)
newmap <- lapply(newmap, unclass)
hyper2 <- convert2cross2(hyper)
newmap2 <- est_map(hyper2, err=0.002, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map works in case of 2 markers", {
skip_on_cran()
data(hyper)
hyper <- pull.markers(hyper, markers=markernames(hyper, chr=6)[2:3])
hyper <- shiftmap(hyper)
newmap <- est.map(hyper, err=0.002, tol=1e-8)
newmap <- lapply(newmap, unclass)
hyper2 <- convert2cross2(hyper)
newmap2 <- est_map(hyper2, err=0.002, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map works in case of 2 markers in intercross", {
skip_on_cran()
data(fake.f2)
fake.f2 <- fake.f2[18,]
newmap <- est.map(fake.f2, err=0.01, tol=1e-8)
newmap <- lapply(newmap, unclass)
fake.f2.2 <- convert2cross2(fake.f2)
newmap2 <- est_map(fake.f2.2, err=0.01, tol=1e-8)
expect_equivalent(newmap, newmap2)
expect_equal(lapply(newmap, attr, "loglik"),
lapply(newmap2, attr, "loglik"))
})
test_that("est_map works when multi-core", {
skip_if(isnt_karl(), "this test only run locally")
data(hyper)
hyper2 <- convert2cross2(hyper)
newmap2 <- est_map(hyper2, err=0.002, tol=1e-8)
newmap2_mc <- est_map(hyper2, err=0.002, tol=1e-8, cores=2)
expect_equal(newmap2_mc, newmap2)
data(listeria)
listeria2 <- convert2cross2(listeria)
newmap2 <- est_map(listeria2, err=0.01, tol=1e-8)
newmap2_mc <- est_map(listeria2, err=0.01, tol=1e-8, cores=2)
expect_equal(newmap2_mc, newmap2)
})
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.