-
Notifications
You must be signed in to change notification settings - Fork 23
/
class-PKNCAdata.R
228 lines (219 loc) · 7.93 KB
/
class-PKNCAdata.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
#' Create a PKNCAdata object.
#'
#' `PKNCAdata()` combines `PKNCAconc` and `PKNCAdose` objects and adds in the
#' intervals for PK calculations.
#'
#' @inheritParams PKNCA.choose.option
#' @param data.conc Concentration data as a `PKNCAconc` object or a data frame
#' @param data.dose Dosing data as a `PKNCAdose` object (see details)
#' @param impute Methods for imputation. `NA` for to search for the column
#' named "impute" in the intervals or no imputation if that column does not
#' exist, a comma-or space-separated list of names, or the name of a column in
#' the `intervals` data.frame. See
#' `vignette("v08-data-imputation", package="PKNCA")` for more details.
#' @param formula.conc Formula for making a `PKNCAconc` object with `data.conc`.
#' This must be given if `data.conc` is a data.frame, and it must not be given
#' if `data.conc` is a `PKNCAconc` object.
#' @param formula.dose Formula for making a `PKNCAdose` object with `data.dose`.
#' This must be given if `data.dose` is a data.frame, and it must not be given
#' if `data.dose` is a `PKNCAdose` object.
#' @param intervals A data frame with the AUC interval specifications as defined
#' in [check.interval.specification()]. If missing, this will be
#' automatically chosen by [choose.auc.intervals()]. (see details)
#' @param units A data.frame of unit assignments and conversions as created by
#' [pknca_units_table()]
#' @param ... arguments passed to `PKNCAdata.default`
#' @returns A PKNCAdata object with concentration, dose, interval, and
#' calculation options stored (note that PKNCAdata objects can also have
#' results after a NCA calculations are done to the data).
#' @details If `data.dose` is not given or is `NA`, then the `intervals` must be
#' given. At least one of `data.dose` and `intervals` must be given.
#' @family PKNCA objects
#' @seealso [choose.auc.intervals()], [pk.nca()], [pknca_units_table()]
#' @export
PKNCAdata <- function(data.conc, data.dose, ...) {
UseMethod("PKNCAdata", data.conc)
}
# Ensure that arguments are reversible
#' @rdname PKNCAdata
#' @export
PKNCAdata.PKNCAconc <- function(data.conc, data.dose, ...) {
PKNCAdata.default(data.conc=data.conc, data.dose=data.dose, ...)
}
#' @rdname PKNCAdata
#' @export
PKNCAdata.PKNCAdose <- function(data.conc, data.dose, ...) {
# Swap the arguments
PKNCAdata.default(data.dose=data.conc, data.conc=data.dose, ...)
}
#' @rdname PKNCAdata
#' @export
PKNCAdata.default <- function(data.conc, data.dose, ...,
formula.conc, formula.dose,
impute = NA_character_,
intervals, units, options=list()) {
if (length(list(...))) {
stop("Unknown argument provided to PKNCAdata. All arguments other than `data.conc` and `data.dose` must be named.")
}
ret <- list()
# Generate the conc element
if (inherits(data.conc, "PKNCAconc")) {
if (!missing(formula.conc)) {
rlang::warn(
message = "data.conc was given as a PKNCAconc object. Ignoring formula.conc",
class = "pknca_dataconc_formulaconc"
)
}
ret$conc <- data.conc
} else {
ret$conc <- PKNCAconc(data.conc, formula=formula.conc)
}
# Generate the dose element
if (missing(data.dose)) {
ret$dose <- NA
} else if (identical(data.dose, NA)) {
ret$dose <- NA
} else if (inherits(data.dose, "PKNCAdose")) {
if (!missing(formula.dose))
rlang::warn(
message = "data.dose was given as a PKNCAdose object. Ignoring formula.dose",
class = "pknca_dataconc_formuladose"
)
ret$dose <- data.dose
} else {
ret$dose <- PKNCAdose(data.dose, formula.dose)
}
# Check the options
if (!is.list(options)) {
stop("options must be a list.")
}
if (length(options) > 0) {
if (is.null(names(options)))
stop("options must have names.")
for (n in names(options)) {
tmp.opt <- list(options[[n]], TRUE)
names(tmp.opt) <- c(n, "check")
do.call(PKNCA.options, tmp.opt)
}
}
ret$options <- options
# Check the intervals
if (missing(intervals) & identical(ret$dose, NA)) {
stop("If data.dose is not given, intervals must be given")
} else if (missing(intervals)) {
# Generate the intervals for each grouping of concentration and
# dosing.
if (length(ret$dose$columns$time) == 0) {
stop("Dose times were not given, so intervals must be manually specified.")
}
n_conc_dose <-
full_join_PKNCAconc_PKNCAdose(
o_conc = ret$conc,
o_dose = ret$dose
)
n_conc_dose$data_intervals <- rep(list(NULL), nrow(n_conc_dose))
for (idx in seq_len(nrow(n_conc_dose))) {
current_conc <- n_conc_dose$data_conc[[idx]]
current_dose <- n_conc_dose$data_dose[[idx]]
current_group <-
n_conc_dose[
idx,
setdiff(names(n_conc_dose), c("data_conc", "data_dose")),
drop=FALSE
]
warning_prefix <-
if (ncol(current_group) > 0) {
paste0(
paste(names(current_group), unlist(lapply(current_group, as.character)), sep="=", collapse="; "),
": "
)
} else {
""
}
if (!is.null(current_conc)) {
generated_intervals <-
choose.auc.intervals(
current_conc$time,
current_dose$time,
options=options
)
if (nrow(generated_intervals) > 0) {
n_conc_dose$data_intervals[[idx]] <- generated_intervals
} else {
warning(warning_prefix, "No intervals generated likely due to limited concentration data")
}
} else {
rlang::warn(
message = paste(warning_prefix, "No intervals generated due to no concentration data"),
class = "pknca_no_intervals_generated"
)
}
}
intervals <-
tidyr::unnest(
n_conc_dose[, setdiff(names(n_conc_dose), c("data_conc", "data_dose")), drop=FALSE],
cols="data_intervals"
)
}
ret$intervals <- check.interval.specification(intervals)
# Verify that either everything or nothing is using units
units_interval_start <- inherits(ret$intervals$start, "units")
units_interval_end <- inherits(ret$intervals$end, "units")
# Insert the unit conversion table
if (!missing(units)) {
stopifnot("`units` must be a data.frame"=is.data.frame(units))
stopifnot(
"`units` data.frame must have at least names 'PPTESTCD' and 'PPORRESU'"=
all(c("PPTESTCD", "PPORRESU") %in% names(units))
)
stopifnot("`units` must have at least one row"=nrow(units) > 0)
ret$units <- units
}
# Insert the imputation methods, if applicable
if (!identical(NA, impute)) {
checkmate::assert_character(impute, len = 1)
ret$impute <- impute
}
# Assign the class and give it all back to the user.
class(ret) <- c("PKNCAdata", class(ret))
ret
}
#' @rdname is_sparse_pk
#' @export
is_sparse_pk.PKNCAdata <- function(object) {
is_sparse_pk(object$conc)
}
#' Print a PKNCAdata object
#' @param x The object to print
#' @param ... Arguments passed on to [print.PKNCAconc()] and [print.PKNCAdose()]
#' @export
print.PKNCAdata <- function(x, ...) {
print.PKNCAconc(x$conc, ...)
if (identical(NA, x$dose)) {
cat("No dosing information.\n")
} else {
print.PKNCAdose(x$dose, ...)
}
cat(sprintf("\nWith %d rows of interval specifications.\n",
nrow(x$intervals)))
if (!is.null(x$units)) {
cat("With units\n")
}
if (!is.null(x$impute)) {
cat(sprintf("With imputation: %s\n", x$impute))
}
if (length(x$options) == 0) {
cat("No options are set differently than default.\n")
} else {
cat("Options changed from default are:\n")
print(x$options)
}
}
#' Summarize a PKNCAdata object showing important details about the
#' concentration, dosing, and interval information.
#' @param object The PKNCAdata object to summarize.
#' @param ... arguments passed on to [print.PKNCAdata()]
#' @export
summary.PKNCAdata <- function(object, ...) {
print.PKNCAdata(object, summarize=TRUE, ...)
}