tests/testthat/test-compare.R

In InteractionSet: Base Classes for Storing Genomic Interaction Data

# Tests the construction and manipulation of GInteractions objects.
# library(InteractionSet); library(testthat); source("test-compare.R")

set.seed(8000)
N <- 30
all.starts <- round(runif(N, 1, 100))
all.ends <- all.starts + round(runif(N, 5, 20))
all.regions <- GRanges(rep(c("chrA", "chrB"), c(N-10, 10)), IRanges(all.starts, all.ends))

Np <- 20
all.anchor1 <- sample(N, Np)
all.anchor2 <- sample(N, Np)
x <- GInteractions(all.anchor1, all.anchor2, all.regions)

ref.match <- function(x, y) {
    match(do.call(paste, c(anchors(x, id=TRUE), sep=".")), 
          do.call(paste, c(anchors(y, id=TRUE), sep=".")))
}

#####################################

test_that("matching between GI objects works", {
    another.x <- x[sample(Np)] 
    
    expect_identical(match(x, another.x), ref.match(x, another.x))
    expect_identical(match(x, another.x[1:5]), ref.match(x, another.x[1:5]))
    expect_identical(match(x[20:10], another.x), ref.match(x[20:10], another.x))
    
    expect_identical(match(x[0], another.x), integer(0))
    expect_identical(match(x, another.x[0]), rep(as.integer(NA), Np))

    # Testing unequal regions, generated by appending regions to the front or end.
    ref <- match(x, another.x)
    more.x <- another.x
    suppressWarnings(appendRegions(more.x) <- GRanges("chrC", IRanges(1, 1)))
    expect_identical(ref, match(x, more.x))

    more.x <- another.x
    suppressWarnings(replaceRegions(more.x) <- c(GRanges("achr", IRanges(1, 1)), all.regions)) # inserts at front.
    expect_identical(ref, match(x, more.x))

    # Testing via the %in% operator.
    expect_identical(x %in% another.x, !is.na(match(x, another.x)))
    expect_identical(x[20:10] %in% another.x, !is.na(match(x[20:10], another.x)))
})

test_that("matching between ISet objects works", {
    iset <- InteractionSet(matrix(runif(Np), dimnames=list(NULL, 1)), x)
    another.x <- x[sample(Np)] 
    iset2 <- InteractionSet(matrix(runif(Np), dimnames=list(NULL, 1)), another.x)
    
    # Testing ISet to GI and vice versa.
    expect_identical(match(iset, x), ref.match(iset, x))
    expect_identical(match(iset, another.x), ref.match(iset, another.x))
    expect_identical(match(iset2, x), ref.match(iset2, x))
    expect_identical(match(x, iset), ref.match(x, iset))
    expect_identical(match(another.x, iset), ref.match(another.x, iset))
    expect_identical(match(x, iset2), ref.match(x, iset2))
    expect_identical(match(iset, iset2), ref.match(iset, iset2))

    # Testing various subsets.
    expect_identical(match(iset[10:15], another.x), ref.match(iset[10:15], another.x))
    expect_identical(match(another.x, iset[10:15]), ref.match(another.x, iset[10:15]))
    expect_identical(match(iset, another.x[20:6]), ref.match(iset, another.x[20:6]))
    expect_identical(match(another.x[20:6], iset), ref.match(another.x[20:6], iset))
    expect_identical(match(iset, iset2[1:6,]), ref.match(iset, iset2[1:6,]))

    # Testing via %in%.
    expect_identical(iset %in% another.x, !is.na(ref.match(iset, another.x)))
    expect_identical(iset %in% iset2, !is.na(ref.match(iset, iset2)))
    expect_identical(another.x %in% iset, !is.na(ref.match(another.x, iset)))
})

#####################################

test_that("comparisons between GI objects works", {
    another.x <- x[sample(Np)] 
    expect_identical(pcompare(x, another.x), ifelse(x@anchor1==another.x@anchor1, x@anchor2-another.x@anchor2, x@anchor1-another.x@anchor1))
    sub.x <- x[3:12] # Recycle the vector...
    expect_identical(pcompare(sub.x, another.x), ifelse(sub.x@anchor1==another.x@anchor1, sub.x@anchor2-another.x@anchor2, sub.x@anchor1-another.x@anchor1))
    expect_identical(pcompare(another.x, sub.x), -pcompare(sub.x, another.x))
    expect_identical(pcompare(x[0], another.x[0]), integer(0))
    
    old <- pcompare(x, another.x)
    expect_identical(x==x, !logical(length(x)))
    expect_identical(x!=x, logical(length(x)))
    expect_identical(x==another.x, old==0L)
    
    # Altering regions.
    more.x <- another.x
    regions(more.x)$whee <- 1
    expect_identical(pcompare(x, more.x), old) # This should be okay, as metadata is ignored.

    ref <- pcompare(x, another.x)
    more.x <- another.x
    suppressWarnings(appendRegions(more.x) <- GRanges("chrC", IRanges(1, 1)))
    expect_identical(ref, pcompare(x, more.x))

    more.x <- another.x
    suppressWarnings(replaceRegions(more.x) <- c(GRanges("achr", IRanges(1, 1)), all.regions)) # inserts at front.
    expect_identical(ref, pcompare(x, more.x))
})

test_that("comparisons between different strictness levels triggers warnings", {
    sx <- as(swapAnchors(x), "StrictGInteractions")
    expect_warning(sx==x, "comparison between GInteractions objects of different strictness")
    rsx <- as(swapAnchors(x, mode="reverse"), "ReverseStrictGInteractions")
    expect_warning(rsx==sx, "comparison between GInteractions objects of different strictness")
    expect_warning(rsx==x, "comparison between GInteractions objects of different strictness")
    expect_warning(match(rsx, x), "comparison between GInteractions objects of different strictness")
})