tests/testthat/test-compositions.R

context("Compositions")

test_that("Integer compositions - ncompositions", {
    expect_equal(ncompositions(10), 512)
    expect_equal(ncompositions(30), 536870912)
    expect_error(ncompositions(50), "integer overflow")
    expect_equal(ncompositions(10, bigz = TRUE), 512)
    expect_equal(ncompositions(30, bigz = TRUE), 536870912)
    expect_equal(ncompositions(50, bigz = TRUE), gmp::as.bigz("562949953421312"))
    expect_equal(ncompositions(0), 1)
    expect_error(ncompositions(-1), "expect integer")
    expect_error(ncompositions(1.5), "expect integer")
})

test_that("Integer compositions - ascending compositions", {
    comp <- compositions(7)
    expect_equal(nrow(comp), 64)
    expect_equal(ncol(comp), 7)
    expect_equal(comp[1, ], rep(1, 7))
    expect_equal(comp[2, ], c(rep(1, 5), 2, 0))
    expect_equal(comp[64, ], c(7, rep(0, 6)))
    expect_true(all(apply(comp, 1, sum) == 7))

    comp <- compositions(7, layout = "row")
    expect_equal(nrow(comp), 64)
    expect_equal(ncol(comp), 7)
    expect_equal(comp[1, ], rep(1, 7))
    expect_equal(comp[2, ], c(rep(1, 5), 2, 0))
    expect_equal(comp[64, ], c(7, rep(0, 6)))
    expect_true(all(apply(comp, 1, sum) == 7))

    comp <- compositions(7, layout = "column")
    expect_equal(nrow(comp), 7)
    expect_equal(ncol(comp), 64)
    expect_equal(comp[, 1], rep(1, 7))
    expect_equal(comp[, 2], c(rep(1, 5), 2, 0))
    expect_equal(comp[, 64], c(7, rep(0, 6)))
    expect_true(all(apply(comp, 2, sum) == 7))

    comp <- compositions(7, layout = "list")
    expect_equal(length(comp), 64)
    expect_equal(comp[[1]], rep(1, 7))
    expect_equal(comp[[2]], c(rep(1, 5), 2))
    expect_equal(comp[[64]], 7)
    expect_true(all(sapply(comp, sum) == 7))

    expect_error(compositions(150), "too many results")
    expect_error(compositions(-1), "expect integer")
    expect_error(compositions(1.5), "expect integer")
})

test_that("Integer compositions - descending compositions", {
    comp <- compositions(7, descending = TRUE)
    expect_equal(nrow(comp), 64)
    expect_equal(ncol(comp), 7)
    expect_equal(comp[1, ], c(7, rep(0, 6)))
    expect_equal(comp[63, ], c(rep(1, 5), 2, 0))
    expect_equal(comp[64, ], rep(1, 7))
    expect_true(all(apply(comp, 1, sum) == 7))

    comp <- compositions(7, descending = TRUE, layout = "row")
    expect_equal(nrow(comp), 64)
    expect_equal(ncol(comp), 7)
    expect_equal(comp[1, ], c(7, rep(0, 6)))
    expect_equal(comp[63, ], c(rep(1, 5), 2, 0))
    expect_equal(comp[64, ], rep(1, 7))
    expect_true(all(apply(comp, 1, sum) == 7))

    comp <- compositions(7, descending = TRUE, layout = "column")
    expect_equal(nrow(comp), 7)
    expect_equal(ncol(comp), 64)
    expect_equal(comp[, 1], c(7, rep(0, 6)))
    expect_equal(comp[, 63], c(rep(1, 5), 2, 0))
    expect_equal(comp[, 64], rep(1, 7))
    expect_true(all(apply(comp, 2, sum) == 7))

    comp <- compositions(7, descending = TRUE, layout = "list")
    expect_equal(length(comp), 64)
    expect_equal(comp[[1]], 7)
    expect_equal(comp[[63]], c(rep(1, 5), 2))
    expect_equal(comp[[64]], rep(1, 7))
    expect_true(all(sapply(comp, sum) == 7))

    expect_error(compositions(150, descending = TRUE), "too many results")
    expect_error(compositions(-1, descending = TRUE), "expect integer")
    expect_error(compositions(1.5, descending = TRUE), "expect integer")
})

test_that("Integer compositions - ascending icompositions", {
    comp <- compositions(7)
    icomp <- icompositions(7)
    expect_is(icomp, "Compositions")
    expect_equal(icomp$collect(), comp)
    expect_equal(icomp$getnext(), comp[1, ])
    expect_equal(icomp$getnext(), comp[2, ])
    expect_equal(icomp$getnext(2), comp[3:4, ])
    icomp$getnext(40)
    expect_equal(nrow(icomp$getnext(40)), 20)
    expect_equal(icomp$getnext(), NULL)

    comp <- compositions(7, layout = "row")
    icomp$reset()
    expect_is(icomp, "Compositions")
    expect_equal(icomp$collect(), comp)
    expect_equal(icomp$getnext(layout = "row"), comp[1, , drop = FALSE])
    expect_equal(icomp$getnext(layout = "row"), comp[2, , drop = FALSE])
    expect_equal(icomp$getnext(2, layout = "row"), comp[3:4, ])
    icomp$getnext(40, layout = "row")
    expect_equal(nrow(icomp$getnext(40, layout = "row")), 20)
    expect_equal(icomp$getnext(layout = "column"), NULL)

    comp <- compositions(7, layout = "column")
    icomp$reset()
    expect_equal(icomp$collect(layout = "column"), comp)
    expect_equal(icomp$getnext(layout = "column"), comp[, 1, drop = FALSE])
    expect_equal(icomp$getnext(layout = "column"), comp[, 2, drop = FALSE])
    expect_equal(icomp$getnext(2, layout = "column"), comp[, 3:4])
    icomp$getnext(40, layout = "column")
    expect_equal(ncol(icomp$getnext(40, layout = "column")), 20)
    expect_equal(icomp$getnext(layout = "column"), NULL)

    comp <- compositions(7, layout = "list")
    icomp$reset()
    expect_equal(icomp$collect(layout = "list"), comp)
    expect_equal(icomp$getnext(layout = "list"), comp[1])
    expect_equal(icomp$getnext(layout = "list"), comp[2])
    expect_equal(icomp$getnext(2, layout = "list"), comp[3:4])
    icomp$getnext(40, layout = "list")
    expect_equal(length(icomp$getnext(40, layout = "list")), 20)
    expect_equal(icomp$getnext(layout = "list"), NULL)

    expect_error(icompositions(-1), "expect integer")
    expect_error(icompositions(1.5), "expect integer")
})

test_that("Integer compositions - descending icompositions", {
    comp <- compositions(7, descending = TRUE)
    icomp <- icompositions(7, descending = TRUE)
    expect_is(icomp, "Compositions")
    expect_equal(icomp$collect(), comp)
    expect_equal(icomp$getnext(), comp[1, ])
    expect_equal(icomp$getnext(), comp[2, ])
    expect_equal(icomp$getnext(2), comp[3:4, ])
    icomp$getnext(40)
    expect_equal(nrow(icomp$getnext(40)), 20)
    expect_equal(icomp$getnext(), NULL)

    comp <- compositions(7, descending = TRUE, layout = "row")
    icomp$reset()
    expect_equal(icomp$collect(layout = "row"), comp)
    expect_equal(icomp$getnext(layout = "row"), comp[1, , drop = FALSE])
    expect_equal(icomp$getnext(layout = "row"), comp[2, , drop = FALSE])
    expect_equal(icomp$getnext(2, layout = "row"), comp[3:4, ])
    icomp$getnext(40, layout = "row")
    expect_equal(nrow(icomp$getnext(40, layout = "row")), 20)
    expect_equal(icomp$getnext(layout = "row"), NULL)

    comp <- compositions(7, descending = TRUE, layout = "column")
    icomp$reset()
    expect_equal(icomp$collect(layout = "column"), comp)
    expect_equal(icomp$getnext(layout = "column"), comp[, 1, drop = FALSE])
    expect_equal(icomp$getnext(layout = "column"), comp[, 2, drop = FALSE])
    expect_equal(icomp$getnext(2, layout = "column"), comp[, 3:4])
    icomp$getnext(40, layout = "column")
    expect_equal(ncol(icomp$getnext(40, layout = "column")), 20)
    expect_equal(icomp$getnext(layout = "column"), NULL)

    comp <- compositions(7, descending = TRUE, layout = "list")
    icomp$reset()
    expect_equal(icomp$collect(layout = "list"), comp)
    expect_equal(icomp$getnext(layout = "list"), comp[1])
    expect_equal(icomp$getnext(layout = "list"), comp[2])
    expect_equal(icomp$getnext(2, layout = "list"), comp[3:4])
    icomp$getnext(40, layout = "list")
    expect_equal(length(icomp$getnext(40, layout = "list")), 20)
    expect_equal(icomp$getnext(layout = "list"), NULL)

    expect_error(icompositions(-1, descending = TRUE), "expect integer")
    expect_error(icompositions(1.5, descending = TRUE), "expect integer")
})


test_that("Integer compositions - index", {
    comp <- compositions(7)
    expect_equal(compositions(7, index = 1:64), comp)
    expect_equal(compositions(7, index = as.numeric(1:64)), comp)
    expect_equal(compositions(7, index = as.character(1:64)), comp)
    expect_equal(compositions(7, index = gmp::as.bigz(1:64)), comp)
    expect_equal(compositions(7, index = 2), c(rep(1, 5), 2, 0))
    expect_equal(compositions(7, index = 64), c(7, rep(0, 6)))
    expect_equal(compositions(50, index = 2), c(rep(1, 48), 2, 0))
    expect_equal(compositions(50, index = "562949953421312"), c(50, rep(0, 49)))

    expect_equal(compositions(0, index = 1), integer(0))

    comp <- compositions(7, descending = TRUE)
    expect_equal(compositions(7, descending = TRUE, index = 1:64), comp)
    expect_equal(compositions(7, descending = TRUE, index = as.numeric(1:64)), comp)
    expect_equal(compositions(7, descending = TRUE, index = as.character(1:64)), comp)
    expect_equal(compositions(7, descending = TRUE, index = gmp::as.bigz(1:64)), comp)
    expect_equal(compositions(7, descending = TRUE, index = 2), c(6, 1, rep(0, 5)))
    expect_equal(compositions(7, descending = TRUE, index = 64), rep(1, 7))
    expect_equal(compositions(50, descending = TRUE, index = 2), c(49, 1, rep(0, 48)))
    expect_equal(compositions(50, descending = TRUE, index = "562949953421312"), rep(1, 50))

    expect_equal(compositions(0, descending = TRUE, index = 1), integer(0))
})


test_that("Integer compositions - skip", {
    expect_equal(compositions(7, skip = 64), compositions(7))
    expect_equal(compositions(7, skip = 3), compositions(7)[4:64, ])
    expect_equal(compositions(7, skip = 3, nitem = 4), compositions(7)[4:7, ])
    expect_equal(compositions(7, skip = gmp::as.bigz(3), nitem = 4), compositions(7)[4:7, ])

    expect_equal(compositions(7, descending = TRUE, skip = 64), compositions(7, descending = TRUE))
    expect_equal(compositions(7, descending = TRUE, skip = 3), compositions(7, descending = TRUE)[4:64, ])
    expect_equal(compositions(7, descending = TRUE, skip = 3, nitem = 4), compositions(7, descending = TRUE)[4:7, ])
    expect_equal(compositions(7, descending = TRUE, skip = gmp::as.bigz(3), nitem = 4), compositions(7, descending = TRUE)[4:7, ])
})


test_that("Integer compositions - small cases", {
    expect_equal(compositions(0), matrix(0, nr = 1, nc = 0))
    expect_equal(compositions(0, 0), matrix(0, nr = 1, nc = 0))
    expect_equal(compositions(0, 1), matrix(0, nr = 0, nc = 1))
    expect_equal(compositions(1), matrix(1, nr = 1, nc = 1))
    expect_equal(compositions(1, 0), matrix(1, nr = 0, nc = 0))

    icomp <- icompositions(0)
    expect_equal(icomp$getnext(), integer(0))
    expect_equal(icomp$getnext(), NULL)

    icomp <- icompositions(0, 0)
    expect_equal(icomp$getnext(), integer(0))
    expect_equal(icomp$getnext(), NULL)

    icomp <- icompositions(0, 1)
    expect_equal(icomp$getnext(), NULL)
    expect_equal(icomp$getnext(), NULL)

    icomp <- icompositions(1)
    expect_equal(icomp$getnext(), 1)
    expect_equal(icomp$getnext(), NULL)

    icomp <- icompositions(1, 0)
    expect_equal(icomp$getnext(), NULL)
    expect_equal(icomp$getnext(), NULL)
})

Try the arrangements package in your browser

Any scripts or data that you put into this service are public.

arrangements documentation built on Sept. 13, 2020, 5:20 p.m.