From dc8635b067d4b93c56e8f69e9d5358544bd08860 Mon Sep 17 00:00:00 2001 From: Ben Bolker Date: Fri, 27 Jun 2025 09:04:50 -0400 Subject: [PATCH 1/6] add test/error msg for missing time, matrix cols --- R/mp_tmb_calibrator.R | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/R/mp_tmb_calibrator.R b/R/mp_tmb_calibrator.R index c76a471f..241a8240 100644 --- a/R/mp_tmb_calibrator.R +++ b/R/mp_tmb_calibrator.R @@ -471,19 +471,28 @@ TMBCalDataStruc = function(data, time) { } FALSE } - + + syns <- list(time = c("time", "Time", "ID", "time_id", "id", + "date", "Date", + "time_step", "timeStep", "TimeStep"), + matrix = c("matrix", "Matrix", "mat", "Mat", + "variable", "var", "Variable", "Var")) data = rename_synonyms(data - , time = c( - "time", "Time", "ID", "time_id", "id", "date", "Date" - , "time_step", "timeStep", "TimeStep" - ) - , matrix = c( - "matrix", "Matrix", "mat", "Mat", "variable", "var", "Variable", "Var" - ) + , time = syns$time + , matrix = syns$matrix , row = c("row", "Row") , col = c("col", "Col", "column", "Column") , value = c("value", "Value", "val", "Val", "default", "Default") ) + for (m in names(syns)) { + if (is.null(data[[m]])) { + stop( + "Supplied data did not contain a column called '", m, "' ", + "(or its synonyms: ", + paste(sprintf("'%s'", syns[[m]]), collapse = ", "), ")" + ) + } + } time_column_test_value = data$time if (is.character(data$time)) { original_coercer = as.character From b38e8f9e3956960e8c211b449ca654bb200560b4 Mon Sep 17 00:00:00 2001 From: Ben Bolker Date: Fri, 27 Jun 2025 09:07:40 -0400 Subject: [PATCH 2/6] add test/error msg for row, col, value --- R/mp_tmb_calibrator.R | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/R/mp_tmb_calibrator.R b/R/mp_tmb_calibrator.R index 241a8240..3d395ec0 100644 --- a/R/mp_tmb_calibrator.R +++ b/R/mp_tmb_calibrator.R @@ -476,14 +476,11 @@ TMBCalDataStruc = function(data, time) { "date", "Date", "time_step", "timeStep", "TimeStep"), matrix = c("matrix", "Matrix", "mat", "Mat", - "variable", "var", "Variable", "Var")) - data = rename_synonyms(data - , time = syns$time - , matrix = syns$matrix - , row = c("row", "Row") - , col = c("col", "Col", "column", "Column") - , value = c("value", "Value", "val", "Val", "default", "Default") - ) + "variable", "var", "Variable", "Var"), + row = c("row", "Row"), + col = c("col", "Col", "column", "Column"), + value = c("value", "Value", "val", "Val", "default", "Default")) + data = do.call(rename_synonyms, c(list(data), syns)) for (m in names(syns)) { if (is.null(data[[m]])) { stop( From 1e2380a9e430f2fea83d3cc2ace0d319becc979c Mon Sep 17 00:00:00 2001 From: Ben Bolker Date: Fri, 27 Jun 2025 09:23:05 -0400 Subject: [PATCH 3/6] don't check calibrator data for rows/cols --- R/mp_tmb_calibrator.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/mp_tmb_calibrator.R b/R/mp_tmb_calibrator.R index 3d395ec0..5749ed63 100644 --- a/R/mp_tmb_calibrator.R +++ b/R/mp_tmb_calibrator.R @@ -481,7 +481,9 @@ TMBCalDataStruc = function(data, time) { col = c("col", "Col", "column", "Column"), value = c("value", "Value", "val", "Val", "default", "Default")) data = do.call(rename_synonyms, c(list(data), syns)) - for (m in names(syns)) { + + ## check presence (row/col not required?) + for (m in setdiff(names(syns), c("row", "col"))) { if (is.null(data[[m]])) { stop( "Supplied data did not contain a column called '", m, "' ", From 9583ce7ef078a88bd8c4d635810b869423b93e2d Mon Sep 17 00:00:00 2001 From: stevencarlislewalker Date: Mon, 30 Jun 2025 12:09:30 -0400 Subject: [PATCH 4/6] in progress --- R/mp_tmb_calibrator.R | 16 +++++++++++++++- tests/testthat/setup.R | 1 + tests/testthat/test-calibrator-traj.R | 18 ++++++++++++++++++ 3 files changed, 34 insertions(+), 1 deletion(-) diff --git a/R/mp_tmb_calibrator.R b/R/mp_tmb_calibrator.R index 5749ed63..331f3cbd 100644 --- a/R/mp_tmb_calibrator.R +++ b/R/mp_tmb_calibrator.R @@ -1261,9 +1261,23 @@ TMBTraj.character = function( ## Depended upon to create a character vector of output variables to fit to self$outputs = function() names(self$list) + # ff = function(dat) { + # xx = split(dat, dat$row) + # time_ids = lapply(xx, getElement, "time_ids") + # row = lapply(xx, getElement, "row") |> lapply(unique) + # if (!all(vapply(row, length, integer(1L)) == 1L)) { + # stop("Ca") + # } + # if (any()) + # list(time_ids, row) + # } + ## implemented methods self$obs = function() lapply(self$list, getElement, "value") - self$obs_times = function() lapply(self$list, getElement, "time_ids") + self$obs_times = function() { + #split(traj$list$infection, traj$list$infection$row) + lapply(self$list, getElement, "time_ids") + } self$distr_params = function() { switch( getOption("macpan2_default_loss")[1L] diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index d9de5a94..bdaa2fca 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -24,6 +24,7 @@ sims = list( , sir_10_I = mp_simulator(all_specs$sir, 10L, "I") , sir_50_infection = mp_simulator(all_specs$sir, 50L, "infection") , sir_50_I = mp_simulator(all_specs$sir, 50L, "I") + , sir_age_10_infection = mp_simulator(all_specs$sir_age, 10L, "infection") ) for (obj in names(sims)) { diff --git a/tests/testthat/test-calibrator-traj.R b/tests/testthat/test-calibrator-traj.R index c4477528..75de214b 100644 --- a/tests/testthat/test-calibrator-traj.R +++ b/tests/testthat/test-calibrator-traj.R @@ -1,4 +1,5 @@ library(macpan2); library(testthat); library(dplyr); library(tidyr); library(ggplot2) +source("tests/testthat/setup.R") test_that("bad outputs give warnings", { sir = mp_tmb_library("starter_models", "sir", package = "macpan2") expect_warning( @@ -60,3 +61,20 @@ test_that("trajectories specified with likelihood distributions end up in calibr ) }) + +sir = "SPEC-sir.rds" |> test_cache_read() +sir_sims = "TRAJ-sir_5_state.rds" |> test_cache_read() +err = "Supplied data did not contain a column called" +expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -time)), err) +expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -matrix)), err) +expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -value)), err) +sir_age = "SPEC-sir_age.rds" |> test_cache_read() +sir_age_sims = "TRAJ-sir_age_10_infection.rds" |> test_cache_read() +sir_age_cal = mp_tmb_calibrator(sir_age + , data = sir_age_sims + , par = "tau" + , traj = "infection" + , outputs = "sim_infection" +) +sir_age_cal$cal_spec |> mp_simulator(10, "infection") |> mp_trajectory() +sir_age_cal$cal_spec |> mp_simulator(10, "sim_infection") |> mp_final() From 81396002dbe71c45d9f61a9f58bc92679e4d7fcb Mon Sep 17 00:00:00 2001 From: stevencarlislewalker Date: Fri, 4 Jul 2025 06:41:39 -0400 Subject: [PATCH 5/6] fix tests --- tests/testthat/test-calibrator-traj.R | 43 ++++++++++++++++----------- 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/tests/testthat/test-calibrator-traj.R b/tests/testthat/test-calibrator-traj.R index 75de214b..3817086e 100644 --- a/tests/testthat/test-calibrator-traj.R +++ b/tests/testthat/test-calibrator-traj.R @@ -1,5 +1,3 @@ -library(macpan2); library(testthat); library(dplyr); library(tidyr); library(ggplot2) -source("tests/testthat/setup.R") test_that("bad outputs give warnings", { sir = mp_tmb_library("starter_models", "sir", package = "macpan2") expect_warning( @@ -62,19 +60,28 @@ test_that("trajectories specified with likelihood distributions end up in calibr }) -sir = "SPEC-sir.rds" |> test_cache_read() -sir_sims = "TRAJ-sir_5_state.rds" |> test_cache_read() -err = "Supplied data did not contain a column called" -expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -time)), err) -expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -matrix)), err) -expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -value)), err) -sir_age = "SPEC-sir_age.rds" |> test_cache_read() -sir_age_sims = "TRAJ-sir_age_10_infection.rds" |> test_cache_read() -sir_age_cal = mp_tmb_calibrator(sir_age - , data = sir_age_sims - , par = "tau" - , traj = "infection" - , outputs = "sim_infection" -) -sir_age_cal$cal_spec |> mp_simulator(10, "infection") |> mp_trajectory() -sir_age_cal$cal_spec |> mp_simulator(10, "sim_infection") |> mp_final() +test_that("missing required columns in calibration data throw errors", { + sir = "SPEC-sir.rds" |> test_cache_read() + sir_sims = "TRAJ-sir_5_state.rds" |> test_cache_read() + err = "Supplied data did not contain a column called" + expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -time)), err) + expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -matrix)), err) + expect_error(mp_tmb_calibrator(sir, data = select(sir_sims, -value)), err) +}) + +test_that("vector-valued trajectories can be calibrated to", { + skip("Skipping because rbind_time is not working on non-scalars") + sir_age = "SPEC-sir_age.rds" |> test_cache_read() + sir_age_sims = "TRAJ-sir_age_10_infection.rds" |> test_cache_read() + sir_age_cal = mp_tmb_calibrator(sir_age + , data = sir_age_sims + , par = "tau" + , traj = "infection" + , outputs = "sim_infection" + ) + sir_age_cal + expect_equal( + sir_age_cal$cal_spec |> mp_simulator(10, "infection") |> mp_trajectory() |> pull(value) + , sir_age_cal$cal_spec |> mp_simulator(10, "sim_infection") |> mp_final() |> pull(value) + ) +}) From fe2e15ba642d99caf744a8f55a5ca6c663493fc4 Mon Sep 17 00:00:00 2001 From: stevencarlislewalker Date: Wed, 9 Jul 2025 15:03:07 -0400 Subject: [PATCH 6/6] version bump --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b741282d..c81decd0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: macpan2 Title: Fast and Flexible Compartmental Modelling -Version: 3.0.0 +Version: 3.1.0 Authors@R: c( person("Steve Walker", email="swalk@mcmaster.ca", role=c("cre", "aut")), person("Weiguang Guan", role="aut"),