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) } } } } })