Merge pull request #105 from mikelove/master

Adds `min.gapwidth` to `reduce_ranges`

DESCRIPTION

@@ -48,7 +48,7 @@ Suggests:
     ggplot2
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.0
+RoxygenNote: 7.2.3
 Collate: 
     'class-AnchoredRanges.R'
     'class-Operator.R'

R/ranges-genomeinfo.R

@@ -18,8 +18,6 @@ genome_info <- function(genome = NULL, seqnames = NULL, seqlengths = NULL, is_ci
 #'
 #' @param .data A Ranges object to annotate or retrieve an annotation for.
 #' @param genome A character vector of length one indicating the genome build.
-#' If this is the only argument supplied, the build information will be
-#' retrieved from UCSC database.
 #' @param seqnames A character vector containing the name of sequences.
 #' @param seqlengths An optional integer vector containg the lengths of sequences.
 #' @param is_circular An optional logical vector indicating whether a sequence is ciruclar.
@@ -28,13 +26,12 @@ genome_info <- function(genome = NULL, seqnames = NULL, seqlengths = NULL, is_ci
 #' as a Ranges object use `get_genome_info`.
 #'
 #' @description To construct annotations by supplying annotation information
-#' use `genome_info`. This function allows you to get UCSC build information
-#' via [GenomeInfoDb::fetchExtendedChromInfoFromUCSC()]. To add
+#' use `genome_info`. To add
 #' annotations to an existing Ranges object use `set_genome_info`. To retrieve
 #' an annotation as a Ranges object use `get_genome_info`.
 #'
 #' @importFrom GenomeInfoDb Seqinfo seqnames seqlengths isCircular genome seqinfo
-#' @seealso [GenomeInfoDb::Seqinfo()], [GenomeInfoDb::fetchExtendedChromInfoFromUCSC()]
+#' @seealso [GenomeInfoDb::Seqinfo()]
 #' @examples
 #' x <- genome_info(genome = "toy",
 #'                  seqnames = letters[1:4],

R/ranges-reduce.R

@@ -35,9 +35,10 @@ reduce_single <- function(.data, ..., rfun = reduce) {
   if (length(dots) == 0L) {
     return(rfun(.data))
   }
+
   reduced <- rfun(.data, with.revmap = TRUE)
 
-  .data <- group_by_revmap(.data, 
+  .data <- group_by_revmap(.data,
                            mcols(reduced)[["revmap"]],
                            make_revmap_rle(mcols(reduced)[["revmap"]]))
 
@@ -78,6 +79,7 @@ reduce_by_grp <- function(.data, ..., rfun = IRanges::reduce) {
 #' Reduce then aggregate a Ranges object
 #'
 #' @param .data a Ranges object to reduce
+#' @param min.gapwidth Ranges separated by a gap of at least min.gapwidth positions are not merged. 
 #' @param ... Name-value pairs of summary functions.
 #'
 #' @return a Ranges object with the
@@ -96,6 +98,7 @@ reduce_by_grp <- function(.data, ..., rfun = IRanges::reduce) {
 #' rng %>% reduce_ranges()
 #' rng %>% reduce_ranges(gc = mean(gc))
 #' rng %>% reduce_ranges_directed(gc = mean(gc))
+#' rng %>% reduce_ranges_directed(gc = mean(gc), min.gapwidth = 10)
 #' 
 #' x <- data.frame(start = c(11:13, 2, 7:6), 
 #'                width=3, 
@@ -106,60 +109,65 @@ reduce_by_grp <- function(.data, ..., rfun = IRanges::reduce) {
 #' x %>% reduce_ranges(score = sum(score))
 #' x %>% group_by(id) %>% reduce_ranges(score = sum(score))
 #' @export
-reduce_ranges <- function(.data, ...) { UseMethod("reduce_ranges") }
+reduce_ranges <- function(.data, min.gapwidth = 1L, ...) { UseMethod("reduce_ranges") }
 
 #' @method reduce_ranges IntegerRanges
 #' @export
-reduce_ranges.IntegerRanges <- function(.data, ...) {
-  reduce_single(.data, ...)
+reduce_ranges.IntegerRanges <- function(.data, min.gapwidth = 1L, ...) {
+  reduce_single(.data, ..., 
+                rfun = function(x, ...) {
+                  reduce(x, ..., min.gapwidth = min.gapwidth)
+                })
 }
 
 #' @method reduce_ranges GroupedIntegerRanges
 #' @export
-reduce_ranges.GroupedIntegerRanges <- function(.data, ...) {
-  reduce_by_grp(.data, ...)
+reduce_ranges.GroupedIntegerRanges <- function(.data, min.gapwidth = 1L, ...) {
+  reduce_by_grp(.data, ..., 
+                rfun = function(x, ...) {
+                  reduce(x, ..., min.gapwidth = min.gapwidth)
+                })
 }
 
-
 #' @method reduce_ranges GroupedGenomicRanges
 #' @export
-reduce_ranges.GroupedGenomicRanges <- function(.data, ...) {
+reduce_ranges.GroupedGenomicRanges <- function(.data, min.gapwidth = 1L, ...) {
   reduce_by_grp(.data, ..., 
                 rfun = function(x, ...) {
-                  reduce(x, ..., ignore.strand = TRUE)
+                  reduce(x, ..., min.gapwidth = min.gapwidth, ignore.strand = TRUE)
                   })
 }
 
 #' @method reduce_ranges GenomicRanges
 #' @export
-reduce_ranges.GenomicRanges <- function(.data, ...) {
+reduce_ranges.GenomicRanges <- function(.data, min.gapwidth = 1L, ...) {
   reduce_single(.data, ..., 
                 rfun = function(x, ...) {
-                  reduce(x, ..., ignore.strand = TRUE)
+                  reduce(x, ..., min.gapwidth = min.gapwidth, ignore.strand = TRUE)
                 })
 }
 
 #' @rdname ranges-reduce
 #' @export
-reduce_ranges_directed <- function(.data, ...) {
+reduce_ranges_directed <- function(.data, min.gapwidth = 1L, ...) {
   UseMethod("reduce_ranges_directed")
 }
 
 #' @importFrom IRanges reduce
 #' @method reduce_ranges_directed GenomicRanges
 #' @export
-reduce_ranges_directed.GenomicRanges <- function(.data, ...) {
+reduce_ranges_directed.GenomicRanges <- function(.data, min.gapwidth = 1L, ...) {
   reduce_single(.data, ..., 
                 rfun = function(x, ...) {
-                  reduce(x, ..., ignore.strand = FALSE)
+                  reduce(x, ..., min.gapwidth = min.gapwidth, ignore.strand = FALSE)
                 })
 }
 
 #' @method reduce_ranges_directed GroupedGenomicRanges
 #' @export
-reduce_ranges_directed.GroupedGenomicRanges <- function(.data, ...) {
+reduce_ranges_directed.GroupedGenomicRanges <- function(.data, min.gapwidth = 1L, ...) {
   reduce_by_grp(.data, ..., 
                 rfun = function(x, ...) {
-                  reduce(x, ..., ignore.strand = FALSE)
+                  reduce(x, ..., min.gapwidth = min.gapwidth, ignore.strand = FALSE)
                 })
-}
+}

tests/testthat/test-reduce.R

@@ -48,7 +48,16 @@ test_that("matches IRanges/GenomicRanges", {
   expect_identical(reduce_ranges(gr, mapping = name),
                    target)
 
+  # reduce with min.gapwidth
+  gr <- GRanges(Rle(factor(c("chr1", "chr2")), c(3, 3)),
+          IRanges(c(1,6,12,1,6,12), width=4),
+          name = paste0("a", 1:6))
 
+  target <- GRanges(Rle(c("chr1", "chr2"), c(2, 2)),
+                    IRanges(start=c(1, 12, 1, 12), end=c(9, 15, 9, 15)))
+
+  expect_identical(reduce_ranges(gr, min.gapwidth = 2), target)
+
 })
 
 
@@ -163,4 +172,4 @@ test_that("expected behaviour for grouped filter w reduce #37",
 
             expect_identical(red2, exp)
           }
-)
+)