test_Hits-class.R
In S4Vectors: Foundation of vector-like and list-like containers in Bioconductor

test_Hits_constructor <- function()
{
    from <- c(5, 2, 3, 3, 3, 2)
    to <- c(11, 15, 5, 4, 5, 11)
    id <- letters[1:6]

    hits0 <- Hits(from, to, 7, 15, id, sort.by.query=FALSE)
    checkTrue(validObject(hits0, complete=TRUE))
    checkTrue(class(hits0) == "Hits")
    checkIdentical(as.integer(from), from(hits0))
    checkIdentical(as.integer(to), to(hits0))
    checkIdentical(7L, nLnode(hits0))
    checkIdentical(15L, nRnode(hits0))
    checkIdentical(id, mcols(hits0)$id)

    hits1 <- Hits(from, to, 7, 15, id, sort.by.query=TRUE)
    checkTrue(validObject(hits1, complete=TRUE))
    checkTrue(class(hits1) == "SortedByQueryHits")
    checkIdentical(c(2L, 2L, 3L, 3L, 3L, 5L), from(hits1))
    checkIdentical(c(15L, 11L, 5L, 4L, 5L, 11L), to(hits1))
    checkIdentical(7L, nLnode(hits1))
    checkIdentical(15L, nRnode(hits1))
    checkIdentical(c("b", "f", "c", "d", "e", "a"), mcols(hits1)$id)

    ## By default, 'sort.by.query' is FALSE.
    checkIdentical(hits0, Hits(from, to, 7, 15, id))
}

test_Hits_coercion <- function()
{
    ## --- Coercion within the Hits class hierarchy ---

    from <- c(5, 2, 3, 10, 5)
    to <- c(10, 2, 2, 2, 8)

    ## promotions

    h <- Hits(from, to, nLnode=10, nRnode=15, label=LETTERS[1:5])

    current <- as(h, "SortedByQueryHits")
    checkIdentical(class(new("SortedByQueryHits")), class(current))
    checkTrue(validObject(current))
    checkIdentical(c("B", "C", "A", "E", "D"), mcols(current)$label)

    checkException(as(h, "SelfHits"))
    checkException(as(h, "SortedByQuerySelfHits"))

    h <- Hits(from, to, nLnode=10, nRnode=10, label=LETTERS[1:5])

    current <- as(h, "SortedByQueryHits")
    checkIdentical(class(new("SortedByQueryHits")), class(current))
    checkTrue(validObject(current))
    checkIdentical(c("B", "C", "A", "E", "D"), mcols(current)$label)

    current <- as(h, "SelfHits")
    checkIdentical(class(new("SelfHits")), class(current))
    checkTrue(validObject(current))
    checkIdentical(mcols(h)$label, mcols(current)$label)

    current <- as(h, "SortedByQuerySelfHits")
    checkIdentical(class(new("SortedByQuerySelfHits")), class(current))
    checkTrue(validObject(current))
    checkIdentical(c("B", "C", "A", "E", "D"), mcols(current)$label)

    ## demotions

    sh <- SelfHits(from, to, nnode=10, label=LETTERS[1:5])

    current <- as(sh, "Hits")
    checkIdentical(class(new("Hits")), class(current))
    checkTrue(validObject(current))
    checkIdentical(mcols(sh)$label, mcols(current)$label)

    h <- Hits(from, to, nLnode=10, nRnode=10, label=LETTERS[1:5],
              sort.by.query=TRUE)

    current <- as(h, "Hits")
    checkIdentical(class(new("Hits")), class(current))
    checkTrue(validObject(current))
    checkIdentical(mcols(h)$label, mcols(current)$label)

    sh <- SelfHits(from, to, nnode=10, label=LETTERS[1:5], sort.by.query=TRUE)

    for (to_class in c("SelfHits", "SortedByQueryHits", "Hits")) {
        current <- as(sh, to_class)
        checkIdentical(class(new(to_class)), class(current))
        checkTrue(validObject(current))
        checkIdentical(mcols(sh)$label, mcols(current)$label)
        checkIdentical(sh, as(sh, to_class, strict=FALSE))
    }

    ## transversal

    h <- Hits(from, to, nLnode=10, nRnode=15, label=LETTERS[1:5],
              sort.by.query=TRUE)

    checkException(as(h, "SelfHits"))

    h <- Hits(from, to, nLnode=10, nRnode=10, label=LETTERS[1:5],
              sort.by.query=TRUE)
    sh1 <- SelfHits(from, to, nnode=10, label=LETTERS[1:5])
    sh2 <- as(as(sh1, "SortedByQuerySelfHits"), "SelfHits")

    checkIdentical(sh2, as(h, "SelfHits"))
    checkIdentical(h, as(sh1, "SortedByQueryHits"))
    checkIdentical(h, as(sh2, "SortedByQueryHits"))

    ## --- Other coercions ---

    ## sparse
    from <- c(1L, 1L, 3L)
    to <- 1:3

    hits <- Hits(from, to, 3, 3)
    checkIdentical(as.matrix(hits), cbind(from=from, to=to))
    checkIdentical(as.table(hits), c(2L, 0L, 1L))
    checkIdentical(as.table(t(hits)), c(1L, 1L, 1L))

    hits <- Hits(from, to, 3, 3, sort.by.query=TRUE)
    checkIdentical(as.matrix(hits), cbind(queryHits=from, subjectHits=to))
    checkIdentical(as.table(hits), c(2L, 0L, 1L))
    checkIdentical(as.table(t(hits)), c(1L, 1L, 1L))

    ## dense
    from <- rep(1:2, each=2)
    to <- rep(1:2, 2)

    hits <- Hits(from, to, 3, 2)
    checkIdentical(as.matrix(hits), cbind(from=from, to=to))
    checkIdentical(as.table(hits), c(2L, 2L, 0L))
    checkIdentical(as.table(t(hits)), c(2L, 2L))

    hits <- Hits(from, to, 3, 2, sort.by.query=TRUE)
    checkIdentical(as.matrix(hits), cbind(queryHits=from, subjectHits=to))
    checkIdentical(as.table(hits), c(2L, 2L, 0L))
    checkIdentical(as.table(t(hits)), c(2L, 2L))
}

test_remapHits <- function()
{
    from0 <- c(1L, 1L, 2L, 3L, 3L)
    to0 <- c(1L, 2L, 5L, 2L, 4L)
    hits0 <- Hits(from0, to0, 3L, 6L, sort.by.query=TRUE)

    ## No remapping (i.e. map is missing or is the identity function).
    checkIdentical(remapHits(hits0), hits0)

    Lnodes.remapping1 <- seq_len(nLnode(hits0))
    new.nLnode1 <- nLnode(hits0)
    Rnodes.remapping1 <- seq_len(nRnode(hits0))
    new.nRnode1 <- nRnode(hits0)

    hits10 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping1,
                               new.nLnode=new.nLnode1)
    checkIdentical(hits10, hits0)

    hits01 <- remapHits(hits0, Rnodes.remapping=Rnodes.remapping1,
                               new.nRnode=new.nRnode1)
    checkIdentical(hits01, hits0)

    hits11 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping1,
                               new.nLnode=new.nLnode1,
                               Rnodes.remapping=Rnodes.remapping1,
                               new.nRnode=new.nRnode1)
    checkIdentical(hits11, hits0)

    ## With maps that add a fixed offset to from(x), and a fixed offset
    ## to to(x).
    Lnodes.remapping2 <- Lnodes.remapping1 + 20L
    new.nLnode2 <- new.nLnode1 + 20L
    Rnodes.remapping2 <- Rnodes.remapping1 + 30L
    new.nRnode2 <- new.nRnode1 + 30L

    hits20 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping2,
                               new.nLnode=new.nLnode2)
    expected_hits20 <- Hits(from0 + 20L, to0, 23, 6, sort.by.query=TRUE)
    checkIdentical(hits20, expected_hits20)

    hits02 <- remapHits(hits0, Rnodes.remapping=Rnodes.remapping2,
                               new.nRnode=new.nRnode2)
    expected_hits02 <- Hits(from0, to0 + 30L, 3, 36, sort.by.query=TRUE)
    checkIdentical(hits02, expected_hits02)

    hits22 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping2,
                               new.nLnode=new.nLnode2,
                               Rnodes.remapping=Rnodes.remapping2,
                               new.nRnode=new.nRnode2)
    expected_hits22 <- Hits(from0 + 20L, to0 + 30L, 23, 36, sort.by.query=TRUE)
    checkIdentical(hits22, expected_hits22)

    ## With injective and non-ascending maps.
    Lnodes.remapping3 <- 100L * rev(Lnodes.remapping1) + Lnodes.remapping1
    new.nLnode3 <- 400L
    Rnodes.remapping3 <- 100L * rev(Rnodes.remapping1) + Rnodes.remapping1
    new.nRnode3 <- 700L

    hits30 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping3,
                               new.nLnode=new.nLnode3)
    expected_hits30 <- Hits(c(103, 103, 202, 301, 301),
                            c(  2,   4,   5,   1,   2),
                            400, 6,
                            sort.by.query=TRUE)
    checkIdentical(hits30, expected_hits30)

    hits03 <- remapHits(hits0, Rnodes.remapping=Rnodes.remapping3,
                               new.nRnode=new.nRnode3)
    expected_hits03 <- Hits(from0, c(502, 601, 205, 304, 502),
                            3, 700,
                            sort.by.query=TRUE)
    checkIdentical(t(hits03), t(expected_hits03))

    hits33 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping3,
                               new.nLnode=new.nLnode3,
                               Rnodes.remapping=Rnodes.remapping3,
                               new.nRnode=new.nRnode3)
    expected_hits33 <- Hits(c(103, 103, 202, 301, 301),
                            c(304, 502, 205, 502, 601),
                            400, 700,
                            sort.by.query=TRUE)
    checkIdentical(t(hits33), t(expected_hits33))

    ## With non-injective maps (as factors).
    Lnodes.remapping4 <- factor(c("B", "A", "B"), levels=c("A", "B"))
    Rnodes.remapping4 <- factor(c("a", "b", "a", "b", "a", "b"), levels=c("a", "b"))

    hits40 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping4)
    expected_hits40 <- Hits(c(1, 2, 2, 2), c(5, 1, 2, 4), 2, 6,
                            sort.by.query=TRUE)
    checkIdentical(hits40, expected_hits40)

    hits04 <- remapHits(hits0, Rnodes.remapping=Rnodes.remapping4)
    expected_hits04 <- Hits(c(1, 1, 2, 3), c(1, 2, 1, 2), 3, 2,
                            sort.by.query=TRUE)
    checkIdentical(hits04, expected_hits04)

    hits44 <- remapHits(hits0, Lnodes.remapping=Lnodes.remapping4,
                               Rnodes.remapping=Rnodes.remapping4)
    expected_hits44 <- Hits(c(1, 2, 2), c(1, 1, 2), 2, 2,
                            sort.by.query=TRUE)
    checkIdentical(hits44, expected_hits44)
}