tests/testthat/testComboGroupsClass.R

In RcppAlgos: High Performance Tools for Combinatorics and Computational Mathematics

test_that("comboGroupsIter produces correct results", {

    comboGroupsClassTest <- function(
        v_pass, n_grps = NULL, grp_sizes = NULL,
        ret = "matrix", testRand = TRUE
    ) {

        myResults <- vector(mode = "logical")

        myRows <- comboGroupsCount(v_pass, n_grps, grp_sizes)
        a <- comboGroupsIter(v_pass, n_grps, grp_sizes, ret)
        b <- comboGroups(v_pass, n_grps, grp_sizes, ret)

        myResults <- c(myResults, isTRUE(all.equal(
            a@summary()$totalResults, myRows)
        ))

        if (length(v_pass) == 1 && v_pass == 0) {
            myResults <- c(myResults, v_pass == a@sourceVector())
        } else if (length(v_pass) == 1) {
            myResults <- c(myResults, isTRUE(
                all.equal(abs(v_pass), length(a@sourceVector()))
            ))
        } else if (is.integer(v_pass) || is.numeric(v_pass)) {
            myResults <- c(myResults, isTRUE(
                all.equal(sort(v_pass), sort(a@sourceVector()))
            ))
        } else {
            myResults <- c(myResults, isTRUE(
                all.equal(v_pass, a@sourceVector())
            ))
        }

        if (testRand && ret == "matrix") {
            myResults <- c(myResults, isTRUE(
                all.equal(a@front(), b[1, ])
            ))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b[1, ])))
            myResults <- c(myResults, isTRUE(all.equal(a@back(),
                                                       b[myRows, ])))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b[myRows, ])))
        } else if (testRand) {
            myResults <- c(myResults, isTRUE(
                all.equal(a@front(), b[1, , ])
            ))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b[1, , ])))
            myResults <- c(myResults, isTRUE(all.equal(a@back(),
                                                       b[myRows, , ])))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b[myRows, , ])))
        }

        a@startOver()
        msg <- capture.output(noMore <- a@currIter())
        myResults <- c(myResults, is.null(noMore))
        myResults <- c(myResults, grepl("Iterator Initialized. To see the first", msg[1]))
        a1 <- b

        if (myRows) {
            if (ret == "matrix") {
                for (i in 1:myRows) {
                    a1[i, ] <- a@nextIter()
                }
            } else {
                for (i in 1:myRows) {
                    a1[i, , ] <- a@nextIter()
                }
            }

            myResults <- c(myResults, isTRUE(all.equal(a1, b)))
            a@startOver()
            num_iters <- if (myRows > 10) 3L else 1L
            numTest   <- as.integer(myRows / num_iters);

            s <- 1L
            e <- numTest

            if (ret == "matrix") {
                for (i in 1:num_iters) {
                    myResults <- c(
                        myResults, isTRUE(
                            all.equal(a@nextNIter(numTest),
                                      b[s:e, , drop = FALSE])
                            )
                    )
                    s <- e + 1L
                    e <- e + numTest
                }
            } else {
                for (i in 1:num_iters) {
                    myResults <- c(
                        myResults, isTRUE(
                            all.equal(a@nextNIter(numTest),
                                      b[s:e, , ])
                        )
                    )
                    s <- e + 1L
                    e <- e + numTest
                }
            }

            a@startOver()
            myResults <- c(myResults, isTRUE(all.equal(a@nextRemaining(), b)))
            msg <- capture.output(noMore <- a@nextIter())
            myResults <- c(myResults, is.null(noMore))

            if (testRand) {
                a@back()
                msg <- capture.output(noMore <- a@nextNIter(1))
                myResults <- c(myResults, is.null(noMore))
                myResults <- c(myResults, "No more results." == msg[1])
                msg <- capture.output(noMore <- a@currIter())
                myResults <- c(myResults, "No more results." == msg[1])

                a@startOver()
                a@back()
                msg <- capture.output(noMore <- a@nextRemaining())
                myResults <- c(myResults, is.null(noMore))
                myResults <- c(myResults, "No more results." == msg[1])

                a@startOver()
                a@back()
                msg <- capture.output(noMore <- a@nextIter())
                myResults <- c(myResults, is.null(noMore))
                myResults <- c(myResults, "No more results." == msg[1])

                samp <- sample(myRows, numTest)
                one_samp <- sample(myRows, 1)

                if (ret == "matrix") {
                    myResults <- c(
                        myResults, isTRUE(all.equal(a[[samp]], b[samp, ]))
                    )

                    myResults <- c(
                        myResults, isTRUE(all.equal(a[[one_samp]],
                                                    b[one_samp, ]))
                    )
                } else {
                    myResults <- c(
                        myResults, isTRUE(all.equal(a[[samp]], b[samp, , ]))
                    )

                    myResults <- c(
                        myResults, isTRUE(all.equal(a[[one_samp]],
                                                    b[one_samp, , ]))
                    )
                }
            }
        } else {
            a@startOver()
            msg <- capture.output(noMore <- a@nextNIter(1))
            myResults <- c(myResults, is.null(noMore))
            myResults <- c(myResults, "No more results." == msg[1])
            msg <- capture.output(noMore <- a@currIter())
            myResults <- c(myResults, "No more results." == msg[1])

            a@startOver()
            msg <- capture.output(noMore <- a@nextIter())
            myResults <- c(myResults, is.null(noMore))
            myResults <- c(myResults, "No more results." == msg[1])

            a@startOver()
            msg <- capture.output(noMore <- a@nextRemaining())
            myResults <- c(myResults, is.null(noMore))
            myResults <- c(myResults, "No more results." == msg[1])
        }

        rm(a, a1, b)
        gc()
        all(myResults)
    }

    expect_true(comboGroupsClassTest(12, 3))
    expect_true(comboGroupsClassTest(runif(10) + rnorm(10) * 1i, 2))
    expect_true(comboGroupsClassTest(as.raw(1:10), grp_sizes = 1:4))
    expect_true(comboGroupsClassTest(sample(state.name, 10), grp_sizes = 4:1))
    expect_true(comboGroupsClassTest(12, 3, ret = "3Darray"))
    expect_true(comboGroupsClassTest(LETTERS[1:8], 2, ret = "3Darray"))
    expect_true(comboGroupsClassTest(as.factor(LETTERS[1:8]),
                                     4, ret = "3Darray"))
    expect_true(comboGroupsClassTest(8, 1))
    expect_true(comboGroupsClassTest(8, 8))

    ## Not tested right now. Sent email to r-devel
    # expect_true(comboGroupsClassTest(8, 1, ret = "3Darray"))
    # expect_true(comboGroupsClassTest(8, 8, ret = "3Darray"))

    expect_true(comboGroupsClassTest(12, grp_sizes = c(3, 3, 6)))
    expect_true(comboGroupsClassTest(12, grp_sizes = c(3, 4, 5)))
    expect_true(comboGroupsClassTest(11, grp_sizes = c(1, 2, 2, 3, 3)))
    expect_true(comboGroupsClassTest(1:4 + 0.1, grp_sizes = c(1, 1, 1, 1)))
    expect_true(comboGroupsClassTest(LETTERS[1:4], grp_sizes = c(1, 1, 2)))
    expect_true(comboGroupsClassTest(as.factor(state.abb[1:3]),
                                     grp_sizes = c(1, 2)))
    expect_true(comboGroupsClassTest(3, 1))
    expect_true(comboGroupsClassTest(1, 1))


    ###****************************** BIG TESTS *****************************###
    comboGroupsClassBigZTest <- function(
        v_pass, n_grps = NULL, grp_sizes = NULL,
        ret = "matrix", lenCheck = 1000, testRand = TRUE
    ) {

        myResults <- vector(mode = "logical")

        myRows <- comboGroupsCount(v_pass, n_grps, grp_sizes)
        a  <- comboGroupsIter(v_pass, n_grps, grp_sizes, ret)
        b1 <- comboGroups(v_pass, n_grps, grp_sizes, ret, upper = lenCheck)
        b2 <- comboGroups(v_pass, n_grps, grp_sizes, ret,
                          lower = gmp::sub.bigz(myRows, lenCheck - 1))

        myResults <- c(myResults, isTRUE(all.equal(
            a@summary()$totalResults, myRows)
        ))

        if (length(v_pass) == 1) {
            myResults <- c(myResults, isTRUE(
                all.equal(v_pass, length(a@sourceVector()))
            ))
        } else if (is.integer(v_pass) || is.numeric(v_pass)) {
            myResults <- c(myResults, isTRUE(
                all.equal(sort(v_pass), sort(a@sourceVector()))
            ))
        } else {
            myResults <- c(myResults, isTRUE(
                all.equal(v_pass, a@sourceVector())
            ))
        }

        if (ret == "matrix") {
            myResults <- c(myResults, isTRUE(
                all.equal(a@front(), b1[1 ,])
            ))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b1[1 ,])))
            myResults <- c(myResults, isTRUE(all.equal(a@back(),
                                                       b2[lenCheck, ])))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b2[lenCheck, ])))
        } else {
            myResults <- c(myResults, isTRUE(
                all.equal(a@front(), b1[1, ,])
            ))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b1[1, ,])))
            myResults <- c(myResults, isTRUE(all.equal(a@back(),
                                                       b2[lenCheck, ,])))
            myResults <- c(myResults, isTRUE(all.equal(a@currIter(),
                                                       b2[lenCheck, ,])))
        }

        a@startOver()
        a1 <- b1

        if (ret == "matrix") {
            for (i in 1:lenCheck) {
                a1[i, ] <- a@nextIter()
            }
        } else {
            for (i in 1:lenCheck) {
                a1[i, ,] <- a@nextIter()
            }
        }

        myResults <- c(myResults, isTRUE(all.equal(a1, b1)))
        a@startOver()
        numTest <- as.integer(lenCheck / 3);
        s <- 1L
        e <- numTest

        if (ret == "matrix") {
            for (i in 1:3) {
                myResults <- c(myResults, isTRUE(all.equal(a@nextNIter(numTest),
                                                           b1[s:e, ])))
                s <- e + 1L
                e <- e + numTest
            }
        } else {
            for (i in 1:3) {
                myResults <- c(myResults, isTRUE(all.equal(a@nextNIter(numTest),
                                                           b1[s:e, ,])))
                s <- e + 1L
                e <- e + numTest
            }
        }

        a@startOver()
        a[[gmp::sub.bigz(myRows, lenCheck)]]
        myResults <- c(myResults, isTRUE(all.equal(a@nextRemaining(), b2)))

        t <- capture.output(a@nextIter())
        myResults <- c(myResults, is.null(a@nextIter()))
        myResults <- c(myResults, is.null(a@nextNIter(1)))
        myResults <- c(myResults, is.null(a@nextRemaining()))

        samp1 <- sample(lenCheck, 5)
        samp2 <- gmp::sub.bigz(myRows, lenCheck) + gmp::as.bigz(samp1)

        if (ret == "matrix") {
            myResults <- c(myResults, isTRUE(all.equal(a[[samp1]], b1[samp1, ])))
            myResults <- c(myResults, isTRUE(all.equal(a[[samp2]], b2[samp1, ])))
        } else {
            myResults <- c(myResults, isTRUE(all.equal(a[[samp1]], b1[samp1, ,])))
            myResults <- c(myResults, isTRUE(all.equal(a[[samp2]], b2[samp1, ,])))
        }

        rm(a, a1, b1, b2)
        gc()
        all(myResults)
    }

    expect_true(comboGroupsClassBigZTest(50, 10))
    expect_true(comboGroupsClassBigZTest(
        runif(50) + rnorm(50) * 1i, 5)
    )
    expect_true(comboGroupsClassBigZTest(
        as.raw(1:45), grp_sizes = 1:9)
    )
    expect_true(comboGroupsClassBigZTest(
        sample(state.name, 45), grp_sizes = 9:1)
    )
    expect_true(
        comboGroupsClassBigZTest(50, 10, ret = "3Darray")
    )
    expect_true(comboGroupsClassBigZTest(state.abb, 10, ret = "3Darray"))
    expect_true(comboGroupsClassBigZTest(
        as.factor(state.abb), 5, ret = "3Darray"
    ))
    expect_true(
        comboGroupsClassBigZTest(40, grp_sizes = c(9, 9, 22))
    )
    expect_true(
        comboGroupsClassBigZTest(42, grp_sizes = c(10, 10, 22))
    )
    expect_true(
        comboGroupsClassBigZTest(48, grp_sizes = 15:17)
    )
    expect_true(
        comboGroupsClassBigZTest(55, grp_sizes = rep(1:5, time = 1:5))
    )
    expect_true(
        comboGroupsClassBigZTest(state.name[1:40], grp_sizes = rep(1:4, 4))
    )
    expect_true(
        comboGroupsClassBigZTest(
            as.factor(state.abb), grp_sizes =
                rep(1:7, times = c(1, 4, 1, 2, 1, 3, 1))
            )
    )
})