x <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 100, 200,
"chr1", 250, 400,
"chr1", 500, 600,
"chr1", 1000, 2000
) |>
group_by(chrom)
y <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 150, 175,
"chr1", 525, 575,
"chr1", 1100, 1200,
"chr1", 1400, 1600
) |>
group_by(chrom)
test_that("any = TRUE eliminates overlapping intervals", {
res <- bed_subtract(x, y, any = TRUE)
pred <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 250, 400
)
expect_equal(res, pred)
})
test_that("fully contained y intervals generate new intervals", {
res <- bed_subtract(x, y)
expect_equal(nrow(res), 8)
})
test_that("left dangling y intervals adjust x starts", {
x <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 100, 200
) |>
group_by(chrom)
y <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 75, 150
) |>
group_by(chrom)
res <- bed_subtract(x, y)
expect_equal(res$start, 150)
})
test_that("right dangling y intervals adjust x ends", {
x <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 100, 200
) |>
group_by(chrom)
y <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 175, 250
) |>
group_by(chrom)
res <- bed_subtract(x, y)
expect_equal(res$end, 175)
})
test_that("fully contained x intervals are removed", {
x <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 100, 200
) |>
group_by(chrom)
y <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 50, 250
) |>
group_by(chrom)
res <- bed_subtract(x, y)
expect_equal(nrow(res), 0)
})
test_that("subtractions from x bed_tbl with more chroms than y are captured", {
x <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 100, 200,
"chr3", 400, 500
)
y <- tibble::tribble(
~chrom, ~start, ~end,
"chr3", 425, 475
)
res <- bed_subtract(x, y)
expect_true("chr3" %in% res$chrom)
})
test_that("non-overlapping intervals from different chrom are not dropped", {
x <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 100, 200,
"chr3", 400, 500
)
y <- tibble::tribble(
~chrom, ~start, ~end,
"chr3", 425, 475
)
res <- bed_subtract(x, y)
expect_true("chr1" %in% res$chrom)
})
a <- tibble::tribble(
~chrom, ~start, ~end, ~name, ~score, ~strand,
"chr1", 10, 20, "a1", 1, "+",
"chr1", 50, 70, "a2", 2, "-"
)
b <- tibble::tribble(
~chrom, ~start, ~end, ~name, ~score, ~strand,
"chr1", 18, 25, "b1", 1, "-",
"chr1", 80, 90, "b2", 2, "+"
)
test_that("tbls grouped by strand are processed", {
res <- bed_subtract(group_by(a, strand), group_by(b, strand))
expect_equal(nrow(res), 2)
expect_true(all(res == a))
})
test_that("longest merged y intervals are used for subtraction", {
x <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 500, 600
)
y <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 510, 580,
"chr1", 550, 575
)
res <- bed_subtract(x, y)
expect_true(max(res$start) == 580)
})
test_that("all intervals are dropped in large dataset", {
bg <- read_bedgraph(valr_example("hela.h3k4.chip.bg.gz"))
res <- bed_subtract(bg, bg)
expect_true(nrow(res) == 0)
})
# from https://github.com/arq5x/bedtools2/blob/master/test/subtract/test-subtract.sh
a <- tibble::tribble(
~chrom, ~start, ~end, ~name, ~score, ~strand,
"chr1", 10, 20, "a1", 1, "+",
"chr1", 50, 70, "a2", 2, "-"
)
b <- tibble::tribble(
~chrom, ~start, ~end, ~name, ~score, ~strand,
"chr1", 18, 25, "b1", 1, "-",
"chr1", 80, 90, "b2", 2, "+"
)
test_that("test baseline subtraction", {
c <- tibble::tribble(
~chrom, ~start, ~end, ~name, ~score, ~strand,
"chr1", 10, 18, "a1", 1, "+",
"chr1", 50, 70, "a2", 2, "-"
)
res <- bed_subtract(a, b)
expect_equal(res, c, ignore_attr = FALSE)
})
test_that("test any = TRUE subtraction", {
c <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 50, 70
)
res <- bed_subtract(a, b, any = TRUE)
expect_equal(res, c)
})
test_that("test with 2 DBs", {
b2 <- tibble::tribble(
~chrom, ~start, ~end,
"chr1", 5, 15,
"chr1", 55, 65
)
c <- tibble::tribble(
~chrom, ~start, ~end, ~name, ~score, ~strand,
"chr1", 15, 18, "a1", 1, "+",
"chr1", 50, 55, "a2", 2, "-",
"chr1", 65, 70, "a2", 2, "-"
)
res <- bed_subtract(bed_subtract(a, b), b2)
expect_equal(res, c, ignore_attr = FALSE)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.