tests/testthat/test-partitions.R

context("Partitions")

test_that("Integer partitions - npartitions", {
    expect_equal(npartitions(10), 42)
    expect_equal(npartitions(100), 190569292)
    expect_error(npartitions(150), "integer overflow")
    expect_equal(npartitions(10, bigz = TRUE), 42)
    expect_equal(npartitions(100, bigz = TRUE), 190569292)
    expect_equal(npartitions(150, bigz = TRUE), gmp::as.bigz("40853235313"))
    expect_equal(npartitions(0), 1)
    expect_error(npartitions(-1), "expect integer")
    expect_error(npartitions(1.5), "expect integer")
})

test_that("Integer partitions - ascending partitions", {
    part <- partitions(10)
    expect_equal(nrow(part), 42)
    expect_equal(ncol(part), 10)
    expect_equal(part[1, ], rep(1, 10))
    expect_equal(part[2, ], c(rep(1, 8), 2, 0))
    expect_equal(part[42, ], c(10, rep(0, 9)))
    expect_true(all(apply(part, 1, sum) == 10))

    part <- partitions(10, layout = "row")
    expect_equal(nrow(part), 42)
    expect_equal(ncol(part), 10)
    expect_equal(part[1, ], rep(1, 10))
    expect_equal(part[2, ], c(rep(1, 8), 2, 0))
    expect_equal(part[42, ], c(10, rep(0, 9)))
    expect_true(all(apply(part, 1, sum) == 10))

    part <- partitions(10, layout = "column")
    expect_equal(nrow(part), 10)
    expect_equal(ncol(part), 42)
    expect_equal(part[, 1], rep(1, 10))
    expect_equal(part[, 2], c(rep(1, 8), 2, 0))
    expect_equal(part[, 42], c(10, rep(0, 9)))
    expect_true(all(apply(part, 2, sum) == 10))

    part <- partitions(10, layout = "list")
    expect_equal(length(part), 42)
    expect_equal(part[[1]], rep(1, 10))
    expect_equal(part[[2]], c(rep(1, 8), 2))
    expect_equal(part[[42]], 10)
    expect_true(all(sapply(part, sum) == 10))

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

test_that("Integer partitions - descending partitions", {
    part <- partitions(10, descending = TRUE)
    expect_equal(nrow(part), 42)
    expect_equal(ncol(part), 10)
    expect_equal(part[1, ], c(10, rep(0, 9)))
    expect_equal(part[41, ], c(2, rep(1, 8), 0))
    expect_equal(part[42, ], rep(1, 10))
    expect_true(all(apply(part, 1, sum) == 10))

    part <- partitions(10, descending = TRUE, layout = "row")
    expect_equal(nrow(part), 42)
    expect_equal(ncol(part), 10)
    expect_equal(part[1, ], c(10, rep(0, 9)))
    expect_equal(part[41, ], c(2, rep(1, 8), 0))
    expect_equal(part[42, ], rep(1, 10))
    expect_true(all(apply(part, 1, sum) == 10))

    part <- partitions(10, descending = TRUE, layout = "column")
    expect_equal(nrow(part), 10)
    expect_equal(ncol(part), 42)
    expect_equal(part[, 1], c(10, rep(0, 9)))
    expect_equal(part[, 41], c(2, rep(1, 8), 0))
    expect_equal(part[, 42], rep(1, 10))
    expect_true(all(apply(part, 2, sum) == 10))

    part <- partitions(10, descending = TRUE, layout = "list")
    expect_equal(length(part), 42)
    expect_equal(part[[1]], 10)
    expect_equal(part[[41]], c(2, rep(1, 8)))
    expect_equal(part[[42]], rep(1, 10))
    expect_true(all(sapply(part, sum) == 10))

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

test_that("Integer partitions - ascending ipartitions", {
    part <- partitions(10)
    ipart <- ipartitions(10)
    expect_is(ipart, "Partitions")
    expect_equal(ipart$collect(), part)
    expect_equal(ipart$getnext(), part[1, ])
    expect_equal(ipart$getnext(), part[2, ])
    expect_equal(ipart$getnext(2), part[3:4, ])
    ipart$getnext(30)
    expect_equal(nrow(ipart$getnext(30)), 8)
    expect_equal(ipart$getnext(), NULL)

    part <- partitions(10, layout = "row")
    ipart$reset()
    expect_is(ipart, "Partitions")
    expect_equal(ipart$collect(), part)
    expect_equal(ipart$getnext(layout = "row"), part[1, , drop = FALSE])
    expect_equal(ipart$getnext(layout = "row"), part[2, , drop = FALSE])
    expect_equal(ipart$getnext(2, layout = "row"), part[3:4, ])
    ipart$getnext(30, layout = "row")
    expect_equal(nrow(ipart$getnext(30, layout = "row")), 8)
    expect_equal(ipart$getnext(layout = "column"), NULL)

    part <- partitions(10, layout = "column")
    ipart$reset()
    expect_equal(ipart$collect(layout = "column"), part)
    expect_equal(ipart$getnext(layout = "column"), part[, 1, drop = FALSE])
    expect_equal(ipart$getnext(layout = "column"), part[, 2, drop = FALSE])
    expect_equal(ipart$getnext(2, layout = "column"), part[, 3:4])
    ipart$getnext(30, layout = "column")
    expect_equal(ncol(ipart$getnext(30, layout = "column")), 8)
    expect_equal(ipart$getnext(layout = "column"), NULL)

    part <- partitions(10, layout = "list")
    ipart$reset()
    expect_equal(ipart$collect(layout = "list"), part)
    expect_equal(ipart$getnext(layout = "list"), part[1])
    expect_equal(ipart$getnext(layout = "list"), part[2])
    expect_equal(ipart$getnext(2, layout = "list"), part[3:4])
    ipart$getnext(30, layout = "list")
    expect_equal(length(ipart$getnext(30, layout = "list")), 8)
    expect_equal(ipart$getnext(layout = "list"), NULL)

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

test_that("Integer partitions - descending ipartitions", {
    part <- partitions(10, descending = TRUE)
    ipart <- ipartitions(10, descending = TRUE)
    expect_is(ipart, "Partitions")
    expect_equal(ipart$collect(), part)
    expect_equal(ipart$getnext(), part[1, ])
    expect_equal(ipart$getnext(), part[2, ])
    expect_equal(ipart$getnext(2), part[3:4, ])
    ipart$getnext(30)
    expect_equal(nrow(ipart$getnext(30)), 8)
    expect_equal(ipart$getnext(), NULL)

    part <- partitions(10, descending = TRUE, layout = "row")
    ipart$reset()
    expect_equal(ipart$collect(layout = "row"), part)
    expect_equal(ipart$getnext(layout = "row"), part[1, , drop = FALSE])
    expect_equal(ipart$getnext(layout = "row"), part[2, , drop = FALSE])
    expect_equal(ipart$getnext(2, layout = "row"), part[3:4, ])
    ipart$getnext(30, layout = "row")
    expect_equal(nrow(ipart$getnext(30, layout = "row")), 8)
    expect_equal(ipart$getnext(layout = "row"), NULL)

    part <- partitions(10, descending = TRUE, layout = "column")
    ipart$reset()
    expect_equal(ipart$collect(layout = "column"), part)
    expect_equal(ipart$getnext(layout = "column"), part[, 1, drop = FALSE])
    expect_equal(ipart$getnext(layout = "column"), part[, 2, drop = FALSE])
    expect_equal(ipart$getnext(2, layout = "column"), part[, 3:4])
    ipart$getnext(30, layout = "column")
    expect_equal(ncol(ipart$getnext(30, layout = "column")), 8)
    expect_equal(ipart$getnext(layout = "column"), NULL)

    part <- partitions(10, descending = TRUE, layout = "list")
    ipart$reset()
    expect_equal(ipart$collect(layout = "list"), part)
    expect_equal(ipart$getnext(layout = "list"), part[1])
    expect_equal(ipart$getnext(layout = "list"), part[2])
    expect_equal(ipart$getnext(2, layout = "list"), part[3:4])
    ipart$getnext(30, layout = "list")
    expect_equal(length(ipart$getnext(30, layout = "list")), 8)
    expect_equal(ipart$getnext(layout = "list"), NULL)

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


test_that("Integer partitions - index", {
    part <- partitions(10)
    expect_equal(partitions(10, index = 1:42), part)
    expect_equal(partitions(10, index = as.numeric(1:42)), part)
    expect_equal(partitions(10, index = as.character(1:42)), part)
    expect_equal(partitions(10, index = gmp::as.bigz(1:42)), part)
    expect_equal(partitions(10, index = 2), c(rep(1, 8), 2, 0))
    expect_equal(partitions(10, index = 42), c(10, rep(0, 9)))
    expect_equal(partitions(200, index = 2), c(rep(1, 198), 2, 0))
    expect_equal(partitions(200, index = "3972999029388"), c(200, rep(0, 199)))

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

    part <- partitions(10, descending = TRUE)
    expect_equal(partitions(10, descending = TRUE, index = 1:42), part)
    expect_equal(partitions(10, descending = TRUE, index = as.numeric(1:42)), part)
    expect_equal(partitions(10, descending = TRUE, index = as.character(1:42)), part)
    expect_equal(partitions(10, descending = TRUE, index = gmp::as.bigz(1:42)), part)
    expect_equal(partitions(10, descending = TRUE, index = 2), c(9, 1, rep(0, 8)))
    expect_equal(partitions(10, descending = TRUE, index = 42), rep(1, 10))
    expect_equal(partitions(200, descending = TRUE, index = 2), c(199, 1, rep(0, 198)))
    expect_equal(partitions(200, descending = TRUE, index = "3972999029388"), rep(1, 200))

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



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

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


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

    ipart <- ipartitions(0)
    expect_equal(ipart$getnext(), integer(0))
    expect_equal(ipart$getnext(), NULL)

    ipart <- ipartitions(0, 0)
    expect_equal(ipart$getnext(), integer(0))
    expect_equal(ipart$getnext(), NULL)

    ipart <- ipartitions(0, 1)
    expect_equal(ipart$getnext(), NULL)
    expect_equal(ipart$getnext(), NULL)

    ipart <- ipartitions(1)
    expect_equal(ipart$getnext(), 1)
    expect_equal(ipart$getnext(), NULL)

    ipart <- ipartitions(1, 0)
    expect_equal(ipart$getnext(), NULL)
    expect_equal(ipart$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.