From 0d26ff4cb44c2f68927457a797db7c1584f05f91 Mon Sep 17 00:00:00 2001 From: Ron Keizer Date: Fri, 19 Sep 2025 14:26:10 -0700 Subject: [PATCH 1/5] add input check --- R/check_inputs.R | 9 +++++++++ tests/testthat/setup.R | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/R/check_inputs.R b/R/check_inputs.R index 5699477..dfa9049 100644 --- a/R/check_inputs.R +++ b/R/check_inputs.R @@ -14,4 +14,13 @@ check_inputs <- function(model, data, parameters, omega, regimen, censoring, typ if(!("function" %in% class(model))) { stop("The 'model' argument requires a function, e.g. a model defined using the new_ode_model() function from the PKPDsim package.") } + if(!is.null(parameters)) { + defined_parameters <- names(attr(model, "parameters")) + if(! all(defined_parameters %in% names(parameters))) { + stop("One or more required parameters for the model have not been specified.") + } + if(any(names(parameters) %in% defined_parameters)) { + warning("One or more of the provided `parameters` are not supported by the model and will be ignored. Passing unknown parameters may affect IIV and IOV structure and result in erroneous output.") + } + } } \ No newline at end of file diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 3fbef06..7a270e7 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -7,4 +7,4 @@ mod_1cmt_oral_lagtime <- PKPDsim::new_ode_model( obs = list(cmt = 2, scale = "V"), dose = list(cmt = 1, bioav = 1), parameters = list(CL = 5, V = 50, KA = 0.5, TLAG = 0.83) -) \ No newline at end of file +) From 7a8ea68c758532d49560a20913324359185401ad Mon Sep 17 00:00:00 2001 From: Ron Keizer Date: Fri, 19 Sep 2025 14:32:19 -0700 Subject: [PATCH 2/5] add test --- R/check_inputs.R | 20 +++++++++++--------- tests/testthat/test-check_inputs.R | 22 +++++++++++++++++++++- 2 files changed, 32 insertions(+), 10 deletions(-) diff --git a/R/check_inputs.R b/R/check_inputs.R index dfa9049..c7b1559 100644 --- a/R/check_inputs.R +++ b/R/check_inputs.R @@ -14,13 +14,15 @@ check_inputs <- function(model, data, parameters, omega, regimen, censoring, typ if(!("function" %in% class(model))) { stop("The 'model' argument requires a function, e.g. a model defined using the new_ode_model() function from the PKPDsim package.") } - if(!is.null(parameters)) { - defined_parameters <- names(attr(model, "parameters")) - if(! all(defined_parameters %in% names(parameters))) { - stop("One or more required parameters for the model have not been specified.") - } - if(any(names(parameters) %in% defined_parameters)) { - warning("One or more of the provided `parameters` are not supported by the model and will be ignored. Passing unknown parameters may affect IIV and IOV structure and result in erroneous output.") - } + check_parameters_matching(model, parameters) +} + +check_parameters_matching <- function(model, parameters) { + defined_parameters <- names(attr(model, "parameters")) + if(! all(defined_parameters %in% names(parameters))) { + stop("One or more required parameters for the model have not been specified.") + } + if(any(names(parameters) %in% defined_parameters)) { + warning("One or more of the provided `parameters` are not supported by the model and will be ignored. Passing unknown parameters may affect IIV and IOV structure and result in erroneous output.") } -} \ No newline at end of file +} diff --git a/tests/testthat/test-check_inputs.R b/tests/testthat/test-check_inputs.R index adf5d1d..c81d6c5 100644 --- a/tests/testthat/test-check_inputs.R +++ b/tests/testthat/test-check_inputs.R @@ -217,4 +217,24 @@ test_that("check_inputs works with different function types", { # Test with named function test_model <- function() {} expect_no_error(check_inputs(test_model, data, parameters, omega, regimen, NULL, "MAP")) -}) \ No newline at end of file +}) + +test_that("check_inputs fails when not all parameters are passed, and warning when too many are passed", { + model <- function() {} + attr(model, "parameters") <- list(CL = 5, V = 10) + data <- data.frame(time = 1:3, dv = c(1, 2, 3)) + parameters <- list(CL = 1) # , V = 10) + omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) + regimen <- list(dose = 100, interval = 12) + + # Should not throw any errors with NULL censoring + expect_error( + check_inputs(model, data, parameters, omega, regimen, NULL, "MAP"), + "One or more required parameters for the model have not been specified" + ) + + parameters <- list(CL = 1, V = 10, V2 = 15) + expect_warning( + check_inputs(model, data, parameters, omega, regimen, NULL, "MAP"), + ) +}) From 52358f1b0fd6c8626a608b643df3b302cfbb9f3e Mon Sep 17 00:00:00 2001 From: Ron Keizer Date: Mon, 22 Sep 2025 13:40:29 -0700 Subject: [PATCH 3/5] fix implementation + tests --- R/check_inputs.R | 29 ++++++++++++++++++----- tests/testthat/test-check_inputs.R | 24 ++++++++++++++++--- tests/testthat/test-get_map_estimates.R | 31 +++++-------------------- 3 files changed, 50 insertions(+), 34 deletions(-) diff --git a/R/check_inputs.R b/R/check_inputs.R index c7b1559..a218ddd 100644 --- a/R/check_inputs.R +++ b/R/check_inputs.R @@ -18,11 +18,28 @@ check_inputs <- function(model, data, parameters, omega, regimen, censoring, typ } check_parameters_matching <- function(model, parameters) { - defined_parameters <- names(attr(model, "parameters")) - if(! all(defined_parameters %in% names(parameters))) { - stop("One or more required parameters for the model have not been specified.") - } - if(any(names(parameters) %in% defined_parameters)) { - warning("One or more of the provided `parameters` are not supported by the model and will be ignored. Passing unknown parameters may affect IIV and IOV structure and result in erroneous output.") + defined_parameters <- attr(model, "parameters") + if(is.null(defined_parameters)) { + warning("Parameter information for model missing, cannot perform parameter consistency check. Please check PKPDsim model definition.") + } else { + if(! all(defined_parameters %in% names(parameters))) { + missing_pars <- defined_parameters[! defined_parameters %in% names(parameters)] + stop( + paste0( + "One or more required parameters for the model have not been specified. Missing: ", + paste0(missing_pars, collapse = ", ") + ) + ) + } + if(any(!(names(parameters) %in% defined_parameters))) { + ignored_pars <- names(parameters)[! names(parameters) %in% defined_parameters] + warning( + paste0( + "Some supplied `parameters` are not supported by the model and will be ignored: ", + paste0(ignored_pars, collapse = ", "), + ". Passing unknown parameters may affect IIV and IOV structure and result in erroneous output." + ) + ) + } } } diff --git a/tests/testthat/test-check_inputs.R b/tests/testthat/test-check_inputs.R index c81d6c5..cf6d66e 100644 --- a/tests/testthat/test-check_inputs.R +++ b/tests/testthat/test-check_inputs.R @@ -1,6 +1,7 @@ test_that("check_inputs passes with valid MAP inputs", { # Create mock objects model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -13,6 +14,7 @@ test_that("check_inputs passes with valid MAP inputs", { test_that("check_inputs passes with valid PLS inputs", { # Create mock objects model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -25,6 +27,7 @@ test_that("check_inputs passes with valid PLS inputs", { test_that("check_inputs passes with valid pls inputs (lowercase)", { # Create mock objects model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -37,6 +40,7 @@ test_that("check_inputs passes with valid pls inputs (lowercase)", { test_that("check_inputs passes with valid MAP inputs (lowercase)", { # Create mock objects model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -49,6 +53,7 @@ test_that("check_inputs passes with valid MAP inputs (lowercase)", { test_that("check_inputs passes with valid censoring argument", { # Create mock objects model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -61,6 +66,7 @@ test_that("check_inputs passes with valid censoring argument", { test_that("check_inputs passes with other type values", { # Create mock objects model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -84,6 +90,7 @@ test_that("check_inputs fails when model is NULL for MAP type", { test_that("check_inputs fails when data is NULL for MAP type", { model <- function() {} + attr(model, "parameters") <- c("CL", "V") parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) regimen <- list(dose = 100, interval = 12) @@ -96,6 +103,7 @@ test_that("check_inputs fails when data is NULL for MAP type", { test_that("check_inputs fails when parameters is NULL for MAP type", { model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) regimen <- list(dose = 100, interval = 12) @@ -108,6 +116,7 @@ test_that("check_inputs fails when parameters is NULL for MAP type", { test_that("check_inputs fails when omega is NULL for MAP type", { model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) regimen <- list(dose = 100, interval = 12) @@ -120,6 +129,7 @@ test_that("check_inputs fails when omega is NULL for MAP type", { test_that("check_inputs fails when regimen is NULL for MAP type", { model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -132,6 +142,7 @@ test_that("check_inputs fails when regimen is NULL for MAP type", { test_that("check_inputs fails when model is not a function", { model <- "not_a_function" + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -145,6 +156,7 @@ test_that("check_inputs fails when model is not a function", { test_that("check_inputs fails when model is a list (not a function)", { model <- list(not_a_function = TRUE) + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -158,6 +170,7 @@ test_that("check_inputs fails when model is a list (not a function)", { test_that("check_inputs fails when censoring is not NULL and not character", { model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -184,6 +197,7 @@ test_that("check_inputs fails when censoring is not NULL and not character", { test_that("check_inputs allows NULL censoring", { model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -195,6 +209,7 @@ test_that("check_inputs allows NULL censoring", { test_that("check_inputs allows character censoring", { model <- function() {} + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -207,6 +222,7 @@ test_that("check_inputs allows character censoring", { test_that("check_inputs works with different function types", { # Test with anonymous function model <- function(x) x + 1 + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1, V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -216,12 +232,13 @@ test_that("check_inputs works with different function types", { # Test with named function test_model <- function() {} + attr(test_model, "parameters") <- c("CL", "V") expect_no_error(check_inputs(test_model, data, parameters, omega, regimen, NULL, "MAP")) }) test_that("check_inputs fails when not all parameters are passed, and warning when too many are passed", { model <- function() {} - attr(model, "parameters") <- list(CL = 5, V = 10) + attr(model, "parameters") <- c("CL", "V") data <- data.frame(time = 1:3, dv = c(1, 2, 3)) parameters <- list(CL = 1) # , V = 10) omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) @@ -230,11 +247,12 @@ test_that("check_inputs fails when not all parameters are passed, and warning wh # Should not throw any errors with NULL censoring expect_error( check_inputs(model, data, parameters, omega, regimen, NULL, "MAP"), - "One or more required parameters for the model have not been specified" + "One or more required parameters for the model have not been specified. Missing: V" ) - parameters <- list(CL = 1, V = 10, V2 = 15) + parameters <- list(CL = 1, V = 10, V2 = 15, Q = 23) expect_warning( check_inputs(model, data, parameters, omega, regimen, NULL, "MAP"), + "Some supplied `parameters` are not supported by the model and will be ignored: V2, Q." ) }) diff --git a/tests/testthat/test-get_map_estimates.R b/tests/testthat/test-get_map_estimates.R index 60d1857..57e7f24 100644 --- a/tests/testthat/test-get_map_estimates.R +++ b/tests/testthat/test-get_map_estimates.R @@ -1,4 +1,4 @@ -mod <- PKPDsim::new_ode_model("pk_1cmt_iv") +mod <- PKPDsim::new_ode_model("pk_1cmt_iv", parameters = c("CL", "V")) test_that("Default MAP fits work and are equal to NONMEM", { ## Basic precision and accuracy of MAP estimation (compared to NONMEM) @@ -210,6 +210,7 @@ test_that("Default MAP fits work and are equal to NONMEM", { }) test_that("allow_obs_before_first_dose works", { + mod_tdminit <- PKPDsim::new_ode_model("pk_1cmt_iv", parameters = c("CL", "V", "TDM_INIT")) data <- data.frame( t = c(-0.45, 35.55), y = c(21.7, 17.8), @@ -226,34 +227,15 @@ test_that("allow_obs_before_first_dose works", { list( CL = 4.5, V = 58.4, - V2 = 38.4, - Q = 6.5, - TH_CRCL = 0.8, - TH_DIAL_CL = 0.7, - TH_DIAL_V = 0.5, TDM_INIT = 21.7 ), units = list( CL = "L/hr", - V = "L/70kg", - Q = "L/hr", - V2 = "L", - CLi = "L/hr", - Vi = "L", - Qi = "L/hr", - V2i = "L" + V = "L/70kg" ) ) - covariates <- list( - WT = PKPDsim::new_covariate(value = 67.5, unit = "kg"), - SEX = PKPDsim::new_covariate(value = 0), - AGE = PKPDsim::new_covariate(value = 55.7, unit = "years"), - CR = PKPDsim::new_covariate(value = c(0.67, 0.65), times = c(0, 23.3), unit = "mg_dl"), - DIAL = PKPDsim::new_covariate(value = 0), - CL_HEMO = PKPDsim::new_covariate(value = 0) - ) - fixed <- c("Q", "TH_CRCL", "TH_DIAL_CL", "TH_DIAL_V", "TDM_INIT") - omega <- c(0.1584, 0, 0.6659, 0, 0, 0.326) + fixed <- c("TDM_INIT") + omega <- c(0.1584, 0, 0.6659) error <- list(prop = 0.227, add = 3.4) regimen <- structure( list( @@ -274,10 +256,9 @@ test_that("allow_obs_before_first_dose works", { expect_error( get_map_estimates( - model = mod, + model = mod_tdminit, data = data, parameters = parameters, - covariates = covariates, fixed = fixed, as_eta = NULL, omega = omega, From f4dce328f24cb0e0e4649a2b8f9085722ac93087 Mon Sep 17 00:00:00 2001 From: Ron Keizer Date: Mon, 22 Sep 2025 13:41:23 -0700 Subject: [PATCH 4/5] rollback unnecessary change --- tests/testthat/test-get_map_estimates.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-get_map_estimates.R b/tests/testthat/test-get_map_estimates.R index 57e7f24..ac3a717 100644 --- a/tests/testthat/test-get_map_estimates.R +++ b/tests/testthat/test-get_map_estimates.R @@ -1,4 +1,4 @@ -mod <- PKPDsim::new_ode_model("pk_1cmt_iv", parameters = c("CL", "V")) +mod <- PKPDsim::new_ode_model("pk_1cmt_iv") test_that("Default MAP fits work and are equal to NONMEM", { ## Basic precision and accuracy of MAP estimation (compared to NONMEM) From 18baff5ebdcc168c10e73b087f2d7c71c7bd45f1 Mon Sep 17 00:00:00 2001 From: Ron Keizer Date: Mon, 22 Sep 2025 21:47:03 -0700 Subject: [PATCH 5/5] add test --- tests/testthat/test-check_inputs.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/testthat/test-check_inputs.R b/tests/testthat/test-check_inputs.R index cf6d66e..995a0fa 100644 --- a/tests/testthat/test-check_inputs.R +++ b/tests/testthat/test-check_inputs.R @@ -256,3 +256,15 @@ test_that("check_inputs fails when not all parameters are passed, and warning wh "Some supplied `parameters` are not supported by the model and will be ignored: V2, Q." ) }) + +test_that("check_inputs warns when no parameters are defined as model attribute", { + model <- function() {} + data <- data.frame(time = 1:3, dv = c(1, 2, 3)) + parameters <- list(CL = 1) # , V = 10) + omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2) + regimen <- list(dose = 100, interval = 12) + expect_warning( + check_inputs(model, data, parameters, omega, regimen, NULL, "MAP"), + "Parameter information for model missing" + ) +})