tests/testthat/test_subtract.r

In valr: Genome Interval Arithmetic

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)
})