valr: Genome Interval Arithmetic

genome <- tibble::tribble(
  ~chrom, ~size,
  "chr1", 5000
)

x <- tibble::tribble(
  ~chrom, ~start, ~end, ~name, ~score, ~strand,
  "chr1", 500, 1000, ".", ".", "+",
  "chr1", 1000, 1500, ".", ".", "-"
)

test_that("left arg works", {
  dist <- 100
  out <- x |>
    bed_slop(genome, left = dist)
  expect_true(all(x$start - out$start == dist))
})

test_that("right arg works", {
  dist <- 100
  out <- x |>
    bed_slop(genome, right = dist)
  expect_true(all(out$end - x$end == dist))
})

test_that("both arg works", {
  dist <- 100
  out <- x |>
    bed_slop(genome, both = dist)
  expect_true(all(x$start - out$start == dist))
  expect_true(all(out$end - x$end == dist))
})

test_that("both with fraction works", {
  res <- bed_slop(x, genome, both = 0.5, fraction = TRUE)
  expect_equal(res$start, c(250, 750))
  expect_equal(res$end, c(1250, 1750))
})

test_that("left / right with fraction works", {
  res <- bed_slop(x, genome, left = 0.5, fraction = TRUE)
  expect_equal(res$start, c(250, 750))
  expect_equal(res$end, c(1000, 1500))
})

test_that("left, fraction, strand works", {
  res <- bed_slop(x, genome, left = 0.5, fraction = TRUE, strand = TRUE)
  expect_equal(res$start, c(250, 1000))
  expect_equal(res$end, c(1000, 1750))
})

test_that("right, fraction, strand works", {
  res <- bed_slop(x, genome, right = 0.5, fraction = TRUE, strand = TRUE)
  expect_equal(res$start, c(500, 750))
  expect_equal(res$end, c(1250, 1500))
})

test_that("strand with left works", {
  res <- bed_slop(x, genome, left = 100, strand = TRUE)
  expect_equal(res$start, c(400, 1000))
  expect_equal(res$end, c(1000, 1600))
})

# from https://github.com/arq5x/bedtools2/blob/master/test/slop/test-slop.sh
a <- tibble::tribble(
  ~chrom, ~start, ~end, ~name, ~score, ~strand,
  "chr1", 100L, 200L, "a1", 1L, "+",
  "chr1", 100L, 200L, "a2", 2L, "-"
)

tiny.genome <- tibble::tribble(
  ~chrom, ~size,
  "chr1", 1000
)

h19 <- read.table(file = valr_example("hg19.chrom.sizes.gz"), sep = "\t", header = FALSE, stringsAsFactors = FALSE)
colnames(h19) <- c("chrom", "size")
h19 <- tibble::as_tibble(h19)

test_that("test going beyond the start of the chrom", {
  res <- bed_slop(a, tiny.genome, both = 200, trim = TRUE)
  expect_equal(res$start, c(0, 0))
  expect_equal(res$end, c(400, 400))
})

test_that("test going beyond the end of the chrom", {
  res <- bed_slop(a, tiny.genome, left = 0, right = 1000, trim = TRUE)
  expect_equal(res$start, c(100, 100))
  expect_equal(res$end, c(1000, 1000))
})

test_that("test going beyond the start and end of the chrom", {
  res <- bed_slop(a, tiny.genome, both = 2000, trim = TRUE)
  expect_equal(res$start, c(0, 0))
  expect_equal(res$end, c(1000, 1000))
})

test_that("test going beyond the start and end of the chrom with strand", {
  res <- bed_slop(a, tiny.genome, both = 2000, strand = TRUE, trim = TRUE)
  expect_equal(res$start, c(0, 0))
  expect_equal(res$end, c(1000, 1000))
})

test_that("test slop factor being larger than a signed int", {
  res <- bed_slop(a, tiny.genome, both = 3000000000, strand = TRUE, trim = TRUE)
  expect_equal(res$start, c(0, 0))
  expect_equal(res$end, c(1000, 1000))
})

test_that("test that old floating-point issues are solved", {
  b <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 16778071, 16778771
  )
  res <- bed_slop(b, h19, left = 200, right = 200)
  expect_equal(res$start, 16777871)
  expect_equal(res$end, 16778971)
})

## order is different compared to bedtools
test_that("test that old floating-point issues are solved", {
  b <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 160, 170,
    "chr1", 100, 200
  )
  res <- bed_slop(b, h19, both = 0.1, fraction = TRUE)
  expect_equal(res$start, c(90, 159))
  expect_equal(res$end, c(210, 171))
})

test_that("test negative slop on l with strand", {
  b <- tibble::tribble(
    ~chrom, ~start, ~end,
    "chr1", 300, 320
  )
  res <- bed_slop(b, tiny.genome, left = -60, right = 60)
  expect_equal(res$start, 360)
  expect_equal(res$end, 380)
})

test_that("test negative slop on l with strand", {
  b <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 300, 320, "a1", 5, "-"
  )
  res <- bed_slop(b, tiny.genome, left = -60, right = 60, strand = TRUE)
  expect_equal(res$start, 240)
  expect_equal(res$end, 260)
})

test_that("test negative slop on r with strand", {
  b <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 300, 320, "a1", 5, "-"
  )

  res <- bed_slop(b, tiny.genome, left = 60, right = -60, strand = TRUE)
  expect_equal(res$start, 360)
  expect_equal(res$end, 380)
})

test_that("test crossover during negative slop", {
  tiny.genome <- tibble::tribble(
    ~chrom, ~size,
    "chr1", 1000
  )
  b <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 300, 320, "a1", 5, "-"
  )
  res <- bed_slop(b, tiny.genome, left = -60, right = -60, strand = TRUE)
  expect_equal(res$start, 260)
  expect_equal(res$end, 360)
})

test_that("test crossover during negative slop resulting in 0 length intervals are tossed out", {
  tiny.genome <- tibble::tribble(
    ~chrom, ~size,
    "chr1", 1000
  )
  b <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 300, 320, "a1", 5, "-"
  )
  expect_warning(res <- bed_slop(b, tiny.genome, left = -10, right = -10, strand = TRUE))
  expect_equal(nrow(res), 0)
})

test_that("going beyond the end of the chrom", {
  tiny.genome <- tibble::tribble(
    ~chrom, ~size,
    "chr1", 1000
  )
  b <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 950, 970, "a1", 5, "-"
  )
  res <- bed_slop(b, tiny.genome, left = 60, right = -60, strand = TRUE, trim = TRUE)
  expect_equal(res$start, 999)
  expect_equal(res$end, 1000)
})

test_that("test edge cases", {
  tiny.genome <- tibble::tribble(
    ~chrom, ~size,
    "chr1", 1000
  )
  b <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 50, 60, "a1", 5, "-"
  )
  res <- bed_slop(b, tiny.genome, left = -60, right = 60, strand = TRUE, trim = TRUE)
  expect_equal(res$start, 0)
  expect_equal(res$end, 1)
})

test_that("test edge cases", {
  tiny.genome <- tibble::tribble(
    ~chrom, ~size,
    "chr1", 1000
  )
  b <- tibble::tribble(
    ~chrom, ~start, ~end, ~name, ~score, ~strand,
    "chr1", 50, 60, "a1", 5, "-"
  )
  res <- bed_slop(b, tiny.genome, left = -100, right = 100, strand = TRUE, trim = TRUE)
  expect_equal(res$start, 0)
  expect_equal(res$end, 1)
})