tests/testthat/test-utils.R

In bmm: Easy and Accessible Bayesian Measurement Models Using 'brms'

test_that("init argument is overwritten if the user supplies it", {
  config_args <- list(formula = 'a', family = 'b', data = 'd', stanvars = 'e', init = 1)
  dots <- list(init = 2)
  out <- combine_args(nlist(config_args, dots))
  expect_equal(out, list(formula = 'a', family = 'b', data = 'd', stanvars = 'e', init = 2))
})

test_that("user cannot overwrite the custom family", {
  config_args <- list(formula = 'a', family = 'b', data = 'd', stanvars = 'e', init = 1)
  dots <- list(family = 'c')
  expect_error(combine_args(nlist(config_args, dots)), 'You cannot provide a family argument to bmm')
})

test_that("empty dots don't crash the function", {
  config_args <- list(formula = 'a', family = 'b', data = 'd', stanvars = 'e', init = 1)
  out <- combine_args(nlist(config_args))
  expect_equal(out, list(formula = 'a', family = 'b', data = 'd', stanvars = 'e', init = 1))
})


test_that("missing arguments in models are handled correctly", {
  expect_error(mixture2p(), "arguments are missing in mixture2p\\(\\)\\: resp_error")
  expect_error(sdm(), "arguments are missing in sdm\\(\\)\\: resp_error")
  expect_error(mixture3p('y'), "arguments are missing in mixture3p\\(\\)\\: nt_features, set_size")
  expect_error(mixture3p(set_size = 'y'), "arguments are missing in mixture3p\\(\\)\\: resp_error, nt_features")
})

test_that("get_variables works", {
  expect_equal(get_variables('a', c('a', 'b', 'c')), 'a')
  expect_equal(get_variables('a', c('a', 'b', 'c'), regex = TRUE), 'a')
  expect_equal(get_variables('a', c('a', 'b', 'c'), regex = FALSE), 'a')
  expect_equal(get_variables('a|b', c('a', 'b', 'c'), regex = TRUE), c('a', 'b'))
  expect_equal(get_variables('abc', c('abc1', 'abc2', 'abc3', 'other'), regex = TRUE),
               c('abc1', 'abc2', 'abc3'))
  expect_equal(get_variables('^abc', c('abc1', 'abc2', 'abc3', 'other_abc4'), regex = TRUE),
               c('abc1', 'abc2', 'abc3'))
  expect_equal(get_variables('abc$', c('nt1_abc', 'nt2_abc', 'nt3_abc', 'other_abc4'), regex = TRUE),
               c('nt1_abc', 'nt2_abc', 'nt3_abc'))
  expect_equal(get_variables('nt.*_abc', c('nt1_abc', 'nt2_abc', 'nt3_abc', 'other_abc4'), regex = TRUE),
               c('nt1_abc', 'nt2_abc', 'nt3_abc'))
  expect_equal(get_variables('a|b', c('a', 'b', 'c'), regex = FALSE), 'a|b')
  expect_error(get_variables('d', c('a', 'b', 'c'), regex = TRUE))
})

test_that("bmm_options works", {
  withr::defer(suppressMessages(bmm_options()))
  expect_message(bmm_options(), "Current bmm options")
  expect_message(bmm_options(sort_data = TRUE), "sort_data = TRUE")
  expect_equal(getOption('bmm.sort_data'), TRUE)
  op <- suppressMessages(bmm_options(sort_data = FALSE))
  expect_equal(getOption('bmm.sort_data'), FALSE)
  options(op)
  expect_equal(getOption('bmm.sort_data'), TRUE)
})


test_that("check_rds_file works", {
  good_files <- list('a.rds', 'abc/a.rds', 'a', 'abc/a', 'a.M')
  bad_files <- list(1, mean, c('a','b'), TRUE)

  for (f in good_files) {
    expect_silent(res <- check_rds_file(f))
    expect_equal(fs::path_ext(res), 'rds')
  }

  for (f in bad_files) {
    expect_error(check_rds_file(f))
  }

  expect_null(check_rds_file(NULL))
})

test_that("read_bmmfit works", {
  mock_fit <- bmm(bmf(c~1, kappa ~ 1), oberauer_lin_2017, sdm('dev_rad'),
                  backend = "mock", mock_fit = 1, rename = F)
  file <- tempfile()
  mock_fit$file <- paste0(file, '.rds')
  saveRDS(mock_fit, paste0(file, '.rds'))
  expect_equal(read_bmmfit(file, FALSE), mock_fit, ignore_function_env = TRUE,
               ignore_formula_env = TRUE)

  x = 1
  saveRDS(x, paste0(file, '.rds'))
  expect_error(read_bmmfit(file, FALSE), "not of class 'bmmfit'")
})

test_that("save_bmmfit works", {
  file <- tempfile()
  mock_fit <- bmm(bmf(c~1, kappa ~ 1), oberauer_lin_2017, sdm('dev_rad'),
                  backend = "mock", mock_fit = 1, rename = F,
                  file = file)
  rds_file <- paste0(file, '.rds')
  expect_true(file.exists(rds_file))
  expect_equal(readRDS(rds_file), mock_fit, ignore_function_env = TRUE,
               ignore_formula_env = TRUE)

  mock_fit2 <- bmm(bmf(c~1, kappa ~ 1), oberauer_lin_2017, sdm('dev_rad'),
                  backend = "mock", mock_fit = 2, rename = F,
                  file = file)
  expect_equal(mock_fit, mock_fit2)

  # they should not be the same if file_refit = TRUE
  mock_fit3 <- bmm(bmf(c~1, kappa ~ 1), oberauer_lin_2017, sdm('dev_rad'),
                  backend = "mock", mock_fit = 3, rename = F,
                  file = file, file_refit = TRUE)
  expect_error(expect_equal(mock_fit, mock_fit3))
})