-
Notifications
You must be signed in to change notification settings - Fork 23
/
class-PKNCAdose.R
300 lines (285 loc) · 11.4 KB
/
class-PKNCAdose.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
#' Create a PKNCAdose object
#'
#' @param data A data frame with time and the groups defined in
#' \code{formula}.
#' @param formula The formula defining the
#' \code{dose.amount~time|groups} where \code{time} is the time of the
#' dosing and \code{dose.amount} is the amount administered at that
#' time (see Details).
#' @param route Define the route of administration. The value may be
#' either a column name from the \code{data} (checked first) or a
#' character string of either \code{"extravascular"} or
#' \code{"intravascular"} (checked second). If given as a column
#' name, then every value of the column must be either
#' \code{"extravascular"} or \code{"intravascular"}.
#' @param rate,duration (optional) for \code{"intravascular"} dosing,
#' the rate or duration of dosing. If given as a character string, it
#' is the name of a column from the \code{data}, and if given as a
#' number, it is the value for all doses. Only one may be given, and
#' if neither is given, then the dose is assumed to be a bolus
#' (\code{duration=0}). If \code{rate} is given, then the dose amount
#' must be given (the left hand side of the \code{formula}).
#' @param time.nominal (optional) The name of the nominal time column
#' (if the main time variable is actual time. The \code{time.nominal}
#' is not used during calculations; it is available to assist with
#' data summary and checking.
#' @param exclude (optional) The name of a column with concentrations to
#' exclude from calculations and summarization. If given, the column
#' should have values of \code{NA} or \code{""} for concentrations to
#' include and non-empty text for concentrations to exclude.
#' @param ... Ignored.
#' @return A PKNCAconc object that can be used for automated NCA.
#' @details The \code{formula} for a \code{PKNCAdose} object can be
#' given three ways: one-sided (missing left side), one-sided (missing
#' right side), or two-sided. Each of the three ways can be given
#' with or without groups. When given one-sided missing the left
#' side, the left side can either be omitted or can be given as a
#' period (\code{.}): \code{~time|treatment+subject} and
#' \code{.~time|treatment+subject} are identical, and dose-related NCA
#' parameters will all be reported as not calculable (for example,
#' clearance). When given one-sided missing the right side, the right
#' side must be specified as a period (\code{.}):
#' \code{dose~.|treatment+subject}, and only a single row may be given
#' per group. When the right side is missing, PKNCA assumes that the
#' same dose is given in every interval. When given as a two-sided
#' formula
#' @family PKNCA objects
#' @export
PKNCAdose <- function(data, ...)
UseMethod("PKNCAdose")
#' @rdname PKNCAdose
#' @export
PKNCAdose.default <- function(data, ...)
PKNCAdose.data.frame(as.data.frame(data), ...)
#' @rdname PKNCAdose
#' @export
PKNCAdose.tbl_df <- function(data, ...)
PKNCAdose.data.frame(as.data.frame(data), ...)
#' @rdname PKNCAdose
#' @export
PKNCAdose.data.frame <- function(data, formula, route, rate, duration,
time.nominal, exclude, ...) {
## The data must have... data
if (nrow(data) == 0) {
stop("data must have at least one row.")
}
## Check inputs
if (!missing(time.nominal)) {
if (!(time.nominal %in% names(data))) {
stop("time.nominal, if given, must be a column name in the input data.")
}
}
## Verify that all the variables in the formula are columns in the
## data.
parsedForm <- parseFormula(formula, require.two.sided=FALSE)
## Check for variable existence and length
if (!(length(all.vars(parsedForm$lhs)) %in% c(0, 1)))
stop("The left side of the formula must have zero or one variable")
if (!(identical(parsedForm$lhs, NA) ||
all.vars(parsedForm$lhs) %in% c(".", names(data)))) {
stop("The left side formula must be a variable in the data, empty, or '.'.")
}
if (length(all.vars(parsedForm$rhs)) != 1)
stop("The right side of the formula (excluding groups) must have exactly one variable")
if (!(all.vars(parsedForm$rhs) %in% c(".", names(data)))) {
stop("The right side formula must be a variable in the data or '.'.")
}
if (!all(all.vars(parsedForm$groups) %in% names(data))) {
stop("All of the variables in the groups must be in the data")
}
## Values must be unique (one value per measurement)
key.cols <- c(setdiff(all.vars(parsedForm$rhs), "."),
all.vars(parsedForm$groupFormula))
if (any(mask.dup <- duplicated(data[,key.cols])))
stop("Rows that are not unique per group and time (column names: ",
paste(key.cols, collapse=", "),
") found within dosing data. Row numbers: ",
paste(seq_along(mask.dup)[mask.dup], collapse=", "))
ret <- list(data=data,
formula=formula)
class(ret) <- c("PKNCAdose", class(ret))
if (missing(exclude)) {
ret <- setExcludeColumn(ret)
} else {
ret <- setExcludeColumn(ret, exclude=exclude)
}
mask.indep <- is.na(getIndepVar.PKNCAdose(ret))
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.")
}
if (missing(route)) {
ret <- setRoute.PKNCAdose(ret)
} else {
ret <- setRoute.PKNCAdose(ret, route)
}
ret <- setDuration.PKNCAdose(ret, duration=duration,
rate=rate, dose=getDepVar.PKNCAdose(ret))
if (!missing(time.nominal)) {
ret <-
setAttributeColumn(object=ret,
attr_name="time.nominal",
col_name=time.nominal)
}
ret
}
#' Set the dosing route
#'
#' @param object A PKNCAdose object
#' @param route A character string indicating one of the following: the
#' column from the data which indicates the route of administration, a
#' scalar indicating the route of administration for all subjects, or
#' a vector indicating the route of administration for each dose in
#' the dataset.
#' @param ... Arguments passed to another setRoute function
#' @return The object with an updated route
#' @export
setRoute <- function(object, ...)
UseMethod("setRoute")
#' @rdname setRoute
#' @export
setRoute.PKNCAdose <- function(object, route, ...) {
if (missing(route)) {
object <-
setAttributeColumn(object=object,
attr_name="route",
default_value="extravascular",
message_if_default="Assuming route of administration is extravascular")
} else {
object <-
setAttributeColumn(object=object,
attr_name="route",
col_or_value=route)
}
if (!all(tolower(getAttributeColumn(object=object, attr_name="route")[[1]]) %in%
c("extravascular", "intravascular"))) {
stop("route must have values of either 'extravascular' or 'intravascular'. Please set to one of those values and retry.")
}
object
}
#' Set the duration of dosing or measurement
#'
#' @param object An object to set a duration on
#' @param duration The value to set for the duration or the name of the
#' column in the data to use for the duration.
#' @param rate (for PKNCAdose objects only) The rate of infusion
#' @param dose (for PKNCAdose objects only) The dose amount
#' @param ... Arguments passed to another setDuration function
#' @return The object with duration set
#' @export
setDuration <- function(object, ...)
UseMethod("setDuration")
#' @rdname setDuration
#' @export
setDuration.PKNCAdose <- function(object, duration, rate, dose, ...) {
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)) {
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)) {
tmprate <- getColumnValueOrNot(object$data, rate, "rate")
tmpdose <- getColumnValueOrNot(object$data, dose, "dose")
duration <- tmpdose$data[[tmpdose$name]]/tmprate$data[[tmprate$name]]
object <- setAttributeColumn(object=object, attr_name="duration", col_or_value=duration)
}
duration.val <- getAttributeColumn(object=object, attr_name="duration")[[1]]
if (is.numeric(duration.val) &&
!any(is.na(duration.val)) &&
!any(is.infinite(duration.val)) &&
all(duration.val >= 0)) {
# It passes
} else {
stop("duration must be numeric without missing (NA) or infinite values, and all values must be >= 0")
}
object
}
#' @rdname formula.PKNCAconc
#' @export
formula.PKNCAdose <- function(x, ...) {
x$formula
}
#' @rdname model.frame.PKNCAconc
#' @export
model.frame.PKNCAdose <- function(formula, ...) {
cbind(getDepVar.PKNCAdose(formula),
getIndepVar.PKNCAdose(formula),
getGroups.PKNCAdose(formula))
}
#' @export
getDepVar.PKNCAdose <- function(x, ...) {
parsedForm <- parseFormula(x$formula, require.two.sided=FALSE)
if (identical(parsedForm$lhs, NA) ||
identical(all.vars(parsedForm$lhs), ".")) {
rep(NA_integer_, nrow(x$data))
} else {
x$data[, all.vars(parseFormula(x)$lhs)]
}
}
#' @export
getIndepVar.PKNCAdose <- function(x, ...) {
parsedForm <- parseFormula(x$formula, require.two.sided=FALSE)
if (identical(parsedForm$rhs, NA) ||
identical(all.vars(parsedForm$rhs), ".")) {
rep(NA_integer_, nrow(x$data))
} else {
x$data[, all.vars(parseFormula(x)$rhs)]
}
}
#' @rdname getGroups.PKNCAconc
#' @export
getGroups.PKNCAdose <- function(...) {
getGroups.PKNCAconc(...)
}
#' @rdname getData.PKNCAconc
#' @export
getData.PKNCAdose <- function(object)
object$data
#' @rdname getDataName
getDataName.PKNCAdose <- function(object)
"data"
#' @rdname print.PKNCAconc
#' @export
print.PKNCAdose <- function(x, n=6, summarize=FALSE, ...) {
cat("Formula for dosing:\n ")
print(stats::formula(x), showEnv=FALSE, ...)
if (!is.null(time_nom_data <- getAttributeColumn(x, attr_name="time.nominal", warn_missing=c()))) {
cat("Nominal time column is: ", names(time_nom_data), "\n", sep="")
} else {
cat("Nominal time column is not specified.\n")
}
if (summarize) {
cat("\n")
grp <- getGroups.PKNCAdose(x)
if (ncol(grp) > 0) {
tmp.summary <- as.data.frame(
lapply(grp, FUN=function(y) length(unique(y))))
cat("Number unique entries in each group:\n")
print.data.frame(tmp.summary, row.names=FALSE)
} else {
cat("No groups.\n")
}
} else {
if (n != 0) {
if (n >= nrow(x$data)) {
cat("\nData for dosing:\n")
} else if (n < 0) {
cat(sprintf("\nFirst %d rows of dosing data:\n",
nrow(x$data)+n))
} else {
cat(sprintf("\nFirst %d rows of dosing data:\n",
n))
}
print.data.frame(utils::head(x$data, n=n), ..., row.names=FALSE)
}
}
}
#' @rdname print.PKNCAconc
#' @export
summary.PKNCAdose <- summary.PKNCAconc
#' @rdname split.PKNCAconc
#' @export
split.PKNCAdose <- split.PKNCAconc