.all.equal.GenomicRanges.R

library(GenomicRanges)

# A fast check that all(x == y) for GenomicRanges objects. 
.all.equal.GenomicRanges <- function(x, y) {
  seqinfo <- merge(seqinfo(x), seqinfo(y))
  seqlevels <- seqlevels(seqinfo)
  if (any(diff(match(seqlevels(y), seqlevels)) < 0L)) {
    stop("the 2 objects to compare have seqlevels in incompatible orders")
  }
  ok <- all(identical(seqnames(x), seqnames(y)),
            identical(ranges(x), ranges(y)),
            identical(strand(x), strand(y)))
  if (ok) {
    return(TRUE)
  } else {
    # TODO: Is it possible for the above to generate a false negative? If so,
    #       fall back to the slow but sure check.
    all(x == y)
  }
}

.compare <- function(x, GenomicRanges = FALSE) {
  x1 <- x[[1]]
  if (GenomicRanges) {
    if (is(x1, "GRangesList")) {
      x <- lapply(x, unlist)
      x1 <- x[[1]]
    }
    for (i in seq_along(x)[-1]) {
      if (length(x1) != length(x[[i]])) {
        return(FALSE)
      }
      ok <- .all.equal.GenomicRanges(x[[1]], x1)
      if (!ok) {
        return(FALSE)
      }
    }
    return(TRUE)
  } else {
    all(vapply(x[-1],
               function(xelt) all(identical(xelt, x[[1]])), logical(1L)))
  }
}

n <- 100000000
a <- GRanges(1, IRanges(seq_len(n), width = 1L))
b <- a
mcols(b)$score <- seq_len(n)

identical(.compare(list(a, b), TRUE), 
          SummarizedExperiment:::.compare(list(a, b), TRUE))
system.time(.compare(list(a, b), TRUE))
# user  system elapsed
# 0.004   0.000   0.004
system.time(SummarizedExperiment:::.compare(list(a, b), TRUE))
# user  system elapsed
# 12.113   1.520  13.676