tests/testthat/test-jaatha-log.R

In jaatha: Simulation-Based Maximum Likelihood Parameter Estimation

context("Logging")

test_that("log initialization works", {
  model <- create_test_model()
  log <- create_jaatha_log(model, NULL, 2, 100)
  expect_equivalent(log$get_estimates(1), 
                    data.frame(rep(NA, 100), NA, NA, NA, NA))
  expect_equivalent(log$get_estimates(2), 
                    data.frame(rep(NA, 100), NA, NA, NA, NA))
})


test_that("logging estimates works", {
  model <- create_test_model()
  log <- create_jaatha_log(model, NULL, 2, 100)
  
  estimate <- list(par = 1:model$get_par_number(), value = 0.1)
  log$log_estimate(1, 1, estimate)

  expect_equivalent(log$get_estimates(1)[1, ], 
                    data.frame(1, 1, estimate$value, 1, 2))
  
  estimate$value <- 0.2
  log$log_estimate(1, 2, estimate)
  expect_equivalent(log$get_estimates(1)[2, ], 
                    data.frame(1, 2, estimate$value, 1, 2))
  
  log$log_estimate(2, 1, estimate)
  expect_equivalent(log$get_estimates(2)[1, ], 
                    data.frame(2, 1, estimate$value, 1, 2))
})


test_that("getting best estimates works", {
  model <- create_test_model()
  log <- create_jaatha_log(model, NULL, 2, 100)
  for (i in c(4, 3, 1, 5, 10, 2, 7, 9, 8) / 10) {
    log$log_estimate(1, i * 10, list(par = rep(i, model$get_par_number()), 
                                     value = i))
  }
  
  for (i in 11:20 / 10) {
    log$log_estimate(2, i * 10, list(par = rep(i, model$get_par_number()), 
                                     value = -i))
  }
  
  expect_equivalent(log$get_best_estimates(1),
                    data.frame(rep = c(1, 2),
                               step = c(10, 11),
                               llh = c(1.0, -1.1),
                               p1 = c(1.0, 1.1),
                               p2 = c(1.0, 1.1)))
  
  expect_equivalent(log$get_best_estimates(2),
                    data.frame(rep = c(1, 1, 2, 2),
                               step = c(10, 9, 11, 12),
                               llh = c(1.0, 0.9, -1.1, -1.2),
                               p1 = c(1.0, 0.9, 1.1, 1.2),
                               p2 = c(1.0, 0.9, 1.1, 1.2)))
  
  # Final
  for (i in c(4, 3, 1, 5, 10, 2, 7, 9, 8) / 10) {
    log$log_estimate("final", i * 10, list(par = rep(i, model$get_par_number()),
                                           value = -i))
  }
  
  expect_equivalent(log$get_best_estimates(2, final = TRUE),
                    data.frame(rep = c(0, 0),
                               step = c(1, 2),
                               llh = c(-0.1, -0.2),
                               p1 = c(0.1, 0.2),
                               p2 = c(0.1, 0.2)))
})


test_that("it creates the results correctly", {
  model <- create_test_model()
  log <- create_jaatha_log(model, NULL, 2, 123)
  log$log_estimate("final", 1, list(par = rep(.1, model$get_par_number()),
                                    value = -1))
  log$log_estimate("final", 2, list(par = rep(.2, model$get_par_number()),
                                    value = -2))
  
  results <- log$create_results()
  expect_true(is_jaatha_result(results))
  expect_output(print(results), "p1")
  expect_equivalent(results$estimate, 
                    model$get_par_ranges()$denormalize(c(.1, .1)))
  expect_equal(results$loglikelihood, -1)
  expect_equal(results$converged, FALSE)
  expect_is(results$args, "list")
  
  log$log_convergence(1)
  expect_equal(log$create_results()$converged, FALSE)
  log$log_convergence(2)
  expect_equal(log$create_results()$converged, TRUE)
})


test_that("the output can be suppressed", {
  model <- create_test_model()
  log <- create_jaatha_log(model, NULL, 2, 123, verbose = FALSE)
  expect_message(log$log_convergence(1), NA)
  expect_message(log$log_initialization("test"), NA)
  expect_message(log$log_new_rep(1, c(.5, .5)), NA)
  expect_message(
    log$log_estimate("final", 1, list(par = rep(.1, model$get_par_number()),
                                      value = -1)),
    NA
  )
  
  model <- create_test_model()
  log <- create_jaatha_log(model, NULL, 2, 123, verbose = TRUE)
  expect_message(log$log_convergence(1))
  expect_message(log$log_initialization("test"))
  expect_message(log$log_new_rep(1, c(.5, .5)))
  expect_message(
    log$log_estimate("final", 1, list(par = rep(.1, model$get_par_number()),
                                      value = -1))
  )
})