bed_tbl <- tibble::tribble( ~chrom, ~start, ~end, ~strand, "chr1", 100, 150, "+", "chr1", 200, 250, "+", "chr2", 300, 350, "+", "chr2", 400, 450, "-", "chr3", 500, 550, "-", "chr3", 600, 650, "-" ) genome <- tibble::tribble( ~chrom, ~size, "chr1", 1000, "chr2", 2000, "chr3", 3000 ) test_that("pos increment works", { size <- 100 out <- bed_shift(bed_tbl, genome, size) expect_true( all(out$start - bed_tbl$start == size), all(out$end - bed_tbl$end == size) ) }) test_that("neg increment works", { size <- -50 out <- bed_shift(bed_tbl, genome, size) expect_true( all(out$start - bed_tbl$start == size), all(out$end - bed_tbl$end == size) ) }) test_that("starts forced to 0", { size <- -120 out <- bed_shift(bed_tbl, genome, size) expect_true(all(out$start >= 0)) }) test_that("end forced to chrom length", { size <- 1675 out <- bed_shift(bed_tbl, genome, size) |> left_join(genome, by = "chrom") expect_true(all(out$end <= out$size)) }) test_that("fraction increment works", { fraction <- 0.5 interval <- bed_tbl$end - bed_tbl$start out <- bed_shift(bed_tbl, genome, fraction = fraction) expect_true(all( out$start - bed_tbl$start == fraction * interval, all(out$end - bed_tbl$end == fraction * interval) )) }) test_that("negative fraction increment works", { fraction <- -0.5 interval <- bed_tbl$end - bed_tbl$start out <- bed_shift(bed_tbl, genome, fraction = fraction) expect_true(all( out$start - bed_tbl$start == fraction * interval, all(out$end - bed_tbl$end == fraction * interval) )) }) test_that("rounding fraction increment works", { fraction <- 0.51234 interval <- bed_tbl$end - bed_tbl$start out <- bed_shift(bed_tbl, genome, fraction = fraction) expect_true(all( out$start - bed_tbl$start == round(fraction * interval), all(out$end - bed_tbl$end == round(fraction * interval)) )) }) test_that("shift by strand works", { size <- 100 x <- group_by(bed_tbl, strand) out <- bed_shift(x, genome, size) expect_true(all( ifelse(out$strand == "+", out$start - bed_tbl$start == size, out$start - bed_tbl$start == -size ), ifelse(out$strand == "+", out$end - bed_tbl$end == size, out$end - bed_tbl$end == -size ) )) }) test_that("shift by strand and fraction works", { fraction <- 0.5 x <- group_by(bed_tbl, strand) sizes <- bed_tbl$end - bed_tbl$start out <- bed_shift(x, genome, fraction = fraction) expect_true(all( ifelse(out$strand == "+", out$start - bed_tbl$start == sizes * fraction, out$start - bed_tbl$start == -sizes * fraction ), ifelse(out$strand == "+", out$end - bed_tbl$end == sizes * fraction, out$end - bed_tbl$end == -sizes * fraction ) )) }) # from https://github.com/arq5x/bedtools2/blob/master/test/shift/test-shift.sh a <- tibble::tribble( ~chrom, ~start, ~end, ~name, ~score, ~strand, "chr1", 100, 200, "a1", 1, "+", "chr1", 100, 200, "a2", 2, "-" ) tiny.genome <- tibble::tribble( ~chrom, ~size, "chr1", 1000 ) test_that("test going beyond the start of the chrom", { out <- bed_shift(a, tiny.genome, size = -300, trim = TRUE) expect_true(all( out$start == c(0, 0), out$end == c(1, 1) )) }) test_that("test going beyond the start of the chrom", { out <- bed_shift(a, tiny.genome, size = -200, trim = TRUE) expect_true(all( out$start == c(0, 0), out$end == c(1, 1) )) }) test_that("test going beyond the end of the chrom", { out <- bed_shift(a, tiny.genome, size = 1000, trim = TRUE) expect_true(all( out$start == c(999, 999), out$end == c(1000, 1000) )) }) test_that("test shift being larger than a signed int", { out <- bed_shift(a, tiny.genome, size = 3000000000, trim = TRUE) expect_true(all( out$start == c(999, 999), out$end == c(1000, 1000) )) }) test_that("test chrom boundaries", { tiny2.genome <- tibble::tribble( ~chrom, ~size, "chr1", 10 ) b <- tibble::tribble( ~chrom, ~start, ~end, ~name, ~score, ~strand, "chr1", 5, 10, "cds1", 0, "+" ) out <- bed_shift(b, tiny2.genome, size = 2, trim = TRUE) expect_true(all( out$start == 7, out$end == 10 )) }) test_that("test shift huge genome", { tiny2.genome <- tibble::tribble( ~chrom, ~size, "chr1", 249250621 ) b <- tibble::tribble( ~chrom, ~start, ~end, ~name, ~score, ~strand, "chr1", 66999638L, 67216822L, "NM_032291", 0L, "+", "chr1", 92145899L, 92351836L, "NR_036634", 0L, "-" ) out <- bed_shift(b, tiny2.genome, size = 1000, trim = TRUE) expect_true(all( out$start == c(67000638, 92146899), out$end == c(67217822, 92352836) )) })