Nothing
context("testing comboGeneral")
test_that("comboGeneral produces correct results with no constraints", {
expect_equal(comboGeneral(5, 3), t(combn(5, 3)))
expect_equal(comboGeneral(factor(1:5, ordered = TRUE), 3),
t(combn(factor(1:5, ordered = TRUE), 3)))
expect_equal(comboGeneral(as.raw(1:5), 3), t(combn(as.raw(1:5), 3)))
expect_equal(comboGeneral(factor(1:5, ordered = TRUE), 5, freqs = rep(3, 5)),
comboSample(factor(1:5, ordered = TRUE), 5, freqs = rep(3, 5),
sampleVec = 1:comboCount(5, 5, freqs = rep(3, 5))))
expect_equal(nrow(comboGeneral(6, 3)), choose(6, 3))
expect_equal(as.vector(comboGeneral(1,1)), 1)
expect_equal(as.vector(comboGeneral(1,1,TRUE)), 1)
expect_equal(comboGeneral(15, 8)[500:600, ], comboGeneral(15, 8,
lower = 500,
upper = 600))
expect_equal(comboGeneral(5, 5),
comboGeneral(5, 5, freqs = rep(1, 5)))
expect_equal(comboGeneral(as.complex(1:5), 3),
t(combn(as.complex(1:5), 3)))
expect_equal(comboGeneral(as.raw(1:5), 3),
t(combn(as.raw(1:5), 3)))
set.seed(103)
myNums = rnorm(5)
expect_equal(comboGeneral(myNums, 3), t(combn(myNums, 3)))
myNums2 = 1:15 / 3
expect_equal(comboGeneral(myNums2, 8, freqs = rep(2, 15))[150000:157000, ],
comboGeneral(myNums2, 8, freqs = rep(2, 15), lower = 150000, upper = 157000))
expect_equal(comboGeneral(letters[1:15], 8, TRUE)[319000:comboCount(15, 8, TRUE), ],
comboGeneral(letters[1:15], 8, TRUE, lower = 319000))
expect_equal(nrow(comboGeneral(myNums, 3, TRUE)), 35)
expect_equal(comboGeneral(myNums, 3, freqs = rep(3, 5)),
comboGeneral(myNums, 3, TRUE))
expect_equal(comboGeneral(LETTERS[1:5], 3, freqs = rep(3, 5)),
comboGeneral(LETTERS[1:5], 3, TRUE))
expect_equal(comboGeneral(LETTERS[1:5], 3), t(combn(LETTERS[1:5], 3)))
expect_equal(sum(comboGeneral(3, 3, freqs = c(1, 1, 1))),
sum(comboGeneral(3, 3)))
expect_equal(as.vector(comboGeneral(1, 2, freqs = 2)), c(1, 1))
expect_equal(ncol(comboGeneral(5, 3)), 3)
expect_equal(ncol(comboGeneral(5, 3, TRUE)), 3)
expect_equal(ncol(comboGeneral(5, 3, FALSE, constraintFun = "prod")), 4)
expect_equal(ncol(comboGeneral(5, 3, TRUE, constraintFun = "prod", keepResults = TRUE)), 4)
expect_equal(ncol(comboGeneral(5, 3, FALSE,
constraintFun = "prod", freqs = c(1,2,1,2,4),
keepResults = TRUE)), 4)
expect_equal(nrow(comboGeneral(10, 3, TRUE, upper = 20)), 20)
expect_equal(nrow(comboGeneral(10, 3, upper = 10)), 10)
expect_equal(nrow(comboGeneral(1:10 + .01, 3, FALSE, constraintFun = "prod",
keepResults = TRUE, upper = 10)), 10)
expect_equal(nrow(comboGeneral(5, 5, freqs = 1:5, upper = 10)), 10)
expect_equal(nrow(comboGeneral(10, 3, TRUE, constraintFun = "prod",
keepResults = TRUE, upper = 10)), 10)
##******** BIG TESTS *********##
## NO REPETITION
numR = comboCount(1000, 10)
n1 = gmp::sub.bigz(numR, 99)
## accepts raw values
expect_equal(nrow(comboGeneral(1000, 10, lower = n1)), 100)
## accepts characters
expect_equal(nrow(comboGeneral(1000, 10, lower = as.character(n1))), 100)
expect_equal(as.vector(comboGeneral(1000, 10, lower = numR)), 991:1000)
## WITH REPETITION
numR = comboCount(1000, 10, TRUE)
n1 = gmp::sub.bigz(numR, 99)
expect_equal(nrow(comboGeneral(1000, 10, TRUE, lower = n1)), 100)
expect_equal(nrow(comboGeneral(1000, 10, TRUE, lower = as.character(n1))), 100)
expect_equal(as.vector(comboGeneral(1000, 10, TRUE, lower = numR)), rep(1000, 10))
## MULTISETS
numR = comboCount(1000, 10, freqs = rep(1:4, 250))
n1 = gmp::sub.bigz(numR, 99)
expect_equal(nrow(comboGeneral(1000, 10, freqs = rep(1:4, 250), lower = n1)), 100)
expect_equal(nrow(comboGeneral(1000, 10, freqs = rep(1:4, 250), lower = as.character(n1))), 100)
expect_equal(as.vector(comboGeneral(1000, 10, freqs = rep(1:4, 250), lower = numR)),
rep(997:1000, times = 1:4))
})
test_that("test combo/permuteGeneral S3 methods", {
## table method
## type character
set.seed(12)
s <- sample(letters[1:5], 10, TRUE)
expect_equal(
comboGeneral(table(s), 3),
comboGeneral(sort(unique(s)), 3, freqs = table(s))
)
expect_equal(
comboCount(table(s), 5),
comboCount(sort(unique(s)), 5, freqs = table(s))
)
## table method
## type integer
t <- sample(5, 10, TRUE)
expect_equal(
comboGeneral(table(t), 5),
comboGeneral(sort(unique(t)), 5, freqs = table(t))
)
expect_equal(
comboCount(table(t), 5),
comboCount(sort(unique(t)), 5, freqs = table(t))
)
## table method
## type numeric
num <- rnorm(5)
c_n <- sample(num, 18, TRUE)
expect_equal(
comboGeneral(table(c_n), 9),
comboGeneral(sort(unique(c_n)), 9, freqs = table(c_n))
)
expect_equal(
comboCount(table(c_n), 8),
comboCount(sort(unique(c_n)), 8, freqs = table(c_n))
)
## table method
## type complex
cmplx <- 1:5 + (1:5) * 1i
c_v <- sample(cmplx, 20, TRUE)
expect_equal(
permuteGeneral(table(c_v), 6),
permuteGeneral(sort(unique(c_v)), 6, freqs = table(c_v))
)
expect_equal(
permuteCount(table(c_v), 8),
permuteCount(sort(unique(c_v)), 8, freqs = table(c_v))
)
## table method
## type logical
bool <- c(TRUE, FALSE)
c_b <- sample(bool, 17, TRUE)
expect_equal(
permuteGeneral(table(c_b), 11),
permuteGeneral(sort(unique(c_b)), 11, freqs = table(c_b))
)
expect_equal(
permuteCount(table(c_b), 100),
permuteCount(sort(unique(c_b)), 100, freqs = table(c_b))
)
## list method
lst <- lapply(1:5, function(x) {
replicate(3, {
i <- sample(15, 1)
sample(letters[1:5], i, TRUE)
})
})
idx_combo <- comboGeneral(length(lst), 3, TRUE)
res_combo <- lapply(seq_len(nrow(idx_combo)), function(i) {
lst[idx_combo[i, ]]
})
idx_perm <- permuteGeneral(length(lst), 3, TRUE)
res_perm <- lapply(seq_len(nrow(idx_perm)), function(i) {
lst[idx_perm[i, ]]
})
expect_equal(comboGeneral(lst, 3, TRUE), res_combo)
expect_equal(comboCount(lst, 3, TRUE), length(res_combo))
expect_equal(permuteGeneral(lst, 3, TRUE), res_perm)
expect_equal(permuteCount(lst, 3, TRUE), length(res_perm))
})
test_that("comboGeneral produces correct results with constraints", {
tinyTol = nrow(comboGeneral(1:5 + 0.00000000001, 3,
constraintFun = "mean",
comparisonFun = "==",
limitConstraints = 3,
tolerance = .Machine$double.eps))
## The default tolerance is sqrt(.Machine$double.eps)
defaultTol = nrow(comboGeneral(1:5 + 0.00000000001, 3,
constraintFun = "mean",
comparisonFun = "==", limitConstraints = 3))
expect_false(tinyTol == defaultTol)
## check that classes behave properly N.B. limitContraint > INT_MAX
expect_equal(class(comboGeneral(10, 5, constraintFun = "prod",
comparisonFun = "<",
limitConstraints = 2^32)[,1]), "numeric")
## the greatest product is prod(100:96) > INT_MAX
expect_equal(class(comboGeneral(100:90, 5, constraintFun = "prod",
comparisonFun = "<",
limitConstraints = 5)[,1]), "numeric")
expect_equal(class(comboGeneral(5, 5, TRUE, constraintFun = "prod",
comparisonFun = "<",
limitConstraints = 5.5)[,1]), "numeric")
expect_equal(nrow(comboGeneral(-5:5, 4, FALSE, constraintFun = "sum",
comparisonFun = "==", limitConstraints = 6)),
length(which(apply(combn(-5:5, 4), 2, sum) == 6)))
expect_equal(unique(comboGeneral(5, 5, TRUE,
constraintFun = "sum", comparisonFun = "==",
limitConstraints = 9,
keepResults = TRUE)[,6]), 9)
expect_true(all(comboGeneral(5, 5, TRUE,
constraintFun = "min", comparisonFun = "<",
limitConstraints = 3,
keepResults = TRUE)[,6] < 3))
expect_equal(as.vector(comboGeneral(5, 5, freqs = 1:5,
constraintFun = "sum",
comparisonFun = "==",
limitConstraints = 25)), rep(5, 5))
expect_equal(as.vector(comboGeneral(5, 5, constraintFun = "sum",
comparisonFun = "==",
limitConstraints = 15)), 1:5)
expect_true(all(comboGeneral(5, 5, TRUE,
constraintFun = "prod", comparisonFun = ">",
limitConstraints = 100,
keepResults = TRUE)[,6] > 100))
expect_true(all(comboGeneral(5, 3, FALSE,
constraintFun = "max", comparisonFun = "=<",
limitConstraints = 4,
keepResults = TRUE)[,4] <= 4))
## N.B. When there are two comparisons (i.e. comparisonFun = c(">=","<"))
## and only one limitConstraint, the first comparison is used. Similarly,
## when there are two limitConstraints and one comparison the first
## limitConstraint is use and the other is ignored (See next test)
expect_true(all(comboGeneral(3, 5, TRUE,
constraintFun = "mean", comparisonFun = c(">=","<"),
limitConstraints = 2L,
keepResults = TRUE)[,6] >= 2))
expect_true(all(comboGeneral(3, 5, TRUE,
constraintFun = "mean", comparisonFun = "==",
limitConstraints = 2,
keepResults = TRUE)[,6] == 2))
expect_true(all(comboGeneral(3, 5, TRUE,
constraintFun = "mean", comparisonFun = ">=",
limitConstraints = c(2L, 1e10),
keepResults = TRUE)[,6] >= 2))
expect_true(all(comboGeneral(5, 5, FALSE, constraintFun = "sum", comparisonFun = ">",
limitConstraints = 18,
freqs = c(1,2,1,2,4),
keepResults = TRUE)[,6] > 18))
expect_equal(comboGeneral(5, 5, TRUE, constraintFun = "sum",
comparisonFun = "==",
limitConstraints = 25, keepResults = TRUE)[,6], 25)
all_combs = comboGeneral(10, 5, freqs = rep(1:5, 2), constraintFun = "sum")
all_combs = all_combs[500:nrow(all_combs), ]
expect_equal(comboGeneral(10, 5, freqs = rep(1:5, 2), keepResults = TRUE,
constraintFun = "sum", comparisonFun = "==",
limitConstraints = 25, lower = 500),
all_combs[all_combs[,6] == 25, ])
test = comboGeneral(10, 5, freqs = rep(1:5, 2),
constraintFun = "sum", comparisonFun = c(">=", "=<"),
limitConstraints = c(27, 23),
lower = 1000, tolerance = 1, keepResults = TRUE)
bench = comboGeneral(10, 5, freqs = rep(1:5, 2),
constraintFun = "sum", lower = 1000)
expect_equal(test, bench[c(which(bench[, 6] > 26 | bench[, 6] < 24)), ])
})
test_that("comboGeneral produces correct results with use of FUN", {
test <- comboGeneral(10, 5, constraintFun = "sum")
expect_equal(as.vector(test[,6]), unlist(comboGeneral(10, 5, FUN = sum)))
expect_equal(dim(comboGeneral(LETTERS, 5, freqs = c(rep(1:4, 6), 1:2),
FUN = function(x) sapply(x, charToRaw),
upper = 8, FUN.VALUE = as.raw(1:5))), c(8, 5))
expect_equal(class(comboGeneral(
LETTERS, 5, TRUE, FUN = function(x) {
sapply(x, function(y) rawToBits(charToRaw(y)))
}, upper = 8, FUN.VALUE = rawToBits(as.raw(1:5))
)[1, ]), "raw")
test <- comboGeneral(10, 4, TRUE)
testFun <- apply(test, 1, function(x) mean(x) * 2)
expect_equal(testFun,
comboGeneral(10, 4, TRUE, FUN = function(x) {mean(x) * 2},
FUN.VALUE = 2.2))
test <- comboGeneral(8, 4, freqs = rep(1:4, 2))
testFun <- lapply(1:nrow(test), function(x) cumsum(test[x, ]))
expect_equal(testFun, comboGeneral(8, 4, freqs = rep(1:4, 2), FUN = cumsum))
expect_equal(class(comboGeneral(5, 3, FUN = cumsum,
FUN.VALUE = as.numeric(1:3))[1, ]), "numeric")
expect_equal(class(comboGeneral(5, 3, FUN = cumsum,
FUN.VALUE = as.complex(1:3))[1, ]), "complex")
expect_equal(testFun[1:100], comboGeneral(8, 4, freqs = rep(1:4, 2), upper = 100, FUN = cumsum))
expect_equal(testFun[101:length(testFun)],
comboGeneral(8, 4, freqs = rep(1:4, 2), lower = 101, FUN = cumsum))
expect_equal(testFun[121:123],
comboGeneral(8, 4, freqs = rep(1:4, 2), lower = 121, upper = 123, FUN = cumsum))
expect_equal(comboGeneral(as.raw(1:5), 3, FUN = rawToChar),
combn(as.raw(1:5), 3, rawToChar, simplify = FALSE))
expect_equal(
comboGeneral(letters[1:5], 3, FUN = paste0,
collapse = "", FUN.VALUE = "a"),
apply(comboGeneral(letters[1:5], 3), 1, paste0, collapse = ""))
})
test_that("comboGeneral produces correct results with exotic constraints", {
a = t(combn(10, 7))
expect_equal(comboGeneral(10, 7, constraintFun = "sum",
comparisonFun = c(">","<"),
limitConstraints = c(40, 45)), a[which(rowSums(a) > 40 & rowSums(a) < 45), ])
set.seed(13)
rSet = 1:10 + rnorm(10)
a = comboGeneral(sort(rSet), 7, TRUE)
b = rowSums(a)
expect_equal(comboGeneral(rSet, 7, TRUE, constraintFun = "sum",
comparisonFun = c(">=","<="),
limitConstraints = c(42.50001, 45.76277)),
a[which(b >= 42.50001 & b <= 45.76277), ])
temp1 = comboGeneral(rSet, 7, TRUE, constraintFun = "sum",
comparisonFun = c("<=",">="),
limitConstraints = c(20.05669, 60.93901),
keepResults = TRUE)
temp2 = cbind(a, b)
temp2 = temp2[which(b <= 20.05669 | b >= 60.93901), ]
expect_equal(sort(temp1[,8]), sort(temp2[,8]))
a = comboGeneral(10, 7, freqs = rep(3, 10))
b = rowSums(a)
expect_equal(comboGeneral(10, 7, freqs = rep(3, 10), constraintFun = "sum",
comparisonFun = c("<=", ">"),
limitConstraints = c(50, 47)), a[which(b > 47 & b <= 50), ])
b = apply(a, 1, max)
expect_equal(comboGeneral(10, 7, freqs = rep(3, 10),
constraintFun = "max",
comparisonFun = c("<=", ">"),
limitConstraints = c(9, 7)), a[which(b > 7 & b <= 9), ])
b = apply(a, 1, min)
expect_equal(comboGeneral(10, 7, freqs = rep(3, 10),
constraintFun = "min",
comparisonFun = "==",
limitConstraints = 3,
lower = 7900, upper = 8500),
a[(7900:8500)[b[7900:8500] == 3], ])
a = comboGeneral(5, 7, TRUE)
b = apply(a, 1, prod)
expect_equal(comboGeneral(5, 7, TRUE, constraintFun = "prod",
comparisonFun = c(">=","<="),
limitConstraints = c(2000, 5000)), a[which(b >= 2000 & b <= 5000), ])
a = comboGeneral(-5, 7, TRUE)
b = apply(a, 1, prod)
expect_equal(nrow(comboGeneral(-5, 7, TRUE, constraintFun = "prod",
comparisonFun = c("<=",">="),
limitConstraints = c(-2000, 5000),
keepResults = TRUE)),
nrow(rbind(a[which(b <= -2000),], a[which(b >= 5000), ])))
set.seed(4321)
samp = sample(-50:50, 16)
a = comboGeneral(samp, 6, TRUE)
b = apply(a, 1, prod)
expect_equal(nrow(comboGeneral(samp, 6, TRUE, constraintFun = "prod",
comparisonFun = c("<",">"),
limitConstraints = c(-6e9, 6e9),
keepResults = TRUE, nThreads = 2)),
nrow(rbind(a[which(b <= -6e9),], a[which(b >= 6e9), ])))
## Testing sums in a range
a = comboGeneral(10, 8, TRUE, lower = 23500, upper = 24000,
constraintFun = "sum", keepResults = TRUE)
expect_equal(comboGeneral(c(NA, 1:10), 8, TRUE, constraintFun = "sum",
comparisonFun = c("=>","=<"),
limitConstraints = c(72, 78),
lower = 23500, upper = 24000),
a[a[,9] >= 72 & a[,9] <= 78, 1:8])
comp1 = c("<", "<=")
comp2 = c(">", ">=")
## Test that unsorted vector is being handled properly
## for both numeric and integer type vectors
# identical(sort(scrambled), 1:10)
# [1] TRUE
scrambled = as.integer(c(8, 2, 5, 1, 6, 3, 4, 7))
scramFreqs = rep(1:4, 2)[scrambled]
funs <- c("sum", "prod", "mean", "max", "min")
m <- 7
allCombs1 = lapply(funs, function(f) {
comboGeneral(8, m, freqs = rep(1:4, 2), constraintFun = f)
})
allCombs2 = lapply(funs, function(f) {
comboGeneral(8:1, m, freqs = rev(rep(1:4, 2)), constraintFun = f)
})
## ensure the left bound is in the solution space
tars = lapply(allCombs1, function(x) {
vals <- sort(x[, m + 1])
t <- quantile(as.numeric(names(table(vals))),
c(0.25, 0.75), names = FALSE)
t[1] <- vals[findInterval(t[1], vals)]
t
})
theVals1 = lapply(allCombs1, function(x) x[, m + 1])
theVals2 = lapply(allCombs2, function(x) x[, m + 1])
allCombs1 = lapply(allCombs1, function(x) x[, 1:m])
allCombs2 = lapply(allCombs2, function(x) x[, 1:m])
for (f in seq_along(funs)) {
for (i in 1:2) {
if (i == 1) {
a = comp1
b = comp2
} else {
a = comp2
b = comp1
}
for (j in a) {
for (k in b) {
myComp = c(j, k)
myTest = comboGeneral(scrambled, m, freqs = scramFreqs,
constraintFun = funs[f],
comparisonFun = myComp,
limitConstraints = tars[[f]],
tolerance = 0)
fun1 = match.fun(j)
fun2 = match.fun(k)
if (i == 1) {
temp1 = allCombs1[[f]][fun1(theVals1[[f]],
tars[[f]][1]), ]
temp2 = allCombs2[[f]][fun2(theVals2[[f]],
tars[[f]][2]), ]
temp = rbind(temp1, temp2)
} else {
temp = allCombs1[[f]][fun1(theVals1[[f]], tars[[f]][1]) &
fun2(theVals1[[f]], tars[[f]][2]), ]
}
expect_equal(temp, myTest, info = list(myComp, funs[f], tars[[f]], i))
}
}
}
}
allCombs1 = lapply(funs, function(f) {
comboGeneral(8, m, TRUE, constraintFun = f, keepResults = TRUE)
})
allCombs2 = lapply(funs, function(f) {
comboGeneral(8:1, m, TRUE, constraintFun = f, keepResults = TRUE)
})
## ensure the right bound is in the solution space
tars = lapply(allCombs1, function(x) {
vals <- sort(x[, m + 1])
t <- quantile(as.numeric(names(table(vals))),
c(0.25, 0.75), names = FALSE)
t[2] <- vals[findInterval(t[2], vals)]
t
})
theVals1 = lapply(allCombs1, function(x) x[, m + 1])
theVals2 = lapply(allCombs2, function(x) x[, m + 1])
allCombs1 = lapply(allCombs1, function(x) x[, 1:m])
allCombs2 = lapply(allCombs2, function(x) x[, 1:m])
for (f in seq_along(funs)) {
for (i in 1:2) {
if (i == 1) {
a = comp1
b = comp2
} else {
a = comp2
b = comp1
}
for (j in a) {
for (k in b) {
myComp = c(j, k)
myTest = comboGeneral(8, m, TRUE,
constraintFun = funs[f],
comparisonFun = myComp,
limitConstraints = tars[[f]],
tolerance = 0)
fun1 = match.fun(j)
fun2 = match.fun(k)
if (i == 1) {
temp1 = allCombs1[[f]][fun1(theVals1[[f]], tars[[f]][1]), ]
temp2 = allCombs2[[f]][fun2(theVals2[[f]], tars[[f]][2]), ]
temp = rbind(temp1, temp2)
} else {
temp = allCombs1[[f]][fun1(theVals1[[f]], tars[[f]][1]) &
fun2(theVals1[[f]], tars[[f]][2]), ]
}
expect_equal(temp, myTest, info = list(myComp, funs[f], tars[[f]], i))
}
}
}
}
allCombs1 = lapply(funs, function(f) {
comboGeneral(15, m, constraintFun = f, keepResults = TRUE)
})
allCombs2 = lapply(funs, function(f) {
comboGeneral(15:1, m, constraintFun = f, keepResults = TRUE)
})
## ensure the both bounds are in the solution space
tars = lapply(allCombs1, function(x) {
vals <- sort(x[, m + 1])
t <- quantile(as.numeric(names(table(vals))),
c(0.25, 0.75), names = FALSE)
t <- vals[findInterval(t, vals)]
t
})
theVals1 = lapply(allCombs1, function(x) x[, m + 1])
theVals2 = lapply(allCombs2, function(x) x[, m + 1])
allCombs1 = lapply(allCombs1, function(x) x[, 1:m])
allCombs2 = lapply(allCombs2, function(x) x[, 1:m])
for (f in seq_along(funs)) {
for (i in 1:2) {
if (i == 1) {
a = comp1
b = comp2
} else {
a = comp2
b = comp1
}
for (j in a) {
for (k in b) {
myComp = c(j, k)
myTest = comboGeneral(15, m,
constraintFun = funs[f],
comparisonFun = myComp,
limitConstraints = tars[[f]],
tolerance = 0)
fun1 = match.fun(j)
fun2 = match.fun(k)
if (i == 1) {
temp1 = allCombs1[[f]][fun1(theVals1[[f]], tars[[f]][1]), ]
temp2 = allCombs2[[f]][fun2(theVals2[[f]], tars[[f]][2]), ]
temp = rbind(temp1, temp2)
} else {
temp = allCombs1[[f]][fun1(theVals1[[f]], tars[[f]][1]) &
fun2(theVals1[[f]], tars[[f]][2]), ]
}
expect_equal(temp, myTest)
}
}
}
}
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.