diff --git a/NEWS.md b/NEWS.md index 2da1b658..e2adb5cc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,9 @@ the dosing including dose amount and route. * `get_halflife_points()` now correctly accounts for start time != 0 and sets times outside of any interval to `NA` (#470) +* The `PKNCAconc` function won't give an error for a concentration-time check +when the issue is due to an excluded point (#310) +* The `PKNCAdose` function won't give an error for a missing-time check when the issue is due to an excluded point (#310) ## New features diff --git a/R/class-PKNCAconc.R b/R/class-PKNCAconc.R index f3bd9bd8..8698e0ab 100644 --- a/R/class-PKNCAconc.R +++ b/R/class-PKNCAconc.R @@ -100,14 +100,7 @@ PKNCAconc.data.frame <- function(data, formula, subject, if (length(parsed_form$time) != 1) { stop("The right hand side of the formula (excluding groups) must have exactly one variable") } - # Do some general checking of the concentration and time data to give an early - # error if the data are not correct. Do not check monotonic.time because the - # data may contain information for more than one subject. - assert_conc_time( - conc = data[[parsed_form$concentration]], - time = data[[parsed_form$time]], - sorted_time = FALSE - ) + # Assign the subject if (missing(subject)) { subject <- parsed_form$groups$group_vars[length(parsed_form$groups$group_vars)] @@ -139,6 +132,22 @@ PKNCAconc.data.frame <- function(data, formula, subject, } class(ret) <- c("PKNCAconc", class(ret)) ret <- setExcludeColumn(ret, exclude = exclude, dataname = getDataName.PKNCAconc(ret)) + + # Do some general checking of the concentration and time data. + # Do not check monotonic.time because the data may contain information + # for more than one subject. Disconsider points that will be excluded. + if (!is.null(exclude)) { + is_excluded <- !is.na(data[[exclude]]) + } else { + is_excluded <- rep(FALSE, nrow(data)) + } + + assert_conc_time( + conc = data[[parsed_form$concentration]][!is_excluded], + time = data[[parsed_form$time]][!is_excluded], + sorted_time = FALSE + ) + # Values must be unique (one value per measurement), check after the exclusion # column has been added to the object so that exclusions can be accounted for # in duplicate checking. diff --git a/R/class-PKNCAdose.R b/R/class-PKNCAdose.R index 18e6fe56..d8ae52d4 100644 --- a/R/class-PKNCAdose.R +++ b/R/class-PKNCAdose.R @@ -125,7 +125,15 @@ PKNCAdose.data.frame <- function(data, formula, route, rate, duration, # in duplicate checking. duplicate_check(object = ret, data_type = "dosing") - mask.indep <- is.na(getIndepVar.PKNCAdose(ret)) + # Do some general checking of the dose and time data. + # Disconsider points that will be excluded. + if (!is.null(exclude)) { + is_excluded <- !is.na(data[[exclude]]) + } else { + is_excluded <- rep(FALSE, nrow(data)) + } + # Check for missing independent variable (time) in non-excluded rows + mask.indep <- is.na(getIndepVar.PKNCAdose(ret)) & !is_excluded if (any(mask.indep) & !all(mask.indep)) { stop("Some but not all values are missing for the independent variable, please see the help for PKNCAdose for how to specify the formula and confirm that your data has dose times for all doses.") } @@ -207,17 +215,17 @@ setDuration.PKNCAdose <- function(object, duration, rate, dose, ...) { if (missing(dose)) { dose <- object$columns$dose } - if (missing(duration) & missing(rate)) { + if (missing(duration) && missing(rate)) { object <- setAttributeColumn(object=object, attr_name="duration", default_value=0, message_if_default="Assuming instant dosing (duration=0)") - } else if (!missing(duration) & !missing(rate)) { + } else if (!missing(duration) && !missing(rate)) { stop("Both duration and rate cannot be given at the same time") # TODO: A consistency check could be done, but that would get into # requiring near-equal checks for floating point error. } else if (!missing(duration)) { object <- setAttributeColumn(object=object, attr_name="duration", col_or_value=duration) - } else if (!missing(rate) & !missing(dose) && !is.na(dose)) { + } else if (!missing(rate) && !missing(dose) && !is.na(dose)) { tmprate <- getColumnValueOrNot(object$data, rate, "rate") tmpdose <- getColumnValueOrNot(object$data, dose, "dose") duration <- tmpdose$data[[tmpdose$name]]/tmprate$data[[tmprate$name]] diff --git a/tests/testthat/test-class-PKNCAconc.R b/tests/testthat/test-class-PKNCAconc.R index 4087a5da..56bef9ea 100644 --- a/tests/testthat/test-class-PKNCAconc.R +++ b/tests/testthat/test-class-PKNCAconc.R @@ -12,6 +12,16 @@ test_that("PKNCAconc expected errors", { ) }) +test_that("PKNCAconc does not error for excluded, invalid times (#310)", { + # Missing time points that are excluded are not checked + tmp.conc <- data.frame(time = c(1, NA), conc = c(1, NA), exclude = c(NA, "foo")) + expect_no_error(PKNCAconc(conc~time, data = tmp.conc, exclude = "exclude")) + + # Exclude column can be not defined (NULL) + tmp.conc <- data.frame(time = c(1, 2), conc = c(1, 2)) + expect_no_error(PKNCAconc(conc~time, data = tmp.conc, exclude = NULL)) +}) + test_that("PKNCAconc", { tmp.conc <- generate.conc(nsub=5, ntreat=2, time.points=0:24) tmp.conc.analyte <- generate.conc(nsub=5, ntreat=2, time.points=0:24, diff --git a/tests/testthat/test-class-PKNCAdose.R b/tests/testthat/test-class-PKNCAdose.R index 13787a87..100387f5 100644 --- a/tests/testthat/test-class-PKNCAdose.R +++ b/tests/testthat/test-class-PKNCAdose.R @@ -579,3 +579,13 @@ test_that("PKNCAdose units (#336)", { structure("doseu_x", unit_type = "column") ) }) + +test_that("PKNCAdose does not error for excluded, invalid times (#310)", { + # Missing time points that are excluded are not checked + tmp.dose <- data.frame(time = c(1, NA), dose = c(1, NA), exclude = c(NA, "foo")) + expect_no_error(PKNCAdose(tmp.dose, formula = dose~time, exclude = "exclude")) + + # Exclude column can be not defined (NULL) + tmp.dose <- data.frame(time = c(1, 2), dose = c(1, 2)) + expect_no_error(PKNCAdose(tmp.dose, formula = dose~time, exclude = NULL)) +})