tests/testthat/test_partition.r

In jayhesselberth/valr: Genome Interval Arithmetic

# https://github.com/bedops/bedops/blob/master/applications/bed/bedops/test/TestPlan.xml#L1541
test_that("basic partition works (bedops partition1 test)", {
  x <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 10L, 100L,
    "chr1", 50L, 125L,
    "chr1", 2000L, 2500L,
    "chr0", 250L, 400L,
    "chr1", 250L, 400L,
    "chr1", 2100L, 2125L,
    "chr21", 500L, 1000L,
    "chr0", 100L, 300L,
    "chr1", 50L, 125L,
    "chr1", 2000L, 2500L
  )

  pred <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr0", 100L, 250L,
    "chr0", 250L, 300L,
    "chr0", 300L, 400L,
    "chr1", 10L, 50L,
    "chr1", 50L, 100L,
    "chr1", 100L, 125L,
    "chr1", 250L, 400L,
    "chr1", 2000L, 2100L,
    "chr1", 2100L, 2125L,
    "chr1", 2125L, 2500L,
    "chr21", 500L, 1000L
  )

  res <- bed_partition(x)
  expect_equal(res, pred, ignore_attr = TRUE)
})


test_that("extended partition works (bedops partition2 test)", {
  x <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 10L, 100L,
    "chr1", 50L, 125L,
    "chr1", 2000L, 2500L,
    "chr3", 1L, 2L,
    "chr0", 100L, 300L,
    "chr1", 50L, 125L,
    "chr1", 2000L, 2500L,
    "chr2", 5L, 7L,
    "chr1", 10L, 100L,
    "chr1", 50L, 125L,
    "chr1", 50L, 125L,
    "chr1", 2000L, 2500L,
    "chr2", 1L, 10L,
    "chr2", 1L, 10L,
    "chr2", 1L, 10L,
    "chr2", 1L, 10L,
    "chr2", 2L, 10L,
    "chr1", 1L, 10L,
    "chr1", 3L, 6L,
    "chr1", 9L, 10L,
    "chr2", 1L, 10L,
    "chr1", 5L, 20L,
    "chr1", 10L, 20L,
    "chr1", 11L, 21L,
    "chr1", 12L, 22L,
    "chr1", 13L, 23L,
    "chr1", 14L, 24L,
    "chr1", 15L, 25L,
    "chr1", 16L, 26L,
    "chr1", 17L, 27L,
    "chr1", 18L, 28L,
    "chr1", 19L, 29L,
    "chr1", 20L, 30L
  )

  pred <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr0", 100L, 300L,
    "chr1", 1L, 3L,
    "chr1", 3L, 5L,
    "chr1", 5L, 6L,
    "chr1", 6L, 9L,
    "chr1", 9L, 10L,
    "chr1", 10L, 11L,
    "chr1", 11L, 12L,
    "chr1", 12L, 13L,
    "chr1", 13L, 14L,
    "chr1", 14L, 15L,
    "chr1", 15L, 16L,
    "chr1", 16L, 17L,
    "chr1", 17L, 18L,
    "chr1", 18L, 19L,
    "chr1", 19L, 20L,
    "chr1", 20L, 21L,
    "chr1", 21L, 22L,
    "chr1", 22L, 23L,
    "chr1", 23L, 24L,
    "chr1", 24L, 25L,
    "chr1", 25L, 26L,
    "chr1", 26L, 27L,
    "chr1", 27L, 28L,
    "chr1", 28L, 29L,
    "chr1", 29L, 30L,
    "chr1", 30L, 50L,
    "chr1", 50L, 100L,
    "chr1", 100L, 125L,
    "chr1", 2000L, 2500L,
    "chr2", 1L, 2L,
    "chr2", 2L, 5L,
    "chr2", 5L, 7L,
    "chr2", 7L, 10L,
    "chr3", 1L, 2L
  )

  res <- bed_partition(x)
  expect_equal(res, pred, ignore_attr = TRUE)
})


test_that("partition drops non-grouped cols (bedops partition3 test)", {
  x <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand, ~seq,
    "chr1", 33657L, 33687L, "+MA0068.1-Pax4", 8.67655e-06, "+", "TAATGCTATCCCTCCCCCAGCCCCCCACCC",
    "chr1", 33666L, 33686L, "+MA0073.1-RREB1", 1.97929e-06, "+", "CCCTCCCCCAGCCCCCCACC",
    "chr1", 33670L, 33690L, "+MA0073.1-RREB1", 1.0924e-06, "+", "CCCCCAGCCCCCCACCCACT",
    "chr1", 33672L, 33682L, "+MA0079.2-SP1", 5.66765e-06, "+", "CCCAGCCCCC",
    "chr1", 34375L, 34390L, "+MA0065.2-PPARG::RXRA", 7.21085e-07, "+", "GGTGGGCAAAGGGCA",
    "chr1", 34377L, 34390L, "+MA0114.1-HNF4A", 5.44281e-06, "+", "TGGGCAAAGGGCA"
  )

  pred <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 33657L, 33666L,
    "chr1", 33666L, 33670L,
    "chr1", 33670L, 33672L,
    "chr1", 33672L, 33682L,
    "chr1", 33682L, 33686L,
    "chr1", 33686L, 33687L,
    "chr1", 33687L, 33690L,
    "chr1", 34375L, 34377L,
    "chr1", 34377L, 34390L
  )

  res <- bed_partition(x)
  expect_equal(res, pred, ignore_attr = TRUE)
})


test_that("partition drops non-grouped cols (bedops partition4 test)", {
  x <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 279L, 280L,
    "chr1", 280L, 281L,
    "chr1", 281L, 282L,
    "chr1", 310L, 311L,
    "chr1", 310L, 320L,
    "chr1", 311L, 312L,
    "chr1", 312L, 313L,
    "chr1", 312L, 318L,
    "chr1", 313L, 314L
  )

  pred <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 279L, 280L,
    "chr1", 280L, 281L,
    "chr1", 281L, 282L,
    "chr1", 310L, 311L,
    "chr1", 311L, 312L,
    "chr1", 312L, 313L,
    "chr1", 313L, 314L,
    "chr1", 314L, 318L,
    "chr1", 318L, 320L
  )

  res <- bed_partition(x)
  expect_equal(res, pred, ignore_attr = TRUE)
})


test_that("grouping is respected", {
  x <- tibble::tribble(
    ~chrom, ~start, ~end, ~strand,
    "chr1", 33657L, 33687L, "+",
    "chr1", 33666L, 33686L, "+",
    "chr1", 33670L, 33690L, "-",
    "chr1", 33672L, 33682L, "-",
    "chr1", 34375L, 34390L, "+",
    "chr1", 34377L, 34390L, "-"
  )

  x <- group_by(x, strand)
  res <- bed_partition(x)
  expect_true("strand" %in% colnames(res))
  expect_true(all(c("+" %in% res$strand, "-" %in% res$strand)))
  expect_equal(nrow(res), 8)
})

test_that("book-ended intervals are not merged", {
  x <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 100L, 200L,
    "chr1", 200L, 250L
  )

  res <- bed_partition(x)
  expect_equal(res, x)
})

x <- tibble::tribble(
  ~chrom, ~start, ~end, ~value, ~id,
  "chr1", 100L, 200L, 1L, "A",
  "chr1", 250L, 500L, 2L, "A",
  "chr2", 250L, 500L, 3L, "A",
  "chr1", 100L, 150L, 10L, "B",
  "chr1", 150L, 250L, 20L, "B",
  "chr1", 140L, 250L, 30L, "B",
  "chr1", 150L, 200L, 40L, "B"
)

test_that("summary functions are executed", {
  res <- bed_partition(x, count = sum(value))
  expect_equal(sum(res$count), 198)
  expect_equal(nrow(res), 6)
})

test_that("summary functions are executed per group", {
  res <- bed_partition(group_by(x, id),
    count = sum(value, na.rm = T)
  )

  expect_equal(sum(res$count), 196)
  expect_equal(nrow(res), 7)
})

test_that("Tests for multiple columns and operations", {
  res <- bed_partition(x,
    count = sum(value),
    max = max(value)
  )
  expect_true(all(c("count", "max") %in% colnames(res)))
  expect_equal(sum(res$count), 198)
  expect_equal(sum(res$max), 115)
})