test_that("x/y groupings are respected", { x <- tibble::tribble( ~chrom, ~start, ~end, ~id, "chr1", 100, 250, 1, "chr2", 250, 500, 2, "chr2", 250, 500, 3 ) |> group_by(id) y <- tibble::tribble( ~chrom, ~start, ~end, ~value, ~id, "chr1", 100, 250, 10, 1, "chr1", 150, 250, 20, 2, "chr2", 250, 500, 500, 3 ) |> group_by(id) pred <- tibble::tribble( ~chrom, ~start, ~end, ~id, ~vals, "chr1", 100, 250, 1, 10, "chr2", 250, 500, 3, 500, "chr2", 250, 500, 2, NA ) res <- bed_map(x, y, vals = sum(value)) expect_true(all(res == pred, na.rm = TRUE)) }) test_that("values_unique works correctly", { x <- tibble::tribble( ~chrom, ~start, ~end, "chr1", 100, 250 ) y <- tibble::tribble( ~chrom, ~start, ~end, ~value, "chr1", 100, 250, 10, "chr1", 150, 250, 20, "chr1", 100, 250, 10, "chr1", 150, 250, 20 ) res <- bed_map(x, y, vals = values_unique(value)) expect_equal(res$vals, c("10,20")) }) x <- tibble::tribble( ~chrom, ~start, ~end, ~id, "chr1", 100, 200, 1, "chr1", 250, 500, 2, "chr2", 250, 500, 3 ) y <- tibble::tribble( ~chrom, ~start, ~end, ~value, "chr1", 100, 150, 10, "chr1", 150, 250, 20, "chr1", 140, 250, 30, "chr1", 150, 200, 40 ) test_that("concat works correctly", { res <- bed_map(x, y, vals = concat(value)) expected <- c("10,30,20,40", NA, NA) expect_equal(res$vals, expected) }) test_that("values works correctly", { res <- bed_map(x, y, vals = values(value)) expected <- c("10,30,20,40", NA, NA) expect_equal(res$vals, expected) }) test_that("first works correctly", { res <- bed_map(x, y, first = first(value)) expected <- c(10, NA, NA) expect_equal(res$first, expected) }) test_that("last works correctly", { res <- bed_map(x, y, last = last(value)) expected <- c(40, NA, NA) expect_equal(res$last, expected) }) test_that("book-ended intervals are not reported", { x <- tibble::tribble( ~chrom, ~start, ~end, "chr1", 100, 200 ) y <- tibble::tribble( ~chrom, ~start, ~end, ~value, "chr1", 100, 150, 10, "chr1", 200, 250, 20 ) expected <- tibble::tribble( ~chrom, ~start, ~end, ~value, "chr1", 100, 200, 10 ) res <- bed_map(x, y, value = sum(value)) expect_equal(res, expected, ignore_attr = TRUE) }) test_that("ensure that mapping is calculated with respect to input tbls issue#108", { x <- tibble::tribble( ~chrom, ~start, ~end, ~group, "chr1", 100, 200, "B", "chr1", 200, 400, "A", "chr1", 500, 600, "C", "chr2", 125, 175, "C", "chr2", 150, 200, "A", "chr3", 100, 300, "A" ) y <- tibble::tribble( ~chrom, ~start, ~end, ~group, ~value, "chr1", 100, 199, "A", 10, "chr1", 200, 400, "B", 20, "chr1", 500, 600, "A", 30, "chr2", 125, 175, "C", 40, "chr2", 350, 500, "A", 50, "chr3", 500, 600, "A", 100 ) pred <- tibble::tribble( ~chrom, ~start, ~end, ~group, ~total, "chr1", 100, 200, "B", NA, "chr1", 200, 400, "A", NA, "chr1", 500, 600, "C", NA, "chr2", 125, 175, "C", 40, "chr2", 150, 200, "A", NA, "chr3", 100, 300, "A", NA ) x <- arrange(x, chrom, start) x <- group_by(x, group) y <- arrange(y, chrom, start) y <- group_by(y, group) res <- bed_map(x, y, total = sum(value)) expect_true(all(pred == res, na.rm = T)) }) # from https://github.com/arq5x/bedtools2/blob/master/test/map/test-map.sh x <- tibble::tribble( ~chrom, ~start, ~end, "chr1", 0L, 100L, "chr1", 100L, 200L, "chr2", 0L, 100L, "chr2", 100L, 200L, "chr3", 0L, 100L, "chr3", 100L, 200L ) y <- tibble::tribble( ~chrom, ~start, ~end, ~group, ~value, ~strand, "chr1", 0L, 10L, "a1", 10L, "+", "chr1", 10L, 20L, "a2", 5L, "+", "chr1", 20L, 30L, "a3", 15L, "+", "chr1", 120L, 130L, "a4", 1L, "+", "chr3", 0L, 10L, "a5", 1L, "+", "chr3", 10L, 20L, "a6", 2L, "+", "chr3", 20L, 30L, "a7", 3L, "+", "chr3", 120L, 130L, "a8", 4L, "+" ) ## output NA instead of 0, see examples for code to change NA to 0 test_that("test count", { res <- bed_map(x, y, vals = n()) expect_equal(res$vals, c(3, 1, NA, NA, 3, 1)) res2 <- bed_map(x, y, vals = n()) |> mutate(vals = ifelse(is.na(vals), 0, vals)) expect_equal(res2$vals, c(3, 1, 0, 0, 3, 1)) }) # R has no built-in mode function test_that("test mode", { getmode <- function(v) { uniqv <- unique(v) uniqv[which.max(tabulate(match(v, uniqv)))] } res <- bed_map(x, y, vals = getmode(value)) expect_equal(res$vals, c(10, 1, NA, NA, 1, 4)) }) test_that("Test GFF column extraction", { z <- tibble::tribble( ~chrom, ~seqid, ~type, ~start, ~end, ~score, ~strand, ~phase, ~attributes, "chr1", "hg19_ccdsGene", "start_codon", 1L, 9L, 0, "+", ".", "gene_id..CCDS30744.1...transcript_id..CCDS30744.1..", "chr1", "hg19_ccdsGene", "CDS", 2L, 11L, 0, "+", "0", "gene_id \"CCDS30744.1\"; transcript_id \"CCDS30744.1\";", "chr1", "hg19_ccdsGene", "exon", 8L, 20L, 0, "+", ".", "gene_id \"CCDS30744.1\"; transcript_id \"CCDS30744.1\";", "chr1", "hg19_ccdsGene", "CDS", 9L, 17L, 0, "+", "2", "gene_id \"CCDS30744.1\"; transcript_id \"CCDS30744.1\";", "chr1", "hg19_ccdsGene", "exon", 40L, 200L, 0, "+", ".", "gene_id \"CCDS30744.1\"; transcript_id \"CCDS30744.1\";" ) res <- bed_map(x, z, vals = list(chrom)) expect_equal(length(res$vals[[1]]), 5) }) test_that("Tests for multiple columns and operations", { res <- bed_map(x, y, count = n(), sum = sum(value)) expect_equal(res$sum, c(30, 1, NA, NA, 6, 4)) })