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