inst/unitTests/test_XStringSet.R

In anandhupresannan/biostrings: Efficient manipulation of biological strings

### -------------------------------------------------------------------------
### Helper functions
###

### In R 2.14 (and maybe before that), 2 external pointers are always
### considered identical so the identical() function cannot be used to
### compare the "pool" slots of 2 XVectorList objects. The workaround we
### use below is to extract the adresses in each pool as a character vector,
### and then to compare the 2 character vectors.

### '.eltAddresses(x)' collects the addresses of the elements in 'x' (in
### practice 'x' will be a list of external pointers or environments).
.eltAddresses <- function(x) sapply(x, XVector:::address)

### 'x' and 'y' must be XVectorList vectors.
.haveIdenticalPools <- function(x, y)
    identical(.eltAddresses(x@pool@xp_list), .eltAddresses(y@pool@xp_list))

### 'x' must be an XVectorList vector.
.poolEltLengths <- function(x)
{
    pool_len <- length(x@pool)
    if (pool_len == 0L)
        return(integer(0))
    sapply(seq_len(pool_len), function(i) length(x@pool[[i]]))
}


### -------------------------------------------------------------------------

test_width_character <- function()
{
    x <- safeExplode(rawToChar(as.raw(1:255)))
    checkIdentical(width(x), rep.int(1L, 255))
}

test_DNAStringSet_constructor <- function()
{
    dna <- DNAStringSet(DNA_ALPHABET)

    ## Checking internal representation.
    checkIdentical(.poolEltLengths(dna), length(DNA_ALPHABET))
}

test_DNAStringSet_width <- function()
{
    dna <- DNAStringSet(DNA_ALPHABET)
    checkIdentical(width(dna), width(DNA_ALPHABET))
}

test_DNAStringSet_subsetting <- function()
{
    dna <- DNAStringSet(DNA_ALPHABET)
    elementMetadata(dna) <- DataFrame(C1=dna)

    dna0 <- dna[FALSE]
    checkIdentical(length(dna0), 0L)
    ## Checking internal representation.
    checkIdentical(.poolEltLengths(dna0), integer(0))
    checkIdentical(.haveIdenticalPools(elementMetadata(dna0)$C1, dna0),
                   TRUE)
    checkIdentical(elementMetadata(dna0)$C1@ranges, dna0@ranges)

    idx <- rep.int((8:6)*2L, 100L)
    dna300 <- dna[idx]
    checkIdentical(length(dna300), length(idx))
    ## Checking internal representation.
    checkIdentical(.haveIdenticalPools(dna300, dna), TRUE)
    checkIdentical(.haveIdenticalPools(elementMetadata(dna300)$C1, dna300),
                   TRUE)
    checkIdentical(elementMetadata(dna300)$C1@ranges, dna300@ranges)
}

test_DNAStringSet_combining <- function()
{
    dna <- DNAStringSet(DNA_ALPHABET)
    elementMetadata(dna) <- DataFrame(C1=dna)

    dna2a <- c(dna, dna)
    dna2b <- rep(dna, 2L)
    checkIdentical(dna2a, dna2b)
    ## Checking internal representation.
    checkIdentical(.haveIdenticalPools(dna2a, dna), TRUE)
    checkIdentical(.haveIdenticalPools(dna2a, dna2b), TRUE)
    checkIdentical(.haveIdenticalPools(elementMetadata(dna2a)$C1, dna2a),
                   TRUE)
    checkIdentical(elementMetadata(dna2a)$C1@ranges, dna2a@ranges)
}

test_DNAStringSet_unlist <- function()
{
    dna <- DNAStringSet(DNA_ALPHABET)
    checkIdentical(as.character(unlist(dna)), paste(DNA_ALPHABET, collapse=""))
}

test_DNAStringSet_compaction <- function()
{
    dna <- DNAStringSet(DNA_ALPHABET)
    elementMetadata(dna) <- DataFrame(C1=dna)

    idx <- rep.int((8:6)*2L, 100L)
    dna300 <- dna[idx]
    compact_dna300 <- compact(dna300)
    checkIdentical(as.character(compact_dna300), as.character(dna300))
    ## Checking internal representation.
    checkIdentical(.poolEltLengths(compact_dna300), 3L)
    checkIdentical(.poolEltLengths(elementMetadata(compact_dna300)$C1),
                   .poolEltLengths(compact_dna300))
    checkIdentical(elementMetadata(compact_dna300)$C1@ranges,
                   compact_dna300@ranges)
}

test_DNAStringSet_showAsCell <- function()
{
    dna <- showAsCell(DNAStringSet())
    checkTrue(is(dna, "character"))
    dna <- showAsCell(DNAStringSet(DNA_ALPHABET))
    checkTrue(is(dna, "character"))
}