Skip to content

Commit 52358f1

Browse files
roninsightrxroninsightrx
committed
fix implementation + tests
1 parent 7a8ea68 commit 52358f1

3 files changed

Lines changed: 50 additions & 34 deletions

File tree

‎R/check_inputs.R‎

Lines changed: 23 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -18,11 +18,28 @@ check_inputs <- function(model, data, parameters, omega, regimen, censoring, typ
1818
}
1919

2020
check_parameters_matching <- function(model, parameters) {
21-
defined_parameters <- names(attr(model, "parameters"))
22-
if(! all(defined_parameters %in% names(parameters))) {
23-
stop("One or more required parameters for the model have not been specified.")
24-
}
25-
if(any(names(parameters) %in% defined_parameters)) {
26-
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.")
21+
defined_parameters <- attr(model, "parameters")
22+
if(is.null(defined_parameters)) {
23+
warning("Parameter information for model missing, cannot perform parameter consistency check. Please check PKPDsim model definition.")
24+
} else {
25+
if(! all(defined_parameters %in% names(parameters))) {
26+
missing_pars <- defined_parameters[! defined_parameters %in% names(parameters)]
27+
stop(
28+
paste0(
29+
"One or more required parameters for the model have not been specified. Missing: ",
30+
paste0(missing_pars, collapse = ", ")
31+
)
32+
)
33+
}
34+
if(any(!(names(parameters) %in% defined_parameters))) {
35+
ignored_pars <- names(parameters)[! names(parameters) %in% defined_parameters]
36+
warning(
37+
paste0(
38+
"Some supplied `parameters` are not supported by the model and will be ignored: ",
39+
paste0(ignored_pars, collapse = ", "),
40+
". Passing unknown parameters may affect IIV and IOV structure and result in erroneous output."
41+
)
42+
)
43+
}
2744
}
2845
}

‎tests/testthat/test-check_inputs.R‎

Lines changed: 21 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
test_that("check_inputs passes with valid MAP inputs", {
22
# Create mock objects
33
model <- function() {}
4+
attr(model, "parameters") <- c("CL", "V")
45
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
56
parameters <- list(CL = 1, V = 10)
67
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
@@ -13,6 +14,7 @@ test_that("check_inputs passes with valid MAP inputs", {
1314
test_that("check_inputs passes with valid PLS inputs", {
1415
# Create mock objects
1516
model <- function() {}
17+
attr(model, "parameters") <- c("CL", "V")
1618
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
1719
parameters <- list(CL = 1, V = 10)
1820
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
@@ -25,6 +27,7 @@ test_that("check_inputs passes with valid PLS inputs", {
2527
test_that("check_inputs passes with valid pls inputs (lowercase)", {
2628
# Create mock objects
2729
model <- function() {}
30+
attr(model, "parameters") <- c("CL", "V")
2831
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
2932
parameters <- list(CL = 1, V = 10)
3033
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)", {
3740
test_that("check_inputs passes with valid MAP inputs (lowercase)", {
3841
# Create mock objects
3942
model <- function() {}
43+
attr(model, "parameters") <- c("CL", "V")
4044
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
4145
parameters <- list(CL = 1, V = 10)
4246
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)", {
4953
test_that("check_inputs passes with valid censoring argument", {
5054
# Create mock objects
5155
model <- function() {}
56+
attr(model, "parameters") <- c("CL", "V")
5257
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
5358
parameters <- list(CL = 1, V = 10)
5459
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
@@ -61,6 +66,7 @@ test_that("check_inputs passes with valid censoring argument", {
6166
test_that("check_inputs passes with other type values", {
6267
# Create mock objects
6368
model <- function() {}
69+
attr(model, "parameters") <- c("CL", "V")
6470
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
6571
parameters <- list(CL = 1, V = 10)
6672
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", {
8490

8591
test_that("check_inputs fails when data is NULL for MAP type", {
8692
model <- function() {}
93+
attr(model, "parameters") <- c("CL", "V")
8794
parameters <- list(CL = 1, V = 10)
8895
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
8996
regimen <- list(dose = 100, interval = 12)
@@ -96,6 +103,7 @@ test_that("check_inputs fails when data is NULL for MAP type", {
96103

97104
test_that("check_inputs fails when parameters is NULL for MAP type", {
98105
model <- function() {}
106+
attr(model, "parameters") <- c("CL", "V")
99107
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
100108
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
101109
regimen <- list(dose = 100, interval = 12)
@@ -108,6 +116,7 @@ test_that("check_inputs fails when parameters is NULL for MAP type", {
108116

109117
test_that("check_inputs fails when omega is NULL for MAP type", {
110118
model <- function() {}
119+
attr(model, "parameters") <- c("CL", "V")
111120
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
112121
parameters <- list(CL = 1, V = 10)
113122
regimen <- list(dose = 100, interval = 12)
@@ -120,6 +129,7 @@ test_that("check_inputs fails when omega is NULL for MAP type", {
120129

121130
test_that("check_inputs fails when regimen is NULL for MAP type", {
122131
model <- function() {}
132+
attr(model, "parameters") <- c("CL", "V")
123133
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
124134
parameters <- list(CL = 1, V = 10)
125135
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", {
132142

133143
test_that("check_inputs fails when model is not a function", {
134144
model <- "not_a_function"
145+
attr(model, "parameters") <- c("CL", "V")
135146
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
136147
parameters <- list(CL = 1, V = 10)
137148
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", {
145156

146157
test_that("check_inputs fails when model is a list (not a function)", {
147158
model <- list(not_a_function = TRUE)
159+
attr(model, "parameters") <- c("CL", "V")
148160
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
149161
parameters <- list(CL = 1, V = 10)
150162
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)", {
158170

159171
test_that("check_inputs fails when censoring is not NULL and not character", {
160172
model <- function() {}
173+
attr(model, "parameters") <- c("CL", "V")
161174
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
162175
parameters <- list(CL = 1, V = 10)
163176
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", {
184197

185198
test_that("check_inputs allows NULL censoring", {
186199
model <- function() {}
200+
attr(model, "parameters") <- c("CL", "V")
187201
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
188202
parameters <- list(CL = 1, V = 10)
189203
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
@@ -195,6 +209,7 @@ test_that("check_inputs allows NULL censoring", {
195209

196210
test_that("check_inputs allows character censoring", {
197211
model <- function() {}
212+
attr(model, "parameters") <- c("CL", "V")
198213
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
199214
parameters <- list(CL = 1, V = 10)
200215
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
@@ -207,6 +222,7 @@ test_that("check_inputs allows character censoring", {
207222
test_that("check_inputs works with different function types", {
208223
# Test with anonymous function
209224
model <- function(x) x + 1
225+
attr(model, "parameters") <- c("CL", "V")
210226
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
211227
parameters <- list(CL = 1, V = 10)
212228
omega <- matrix(c(0.1, 0, 0, 0.1), nrow = 2)
@@ -216,12 +232,13 @@ test_that("check_inputs works with different function types", {
216232

217233
# Test with named function
218234
test_model <- function() {}
235+
attr(test_model, "parameters") <- c("CL", "V")
219236
expect_no_error(check_inputs(test_model, data, parameters, omega, regimen, NULL, "MAP"))
220237
})
221238

222239
test_that("check_inputs fails when not all parameters are passed, and warning when too many are passed", {
223240
model <- function() {}
224-
attr(model, "parameters") <- list(CL = 5, V = 10)
241+
attr(model, "parameters") <- c("CL", "V")
225242
data <- data.frame(time = 1:3, dv = c(1, 2, 3))
226243
parameters <- list(CL = 1) # , V = 10)
227244
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
230247
# Should not throw any errors with NULL censoring
231248
expect_error(
232249
check_inputs(model, data, parameters, omega, regimen, NULL, "MAP"),
233-
"One or more required parameters for the model have not been specified"
250+
"One or more required parameters for the model have not been specified. Missing: V"
234251
)
235252

236-
parameters <- list(CL = 1, V = 10, V2 = 15)
253+
parameters <- list(CL = 1, V = 10, V2 = 15, Q = 23)
237254
expect_warning(
238255
check_inputs(model, data, parameters, omega, regimen, NULL, "MAP"),
256+
"Some supplied `parameters` are not supported by the model and will be ignored: V2, Q."
239257
)
240258
})

‎tests/testthat/test-get_map_estimates.R‎

Lines changed: 6 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
mod <- PKPDsim::new_ode_model("pk_1cmt_iv")
1+
mod <- PKPDsim::new_ode_model("pk_1cmt_iv", parameters = c("CL", "V"))
22

33
test_that("Default MAP fits work and are equal to NONMEM", {
44
## 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", {
210210
})
211211

212212
test_that("allow_obs_before_first_dose works", {
213+
mod_tdminit <- PKPDsim::new_ode_model("pk_1cmt_iv", parameters = c("CL", "V", "TDM_INIT"))
213214
data <- data.frame(
214215
t = c(-0.45, 35.55),
215216
y = c(21.7, 17.8),
@@ -226,34 +227,15 @@ test_that("allow_obs_before_first_dose works", {
226227
list(
227228
CL = 4.5,
228229
V = 58.4,
229-
V2 = 38.4,
230-
Q = 6.5,
231-
TH_CRCL = 0.8,
232-
TH_DIAL_CL = 0.7,
233-
TH_DIAL_V = 0.5,
234230
TDM_INIT = 21.7
235231
),
236232
units = list(
237233
CL = "L/hr",
238-
V = "L/70kg",
239-
Q = "L/hr",
240-
V2 = "L",
241-
CLi = "L/hr",
242-
Vi = "L",
243-
Qi = "L/hr",
244-
V2i = "L"
234+
V = "L/70kg"
245235
)
246236
)
247-
covariates <- list(
248-
WT = PKPDsim::new_covariate(value = 67.5, unit = "kg"),
249-
SEX = PKPDsim::new_covariate(value = 0),
250-
AGE = PKPDsim::new_covariate(value = 55.7, unit = "years"),
251-
CR = PKPDsim::new_covariate(value = c(0.67, 0.65), times = c(0, 23.3), unit = "mg_dl"),
252-
DIAL = PKPDsim::new_covariate(value = 0),
253-
CL_HEMO = PKPDsim::new_covariate(value = 0)
254-
)
255-
fixed <- c("Q", "TH_CRCL", "TH_DIAL_CL", "TH_DIAL_V", "TDM_INIT")
256-
omega <- c(0.1584, 0, 0.6659, 0, 0, 0.326)
237+
fixed <- c("TDM_INIT")
238+
omega <- c(0.1584, 0, 0.6659)
257239
error <- list(prop = 0.227, add = 3.4)
258240
regimen <- structure(
259241
list(
@@ -274,10 +256,9 @@ test_that("allow_obs_before_first_dose works", {
274256

275257
expect_error(
276258
get_map_estimates(
277-
model = mod,
259+
model = mod_tdminit,
278260
data = data,
279261
parameters = parameters,
280-
covariates = covariates,
281262
fixed = fixed,
282263
as_eta = NULL,
283264
omega = omega,

0 commit comments

Comments
 (0)