From a30b189b23b74b53fb7d7eff8bafb146ff2c6ad6 Mon Sep 17 00:00:00 2001 From: Bai-Li-NOAA Date: Wed, 25 Sep 2024 12:18:33 -0400 Subject: [PATCH] test: update fimsfit snapshot with real fit output --- tests/testthat/_snaps/fimsfit.md | 14 ++--- .../testthat/helper-integration-tests-setup.R | 53 ++++++++++++------- tests/testthat/test-fimsfit.R | 45 +++++++--------- 3 files changed, 60 insertions(+), 52 deletions(-) diff --git a/tests/testthat/_snaps/fimsfit.md b/tests/testthat/_snaps/fimsfit.md index be8eb14a..2d0180d0 100644 --- a/tests/testthat/_snaps/fimsfit.md +++ b/tests/testthat/_snaps/fimsfit.md @@ -1,14 +1,14 @@ # print.fimsfit prints summary correctly Code - print.fimsfit(fit_obj) + print.fimsfit(fit_obj_fix_runtime) Message - i FIMS model version: "1.0" - i Total run time was 10 seconds + i FIMS model version: "Model Comparison Project example" + i Total run time was 0.607 seconds i Number of parameters: total=77, fixed_effects=77, and random_effects=0 - i Maximum gradient= 1e-04 + i Maximum gradient= 0.00248 i Negative log likelihood (NLL): - * Marginal NLL= 1498.433 - * Total NLL= 1498.33 - i Terminal SB= 10000 + * Marginal NLL= 1498.43281 + * Total NLL= 1498.43281 + i Terminal SB= 1514.67842 diff --git a/tests/testthat/helper-integration-tests-setup.R b/tests/testthat/helper-integration-tests-setup.R index 04c903e1..6f1ffef0 100644 --- a/tests/testthat/helper-integration-tests-setup.R +++ b/tests/testthat/helper-integration-tests-setup.R @@ -43,11 +43,11 @@ #' estimation_mode = TRUE #' ) setup_and_run_FIMS_without_wrappers <- function(iter_id, - om_input_list, - om_output_list, - em_input_list, - estimation_mode = TRUE, - map = list()) { + om_input_list, + om_output_list, + em_input_list, + estimation_mode = TRUE, + map = list()) { # Load operating model data for the current iteration om_input <- om_input_list[[iter_id]] om_output <- om_output_list[[iter_id]] @@ -208,7 +208,7 @@ setup_and_run_FIMS_without_wrappers <- function(iter_id, opt <- NULL if (estimation_mode == TRUE) { opt <- stats::nlminb(obj$par, obj$fn, obj$gr, - control = list(eval.max = 800, iter.max = 800) + control = list(eval.max = 800, iter.max = 800) ) } # Call report using MLE parameter values, or @@ -277,11 +277,12 @@ setup_and_run_FIMS_without_wrappers <- function(iter_id, #' estimation_mode = TRUE #' ) setup_and_run_FIMS_with_wrappers <- function(iter_id, - om_input_list, - om_output_list, - em_input_list, - estimation_mode = TRUE, - map = list()) { + om_input_list, + om_output_list, + em_input_list, + estimation_mode = TRUE, + map = list(), + return_fit = FALSE) { # Load operating model data for the current iteration om_input <- om_input_list[[iter_id]] om_output <- om_output_list[[iter_id]] @@ -435,17 +436,29 @@ setup_and_run_FIMS_with_wrappers <- function(iter_id, parameters <- list(p = get_fixed()) input <- list() input$parameters <- parameters - input$version = "Model Comparison Project example" + input$version <- "Model Comparison Project example" fit <- fit_fims(input, do.fit = estimation_mode) clear() # Return the results as a list - return(list( - parameters = fit$input$parameters, - obj = fit$obj, - opt = fit$opt, - report = fit$rep, - sdr_report = fit$sd - )) -} + if(return_fit){ + return(list( + parameters = fit$input$parameters, + obj = fit$obj, + opt = fit$opt, + report = fit$rep, + sdr_report = fit$sd, + fit = fit + )) + } else { + return(list( + parameters = fit$input$parameters, + obj = fit$obj, + opt = fit$opt, + report = fit$rep, + sdr_report = fit$sd, + fit = fit + )) + } +} diff --git a/tests/testthat/test-fimsfit.R b/tests/testthat/test-fimsfit.R index 9c6ec989..85df8953 100644 --- a/tests/testthat/test-fimsfit.R +++ b/tests/testthat/test-fimsfit.R @@ -1,6 +1,16 @@ +load(test_path("fixtures", "integration_test_data.RData")) +iter_id <- 1 +result <- setup_and_run_FIMS_with_wrappers( + iter_id = iter_id, + om_input_list = om_input_list, + om_output_list = om_output_list, + em_input_list = em_input_list, + estimation_mode = TRUE, + return_fit = TRUE +) +fit_obj <- result$fit + test_that("fimsfit creates an object of class 'fimsfit'", { - fit_obj <- list(version = "1.0", timing = list(time_total = 10), opt = list(num_pars = list(total = 10, fixed_effects = 5, random_effects = 5)), rep = list(ssb = 1), parList = list(), obj = NULL) - class(fit_obj) <- "list" result <- fimsfit(fit_obj) expect_s3_class(result, "fimsfit") @@ -13,46 +23,31 @@ test_that("fimsfit returns a warning for non-list input", { }) test_that("fimsfit stops for missing version", { - fit_obj <- list(timing = list(time_total = 10), opt = list(num_pars = list(total = 10, fixed_effects = 5, random_effects = 5)), rep = list(ssb = 1), parList = list(), obj = NULL) - class(fit_obj) <- "list" - expect_error(fimsfit(fit_obj), "No version found, something went wrong") + fit_obj_no_version <- fit_obj + fit_obj_no_version <- within(fit_obj_no_version, rm(version)) + expect_error(fimsfit(fit_obj_no_version), "No version found, something went wrong") }) test_that("is.fimsfit detects fimsfit objects correctly", { - fit_obj <- list(version = "1.0", timing = list(time_total = 10), opt = list(num_pars = list(total = 10, fixed_effects = 5, random_effects = 5)), rep = list(ssb = 1), parList = list(), obj = NULL) - class(fit_obj) <- c("fimsfit", "list") expect_true(is.fimsfit(fit_obj)) - expect_false(is.fimsfit(list(version = "1.0"))) + expect_false(is.fimsfit(list(version = "Model Comparison Project example"))) }) test_that("is.fimsfits detects lists of fimsfit objects correctly", { - fit_obj <- list(version = "1.0", timing = list(time_total = 10), opt = list(num_pars = list(total = 10, fixed_effects = 5, random_effects = 5)), rep = list(ssb = 1), parList = list(), obj = NULL) - class(fit_obj) <- c("fimsfit", "list") fit_list <- list(fit_obj, fit_obj) non_fit_list <- list(fit_obj, list(version = "1.0")) expect_true(is.fimsfits(fit_list)) expect_false(is.fimsfits(non_fit_list)) - expect_false(is.fimsfits("not_a_list")) + expect_warning(is.fimsfits("not_a_list")) }) test_that("print.fimsfit prints summary correctly", { - fit_obj <- list(version = "1.0", - timing = list(time_total = 10), - opt = list(num_pars = list(total = 77, - fixed_effects = 77, - random_effects = 0), - max_gradient = 0.0001, - objective = 1498.433), - rep = list(ssb = list(rep(10000, 5)), - jnll = 1498.33), - parList = list() - ) - class(fit_obj) <- c("fimsfit", "list") - + fit_obj_fix_runtime <- fit_obj + fit_obj_fix_runtime$timing$time_total <- 0.607 expect_snapshot( - print.fimsfit(fit_obj) + print.fimsfit(fit_obj_fix_runtime) ) })