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