diff --git a/R/check_inputs.R b/R/check_inputs.R index 5699477..a218ddd 100644 --- a/R/check_inputs.R +++ b/R/check_inputs.R @@ -14,4 +14,32 @@ 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.") } -} \ No newline at end of file + check_parameters_matching(model, parameters) +} + +check_parameters_matching <- function(model, parameters) { + 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/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 +) diff --git a/tests/testthat/test-check_inputs.R b/tests/testthat/test-check_inputs.R index adf5d1d..995a0fa 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,5 +232,39 @@ 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")) -}) \ 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") <- 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) + 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. Missing: V" + ) + + 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." + ) +}) + +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" + ) +}) diff --git a/tests/testthat/test-get_map_estimates.R b/tests/testthat/test-get_map_estimates.R index 60d1857..ac3a717 100644 --- a/tests/testthat/test-get_map_estimates.R +++ b/tests/testthat/test-get_map_estimates.R @@ -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,