Nothing
context("interpolate gen <-> phys maps")
test_that("interpolate_map works", {
set.seed(31728290)
oldmap <- sort(runif(20, 0, 100))
newmap <- sort(runif(20, 0, 200))
oldpos <- c(-2, seq(0, 100, by=10), 104)
newpos <- interpolate_map(oldpos, oldmap, newmap)
# calculate what result should be in R
expected <- numeric(length(oldpos))
wh_left <- (oldpos < min(oldmap))
if(any(wh_left))
expected[wh_left] <- min(newmap) - (min(oldmap) - oldpos[wh_left])*diff(range(newmap))/diff(range(oldmap))
wh_right <- (oldpos >= max(oldmap))
if(any(wh_right))
expected[wh_right] <- min(newmap) + (oldpos[wh_right] - min(oldmap))*diff(range(newmap))/diff(range(oldmap))
other <- (!wh_left & !wh_right)
if(any(other)) {
index <- sapply(oldpos[other], function(a,b) sum(b <= a), oldmap)
expected[other] <- newmap[index] + (oldpos[other] - oldmap[index]) *
(newmap[index+1] - newmap[index]) / (oldmap[index+1] - oldmap[index])
}
expect_equal(newpos, expected)
})
test_that("find_intervals works", {
set.seed(11703070)
library(qtl)
data(hyper)
map <- pull.map(hyper)[[1]]
pos <- round(runif(1000, 0, 120), 1)
result <- find_intervals(pos, map)
interval <- result[,1]
on_map <- (result[,2]==1)
# none of the pos are on the map
expect_equal(pos %in% map, on_map)
# intervals correct?
expect_true(all(pos[interval==-1] < min(map)))
expect_true(all(pos[interval==length(map)-1] >= max(map)))
middle <- (interval >= 0 & interval < length(map)-1)
expect_true(all(pos[middle] >= map[interval[middle]+1] &
pos[middle] < map[interval[middle]+2]))
# include some positions that are right on the map
pos <- sample(c(pos, sample(map, 10)))
result <- find_intervals(pos, map)
interval <- result[,1]
on_map <- (result[,2]==1)
# intervals correct?
expect_true(all(pos[interval==-1] < min(map)))
expect_true(all(pos[interval==length(map)-1] >= max(map)))
middle <- (interval >= 0 & interval < length(map)-1)
expect_true(all(pos[middle] >= map[interval[middle]+1] &
pos[middle] < map[interval[middle]+2]))
# also check whether 2nd column is correct
expect_equal(sum(on_map), 10)
expect_equal(pos[on_map], map[interval[on_map]+1])
})
test_that("interp_map works in simplest case", {
set.seed(31728290)
oldmap <- list("1"=sort(runif(20, 0, 100)),
"2"=sort(runif(20, 0, 80)),
"3"=sort(runif(20, 0, 60)))
# newmap is just double oldmap
newmap <- oldmap
for(i in seq(along=newmap)) newmap[[i]] <- oldmap[[i]]*2
chr2 <- list("2"=c(0, 5, 20, 30))
chr2_doubled <- list("2"=c(0, 10, 40, 60))
expect_equal(interp_map(chr2, oldmap, newmap),
chr2_doubled)
chr23 <- list("2"=c(0, 5, 20, 30), "3"=c(-5, 20, 40, 100))
chr23_doubled <- list("2"=c(0, 10, 40, 60), "3"=c(-10, 40, 80, 200))
expect_equal(interp_map(chr23, oldmap, newmap),
chr23_doubled)
})
test_that("interp_map preserves positions", {
oldmap <- list("1"=c(0, 5, 5, 5, 10, 20))
newmap <- list("1"=c(0, 5, 10, 15, 20, 30))
names(oldmap[[1]]) <- names(newmap[[1]]) <- paste0("marker", seq_along(oldmap[[1]]))
expect_equal(newmap, interp_map(oldmap, oldmap, newmap))
})
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.