/usr/lib/R/site-library/GenomicRanges/unitTests/test_GRangesList-class.R is in r-bioc-genomicranges 1.30.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | make_test_GRangesList <- function() {
GRangesList(
a = GRanges(
seqnames = Rle(factor(c("chr1", "chr2", "chr1", "chr3")), c(1, 3, 2, 4)),
ranges = IRanges(1:10, width = 10:1, names = head(letters, 10)),
strand = Rle(strand(c("-", "+", "*", "+", "-")), c(1, 2, 2, 3, 2)),
seqinfo = Seqinfo(seqnames = paste("chr", 1:3, sep="")),
score = 1:10, GC = seq(1, 0, length=10)),
b = GRanges(
seqnames = Rle(factor(c("chr2", "chr4", "chr5")), c(3, 6, 4)),
ranges = IRanges(1:13, width = 13:1, names = tail(letters, 13)),
strand = Rle(strand(c("-", "+", "-")), c(4, 5, 4)),
seqinfo = Seqinfo(seqnames = paste("chr", c(2L, 4:5), sep="")),
score = 1:13, GC = seq(0, 1, length=13))
)
}
test_GRangesList_construction <- function() {
checkException(GRangesList(IRangesList()), silent = TRUE)
checkTrue(validObject(new("GRangesList")))
checkTrue(validObject(GRangesList()))
checkTrue(validObject(GRangesList(GRanges())))
checkTrue(validObject(GRangesList(GRanges(), GRanges())))
checkTrue(validObject(GRangesList(list(GRanges(), GRanges()))))
checkTrue(validObject(GRangesList(a = GRanges())))
checkTrue(validObject(make_test_GRangesList()))
}
test_GRangesList_getters <- function() {
grl <- make_test_GRangesList()
checkIdentical(seqnames(grl), RleList(lapply(grl, seqnames), compress=TRUE))
checkIdentical(ranges(grl), IRangesList(lapply(grl, ranges)))
checkIdentical(strand(grl), RleList(lapply(grl, strand), compress=TRUE))
checkIdentical(seqlengths(grl), seqlengths(grl@unlistData))
checkIdentical(mcols(grl, level="within"),
SplitDataFrameList(lapply(grl, mcols)))
}
test_GRangesList_setters <- function() {
grl0 <- GRangesList(A=GRanges("chr2", IRanges(3:2, 5)),
B=GRanges(c("chr2", "chrMT"), IRanges(7:6, 15)),
C=GRanges(c("chrY", "chrMT"), IRanges(17:16, 25)),
D=GRanges())
current <- grl0
seqlevels(current, pruning.mode="coarse") <- c("chr2", "chr5")
target <- GRangesList(A=GRanges("chr2", IRanges(3:2, 5),
seqinfo=Seqinfo(c("chr2", "chr5"))),
D=GRanges())
checkIdentical(target, current)
current <- grl0
seqlevels(current, pruning.mode="fine") <- c("chr2", "chr5")
target <- GRangesList(A=GRanges("chr2", IRanges(3:2, 5),
seqinfo=Seqinfo(c("chr2", "chr5"))),
B=GRanges("chr2", IRanges(7, 15)),
C=GRanges(),
D=GRanges())
checkIdentical(target, current)
current <- grl0
seqlevels(current, pruning.mode="tidy") <- c("chr2", "chr5")
target <- GRangesList(A=GRanges("chr2", IRanges(3:2, 5),
seqinfo=Seqinfo(c("chr2", "chr5"))),
B=GRanges("chr2", IRanges(7, 15)),
D=GRanges())
checkIdentical(target, current)
}
test_GRangesList_coercion <- function() {
## as.data.frame
gr1 <-
GRanges(seqnames = c(1,1,2),
ranges = IRanges(1:3,4:6, names = head(letters,3)),
strand = strand(c("+", "-", "*")),
score = c(10L,2L,NA))
gr2 <-
GRanges(seqnames = c("chr1", "chr2"),
ranges = IRanges(1:2,1:2, names = tail(letters,2)),
strand = strand(c("*", "*")),
score = 12:13)
grl <- GRangesList(a = gr1, b = gr2)
df <-
data.frame(group = togroup(PartitioningByWidth(grl)),
group_name = rep(c("a","b"), c(3, 2)),
seqnames = factor(c(1,1,2,"chr1","chr2")),
start = c(1:3,1:2), end = c(4:6,1:2),
width = c(4L, 4L, 4L, 1L, 1L),
strand = strand(c("+", "-", "*", "*", "*")),
score = c(10L,2L,NA,12:13),
stringsAsFactors = FALSE)
checkIdentical(as.data.frame(grl), df)
}
test_GRangesList_RangesList <- function() {
grl <- make_test_GRangesList()
checkIdentical(start(grl), IntegerList(lapply(grl, start)))
checkIdentical(end(grl), IntegerList(lapply(grl, end)))
checkIdentical(width(grl), IntegerList(lapply(grl, width)))
## start
checkException(start(GRangesList()) <- NULL, silent = TRUE)
checkException(start(make_test_GRangesList()) <- 1:26, silent = TRUE)
grl <- make_test_GRangesList()
orig <- start(grl)
start(grl) <- orig + 1L
checkIdentical(start(grl), orig + 1L)
## end
checkException(end(GRangesList()) <- NULL, silent = TRUE)
checkException(end(make_test_GRangesList()) <- 1:26, silent = TRUE)
grl <- make_test_GRangesList()
orig <- end(grl)
end(grl) <- orig + 1L
checkIdentical(end(grl), orig + 1L)
## width
checkException(width(GRangesList()) <- NULL, silent = TRUE)
checkException(width(make_test_GRangesList()) <- 1:26, silent = TRUE)
grl <- make_test_GRangesList()
orig <- width(grl)
width(grl) <- orig + 1L
checkIdentical(width(grl), orig + 1L)
}
test_GRangesList_Vector <- function() {
grl <- make_test_GRangesList()
checkIdentical(grl, grl[])
checkIdentical(grl[,"score"],
GRangesList(lapply(grl, function(x) x[,"score"])))
checkIdentical(grl[seqnames(grl) == "chr2",],
GRangesList(lapply(grl, function(x)
x[seqnames(x) == "chr2",])))
checkIdentical(grl[seqnames(grl) == "chr2", "score"],
GRangesList(lapply(grl, function(x)
x[seqnames(x) == "chr2", "score"])))
checkIdentical(GRangesList(), c(GRangesList(), GRangesList()))
checkIdentical(grl, c(grl, GRangesList()))
checkIdentical(grl, c(GRangesList(), grl))
GRL <- local({
x <- grl
names(x) <- toupper(names(grl))
for (i in seq_len(length(x)))
names(x[[i]]) <- toupper(names(grl[[i]]))
x
})
res <- c(grl, GRL)
checkTrue(validObject(res))
## [
checkIdentical(grl, grl[Rle(TRUE)])
checkIdentical(grl, res[seq_len(length(grl))])
checkIdentical(GRL, res[-seq_len(length(grl))])
## checkException(c(grl, grl), "c() check for duplicated names", TRUE)
checkIdentical(grl, local({
x <- grl
x[IRanges(1, 1)] <- grl[IRanges(1, 1)]
x
}), "[ by IRanges")
checkIdentical(grl, local({
x <- grl; x[1] <- grl[1]; x
}), "[<- 1")
checkIdentical(grl, local({
x <- grl; x[1:2] <- grl[1:2]; x
}), "[<- 2")
checkIdentical(grl, local({
x <- grl; x[[1]] <- grl[[1]]
names(x) <- names(grl)
x
}), "[[<-, replace")
checkIdentical(grl, local({
x <- grl; x[["b"]] <- grl[[2]]
names(x) <- names(grl)
x
}), "[[<-, replace char")
checkIdentical(grl, local({
x <- grl[1]; x[[2]] <- grl[[2]]
names(x) <- names(grl)
x
}), "[[<-, extend-by-1")
checkIdentical(grl, local({
x <- grl[1]; x[["b"]] <- grl[[2]]
names(x) <- names(grl)
x
}), "[[<-, extend-by-1 char")
}
|