tests/testthat/test-experiment-methods.R

In calmr: Canonical Associative Learning Models and their Representations

df <- get_design("relative_validity")

exper <- make_experiment(df,
  model = "RW1972",
  parameters = get_parameters(df, model = "RW1972")
)

test_that("parameters retrieves the parameters", {
  expect_named(parameters(exper))
})

test_that("parameters<- sets the parameters", {
  oldpars <- parameters(exper)[[1]]
  pars <- get_parameters(df, model = "RW1972")
  pars$betas_on["US"] <- 0.7
  parameters(exper) <- pars
  newpars <- parameters(exper)[[1]]
  expect_true(newpars$betas_on["US"] != oldpars$betas_on["US"])
})

test_that("parameters<- throws error with weird list", {
  expect_error(parameters(exper) <- list("asdf" = 1))
})

test_that("parameters<- throws error with partial list", {
  pars <- parameters(exper)
  pars[[1]] <- pars[[1]][-1]
  expect_error(parameters(exper) <- pars)
})

test_that("show method works", {
  expect_no_error(capture_message(show(exper)))
})

test_that("design method works", {
  expect_no_error(design(exper))
})

test_that("trials method works", {
  expect_no_error(trials(exper))
})

raw_exper <- run_experiment(exper, parse = FALSE, aggregate = FALSE)
parsed_exper <- parse(raw_exper)
agg_exper <- aggregate(parsed_exper)
test_that("results returns aggregated results", {
  expect_named(results(agg_exper))
})

test_that("results returns aggregated results", {
  expect_named(parsed_results(agg_exper)[[1]])
})

test_that("raw_results returns raw results", {
  expect_true(all(sapply(raw_results(agg_exper), lapply, class) == "array"))
})

test_that("aggregate method works does not work with raw experiments", {
  expect_error(aggregate(raw_exper))
})

test_that("parse method throws error without raw_results", {
  expect_error(parse(exper))
})

test_that("plot method throws error when missing aggregated results", {
  expect_error(plot(raw_exper, type = "vs"))
})

test_that("plot method warns when missing aggregated output", {
  pagg <- aggregate(parse(raw_exper), outputs = "rs")
  expect_warning(plot(pagg, type = "vs"))
})

test_that("graph method throws error when there are no agregated_results", {
  expect_error(graph(parse(raw_exper)))
})

test_that("parse method will return only some outputs", {
  expect_setequal(
    names(
      parsed_results(parse(raw_exper, outputs = "vs"))[[1]]
    ),
    c("vs")
  )
})

test_that("parse method is able to parse partially parsed experiments", {
  pparsed <- parse(raw_exper, outputs = "vs")
  expect_setequal(
    names(parsed_results(parse(pparsed, outputs = "rs"))[[1]]),
    c("vs", "rs")
  )
  # can skip parsing
  expect_setequal(
    names(parsed_results(parse(pparsed, outputs = "vs"))[[1]]),
    c("vs")
  )
})

test_that("parse method throws errors with bad outputs", {
  expect_error(
    parse(raw_exper, outputs = "os")
  )
})

test_that("aggregate method throws errors with bad outputs", {
  expect_error(
    aggregate(agg_exper, outputs = "os")
  )
})

test_that("aggregate method is able to agg partially parsed experiments", {
  pparsed <- parse(raw_exper, outputs = "vs")
  # can aggregate existing parsed_results
  expect_setequal("vs", names(results(aggregate(pparsed, outputs = "vs"))))
  # should aggregate nonexisting parsed results (would involve parallel woes)
  expect_error(aggregate(pparsed, outputs = "rs"))
  # uses output sanitization
  expect_warning(aggregate(pparsed, outputs = c("vs", "os")))
  # but can work in tandem from the beginning
  expect_setequal(
    "vs",
    names(results(run_experiment(exper, outputs = c("vs"))))
  )
})