tests/testthat/test-GI.R
In LTLA/InteractionSet: Base Classes for Storing Genomic Interaction Data
# Tests the construction and manipulation of GInteractions objects.
# library(InteractionSet); library(testthat); source("test-GI.R")
set.seed(7000)
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)
test_that("show methods work for GI objects", {
expect_output(sub("[0-9]", " ", show(x)), "GInteractions object with 20 interactions and 0 metadata columns:
seqnames1 ranges1 seqnames2 ranges2
<Rle> <IRanges> <Rle> <IRanges>
[1] chrA 94-105 --- chrA 41-48
[2] chrB 42-54 --- chrA 94-105
[3] chrA 41-48 --- chrA 59-72
[4] chrB 64-78 --- chrA 55-68
[5] chrA 41-59 --- chrA 3-23
... ... ... ... ... ...
[16] chrA 76-95 --- chrB 91-98
[17] chrA 46-66 --- chrB 67-84
[18] chrA 68-78 --- chrA 20-33
[19] chrA 61-67 --- chrA 87-104
[20] chrA 18-35 --- chrB 63-76
-------
regions: 30 ranges and 0 metadata columns
seqinfo: 2 sequences from an unspecified genome; no seqlengths", fixed=TRUE)
})
######################################
# Needed in many test chunks, so I'll let it out here.
o <- order(all.regions)
ref.regions <- all.regions[o]
new.pos <- integer(length(o))
new.pos[o] <- seq_along(new.pos)
ref.anchor1 <- new.pos[all.anchor1]
ref.anchor2 <- new.pos[all.anchor2]
test_that("slot access works in GI objects", {
expect_that(x, is_a("GInteractions"))
expect_true(!is.unsorted(regions(x)))
expect_identical(regions(x), ref.regions)
expect_identical(anchors(x, id=TRUE, type="first"), ref.anchor1)
expect_identical(anchors(x, id=TRUE, type="second"), ref.anchor2)
expect_identical(anchors(x, id=TRUE), list(first=ref.anchor1, second=ref.anchor2))
expect_identical(anchors(x, type="first"), ref.regions[ref.anchor1])
expect_identical(anchors(x, type="second"), ref.regions[ref.anchor2])
expect_identical(anchors(x), list(first=ref.regions[ref.anchor1], second=ref.regions[ref.anchor2]))
expect_identical(anchors(x, type="first"), first(x))
expect_identical(anchors(x, type="second"), second(x))
})
######################################
test_that("alternative construction methods work for GI objects", {
x2 <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2])
was.used <- sort(unique(all.regions[union(all.anchor1, all.anchor2)])) # Only includes the regions actually used.
expect_identical(regions(x2), was.used)
expect_identical(anchors(x2), anchors(x))
x3 <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], was.used)
expect_identical(anchors(x3, id=TRUE), anchors(x2, id=TRUE))
expect_identical(regions(x3), regions(x2))
anno.regions <- all.regions
anno.regions$score <- seq_along(anno.regions) # Seeing what happens with annotation.
anno.regions$revscore <- rev(seq_along(anno.regions))
x4 <- GInteractions(anno.regions[all.anchor1], anno.regions[all.anchor2])
expect_identical(regions(x2), regions(x4))
expect_identical(mcols(x4), DataFrame(anchor1.score=anno.regions$score[all.anchor1], anchor1.revscore=anno.regions$revscore[all.anchor1],
anchor2.score=anno.regions$score[all.anchor2], anchor2.revscore=anno.regions$revscore[all.anchor2]))
})
######################################
test_that("GI constructors behave properly on crappy inputs", {
empty <- GInteractions(integer(0), numeric(0), GRanges())
expect_identical(length(empty), 0L)
expect_identical(length(anchors(empty, type="first")), 0L)
expect_identical(empty, GInteractions())
empty <- GInteractions(GRanges(), GRanges())
expect_identical(length(empty), 0L)
expect_identical(length(anchors(empty, type="first")), 0L)
expect_identical(empty, GInteractions())
empty <- GInteractions(GRanges(), GRanges(), all.regions)
expect_identical(length(empty), 0L)
expect_identical(length(anchors(empty, type="first")), 0L)
expect_identical(length(regions(empty)), length(all.regions))
expect_error(GInteractions(1:4, 1, all.regions), "first and second anchor vectors have different lengths")
expect_error(GInteractions(0:3, 1:4, all.regions), "all anchor indices must be positive integers")
expect_error(GInteractions(c(1,2,3,NA), 1:4, all.regions), "all anchor indices must be finite integers")
expect_error(GInteractions(c(1,2,3,length(all.regions)+1L), 1:4, all.regions), "all anchor indices must refer to entries in 'regions'")
missing.value <- GRanges("chrB", IRanges(1000,1000))
expect_error(GInteractions(missing.value, missing.value, all.regions), "anchor regions missing in specified 'regions'")
})
######################################
test_that("GI constructors preserve metadata", {
m.x <- GInteractions(all.anchor1, all.anchor2, all.regions, score=1L)
expect_identical(m.x$score, rep(1L, length(m.x)))
m.x <- GInteractions(all.anchor1, all.anchor2, all.regions, score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], all.regions, score=1L)
expect_identical(m.x$score, rep(1L, length(m.x)))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], all.regions, score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], score=1L)
expect_identical(m.x$score, rep(1L, length(m.x)))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
m.regions <- all.regions
m.regions$GC <- rev(seq_along(m.regions))
m.x <- GInteractions(m.regions[all.anchor1], m.regions[all.anchor2], score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
expect_identical(m.x$anchor1.GC, m.regions$GC[all.anchor1])
expect_identical(m.x$anchor2.GC, m.regions$GC[all.anchor2])
m.x <- GInteractions(integer(0), integer(0), all.regions, score=1)
expect_identical(m.x$score, numeric(0))
m.x <- GInteractions(regions=all.regions, score=numeric(0))
expect_identical(m.x$score, numeric(0))
m.x <- GInteractions(regions=all.regions, score=1)
expect_identical(m.x$score, numeric(0))
m.x <- GInteractions(regions=all.regions, score=1:2)
expect_identical(m.x$score, integer(0))
})
######################################
set.seed(7001)
test_that("anchor setters work properly for GI objects", {
fresh.anchor1 <- sample(N, Np)
fresh.anchor2 <- sample(N, Np)
anchorIds(x) <- list(fresh.anchor1, fresh.anchor2)
expect_identical(anchors(x, id=TRUE, type="first"), fresh.anchor1)
expect_identical(anchors(x, id=TRUE, type="second"), fresh.anchor2)
expect_error(anchorIds(x) <- list(ref.anchor1, ref.anchor2, ref.anchor1), "must be a list of 2 numeric vectors")
expect_error(anchorIds(x) <- list(ref.anchor1[1:(Np/2)], ref.anchor2), "x@anchor2' is not parallel to 'x'")
mod.x <- x
anchorIds(mod.x, type="first") <- ref.anchor1 # Checking that this also works
expect_identical(anchors(mod.x, id=TRUE, type="first"), ref.anchor1)
mod.x <- x
anchorIds(mod.x, type="second") <- ref.anchor2
expect_identical(anchors(mod.x, id=TRUE, type="second"), ref.anchor2)
anchorIds(x, type="both") <- list(ref.anchor1, ref.anchor2) # Restoring.
expect_identical(anchors(x, id=TRUE, type="first"), ref.anchor1)
expect_identical(anchors(x, id=TRUE, type="second"), ref.anchor2)
})
test_that("region setters work properly for GI objects", {
shuffled <- sample(100, N, replace=TRUE)
regions(x)$score <- shuffled
expect_identical(regions(x)$score, shuffled)
expect_false(identical(regions(x), ref.regions))
regions(x) <- ref.regions # Restoring.
expect_true(identical(regions(x), ref.regions))
x.dump <- x
mod.ranges <- resize(regions(x), fix="center", width=50)
new.ranges <- c(regions(x), mod.ranges)
expect_error(regions(x.dump) <- new.ranges, "assigned value must be of the same length")
replaceRegions(x.dump) <- new.ranges
expect_identical(anchors(x.dump), anchors(x))
expect_identical(sort(new.ranges), regions(x.dump))
expect_error(replaceRegions(x.dump) <- mod.ranges, "some existing ranges do not exist in replacement GRanges")
x.dump2 <- x
appendRegions(x.dump2) <- mod.ranges
expect_identical(anchors(x.dump2), anchors(x))
expect_identical(regions(x.dump), regions(x.dump2))
x.dump <- reduceRegions(x)
expect_identical(anchors(x), anchors(x.dump))
expect_identical(regions(x)[sort(unique(unlist(anchors(x, id=TRUE))))], regions(x.dump))
})
ref.score <- runif(Np)
test_that("other setters work properly for GI objects", {
x$stuff <- ref.score
expect_identical(x$stuff, mcols(x)$stuff)
expect_identical(colnames(mcols(x)), "stuff")
expect_output(show(x), "stuff")
x$stuff <- NULL
new.si <- Seqinfo(seqnames=c("chrA", "chrB"), seqlengths=c(1000, 2000))
new.x <- x
seqinfo(new.x) <- new.si
expect_identical(seqinfo(new.x), new.si)
})
######################################
test_that("subsetting works for GI objects", {
rchosen <- 1:10
xsub <- x[rchosen,]
expect_output(show(xsub), "GInteractions object with 10 interactions and 0 metadata columns:
seqnames1 ranges1 seqnames2 ranges2
<Rle> <IRanges> <Rle> <IRanges>
[1] chrA 94-105 --- chrA 41-48
[2] chrB 42-54 --- chrA 94-105
[3] chrA 41-48 --- chrA 59-72
[4] chrB 64-78 --- chrA 55-68
[5] chrA 41-59 --- chrA 3-23
[6] chrA 47-54 --- chrA 14-19
[7] chrA 82-100 --- chrA 84-103
[8] chrB 89-97 --- chrA 46-66
[9] chrA 86-105 --- chrA 82-100
[10] chrA 55-68 --- chrB 81-98
-------
regions: 30 ranges and 0 metadata columns
seqinfo: 2 sequences from an unspecified genome; no seqlengths", fixed=TRUE)
expect_identical(xsub, x[rchosen])
log.chosen <- logical(length(x))
log.chosen[rchosen] <- TRUE
expect_identical(xsub, subset(x, log.chosen))
expect_identical(x[log.chosen], subset(x, log.chosen))
expect_identical(length(xsub), length(rchosen))
expect_identical(regions(xsub), regions(x))
expect_identical(anchors(xsub, type="first"), ref.regions[ref.anchor1][rchosen])
expect_identical(anchors(xsub, type="second"), ref.regions[ref.anchor2][rchosen])
temp.x <- x
temp.x$score <- ref.score
expect_identical(temp.x[rchosen]$score, ref.score[rchosen])
expect_identical(nrow(mcols(temp.x[rchosen])), length(rchosen))
expect_identical(length(x[0,]), 0L)
expect_identical(length(x[0]), 0L)
expect_error(x[,1], "subscript contains out-of-bounds indices")
# Subsetting by mcols works as expected.
mcols(x)$stuff <- runif(length(x))
expect_identical(x[,1], x)
alt.x <- x
mcols(alt.x)$whee <- runif(length(x))
mcols(x)$stuff <- NULL
mcols(x)$whee <- mcols(alt.x)$whee
expect_identical(alt.x[,2], x)
expect_error(x[,,1], "invalid subsetting")
})
test_that("subset assignment works for GI objects", {
temp.x <- x
temp.x[1:5+10,] <- x[1:5,]
new.index <- seq_along(x)
new.index[1:5+10] <- 1:5
expect_identical(anchors(temp.x, type="first"), anchors(x, type="first")[new.index,])
expect_identical(anchors(temp.x, type="second"), anchors(x, type="second")[new.index,])
temp.x <- x
temp.x[0,] <- x[0,]
expect_identical(temp.x, x)
temp.x[] <- x
expect_identical(temp.x, x)
temp.x <- x
temp.x$score <- ref.score
temp.x[1:5]$score <- 5:1
mod.score <- ref.score
mod.score[1:5] <- 5:1
expect_identical(temp.x$score, mod.score)
rchosen <- 1:10
expect_identical(temp.x[rchosen]$score, mod.score[rchosen])
expect_identical(nrow(mcols(temp.x[rchosen])), length(rchosen))
temp.x <- x
regions(temp.x) <- resize(regions(temp.x), 10) # what happens with different regions?
ref <- c(x[1], temp.x[-1])
temp.x[1] <- x[1]
expect_identical(temp.x, ref)
temp.x <- x
regions(temp.x) <- resize(regions(temp.x), 20) # Checking again, just in case.
ref <- c(temp.x[1:5], x[1:5], temp.x[11:length(temp.x)])
temp.x[6:10] <- x[1:5]
expect_identical(temp.x, ref)
})
######################################
test_that("combining works for GI obejcts", {
# When regions are the same.
xsub <- x[1:5,]
xsub2 <- x[6:20,]
expect_identical(c(xsub, xsub2), x)
xsub <- x[1:15]
xsub2 <- x[16:20]
expect_identical(c(xsub, xsub2), x)
expect_identical(c(x[0,], x[0,]), x[0,])
expect_identical(c(x, x[0,]), x)
temp.x <- x
temp.x$score <- ref.score
double.up <- c(temp.x, temp.x)
expect_identical(regions(double.up), regions(x))
expect_identical(anchors(double.up, type="first"), rep(anchors(x, type="first"), 2))
expect_identical(anchors(double.up, type="second"), rep(anchors(x, type="second"), 2))
expect_identical(double.up$score, rep(temp.x$score, 2))
# When regions are different.
set.seed(7002)
next.starts <- round(runif(N, 1, 100))
next.ends <- next.starts + round(runif(N, 5, 20))
next.regions <- GRanges(rep(c("chrA", "chrB"), c(N-10, 10)), IRanges(next.starts, next.ends))
next.anchor1 <- sample(N, Np)
next.anchor2 <- sample(N, Np)
next.x <- GInteractions(next.anchor1, next.anchor2, next.regions)
c.x <- c(x, next.x)
expect_identical(c(anchors(x, type="first"), anchors(next.x, type="first")), anchors(c.x, type="first"))
expect_identical(c(anchors(x, type="second"), anchors(next.x, type="second")), anchors(c.x, type="second"))
expect_identical(unique(sort(c(regions(x), regions(next.x)))), regions(c.x))
expect_identical(anchors(c(x[0,], next.x[0,])), anchors(x[0,])) # Behaviour with empties.
expect_identical(anchors(c(x, next.x[0,])), anchors(x)) # Not fully equal, as regions have changed.
next.x2 <- GInteractions(1:10, 1:10, next.regions[1:10]) # What happens with non-equal lengths of the regions?
c.x <- c(x, next.x2)
expect_identical(c(anchors(x, type="first"), anchors(next.x2, type="first")), anchors(c.x, type="first"))
expect_identical(c(anchors(x, type="second"), anchors(next.x2, type="second")), anchors(c.x, type="second"))
expect_identical(unique(sort(c(regions(x), regions(next.x2)))), regions(c.x))
# Plus metadata
temp.x <- x
temp.x$score <- ref.score
double.up <- c(temp.x, temp.x)
expect_identical(regions(double.up), regions(x))
expect_identical(anchors(double.up, type="first"), rep(anchors(x, type="first"), 2))
expect_identical(anchors(double.up, type="second"), rep(anchors(x, type="second"), 2))
expect_identical(double.up$score, rep(temp.x$score, 2))
# Plus names.
temp.x <- temp.x2 <- x
names(temp.x) <- paste0("Inter", seq_along(temp.x))
names(temp.x2) <- paste0("Whee", seq_along(temp.x2))
combined <- c(temp.x, temp.x2)
expect_identical(names(combined), c(names(temp.x), names(temp.x2)))
})
######################################
test_that("sorting and deduplication of GI objects works", {
o.x <- order(anchors(x, type="first"), anchors(x, type="second"))
expect_identical(o.x, order(x))
expect_identical(sort(x), x[o.x,])
set.seed(70003)
x.1 <- x[sample(length(x), 100, replace=TRUE)]
x.2 <- x[sample(length(x), 100, replace=TRUE)]
o.x2 <- order(anchors(x.1, type="first"), anchors(x.1, type="second"), anchors(x.2, type="first"), anchors(x.2, type="second"))
expect_identical(o.x2, order(x.1, x.2))
is.dup <- duplicated(paste0(anchors(x, type="first"), ".", anchors(x, type="second")))
expect_identical(is.dup, duplicated(x))
temp.x <- c(x, x)
is.dup <- duplicated(paste0(anchors(temp.x, type="first"), ".", anchors(temp.x, type="second")))
expect_identical(is.dup, duplicated(temp.x))
expect_true(all(tail(is.dup, length(x)))) # if ordering is stable; only the first occurrence should be true.
expect_identical(x, unique(temp.x))
is.dup <- duplicated(paste0(anchors(temp.x, type="first"), ".", anchors(temp.x, type="second")), fromLast=TRUE)
expect_identical(is.dup, duplicated(temp.x, fromLast=TRUE))
expect_true(all(head(is.dup, length(x)))) # if ordering is stable; only the first occurrence should be true.
expect_equal(x, unique(temp.x, fromLast=TRUE))
expect_false(any(duplicated(unique(temp.x))))
expect_identical(order(x[0,]), integer(0))
expect_identical(duplicated(x[0,]), logical(0))
})
test_that("anchor swapping for GI objects works", {
new.x <- swapAnchors(x)
expect_identical(anchors(new.x, type="first", id=TRUE), pmin(anchors(x, type="first", id=TRUE), anchors(x, type="second", id=TRUE)))
expect_identical(anchors(new.x, type="second", id=TRUE), pmax(anchors(x, type="first", id=TRUE), anchors(x, type="second", id=TRUE)))
expect_identical(regions(x), regions(new.x))
new.x2 <- swapAnchors(x, mode="reverse")
expect_identical(anchors(new.x2, type="first"), anchors(new.x, type="second"))
expect_identical(anchors(new.x, type="first"), anchors(new.x2, type="second"))
expect_identical(regions(x), regions(new.x2))
new.x3 <- swapAnchors(x, mode="all")
expect_identical(anchors(new.x3, type="first"), anchors(x, type="second"))
expect_identical(anchors(x, type="first"), anchors(new.x3, type="second"))
expect_identical(regions(x), regions(new.x3))
})
test_that("splitting of GI objects works", {
flen <- c(5L, 10L, 5L)
f <- rep(1:3, flen)
out <- split(x, f)
expect_equivalent(lengths(out), flen)
for (i in seq_along(flen)) {
expect_identical(out[[i]], x[f==i])
}
temp.x <- x
temp.x$score <- ref.score
out <- split(temp.x, f)
for (i in seq_along(flen)) {
expect_identical(out[[i]]$score, temp.x[f==i]$score)
}
})
test_that("data.frame coercions of GI objects works", {
out <- as.data.frame(x)
ref1 <- as.data.frame(anchors(x, type="first"))
colnames(ref1) <- paste0(colnames(ref1), "1")
ref2 <- as.data.frame(anchors(x, type="second"))
colnames(ref2) <- paste0(colnames(ref2), "2")
expect_identical(out, data.frame(ref1, ref2))
temp.x <- x
temp.x$stuff <- ref.score
out <- as.data.frame(temp.x)
expect_identical(out, data.frame(ref1, ref2, stuff=ref.score))
names(temp.x) <- paste0("X", seq_along(temp.x))
out <- as.data.frame(temp.x)
expect_identical(out, data.frame(ref1, ref2, stuff=ref.score, row.names=names(temp.x)))
empty <- as.data.frame(x[0,])
expect_identical(colnames(empty), colnames(as.data.frame(x)))
expect_identical(nrow(empty), 0L)
})
test_that("environment generation works for GI objects", {
expect_identical(anchors(x, id=TRUE, type="first"), with(x, anchor1))
expect_identical(anchors(x, id=TRUE, type="second"), with(x, anchor2))
expect_identical(regions(x), with(x, regions))
expect_identical(anchors(x, type="first"), with(x, regions[anchor1]))
expect_identical(anchors(x, type="second"), with(x, regions[anchor2]))
expect_identical(names(x), with(x, names))
})
test_that("conversion to Pairs/GRangesList works for GI objects", {
temp.x <- x
temp.x$score <- ref.score
prs <- pairs(temp.x)
expect_identical(anchors(x, type="first"), first(prs))
expect_identical(anchors(x, type="second"), second(prs))
expect_identical(mcols(temp.x), mcols(prs))
expect_identical(names(temp.x), names(prs))
expect_identical(makeGInteractionsFromGRangesPairs(prs), reduceRegions(temp.x))
grl <- pairs(temp.x, as.grlist=TRUE)
first <- do.call(c, sapply(grl, function(x) { unname(x[1]) }))
second <- do.call(c, sapply(grl, function(x) { unname(x[2]) }))
expect_identical(anchors(x, type="first"), first)
expect_identical(anchors(x, type="second"), second)
expect_identical(mcols(temp.x), mcols(grl))
out <- pairs(temp.x, id=TRUE)
expect_identical(from(out), anchors(temp.x, id=TRUE, type="first"))
expect_identical(to(out), anchors(temp.x, id=TRUE, type="second"))
expect_identical(nnode(out), length(regions(temp.x)))
})
######################################
test_that("name handling is correct with GI objects", {
temp.x <- x
ref.names <- paste0("X", seq_along(temp.x))
names(temp.x) <- ref.names
expect_output(show(temp.x),"GInteractions object with 20 interactions and 0 metadata columns:
seqnames1 ranges1 seqnames2 ranges2
<Rle> <IRanges> <Rle> <IRanges>
X1 chrA 94-105 --- chrA 41-48
X2 chrB 42-54 --- chrA 94-105
X3 chrA 41-48 --- chrA 59-72
X4 chrB 64-78 --- chrA 55-68
X5 chrA 41-59 --- chrA 3-23
... ... ... ... ... ...
X16 chrA 76-95 --- chrB 91-98
X17 chrA 46-66 --- chrB 67-84
X18 chrA 68-78 --- chrA 20-33
X19 chrA 61-67 --- chrA 87-104
X20 chrA 18-35 --- chrB 63-76
-------
regions: 30 ranges and 0 metadata columns
seqinfo: 2 sequences from an unspecified genome; no seqlengths", fixed=TRUE)
expect_identical(names(temp.x), ref.names)
expect_identical(names(temp.x[2:5]), ref.names[2:5])
expect_identical(names(c(temp.x, temp.x)), c(ref.names, ref.names))
expect_identical(names(c(temp.x, x)), c(ref.names, character(length(x))))
for (id in c(TRUE, FALSE)) {
expect_identical(names(anchors(temp.x, id=id)[[1]]), ref.names)
expect_identical(names(anchors(temp.x, id=id)[[2]]), ref.names)
expect_identical(names(anchors(temp.x, id=id, type="first")), ref.names)
expect_identical(names(anchors(temp.x, id=id, type="second")), ref.names)
}
})
######################################
test_that("StrictGI objects are correctly formed", {
sx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="strict")
expect_that(sx, is_a("StrictGInteractions"))
expect_identical(sx, as(x, "StrictGInteractions"))
expect_identical(anchors(sx, id=TRUE, type="first"), do.call(pmin, anchors(x, id=TRUE)))
expect_identical(anchors(sx, id=TRUE, type="second"), do.call(pmax, anchors(x, id=TRUE)))
expect_identical(regions(sx), regions(x))
temp.sx <- sx
set.seed(70005)
fresh.anchor1 <- sample(N, Np)
fresh.anchor2 <- sample(N, Np)
anchorIds(temp.sx, type="first") <- fresh.anchor1
expect_identical(anchors(temp.sx, id=TRUE, type="first"), pmin(fresh.anchor1, anchors(sx, id=TRUE, type="second")))
expect_identical(anchors(temp.sx, id=TRUE, type="second"), pmax(fresh.anchor1, anchors(sx, id=TRUE, type="second")))
temp.sx <- sx
anchorIds(temp.sx, type="second") <- fresh.anchor2
expect_identical(anchors(temp.sx, id=TRUE, type="first"), pmin(fresh.anchor2, anchors(sx, id=TRUE, type="first")))
expect_identical(anchors(temp.sx, id=TRUE, type="second"), pmax(fresh.anchor2, anchors(sx, id=TRUE, type="first")))
temp.sx <- sx
anchorIds(temp.sx) <- list(fresh.anchor1, fresh.anchor2)
expect_identical(anchors(temp.sx, id=TRUE, type="first"), pmin(fresh.anchor1, fresh.anchor2))
expect_identical(anchors(temp.sx, id=TRUE, type="second"), pmax(fresh.anchor1, fresh.anchor2))
temp.sx2 <- sx
anchorIds(temp.sx2, type="both") <- list(fresh.anchor2, fresh.anchor1)
expect_identical(temp.sx2, temp.sx)
})
test_that("ReverseStrictGI objects are correctly formed", {
rsx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="reverse")
expect_that(rsx, is_a("ReverseStrictGInteractions"))
expect_identical(rsx, as(x, "ReverseStrictGInteractions"))
expect_identical(anchors(rsx, id=TRUE, type="first"), do.call(pmax, anchors(x, id=TRUE)))
expect_identical(anchors(rsx, id=TRUE, type="second"), do.call(pmin, anchors(x, id=TRUE)))
expect_identical(regions(rsx), regions(x))
temp.rsx <- rsx
set.seed(70006)
fresh.anchor1 <- sample(N, Np)
fresh.anchor2 <- sample(N, Np)
anchorIds(temp.rsx, type="first") <- fresh.anchor1
expect_identical(anchors(temp.rsx, id=TRUE, type="first"), pmax(fresh.anchor1, anchors(rsx, id=TRUE, type="second")))
expect_identical(anchors(temp.rsx, id=TRUE, type="second"), pmin(fresh.anchor1, anchors(rsx, id=TRUE, type="second")))
temp.rsx <- rsx
anchorIds(temp.rsx, type="second") <- fresh.anchor2
expect_identical(anchors(temp.rsx, id=TRUE, type="first"), pmax(fresh.anchor2, anchors(rsx, id=TRUE, type="first")))
expect_identical(anchors(temp.rsx, id=TRUE, type="second"), pmin(fresh.anchor2, anchors(rsx, id=TRUE, type="first")))
temp.rsx <- rsx
anchorIds(temp.rsx) <- list(fresh.anchor1, fresh.anchor2)
expect_identical(anchors(temp.rsx, id=TRUE, type="first"), pmax(fresh.anchor1, fresh.anchor2))
expect_identical(anchors(temp.rsx, id=TRUE, type="second"), pmin(fresh.anchor1, fresh.anchor2))
temp.rsx2 <- rsx
anchorIds(temp.rsx2, type="both") <- list(fresh.anchor2, fresh.anchor1)
expect_identical(temp.rsx2, temp.rsx)
})
test_that("combining GI objects of different strictness", {
rsx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="reverse")
sx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="strict")
expect_identical(c(rsx, sx, x), as(c(x, x, x), "ReverseStrictGInteractions"))
expect_identical(c(x, sx, rsx), as(c(x, swapAnchors(x), swapAnchors(x, mode="reverse")), "GInteractions"))
expect_identical(c(sx, rsx, x), as(c(x, x, x), "StrictGInteractions"))
# Checking for correct coercions between Strict subclasses.
expect_identical(rsx, as(sx, "ReverseStrictGInteractions"))
expect_identical(sx, as(rsx, "StrictGInteractions"))
})
LTLA/InteractionSet documentation built on July 3, 2023, 8:44 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Tests the construction and manipulation of GInteractions objects.
# library(InteractionSet); library(testthat); source("test-GI.R")
set.seed(7000)
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)
test_that("show methods work for GI objects", {
expect_output(sub("[0-9]", " ", show(x)), "GInteractions object with 20 interactions and 0 metadata columns:
seqnames1 ranges1 seqnames2 ranges2
<Rle> <IRanges> <Rle> <IRanges>
[1] chrA 94-105 --- chrA 41-48
[2] chrB 42-54 --- chrA 94-105
[3] chrA 41-48 --- chrA 59-72
[4] chrB 64-78 --- chrA 55-68
[5] chrA 41-59 --- chrA 3-23
... ... ... ... ... ...
[16] chrA 76-95 --- chrB 91-98
[17] chrA 46-66 --- chrB 67-84
[18] chrA 68-78 --- chrA 20-33
[19] chrA 61-67 --- chrA 87-104
[20] chrA 18-35 --- chrB 63-76
-------
regions: 30 ranges and 0 metadata columns
seqinfo: 2 sequences from an unspecified genome; no seqlengths", fixed=TRUE)
})
######################################
# Needed in many test chunks, so I'll let it out here.
o <- order(all.regions)
ref.regions <- all.regions[o]
new.pos <- integer(length(o))
new.pos[o] <- seq_along(new.pos)
ref.anchor1 <- new.pos[all.anchor1]
ref.anchor2 <- new.pos[all.anchor2]
test_that("slot access works in GI objects", {
expect_that(x, is_a("GInteractions"))
expect_true(!is.unsorted(regions(x)))
expect_identical(regions(x), ref.regions)
expect_identical(anchors(x, id=TRUE, type="first"), ref.anchor1)
expect_identical(anchors(x, id=TRUE, type="second"), ref.anchor2)
expect_identical(anchors(x, id=TRUE), list(first=ref.anchor1, second=ref.anchor2))
expect_identical(anchors(x, type="first"), ref.regions[ref.anchor1])
expect_identical(anchors(x, type="second"), ref.regions[ref.anchor2])
expect_identical(anchors(x), list(first=ref.regions[ref.anchor1], second=ref.regions[ref.anchor2]))
expect_identical(anchors(x, type="first"), first(x))
expect_identical(anchors(x, type="second"), second(x))
})
######################################
test_that("alternative construction methods work for GI objects", {
x2 <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2])
was.used <- sort(unique(all.regions[union(all.anchor1, all.anchor2)])) # Only includes the regions actually used.
expect_identical(regions(x2), was.used)
expect_identical(anchors(x2), anchors(x))
x3 <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], was.used)
expect_identical(anchors(x3, id=TRUE), anchors(x2, id=TRUE))
expect_identical(regions(x3), regions(x2))
anno.regions <- all.regions
anno.regions$score <- seq_along(anno.regions) # Seeing what happens with annotation.
anno.regions$revscore <- rev(seq_along(anno.regions))
x4 <- GInteractions(anno.regions[all.anchor1], anno.regions[all.anchor2])
expect_identical(regions(x2), regions(x4))
expect_identical(mcols(x4), DataFrame(anchor1.score=anno.regions$score[all.anchor1], anchor1.revscore=anno.regions$revscore[all.anchor1],
anchor2.score=anno.regions$score[all.anchor2], anchor2.revscore=anno.regions$revscore[all.anchor2]))
})
######################################
test_that("GI constructors behave properly on crappy inputs", {
empty <- GInteractions(integer(0), numeric(0), GRanges())
expect_identical(length(empty), 0L)
expect_identical(length(anchors(empty, type="first")), 0L)
expect_identical(empty, GInteractions())
empty <- GInteractions(GRanges(), GRanges())
expect_identical(length(empty), 0L)
expect_identical(length(anchors(empty, type="first")), 0L)
expect_identical(empty, GInteractions())
empty <- GInteractions(GRanges(), GRanges(), all.regions)
expect_identical(length(empty), 0L)
expect_identical(length(anchors(empty, type="first")), 0L)
expect_identical(length(regions(empty)), length(all.regions))
expect_error(GInteractions(1:4, 1, all.regions), "first and second anchor vectors have different lengths")
expect_error(GInteractions(0:3, 1:4, all.regions), "all anchor indices must be positive integers")
expect_error(GInteractions(c(1,2,3,NA), 1:4, all.regions), "all anchor indices must be finite integers")
expect_error(GInteractions(c(1,2,3,length(all.regions)+1L), 1:4, all.regions), "all anchor indices must refer to entries in 'regions'")
missing.value <- GRanges("chrB", IRanges(1000,1000))
expect_error(GInteractions(missing.value, missing.value, all.regions), "anchor regions missing in specified 'regions'")
})
######################################
test_that("GI constructors preserve metadata", {
m.x <- GInteractions(all.anchor1, all.anchor2, all.regions, score=1L)
expect_identical(m.x$score, rep(1L, length(m.x)))
m.x <- GInteractions(all.anchor1, all.anchor2, all.regions, score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], all.regions, score=1L)
expect_identical(m.x$score, rep(1L, length(m.x)))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], all.regions, score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], score=1L)
expect_identical(m.x$score, rep(1L, length(m.x)))
m.x <- GInteractions(all.regions[all.anchor1], all.regions[all.anchor2], score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
m.regions <- all.regions
m.regions$GC <- rev(seq_along(m.regions))
m.x <- GInteractions(m.regions[all.anchor1], m.regions[all.anchor2], score=seq_along(all.anchor1))
expect_identical(m.x$score, seq_along(m.x))
expect_identical(m.x$anchor1.GC, m.regions$GC[all.anchor1])
expect_identical(m.x$anchor2.GC, m.regions$GC[all.anchor2])
m.x <- GInteractions(integer(0), integer(0), all.regions, score=1)
expect_identical(m.x$score, numeric(0))
m.x <- GInteractions(regions=all.regions, score=numeric(0))
expect_identical(m.x$score, numeric(0))
m.x <- GInteractions(regions=all.regions, score=1)
expect_identical(m.x$score, numeric(0))
m.x <- GInteractions(regions=all.regions, score=1:2)
expect_identical(m.x$score, integer(0))
})
######################################
set.seed(7001)
test_that("anchor setters work properly for GI objects", {
fresh.anchor1 <- sample(N, Np)
fresh.anchor2 <- sample(N, Np)
anchorIds(x) <- list(fresh.anchor1, fresh.anchor2)
expect_identical(anchors(x, id=TRUE, type="first"), fresh.anchor1)
expect_identical(anchors(x, id=TRUE, type="second"), fresh.anchor2)
expect_error(anchorIds(x) <- list(ref.anchor1, ref.anchor2, ref.anchor1), "must be a list of 2 numeric vectors")
expect_error(anchorIds(x) <- list(ref.anchor1[1:(Np/2)], ref.anchor2), "x@anchor2' is not parallel to 'x'")
mod.x <- x
anchorIds(mod.x, type="first") <- ref.anchor1 # Checking that this also works
expect_identical(anchors(mod.x, id=TRUE, type="first"), ref.anchor1)
mod.x <- x
anchorIds(mod.x, type="second") <- ref.anchor2
expect_identical(anchors(mod.x, id=TRUE, type="second"), ref.anchor2)
anchorIds(x, type="both") <- list(ref.anchor1, ref.anchor2) # Restoring.
expect_identical(anchors(x, id=TRUE, type="first"), ref.anchor1)
expect_identical(anchors(x, id=TRUE, type="second"), ref.anchor2)
})
test_that("region setters work properly for GI objects", {
shuffled <- sample(100, N, replace=TRUE)
regions(x)$score <- shuffled
expect_identical(regions(x)$score, shuffled)
expect_false(identical(regions(x), ref.regions))
regions(x) <- ref.regions # Restoring.
expect_true(identical(regions(x), ref.regions))
x.dump <- x
mod.ranges <- resize(regions(x), fix="center", width=50)
new.ranges <- c(regions(x), mod.ranges)
expect_error(regions(x.dump) <- new.ranges, "assigned value must be of the same length")
replaceRegions(x.dump) <- new.ranges
expect_identical(anchors(x.dump), anchors(x))
expect_identical(sort(new.ranges), regions(x.dump))
expect_error(replaceRegions(x.dump) <- mod.ranges, "some existing ranges do not exist in replacement GRanges")
x.dump2 <- x
appendRegions(x.dump2) <- mod.ranges
expect_identical(anchors(x.dump2), anchors(x))
expect_identical(regions(x.dump), regions(x.dump2))
x.dump <- reduceRegions(x)
expect_identical(anchors(x), anchors(x.dump))
expect_identical(regions(x)[sort(unique(unlist(anchors(x, id=TRUE))))], regions(x.dump))
})
ref.score <- runif(Np)
test_that("other setters work properly for GI objects", {
x$stuff <- ref.score
expect_identical(x$stuff, mcols(x)$stuff)
expect_identical(colnames(mcols(x)), "stuff")
expect_output(show(x), "stuff")
x$stuff <- NULL
new.si <- Seqinfo(seqnames=c("chrA", "chrB"), seqlengths=c(1000, 2000))
new.x <- x
seqinfo(new.x) <- new.si
expect_identical(seqinfo(new.x), new.si)
})
######################################
test_that("subsetting works for GI objects", {
rchosen <- 1:10
xsub <- x[rchosen,]
expect_output(show(xsub), "GInteractions object with 10 interactions and 0 metadata columns:
seqnames1 ranges1 seqnames2 ranges2
<Rle> <IRanges> <Rle> <IRanges>
[1] chrA 94-105 --- chrA 41-48
[2] chrB 42-54 --- chrA 94-105
[3] chrA 41-48 --- chrA 59-72
[4] chrB 64-78 --- chrA 55-68
[5] chrA 41-59 --- chrA 3-23
[6] chrA 47-54 --- chrA 14-19
[7] chrA 82-100 --- chrA 84-103
[8] chrB 89-97 --- chrA 46-66
[9] chrA 86-105 --- chrA 82-100
[10] chrA 55-68 --- chrB 81-98
-------
regions: 30 ranges and 0 metadata columns
seqinfo: 2 sequences from an unspecified genome; no seqlengths", fixed=TRUE)
expect_identical(xsub, x[rchosen])
log.chosen <- logical(length(x))
log.chosen[rchosen] <- TRUE
expect_identical(xsub, subset(x, log.chosen))
expect_identical(x[log.chosen], subset(x, log.chosen))
expect_identical(length(xsub), length(rchosen))
expect_identical(regions(xsub), regions(x))
expect_identical(anchors(xsub, type="first"), ref.regions[ref.anchor1][rchosen])
expect_identical(anchors(xsub, type="second"), ref.regions[ref.anchor2][rchosen])
temp.x <- x
temp.x$score <- ref.score
expect_identical(temp.x[rchosen]$score, ref.score[rchosen])
expect_identical(nrow(mcols(temp.x[rchosen])), length(rchosen))
expect_identical(length(x[0,]), 0L)
expect_identical(length(x[0]), 0L)
expect_error(x[,1], "subscript contains out-of-bounds indices")
# Subsetting by mcols works as expected.
mcols(x)$stuff <- runif(length(x))
expect_identical(x[,1], x)
alt.x <- x
mcols(alt.x)$whee <- runif(length(x))
mcols(x)$stuff <- NULL
mcols(x)$whee <- mcols(alt.x)$whee
expect_identical(alt.x[,2], x)
expect_error(x[,,1], "invalid subsetting")
})
test_that("subset assignment works for GI objects", {
temp.x <- x
temp.x[1:5+10,] <- x[1:5,]
new.index <- seq_along(x)
new.index[1:5+10] <- 1:5
expect_identical(anchors(temp.x, type="first"), anchors(x, type="first")[new.index,])
expect_identical(anchors(temp.x, type="second"), anchors(x, type="second")[new.index,])
temp.x <- x
temp.x[0,] <- x[0,]
expect_identical(temp.x, x)
temp.x[] <- x
expect_identical(temp.x, x)
temp.x <- x
temp.x$score <- ref.score
temp.x[1:5]$score <- 5:1
mod.score <- ref.score
mod.score[1:5] <- 5:1
expect_identical(temp.x$score, mod.score)
rchosen <- 1:10
expect_identical(temp.x[rchosen]$score, mod.score[rchosen])
expect_identical(nrow(mcols(temp.x[rchosen])), length(rchosen))
temp.x <- x
regions(temp.x) <- resize(regions(temp.x), 10) # what happens with different regions?
ref <- c(x[1], temp.x[-1])
temp.x[1] <- x[1]
expect_identical(temp.x, ref)
temp.x <- x
regions(temp.x) <- resize(regions(temp.x), 20) # Checking again, just in case.
ref <- c(temp.x[1:5], x[1:5], temp.x[11:length(temp.x)])
temp.x[6:10] <- x[1:5]
expect_identical(temp.x, ref)
})
######################################
test_that("combining works for GI obejcts", {
# When regions are the same.
xsub <- x[1:5,]
xsub2 <- x[6:20,]
expect_identical(c(xsub, xsub2), x)
xsub <- x[1:15]
xsub2 <- x[16:20]
expect_identical(c(xsub, xsub2), x)
expect_identical(c(x[0,], x[0,]), x[0,])
expect_identical(c(x, x[0,]), x)
temp.x <- x
temp.x$score <- ref.score
double.up <- c(temp.x, temp.x)
expect_identical(regions(double.up), regions(x))
expect_identical(anchors(double.up, type="first"), rep(anchors(x, type="first"), 2))
expect_identical(anchors(double.up, type="second"), rep(anchors(x, type="second"), 2))
expect_identical(double.up$score, rep(temp.x$score, 2))
# When regions are different.
set.seed(7002)
next.starts <- round(runif(N, 1, 100))
next.ends <- next.starts + round(runif(N, 5, 20))
next.regions <- GRanges(rep(c("chrA", "chrB"), c(N-10, 10)), IRanges(next.starts, next.ends))
next.anchor1 <- sample(N, Np)
next.anchor2 <- sample(N, Np)
next.x <- GInteractions(next.anchor1, next.anchor2, next.regions)
c.x <- c(x, next.x)
expect_identical(c(anchors(x, type="first"), anchors(next.x, type="first")), anchors(c.x, type="first"))
expect_identical(c(anchors(x, type="second"), anchors(next.x, type="second")), anchors(c.x, type="second"))
expect_identical(unique(sort(c(regions(x), regions(next.x)))), regions(c.x))
expect_identical(anchors(c(x[0,], next.x[0,])), anchors(x[0,])) # Behaviour with empties.
expect_identical(anchors(c(x, next.x[0,])), anchors(x)) # Not fully equal, as regions have changed.
next.x2 <- GInteractions(1:10, 1:10, next.regions[1:10]) # What happens with non-equal lengths of the regions?
c.x <- c(x, next.x2)
expect_identical(c(anchors(x, type="first"), anchors(next.x2, type="first")), anchors(c.x, type="first"))
expect_identical(c(anchors(x, type="second"), anchors(next.x2, type="second")), anchors(c.x, type="second"))
expect_identical(unique(sort(c(regions(x), regions(next.x2)))), regions(c.x))
# Plus metadata
temp.x <- x
temp.x$score <- ref.score
double.up <- c(temp.x, temp.x)
expect_identical(regions(double.up), regions(x))
expect_identical(anchors(double.up, type="first"), rep(anchors(x, type="first"), 2))
expect_identical(anchors(double.up, type="second"), rep(anchors(x, type="second"), 2))
expect_identical(double.up$score, rep(temp.x$score, 2))
# Plus names.
temp.x <- temp.x2 <- x
names(temp.x) <- paste0("Inter", seq_along(temp.x))
names(temp.x2) <- paste0("Whee", seq_along(temp.x2))
combined <- c(temp.x, temp.x2)
expect_identical(names(combined), c(names(temp.x), names(temp.x2)))
})
######################################
test_that("sorting and deduplication of GI objects works", {
o.x <- order(anchors(x, type="first"), anchors(x, type="second"))
expect_identical(o.x, order(x))
expect_identical(sort(x), x[o.x,])
set.seed(70003)
x.1 <- x[sample(length(x), 100, replace=TRUE)]
x.2 <- x[sample(length(x), 100, replace=TRUE)]
o.x2 <- order(anchors(x.1, type="first"), anchors(x.1, type="second"), anchors(x.2, type="first"), anchors(x.2, type="second"))
expect_identical(o.x2, order(x.1, x.2))
is.dup <- duplicated(paste0(anchors(x, type="first"), ".", anchors(x, type="second")))
expect_identical(is.dup, duplicated(x))
temp.x <- c(x, x)
is.dup <- duplicated(paste0(anchors(temp.x, type="first"), ".", anchors(temp.x, type="second")))
expect_identical(is.dup, duplicated(temp.x))
expect_true(all(tail(is.dup, length(x)))) # if ordering is stable; only the first occurrence should be true.
expect_identical(x, unique(temp.x))
is.dup <- duplicated(paste0(anchors(temp.x, type="first"), ".", anchors(temp.x, type="second")), fromLast=TRUE)
expect_identical(is.dup, duplicated(temp.x, fromLast=TRUE))
expect_true(all(head(is.dup, length(x)))) # if ordering is stable; only the first occurrence should be true.
expect_equal(x, unique(temp.x, fromLast=TRUE))
expect_false(any(duplicated(unique(temp.x))))
expect_identical(order(x[0,]), integer(0))
expect_identical(duplicated(x[0,]), logical(0))
})
test_that("anchor swapping for GI objects works", {
new.x <- swapAnchors(x)
expect_identical(anchors(new.x, type="first", id=TRUE), pmin(anchors(x, type="first", id=TRUE), anchors(x, type="second", id=TRUE)))
expect_identical(anchors(new.x, type="second", id=TRUE), pmax(anchors(x, type="first", id=TRUE), anchors(x, type="second", id=TRUE)))
expect_identical(regions(x), regions(new.x))
new.x2 <- swapAnchors(x, mode="reverse")
expect_identical(anchors(new.x2, type="first"), anchors(new.x, type="second"))
expect_identical(anchors(new.x, type="first"), anchors(new.x2, type="second"))
expect_identical(regions(x), regions(new.x2))
new.x3 <- swapAnchors(x, mode="all")
expect_identical(anchors(new.x3, type="first"), anchors(x, type="second"))
expect_identical(anchors(x, type="first"), anchors(new.x3, type="second"))
expect_identical(regions(x), regions(new.x3))
})
test_that("splitting of GI objects works", {
flen <- c(5L, 10L, 5L)
f <- rep(1:3, flen)
out <- split(x, f)
expect_equivalent(lengths(out), flen)
for (i in seq_along(flen)) {
expect_identical(out[[i]], x[f==i])
}
temp.x <- x
temp.x$score <- ref.score
out <- split(temp.x, f)
for (i in seq_along(flen)) {
expect_identical(out[[i]]$score, temp.x[f==i]$score)
}
})
test_that("data.frame coercions of GI objects works", {
out <- as.data.frame(x)
ref1 <- as.data.frame(anchors(x, type="first"))
colnames(ref1) <- paste0(colnames(ref1), "1")
ref2 <- as.data.frame(anchors(x, type="second"))
colnames(ref2) <- paste0(colnames(ref2), "2")
expect_identical(out, data.frame(ref1, ref2))
temp.x <- x
temp.x$stuff <- ref.score
out <- as.data.frame(temp.x)
expect_identical(out, data.frame(ref1, ref2, stuff=ref.score))
names(temp.x) <- paste0("X", seq_along(temp.x))
out <- as.data.frame(temp.x)
expect_identical(out, data.frame(ref1, ref2, stuff=ref.score, row.names=names(temp.x)))
empty <- as.data.frame(x[0,])
expect_identical(colnames(empty), colnames(as.data.frame(x)))
expect_identical(nrow(empty), 0L)
})
test_that("environment generation works for GI objects", {
expect_identical(anchors(x, id=TRUE, type="first"), with(x, anchor1))
expect_identical(anchors(x, id=TRUE, type="second"), with(x, anchor2))
expect_identical(regions(x), with(x, regions))
expect_identical(anchors(x, type="first"), with(x, regions[anchor1]))
expect_identical(anchors(x, type="second"), with(x, regions[anchor2]))
expect_identical(names(x), with(x, names))
})
test_that("conversion to Pairs/GRangesList works for GI objects", {
temp.x <- x
temp.x$score <- ref.score
prs <- pairs(temp.x)
expect_identical(anchors(x, type="first"), first(prs))
expect_identical(anchors(x, type="second"), second(prs))
expect_identical(mcols(temp.x), mcols(prs))
expect_identical(names(temp.x), names(prs))
expect_identical(makeGInteractionsFromGRangesPairs(prs), reduceRegions(temp.x))
grl <- pairs(temp.x, as.grlist=TRUE)
first <- do.call(c, sapply(grl, function(x) { unname(x[1]) }))
second <- do.call(c, sapply(grl, function(x) { unname(x[2]) }))
expect_identical(anchors(x, type="first"), first)
expect_identical(anchors(x, type="second"), second)
expect_identical(mcols(temp.x), mcols(grl))
out <- pairs(temp.x, id=TRUE)
expect_identical(from(out), anchors(temp.x, id=TRUE, type="first"))
expect_identical(to(out), anchors(temp.x, id=TRUE, type="second"))
expect_identical(nnode(out), length(regions(temp.x)))
})
######################################
test_that("name handling is correct with GI objects", {
temp.x <- x
ref.names <- paste0("X", seq_along(temp.x))
names(temp.x) <- ref.names
expect_output(show(temp.x),"GInteractions object with 20 interactions and 0 metadata columns:
seqnames1 ranges1 seqnames2 ranges2
<Rle> <IRanges> <Rle> <IRanges>
X1 chrA 94-105 --- chrA 41-48
X2 chrB 42-54 --- chrA 94-105
X3 chrA 41-48 --- chrA 59-72
X4 chrB 64-78 --- chrA 55-68
X5 chrA 41-59 --- chrA 3-23
... ... ... ... ... ...
X16 chrA 76-95 --- chrB 91-98
X17 chrA 46-66 --- chrB 67-84
X18 chrA 68-78 --- chrA 20-33
X19 chrA 61-67 --- chrA 87-104
X20 chrA 18-35 --- chrB 63-76
-------
regions: 30 ranges and 0 metadata columns
seqinfo: 2 sequences from an unspecified genome; no seqlengths", fixed=TRUE)
expect_identical(names(temp.x), ref.names)
expect_identical(names(temp.x[2:5]), ref.names[2:5])
expect_identical(names(c(temp.x, temp.x)), c(ref.names, ref.names))
expect_identical(names(c(temp.x, x)), c(ref.names, character(length(x))))
for (id in c(TRUE, FALSE)) {
expect_identical(names(anchors(temp.x, id=id)[[1]]), ref.names)
expect_identical(names(anchors(temp.x, id=id)[[2]]), ref.names)
expect_identical(names(anchors(temp.x, id=id, type="first")), ref.names)
expect_identical(names(anchors(temp.x, id=id, type="second")), ref.names)
}
})
######################################
test_that("StrictGI objects are correctly formed", {
sx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="strict")
expect_that(sx, is_a("StrictGInteractions"))
expect_identical(sx, as(x, "StrictGInteractions"))
expect_identical(anchors(sx, id=TRUE, type="first"), do.call(pmin, anchors(x, id=TRUE)))
expect_identical(anchors(sx, id=TRUE, type="second"), do.call(pmax, anchors(x, id=TRUE)))
expect_identical(regions(sx), regions(x))
temp.sx <- sx
set.seed(70005)
fresh.anchor1 <- sample(N, Np)
fresh.anchor2 <- sample(N, Np)
anchorIds(temp.sx, type="first") <- fresh.anchor1
expect_identical(anchors(temp.sx, id=TRUE, type="first"), pmin(fresh.anchor1, anchors(sx, id=TRUE, type="second")))
expect_identical(anchors(temp.sx, id=TRUE, type="second"), pmax(fresh.anchor1, anchors(sx, id=TRUE, type="second")))
temp.sx <- sx
anchorIds(temp.sx, type="second") <- fresh.anchor2
expect_identical(anchors(temp.sx, id=TRUE, type="first"), pmin(fresh.anchor2, anchors(sx, id=TRUE, type="first")))
expect_identical(anchors(temp.sx, id=TRUE, type="second"), pmax(fresh.anchor2, anchors(sx, id=TRUE, type="first")))
temp.sx <- sx
anchorIds(temp.sx) <- list(fresh.anchor1, fresh.anchor2)
expect_identical(anchors(temp.sx, id=TRUE, type="first"), pmin(fresh.anchor1, fresh.anchor2))
expect_identical(anchors(temp.sx, id=TRUE, type="second"), pmax(fresh.anchor1, fresh.anchor2))
temp.sx2 <- sx
anchorIds(temp.sx2, type="both") <- list(fresh.anchor2, fresh.anchor1)
expect_identical(temp.sx2, temp.sx)
})
test_that("ReverseStrictGI objects are correctly formed", {
rsx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="reverse")
expect_that(rsx, is_a("ReverseStrictGInteractions"))
expect_identical(rsx, as(x, "ReverseStrictGInteractions"))
expect_identical(anchors(rsx, id=TRUE, type="first"), do.call(pmax, anchors(x, id=TRUE)))
expect_identical(anchors(rsx, id=TRUE, type="second"), do.call(pmin, anchors(x, id=TRUE)))
expect_identical(regions(rsx), regions(x))
temp.rsx <- rsx
set.seed(70006)
fresh.anchor1 <- sample(N, Np)
fresh.anchor2 <- sample(N, Np)
anchorIds(temp.rsx, type="first") <- fresh.anchor1
expect_identical(anchors(temp.rsx, id=TRUE, type="first"), pmax(fresh.anchor1, anchors(rsx, id=TRUE, type="second")))
expect_identical(anchors(temp.rsx, id=TRUE, type="second"), pmin(fresh.anchor1, anchors(rsx, id=TRUE, type="second")))
temp.rsx <- rsx
anchorIds(temp.rsx, type="second") <- fresh.anchor2
expect_identical(anchors(temp.rsx, id=TRUE, type="first"), pmax(fresh.anchor2, anchors(rsx, id=TRUE, type="first")))
expect_identical(anchors(temp.rsx, id=TRUE, type="second"), pmin(fresh.anchor2, anchors(rsx, id=TRUE, type="first")))
temp.rsx <- rsx
anchorIds(temp.rsx) <- list(fresh.anchor1, fresh.anchor2)
expect_identical(anchors(temp.rsx, id=TRUE, type="first"), pmax(fresh.anchor1, fresh.anchor2))
expect_identical(anchors(temp.rsx, id=TRUE, type="second"), pmin(fresh.anchor1, fresh.anchor2))
temp.rsx2 <- rsx
anchorIds(temp.rsx2, type="both") <- list(fresh.anchor2, fresh.anchor1)
expect_identical(temp.rsx2, temp.rsx)
})
test_that("combining GI objects of different strictness", {
rsx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="reverse")
sx <- GInteractions(all.anchor1, all.anchor2, all.regions, mode="strict")
expect_identical(c(rsx, sx, x), as(c(x, x, x), "ReverseStrictGInteractions"))
expect_identical(c(x, sx, rsx), as(c(x, swapAnchors(x), swapAnchors(x, mode="reverse")), "GInteractions"))
expect_identical(c(sx, rsx, x), as(c(x, x, x), "StrictGInteractions"))
# Checking for correct coercions between Strict subclasses.
expect_identical(rsx, as(sx, "ReverseStrictGInteractions"))
expect_identical(sx, as(rsx, "StrictGInteractions"))
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.