tests/testthat/test-DexiFunctions.R

test_that("dexi_index() works", {
  expect_equal(dexi_index(c(1,1), c(2,3)), 1)
  expect_equal(dexi_index(c(1,2), c(2,3)), 2)
  expect_equal(dexi_index(c(1,3), c(2,3)), 3)
  expect_equal(dexi_index(c(2,1), c(2,3)), 4)
  expect_equal(dexi_index(c(2,2), c(2,3)), 5)
  expect_equal(dexi_index(c(2,3), c(2,3)), 6)
  expect_true(is.na(dexi_index(c(2,NA), c(2,3))))
  expect_true(is.na(dexi_index(c(2,1), c(2,NA))))
})

test_that("dexi_table() works", {
  expect_error(dexi_table())
  expect_error(dexi_table(1))
  expect_error(dexi_table(c(1, 2)))
  expect_error(dexi_table(c("a", "b")))
  expect_error(dexi_table("12", dim = c(1,2,3)))
  expect_error(dexi_table("12"))
  expect_error(dexi_table("12", NULL))
  t <- dexi_table("123456", dim = c(2, 3))
  expect_true(is.list(t))
  expect_true(length(t) == 6)
  expect_equal(unlist(t), c(1, 4, 2, 5, 3, 6) + 1)
  expect_equal(dim(t), c(2,3))
  t <- dexi_table("123456", "224466", dim = c(2, 3))
  expect_true(is.list(t))
  expect_true(length(t) == 6)
  expect_equal(t[[1, 1]], c(1,2) + 1)
  expect_equal(t[[1, 2]], 2 + 1)
  expect_equal(t[[1, 3]], c(3,4) + 1)
  expect_equal(t[[2, 1]], 4 + 1)
  expect_equal(t[[2, 2]], c(5,6) + 1)
  expect_equal(t[[2, 3]], 6 + 1)
  expect_equal(dim(t), c(2,3))
})

test_that("make_args() works", {
  a <- make_args(c(2,3))
  expect_true(is.list(a))
  expect_true(length(a) == 6)
  expect_equal(a[[1]], c(1,1))
  expect_equal(a[[2]], c(2,1))
  expect_equal(a[[6]], c(2,3))
})

test_that("Creating DexiFunction", {
  f <- DexiFunction()
  expect_silent(f$verify())
})

test_that("Creating DexiTabularFunction without attribute", {
  expect_error(DexiTabularFunction())
  expect_error(DexiTabularFunction(NULL, NULL))

  #empty values from dim
  f <- DexiTabularFunction(dim = c(2,3))
  expect_silent(f$verify())
  expect_null((f$attribute))
  expect_true(is.list(f$values))
  expect_equal(length(f$values), 6)
  expect_true(all(is.null(unlist(f$values))))
  expect_true(is.list(f$args))
  expect_equal(length(f$args), 6)
  expect_identical(f$args, make_args(c(2,3)))
  expect_equal(f$nargs(), 2)
  expect_equal(f$nvals(), 6)

  #values from values
  f <- DexiTabularFunction(dim = c(2,3), values = list(1,2,3,4,5,6))
  expect_silent(f$verify())
  expect_null((f$attribute))
  expect_true(is.list(f$values))
  expect_equal(length(f$values), 6)
  expect_equal(unlist(f$values), c(1,2,3,4,5,6))
  expect_true(is.list(f$args))
  expect_equal(length(f$args), 6)
  expect_identical(f$args, make_args(c(2,3)))
  expect_equal(f$nargs(), 2)
  expect_equal(f$nvals(), 6)

  #values from DEXi low
  f <- DexiTabularFunction(dim = c(2,3), low = "123456")
  expect_silent(f$verify())
  expect_null((f$attribute))
  expect_true(is.list(f$values))
  expect_equal(length(f$values), 6)
  expect_equal(unlist(f$values), c(1,4,2,5,3,6) + 1)
  expect_true(is.list(f$args))
  expect_equal(length(f$args), 6)
  expect_identical(f$args, make_args(c(2,3)))
  expect_equal(f$nargs(), 2)
  expect_equal(f$nvals(), 6)
})

test_that("DexiTabularFunction$value() and DexiTabularFunction$evaluate() work", {
  f <- DexiTabularFunction(dim = c(2,3), low = "123456", high = "224466")
  expect_silent(f$verify)
  expect_equal(f$value(c(1, 1)), c(1,2) + 1)
  expect_equal(f$value(c(1, 2)), 2 + 1)
  expect_equal(f$value(c(1, 3)), c(3,4) + 1)
  expect_equal(f$value(c(2, 1)), 4 + 1)
  expect_equal(f$value(c(2, 2)), c(5,6) + 1)
  expect_equal(f$value(c(2, 3)), 6 + 1)

  expect_error(f$value(c(-2, 2)))
  expect_error(f$value(c(-2, 5)))
  expect_error(f$value(c(2, NA)))
  expect_error(f$value(NULL))
  expect_error(f$value(c(1, 2, 3)))

  expect_null(f$evaluate(c(-2, 2)))
  expect_null(f$evaluate(c(-2, 5)))
  expect_null(f$evaluate(c(2, NA)))
  expect_null(f$evaluate(NULL))
  expect_null(f$evaluate(c(1, 2, 3)))

})

test_that("Creating DexiDiscretizeFunction without attribute", {
  expect_error(DexiDiscretizeFunction(1))
  expect_error(DexiDiscretizeFunction(bounds = c(1,2), values=c(2,1)))
  expect_error(DexiDiscretizeFunction(bounds = c(1,2), values=c(2,1,3,4)))

  #empty bounds
  f <- DexiDiscretizeFunction()
  expect_silent(f$verify())
  expect_null((f$attribute))
  expect_null((f$bounds))
  expect_true(is.list(f$values))
  expect_equal(length(f$values), 1)
  expect_true(all(is.null(unlist(f$values))))
  expect_null((f$assoc))
  expect_equal(f$nargs(), 1)
  expect_equal(f$nvals(), 1)

  #empty values
  f <- DexiDiscretizeFunction(bounds = 2)
  expect_silent(f$verify())
  expect_null((f$attribute))
  expect_equal(length(f$bounds), 1)
  expect_equal(f$bounds, 2)
  expect_true(is.list(f$values))
  expect_equal(length(f$values), 2)
  expect_true(all(is.null(unlist(f$values))))
  expect_null((f$assoc))
  expect_equal(f$nargs(), 1)
  expect_equal(f$nvals(), 2)
})

test_that("DexiDiscretizeFunction$value() and DexiDiscretizeFunction$evaluate() work", {

  # one bound
  f <- DexiDiscretizeFunction(bounds = 2, values = list(1,3))
  expect_silent(f$verify())
  expect_null(f$value("a"))

  expect_true(is.na(f$value(NA)))
  expect_true(is.null(f$value(NULL)))
  expect_equal(f$value(0), 1)
  expect_equal(f$value(1), 1)
  expect_equal(f$value(1.9), 1)
  expect_equal(f$value(2), 1)
  expect_equal(f$value(2.1), 3)
  expect_equal(f$value(3), 3)

  # one bound with assoc
  f <- DexiDiscretizeFunction(bounds = 2, values = list(1,3), assoc = c("up", "up"))
  expect_silent(f$verify())
  expect_true(is.na(f$value(NA)))
  expect_true(is.null(f$value(NULL)))
  expect_equal(f$value(0), 1)
  expect_equal(f$value(1), 1)
  expect_equal(f$value(1.9), 1)
  expect_equal(f$value(2), 3)
  expect_equal(f$value(2.1), 3)
  expect_equal(f$value(3), 3)

  # two bounds
  f <- DexiDiscretizeFunction(bounds = c(2, 4), values = list(1, 3, 5))
  expect_silent(f$verify())
  expect_true(is.na(f$value(NA)))
  expect_true(is.null(f$value(NULL)))
  expect_equal(f$value(0), 1)
  expect_equal(f$value(1), 1)
  expect_equal(f$value(1.9), 1)
  expect_equal(f$value(2), 1)
  expect_equal(f$value(2.1), 3)
  expect_equal(f$value(3), 3)
  expect_equal(f$value(4), 3)
  expect_equal(f$value(5), 5)
  expect_equal(f$value(6), 5)

  # two bounds with assoc
  f <- DexiDiscretizeFunction(bounds = c(2, 4), values = list(1, 3, 5), assoc = c("up", "down"))
  expect_silent(f$verify())
  expect_true(is.na(f$value(NA)))
  expect_true(is.null(f$value(NULL)))
  expect_equal(f$value(0), 1)
  expect_equal(f$value(1), 1)
  expect_equal(f$value(1.9), 1)
  expect_equal(f$value(2), 3)
  expect_equal(f$value(2.1), 3)
  expect_equal(f$value(3), 3)
  expect_equal(f$value(4), 3)
  expect_equal(f$value(5), 5)
  expect_equal(f$value(6), 5)
})

Try the DEXiR package in your browser

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

DEXiR documentation built on Sept. 30, 2024, 9:39 a.m.