tests/testthat/test-unit-genInit-init-options.R

In Andrea-Havron/clustTMB: Spatio-Temporal Finite Mixture Model using 'TMB'

stopifnot(
  require("testthat"),
  require("clustTMB")
)

context("test init.method input")
init.method.names <- c(
  "hc", "quantile", "random",
  "mclust", "kmeans", "mixed"
)
test_that("test default", {
  expect_equal("hc", init.options()$init.method)
})

test_that("test correct user init.method input", {
  for (nm in seq_along(init.method.names)) {
    expect_equal(
      init.method.names[nm],
      init.options(init.method = init.method.names[nm])$init.method
    )
  }
})

test_that("test incorrect user init.method input", {
  expect_error(init.options(init.method = "a"))
  expect_error(init.options(init.method = 1))
  expect_error(init.options(init.method = c("hc", "random")))
})


context("test hc.options input")
hc.options.names <- list(
  modelName = c("VVV", "EII", "EEE", "VII", "V", "E"),
  use = c("SVD", "VARS", "STD", "SPH", "PCS", "PCR", "RND")
)
test_that("test default", {
  expect_equal("VVV", init.options()$hc.options$modelName)
  expect_equal("SVD", init.options()$hc.options$use)
  expect_equal(
    "VVV",
    init.options(
      hc.options = list(use = "SVD")
    )$hc.options$modelName
  )
  expect_equal(
    "SVD",
    init.options(
      hc.options = list(modelName = "VVV")
    )$hc.options$use
  )
})
test_that("test correct user input", {
  for (nm in seq_along(hc.options.names$modelName)) {
    expect_equal(
      hc.options.names$modelName[nm],
      init.options(
        hc.options =
          list(modelName = hc.options.names$modelName[nm])
      )$hc.options$modelName
    )
  }
  for (nm in seq_along(hc.options.names$use)) {
    expect_equal(
      hc.options.names$use[nm],
      init.options(
        hc.options =
          list(use = hc.options.names$use[nm])
      )$hc.options$use
    )
  }

  expect_equal(
    "VVV",
    init.options(
      hc.options = list("VVV", "SVD")
    )$hc.options$modelName
  )
  expect_equal(
    "VVV",
    init.options(
      hc.options = list("VVV")
    )$hc.options$modelName
  )
  expect_equal(
    "VVV",
    init.options(
      hc.options = list("SVD")
    )$hc.options$modelName
  )

  expect_equal(
    "SVD",
    init.options(
      hc.options = list("VVV", "SVD")
    )$hc.options$use
  )
  expect_equal(
    "SVD",
    init.options(
      hc.options = list("VVV")
    )$hc.options$use
  )
  expect_equal(
    "SVD",
    init.options(
      hc.options = list("SVD")
    )$hc.options$use
  )
})
test_that("test incorrect user input", {
  expect_error(init.options(hc.options = c("VVV", "SVD")))
  expect_error(init.options(hc.options = list(modelName = "a")))
  expect_error(init.options(hc.options = list(use = "a")))
  expect_error(init.options(hc.options = "VVV"))
  expect_error(init.options(hc.options = list(modelName = c("VVV", "EEE"))))
  expect_error(init.options(hc.options = list("VVV", "EEE", "SVD")))
})

# TODO: exp.init tests

context("test mix.method input")
test_that("test default input", {
  expect_equal("Gower kmeans", init.options()$mix.method)
})
test_that("test correct input", {
  mix.method.nms <- c("Gower kmeans", "Gower hclust", "kproto")
  for (nm in seq_along(mix.method.nms)) {
    expect_equal(
      mix.method.nms[nm],
      init.options(mix.method = mix.method.nms[nm])$mix.method
    )
  }
})
test_that("test incorrect input", {
  expect_error(init.options(mix.method = "a"))
  expect_error(init.options(mix.method = 1))
  expect_error(init.options(mix.method = c("Gower kmeans", "kproto")))
})

context("test user class")
test_that("test default input", {
  expect_equal(integer(0), init.options()$user.class)
})
test_that("test correct input", {
  set.seed(123)
  input.class <- rbinom(10, 3, .5)
  expect_equal(input.class + 1, init.options(
    init.method = "user",
    user.class = input.class
  )$user.class)
  expect_equal(
    as.integer(as.factor(c("a", "b", "c", "d"))),
    init.options(user.class = c("a", "b", "c", "d"))$user.class
  )
  expect_equal(
    as.integer(as.factor(c("a", "b", "c", "d"))),
    init.options(user.class = as.factor(c("a", "b", "c", "d")))$user.class
  )
  input.class <- c(2.1, 2.1, 2.1, 4.0, 4.0, 4.0, 5.3, 5.3)
  expect_equal(
    as.numeric(factor(input.class)),
    init.options(user.class = input.class)$user.class
  )
  # depends on implementation:
  # expect_message(init.options(user.class = input.class)$user.class)
})
test_that("test incorrect input", {
  expect_error(init.options(init.method = "user"))
})

context("test default")
test_that("test default", {
  expect_equal(
    c("init.method", "hcName", "hcUse", "mix.method"),
    init.options()$defaults
  )
})