tests/testthat/test_shuffle.r

In jayhesselberth/valr: Genome Interval Arithmetic

genome <- tibble::tribble(
  ~chrom, ~size,
  "chr1", 1e6,
  "chr2", 1e7,
  "chr3", 1e8
)

# Seed for reproducible bed_shuffle tests
seed <- 1010486

# Random genome intervals for bed_shuffle tests
x <- bed_random(genome, n = 100, seed = seed) |>
  arrange(chrom, start)

test_that("within = TRUE maintains chroms", {
  res <- bed_shuffle(x, genome, within = TRUE, seed = seed)
  expect_true(all(x$chrom == res$chrom))
})

test_that("within = FALSE shuffles chroms", {
  res <- bed_shuffle(x, genome, within = FALSE, seed = seed)
  expect_false(all(x$chrom == res$chrom))
})

test_that("`incl` includes intervals", {
  incl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 10000, 1000000
  )
  res <- bed_shuffle(x, genome, incl = incl, seed = seed)
  expect_true(all(res$chrom == "chr1"))
  expect_true(all(res$start >= 1e4))
  expect_true(all(res$end <= 1e6))
})

test_that("`excl` excludes intervals", {
  excl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 10000, 1000000,
    "chr2", 1, 10000000,
    "chr3", 1, 100000000
  )
  res <- bed_shuffle(x, genome, excl = excl, seed = seed)
  expect_true(all(res$chrom == "chr1"))
  expect_false(any(res$chrom == "chr2"))
  expect_false(any(res$chrom == "chr3"))
  expect_true(all(res$start < 1e4))
})

test_that("completely excluded intervals throw an error", {
  # all intervals completely excluded
  excl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 1, 1000000,
    "chr2", 1, 10000000,
    "chr3", 1, 100000000
  )
  expect_error(bed_shuffle(x, genome, excl = excl, seed = seed))
})

test_that("`incl` and `excl` are handled", {
  excl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 1, 500000,
    "chr2", 1, 10000000
  )
  incl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 1, 1000000
  )
  res <- bed_shuffle(x, genome, incl, excl, seed = seed)
  expect_true(all(res$chrom == "chr1"))
  expect_true(all(res$start > 500000))
})

test_that("empty intervals derived from `incl` and `excl` is handled", {
  excl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 1, 1000000
  )
  incl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 1, 1000000
  )
  expect_error(bed_shuffle(x, genome, incl, excl, seed = seed))
})

test_that("exceeding `max_tries` yields an error", {
  # 100 bp interval is left but x intervals are 1kb
  excl <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 100, 1e6,
    "chr2", 1, 1e7,
    "chr3", 1, 1e8
  )
  expect_error(bed_shuffle(x, genome, excl = excl, seed = seed))
})

test_that("`seed` generates reproducible intervals", {
  res1 <- bed_shuffle(x, genome, seed = seed)
  res2 <- bed_shuffle(x, genome, seed = seed)
  expect_identical(res1, res2)
})

test_that("all supplied x interval columns are passed to the result", {
  x <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 80, 100, "q1", 1, "+"
  )

  res <- bed_shuffle(x, genome, seed = seed)
  expect_true(all(c("strand", "score", "name", "start") %in% colnames(res)))
})

# from https://github.com/arq5x/bedtools2/blob/master/test/shuffle/test-shuffle.sh
## does not handle error/ignore entry
# test_that("test an interval that is bigger than the max chrom length", {
#   x <- tibble::tribble(
#     ~chrom, ~start, ~end,
#     "chr1", 0, 110
#   )
#
#   y <- tibble::tribble(
#     ~chrom, ~size,
#     "chr1", 100
#   )
#
#   res <- bed_shuffle(x, y)
#   expect_true(all(c("strand", "score", "name", "start") %in% colnames(res)))
# })