191 lines
8.3 KiB
R
191 lines
8.3 KiB
R
|
test_AtomicList_GroupGenerics <- function() {
|
||
|
|
vec1 <- c(1L,2L,3L,5L,2L,8L)
|
||
|
|
vec2 <- c(15L,45L,20L,1L,15L,100L,80L,5L)
|
||
|
|
for (compress in c(TRUE, FALSE)) {
|
||
|
|
for (type in c("IntegerList", "RleList")) {
|
||
|
|
list1 <- do.call(type, list(one = vec1, vec2, compress = compress))
|
||
|
|
checkIdentical(as.list(list1 + list1), Map("+", list1, list1))
|
||
|
|
checkIdentical(as.list(log(list1)), lapply(list1, log))
|
||
|
|
checkIdentical(as.list(round(sqrt(list1))),
|
||
|
|
lapply(list1, function(x) round(sqrt(x))))
|
||
|
|
checkIdentical(sum(list1), sapply(list1, sum))
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
test_AtomicList_logical <- function() {
|
||
|
|
vec1 <- c(TRUE,NA,FALSE, NA)
|
||
|
|
vec2 <- c(TRUE,TRUE,FALSE,FALSE,TRUE,FALSE,TRUE,TRUE,TRUE)
|
||
|
|
for (compress in c(TRUE, FALSE)) {
|
||
|
|
for (type in c("LogicalList", "RleList")) {
|
||
|
|
list1 <- do.call(type, list(one = vec1, vec2, compress = compress))
|
||
|
|
checkIdentical(as.list(!list1), lapply(list1, "!"))
|
||
|
|
checkIdentical(as.list(which(list1)), lapply(list1, which))
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
test_AtomicList_numerical <- function() {
|
||
|
|
vec1 <- c(1L,2L,NA,3L,NA,5L,2L,8L)
|
||
|
|
vec2 <- c(NA,15L,45L,20L,NA,1L,15L,100L,80L,5L,NA)
|
||
|
|
for (compress in c(TRUE, FALSE)) {
|
||
|
|
for (type in c("IntegerList", "RleList")) {
|
||
|
|
list1 <- do.call(type, list(one = vec1, vec2, compress = compress))
|
||
|
|
list2 <- endoapply(list1, rev)
|
||
|
|
checkIdentical(as.list(diff(list1)), lapply(list1, diff))
|
||
|
|
checkIdentical(as.list(pmax(list1, list2)),
|
||
|
|
mapply(pmax, list1, list2))
|
||
|
|
checkIdentical(as.list(pmin(list1, list2)),
|
||
|
|
mapply(pmin, list1, list2))
|
||
|
|
checkIdentical(as.list(pmax.int(list1, list2)),
|
||
|
|
mapply(pmax.int, list1, list2))
|
||
|
|
checkIdentical(as.list(pmin.int(list1, list2)),
|
||
|
|
mapply(pmin.int, list1, list2))
|
||
|
|
checkIdentical(mean(list1, na.rm=TRUE),
|
||
|
|
sapply(list1, mean, na.rm=TRUE))
|
||
|
|
checkIdentical(var(list1, na.rm=TRUE),
|
||
|
|
sapply(list1, var, na.rm=TRUE))
|
||
|
|
checkIdentical(cov(list1, list2, use="complete.obs"),
|
||
|
|
mapply(cov, list1, list2,
|
||
|
|
MoreArgs = list(use="complete.obs")))
|
||
|
|
checkIdentical(cor(list1, list2, use="complete.obs"),
|
||
|
|
mapply(cor, list1, list2,
|
||
|
|
MoreArgs = list(use="complete.obs")))
|
||
|
|
checkIdentical(sd(list1, na.rm=TRUE),
|
||
|
|
sapply(list1, sd, na.rm=TRUE))
|
||
|
|
checkIdentical(median(list1, na.rm=TRUE),
|
||
|
|
sapply(list1, median, na.rm=TRUE))
|
||
|
|
checkIdentical(quantile(list1, na.rm=TRUE),
|
||
|
|
do.call(rbind, lapply(list1, quantile, na.rm=TRUE)))
|
||
|
|
checkIdentical(mad(list1, na.rm=TRUE),
|
||
|
|
sapply(list1, mad, na.rm=TRUE))
|
||
|
|
checkIdentical(IQR(list1, na.rm=TRUE),
|
||
|
|
sapply(list1, IQR, na.rm=TRUE))
|
||
|
|
|
||
|
|
vec3 <- (-20:20)^2
|
||
|
|
vec3[c(1,10,21,41)] <- c(100L, 30L, 400L, 470L)
|
||
|
|
list3 <- do.call(type, list(one = vec3, rev(vec3), compress = compress))
|
||
|
|
checkIdentical(as.list(smoothEnds(list3)), lapply(list3, smoothEnds))
|
||
|
|
checkIdentical(as.list(runmed(list3, 7)),
|
||
|
|
lapply(list3, function(x) {
|
||
|
|
y <- runmed(x, 7)
|
||
|
|
if (type != "RleList")
|
||
|
|
y <- as.vector(y)
|
||
|
|
y
|
||
|
|
}))
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
test_AtomicList_character <- function() {
|
||
|
|
txt <- c("The", "licenses", "for", "most", "software", "are",
|
||
|
|
"designed", "to", "take", "away", "your", "freedom",
|
||
|
|
"to", "share", "and", "change", "it.",
|
||
|
|
"", "By", "contrast,", "the", "GNU", "General", "Public", "License",
|
||
|
|
"is", "intended", "to", "guarantee", "your", "freedom", "to",
|
||
|
|
"share", "and", "change", "free", "software", "--",
|
||
|
|
"to", "make", "sure", "the", "software", "is",
|
||
|
|
"free", "for", "all", "its", "users")
|
||
|
|
for (compress in c(TRUE, FALSE)) {
|
||
|
|
for (type in c("CharacterList", "RleList")) {
|
||
|
|
list1 <- do.call(type, list(one = txt, rev(txt), compress = compress))
|
||
|
|
checkIdentical(as.list(nchar(list1)), lapply(list1, nchar))
|
||
|
|
checkIdentical(as.list(chartr("@!*", "alo", list1)),
|
||
|
|
lapply(list1, chartr, old="@!*", new="alo"))
|
||
|
|
checkIdentical(as.list(tolower(list1)), lapply(list1, tolower))
|
||
|
|
checkIdentical(as.list(toupper(list1)), lapply(list1, toupper))
|
||
|
|
checkIdentical(as.list(sub("[b-e]",".", list1)),
|
||
|
|
lapply(list1, sub, pattern="[b-e]", replacement="."))
|
||
|
|
checkIdentical(as.list(gsub("[b-e]",".", list1)),
|
||
|
|
lapply(list1, gsub, pattern="[b-e]", replacement="."))
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
test_RleList_methods <- function() {
|
||
|
|
## na.rm
|
||
|
|
x <- RleList(c(NA,1,1),
|
||
|
|
c(1L,NA_integer_,1L),
|
||
|
|
c(1,Inf,1,-Inf),compress=TRUE)
|
||
|
|
|
||
|
|
target <- RleList(c(1,2), c(1L,1L), c(Inf,Inf,-Inf))
|
||
|
|
current <- runsum(x,2, na.rm = TRUE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(c(NA,2), c(NA_integer_,NA_integer_), c(Inf,Inf,-Inf))
|
||
|
|
current <- runsum(x,2, na.rm = FALSE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
|
||
|
|
target <- RleList(c(2,4), c(2,2), c(Inf, Inf, -Inf))
|
||
|
|
current <- runwtsum(x,2, c(2,2), na.rm = TRUE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(c(NA,4), c(NA_real_,NA_real_), c(Inf,Inf,-Inf))
|
||
|
|
current <- runwtsum(x,2, c(2,2), na.rm = FALSE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
|
||
|
|
target <- RleList(c(1,1), c(1,1), c(Inf,Inf,-Inf))
|
||
|
|
current <- runmean(x, 2, na.rm = TRUE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(c(NA,1), c(NA_real_, NA_real_), c(Inf, Inf, -Inf))
|
||
|
|
current <- runmean(x, 2, na.rm = FALSE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
|
||
|
|
x <- RleList(c(NA,1,2),
|
||
|
|
c(2L,NA_integer_,1L),
|
||
|
|
c(1,Inf,1,-Inf),compress=TRUE)
|
||
|
|
target <- RleList(c(1,2), c(2L,1L), c(Inf,Inf,1))
|
||
|
|
current <- runq(x, 2, 2, na.rm = TRUE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(c(NA,2), c(NA_integer_, NA_integer_), c(Inf, Inf, 1))
|
||
|
|
current <- runq(x, 2, 2, na.rm = FALSE)
|
||
|
|
checkIdentical(target, current)
|
||
|
|
|
||
|
|
## Binary operations between an RleList and an atomic vector:
|
||
|
|
a1 <- Rle(1, 999722111)
|
||
|
|
a2 <- 20 * a1
|
||
|
|
a <- RleList(a1, a2, compress=TRUE)
|
||
|
|
b1 <- c(a1, a1)
|
||
|
|
b2 <- 20 * b1
|
||
|
|
b <- RleList(b1, b2, compress=FALSE)
|
||
|
|
for (y in list(8L, 8)) {
|
||
|
|
## With a CompressedRleList
|
||
|
|
target <- RleList(a1 + y, a2 + y, compress=TRUE)
|
||
|
|
current <- a + y
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(a1 * y, a2 * y, compress=TRUE)
|
||
|
|
current <- a * y
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(a1 / y, a2 / y, compress=TRUE)
|
||
|
|
current <- a / y
|
||
|
|
checkIdentical(target, current)
|
||
|
|
## With a SimpleRleList
|
||
|
|
target <- RleList(b1 + y, b2 + y, compress=FALSE)
|
||
|
|
current <- b + y
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(b1 * y, b2 * y, compress=FALSE)
|
||
|
|
current <- b * y
|
||
|
|
checkIdentical(target, current)
|
||
|
|
target <- RleList(b1 / y, b2 / y, compress=FALSE)
|
||
|
|
current <- b / y
|
||
|
|
checkIdentical(target, current)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
test_AtomicList_repElements <- function() {
|
||
|
|
test_addition <- function(x, y) {
|
||
|
|
current <- x + y
|
||
|
|
target <- IntegerList(Map(function(x, y) x + y, x, y))
|
||
|
|
checkIdentical(current, target)
|
||
|
|
}
|
||
|
|
|
||
|
|
test_addition(IntegerList(NULL), IntegerList(NULL))
|
||
|
|
test_addition(IntegerList(11:13), IntegerList(NULL))
|
||
|
|
test_addition(IntegerList(11:13, NULL), IntegerList(NULL, NULL))
|
||
|
|
test_addition(IntegerList(11:13, NULL), IntegerList(NULL, 10:12))
|
||
|
|
test_addition(IntegerList(11:13, NULL), IntegerList(10:12, NULL))
|
||
|
|
test_addition(IntegerList(11:13), IntegerList(NULL, 10:12))
|
||
|
|
|
||
|
|
test_addition(IntegerList(11:12), IntegerList(10:13))
|
||
|
|
test_addition(IntegerList(11:12), IntegerList(10:12))
|
||
|
|
test_addition(IntegerList(11:13, 11:12), IntegerList(10:12))
|
||
|
|
}
|