tests/testthat/test-latin.R

test_that("latin squares and its generalisation", {
  x <- latin_rectangle(4, 5, 5)
  expect_equal(as.vector(table(x)), rep(4, 5))
  expect_false(any(apply(x, 1, duplicated)))
  expect_false(any(apply(x, 2, duplicated)))
  expect_true(all(x %in% 1:5))
  expect_true(all(apply(x, 2, function(x) table(factor(x, 1:5))) %in% c(0, 1)))

  y <- latin_array(dim = c(5, 5, 5), 5)
  expect_equal(as.vector(table(y[1,,])), rep(5, 5))
  expect_equal(as.vector(table(y[2,,])), rep(5, 5))
  expect_equal(as.vector(table(y[3,,])), rep(5, 5))
  expect_equal(as.vector(table(y[4,,])), rep(5, 5))
  expect_equal(as.vector(table(y[5,,])), rep(5, 5))
  expect_false(any(apply(y, 1, duplicated)))
  expect_false(any(apply(y, 2, duplicated)))
  expect_false(any(apply(y, 3, duplicated)))

  y <- latin_array(dim = c(5, 5, 5, 5), 5)
  expect_equal(as.vector(table(y[1,,,])), rep(25, 5))
  expect_equal(as.vector(table(y[2,,,])), rep(25, 5))
  expect_equal(as.vector(table(y[3,,,])), rep(25, 5))
  expect_equal(as.vector(table(y[4,,,])), rep(25, 5))
  expect_equal(as.vector(table(y[5,,,])), rep(25, 5))
  expect_false(any(apply(y, 1, duplicated)))
  expect_false(any(apply(y, 2, duplicated)))
  expect_false(any(apply(y, 3, duplicated)))
  expect_false(any(apply(y, 4, duplicated)))

  y <- latin_array(c(10, 8), 5)
  expect_equal(table(apply(y, 2, table)), table(rep(2, 40)))
  expect_equal(table(apply(y, 1, table)), table(rep(1:2, c(20, 30))))
})

Try the edibble package in your browser

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

edibble documentation built on June 22, 2024, 11:04 a.m.