-
Notifications
You must be signed in to change notification settings - Fork 23
/
interpolate.conc.R
736 lines (714 loc) · 31.5 KB
/
interpolate.conc.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
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
#' Interpolate concentrations between measurements or extrapolate concentrations
#' after the last measurement.
#'
#' `interpolate.conc()` and `extrapolate.conc()` returns an interpolated (or
#' extrapolated) concentration. `interp.extrap.conc()` will choose whether
#' interpolation or extrapolation is required and will also operate on many
#' concentrations. These will typically be used to estimate the concentration
#' between two measured concentrations or after the last measured concentration.
#' Of note, these functions will not extrapolate prior to the first point.
#'
#' An `NA` value for the `lambda.z` parameter will prevent extrapolation.
#'
#' @inheritParams assert_conc_time
#' @inheritParams assert_lambdaz
#' @inheritParams PKNCA.choose.option
#' @inheritParams choose_interval_method
#' @param interp.method,extrap.method deprecated in favor of method and auc.type
#' @param time.dose Time of the dose
#' @param time.out Time when interpolation is requested (vector for
#' `interp.extrap.conc()`, scalar otherwise)
#' @param clast The last observed concentration above the limit of
#' quantification. If not given, `clast` is calculated from
#' [pk.calc.clast.obs()]
#' @param conc.origin The concentration before the first measurement.
#' `conc.origin` is typically used to set predose values to zero (default),
#' set a predose concentration for endogenous compounds, or set predose
#' concentrations to `NA` if otherwise unknown.
#' @param conc.blq How to handle BLQ values. (See [clean.conc.blq()] for usage
#' instructions.)
#' @param conc.na How to handle NA concentrations. (See [clean.conc.na()])
#' @param route.dose What is the route of administration ("intravascular" or
#' "extravascular"). See the details for how this parameter is used.
#' @param duration.dose What is the duration of administration? See the details
#' for how this parameter is used.
#' @param out.after Should interpolation occur from the data before (`FALSE`) or
#' after (`TRUE`) the interpolated point? See the details for how this
#' parameter is used. It only has a meaningful effect at the instant of an IV
#' bolus dose.
#' @param check Run [assert_conc_time()], [clean.conc.blq()], and
#' [clean.conc.na()]?
#' @param ... Additional arguments passed to `interpolate.conc()` or
#' `extrapolate.conc()`.
#' @returns The interpolated or extrapolated concentration value as a scalar
#' double (or vector for `interp.extrap.conc()`).
#'
#' @details
#' \describe{
#' \item{extrap.method}{
#' \describe{
#' \item{'AUCinf'}{Use lambda.z to extrapolate beyond the last point with the half-life.}
#' \item{'AUCall'}{If the last point is above the limit of quantification or missing, this is identical to 'AUCinf'. If the last point is below the limit of quantification, then linear interpolation between the Clast and the next BLQ is used for that interval and all additional points are extrapolated as 0.}
#' \item{'AUClast'}{Extrapolates all points after the last above the limit of quantification as 0.}
#' }
#' }
#' }
#'
#' `duration.dose` and `direction.out` are ignored if `route.dose ==
#' "extravascular"`. `direction.out` is ignored if `duration.dose > 0`.
#'
#' `route.dose` and `duration.dose` affect how interpolation/extrapolation of
#' the concentration occurs at the time of dosing. If `route.dose ==
#' "intravascular"` and `duration.dose == 0` then extrapolation occurs for an IV
#' bolus using [pk.calc.c0()] with the data after dosing. Otherwise (either
#' `route.dose == "extravascular"` or `duration.dose > 0`), extrapolation occurs
#' using the concentrations before dosing and estimating the half-life (or more
#' precisely, estimating `lambda.z`). Finally, `direction.out` can change the
#' direction of interpolation in cases with `route.dose == "intravascular"` and
#' `duration.dose == 0`. When `direction.out == "before"` interpolation occurs
#' only with data before the dose (as is the case for `route.dose ==
#' "extravascular"`), but if `direction.out == "after"` interpolation occurs
#' from the data after dosing.
#'
#' @seealso [pk.calc.clast.obs()], [pk.calc.half.life()], [pk.calc.c0()]
#' @export
interp.extrap.conc <- function(conc, time, time.out,
lambda.z=NA,
clast=pk.calc.clast.obs(conc, time),
options=list(),
method = NULL,
auc.type = "AUCinf",
interp.method,
extrap.method,
...,
conc.blq=NULL,
conc.na=NULL,
check=TRUE) {
# Defunct inputs
if (!missing(interp.method)) {
.Defunct(msg = "the `interp.method` has been replaced by the `method` argument for consistency with the rest of PKNCA") # nocov
} else if (!missing(extrap.method)) {
.Defunct(msg = "the `extrap.method` has been replaced by the `auc.type` argument for consistency with the rest of PKNCA") # nocov
}
# Check inputs
method <- PKNCA.choose.option(name="auc.method", value=method, options=options)
conc.blq <- PKNCA.choose.option(name="conc.blq", value=conc.blq, options=options)
conc.na <- PKNCA.choose.option(name="conc.na", value=conc.na, options=options)
if (check) {
assert_conc_time(conc = conc, time = time)
data <-
clean.conc.blq(
conc, time,
conc.blq=conc.blq,
conc.na=conc.na,
check=FALSE
)
} else {
data <- data.frame(conc, time)
}
if (length(time.out) < 1) {
stop("time.out must be a vector with at least one element")
}
if (all(data$conc %in% 0)) {
# tlast would be NA in this case, but if everything input is zero, then all
# interpolated and extrapolated times will be zero, too.
ret <- rep(0, length(time.out))
} else {
tlast <- pk.calc.tlast(data$conc, data$time, check=FALSE)
ret <- rep(NA, length(time.out))
for (i in seq_len(length(time.out)))
if (is.na(tlast)) {
stop("Please report a bug: tlast is NA; cannot interpolate/extrapolate") # nocov
} else if (is.na(time.out[i])) {
warning("An interpolation/extrapolation time is NA")
} else if (time.out[i] <= tlast) {
ret[i] <-
interpolate.conc(
conc=data$conc, time=data$time,
time.out=time.out[i],
method=method,
conc.blq=conc.blq,
conc.na=conc.na,
check=FALSE
)
} else {
ret[i] <-
extrapolate.conc(
conc=data$conc, time=data$time,
time.out=time.out[i],
lambda.z=lambda.z,
clast=clast,
auc.type=auc.type,
check=FALSE
)
}
}
ret
}
#' @describeIn interp.extrap.conc Interpolate concentrations through Tlast (inclusive)
#' @export
interpolate.conc <- function(conc, time, time.out,
options=list(),
method = NULL,
interp.method,
conc.blq=NULL,
conc.na=NULL,
conc.origin=0,
...,
check=TRUE) {
# Defunct inputs
if (!missing(interp.method)) {
.Defunct(msg = "the `interp.method` has been replaced by the `method` argument for consistency with the rest of PKNCA") # nocov
}
# Check the inputs
method <-
tolower(PKNCA.choose.option(
name="auc.method", value=method, options=options
))
conc.blq <- PKNCA.choose.option(name="conc.blq", value=conc.blq, options=options)
conc.na <- PKNCA.choose.option(name="conc.na", value=conc.na, options=options)
if (check) {
assert_conc_time(conc, time)
data <-
clean.conc.blq(
conc=conc, time=time,
conc.blq=conc.blq,
conc.na=conc.na,
check=FALSE
)
} else {
data <- data.frame(conc, time)
}
checkmate::assert_number(x=conc.origin, na.ok=TRUE)
checkmate::assert_number(x=time.out, na.ok=FALSE)
if (time.out > max(data$time)) {
stop("`interpolate.conc()` does not extrapolate, use `interp.extrap.conc()`")
}
# Verify that we are interpolating between the first concentration
# and the last above LOQ concentration
tlast <- pk.calc.tlast(conc=data$conc, time=data$time, check=FALSE)
if (time.out < min(data$time)) {
ret <- conc.origin
} else if (all(data$conc == 0)) {
ret <- 0
} else if (time.out > tlast) {
stop("`interpolate.conc()` can only works through Tlast, please use `interp.extrap.conc()` to combine both interpolation and extrapolation.")
} else if (time.out %in% data$time) {
# See if there is an exact time match and return that if it
# exists.
ret <- data$conc[time.out == data$time]
} else {
interp_methods_all <-
choose_interval_method(
conc = data$conc,
time = data$time,
method = method,
# AUClast because it doesn't affect the output for interpolation
auc.type = "AUClast",
options = options
)
# Find the last time before and the first time after the output
# time, then interpolate.
idx_before <- rev(which(data$time <= time.out))[1]
idx_after <- which(time.out <= data$time)[1]
time_1 <- data$time[idx_before]
time_2 <- data$time[idx_after]
conc_1 <- data$conc[idx_before]
conc_2 <- data$conc[idx_after]
interp_method <- interp_methods_all[idx_before]
ret <-
if (interp_method == "linear") {
interpolate_conc_linear(conc_1=conc_1, conc_2=conc_2, time_1=time_1, time_2=time_2, time_out=time.out)
} else if (interp_method == "log") {
interpolate_conc_log(conc_1=conc_1, conc_2=conc_2, time_1=time_1, time_2=time_2, time_out=time.out)
} else if (interp_method == "zero") {
0
} else {
stop("Please report a bug: invalid interp_method") # nocov
}
}
ret
}
#' @describeIn interp.extrap.conc Extrapolate concentrations after Tlast
#' @export
extrapolate.conc <- function(conc, time, time.out,
lambda.z=NA, clast=pk.calc.clast.obs(conc, time),
auc.type = "AUCinf",
extrap.method,
options=list(),
conc.na=NULL,
conc.blq=NULL,
...,
check=TRUE) {
if (!missing(extrap.method)) {
.Defunct(msg = "the `extrap.method` has been replaced by the `auc.type` argument for consistency with the rest of PKNCA") # nocov
}
assert_lambdaz(lambda.z)
conc.na <- PKNCA.choose.option(name="conc.na", value=conc.na, options=options)
conc.blq <- PKNCA.choose.option(name="conc.blq", value=conc.blq, options=options)
if (check) {
assert_conc_time(conc, time)
data <-
clean.conc.blq(
conc=conc, time=time,
conc.na=conc.na,
check=FALSE
)
} else {
data <- data.frame(conc, time)
}
auc.type <- tolower(auc.type)
if (!(auc.type %in% c("aucinf", "aucall", "auclast")))
stop("`auc.type` must be one of 'AUCinf', 'AUClast', or 'AUCall'")
if (length(time.out) != 1)
stop("Only one time.out value may be estimated at once.")
tlast <- pk.calc.tlast(conc=data$conc, time=data$time, check=FALSE)
if (is.na(tlast)) {
# If there are no observed concentrations, return NA
ret <- NA
} else if (time.out <= tlast) {
stop("extrapolate.conc can only work beyond Tlast, please use interp.extrap.conc to combine both interpolation and extrapolation.")
} else {
# Start the interpolation
if (auc.type %in% "aucinf") {
# If AUCinf is requested, extrapolate using the half-life
ret <- extrapolate_conc_lambdaz(clast=clast, lambda.z=lambda.z, tlast=tlast, time_out=time.out)
} else if (auc.type %in% "auclast" |
(auc.type %in% "aucall" &
tlast == max(data$time))) {
# If AUClast is requested or AUCall is requested and there are
# no BLQ at the end, we are already certain that we are after
# Tlast, so the answer is 0.
ret <- 0
} else if (auc.type %in% "aucall") {
# If the last non-missing concentration is below the limit of
# quantification, extrapolate with the triangle method of
# AUCall.
time_prev <- max(data$time[data$time <= time.out])
conc_prev <- data$conc[data$time %in% time_prev]
if (conc_prev %in% 0) {
# If we are already BLQ, then we have confirmed that there
# are no more ALQ measurements (because we are beyond
# Tlast) and therefore we can extrapolate as 0.
ret <- 0
} else {
if (time_prev != max(data$time)) {
time_next <- min(data$time[data$time >= time.out])
}
# If we are not already BLQ, then we have confirmed that we
# are in the triangle extrapolation region and need to draw
# a line.
ret <-
interpolate_conc_linear(
conc_1 = conc_prev, conc_2 = 0,
time_1 = time_prev, time_2 = time_next,
time_out = time.out
)
}
} else {
stop("Invalid auc.type caught too late (seeing this error indicates a software bug)") # nocov
}
}
ret
}
# Choices for events in interp.extrap.conc.dose. This is included here to
# assist with testing later.
event_choices_interp.extrap.conc.dose <-
list(conc_dose_iv_bolus_after="conc_dose_iv_bolus_after",
conc_dose="conc_dose",
dose_iv_bolus_after="dose_iv_bolus_after",
dose="dose",
conc="conc",
output_only="output_only",
none="none")
#' @describeIn interp.extrap.conc Interpolate and extrapolate concentrations
#' without interpolating or extrapolating beyond doses.
#' @export
interp.extrap.conc.dose <- function(conc, time,
time.dose, route.dose="extravascular", duration.dose=NA,
time.out, out.after=FALSE,
options=list(),
conc.blq=NULL,
conc.na=NULL,
...,
check=TRUE) {
# Check inputs
conc.na <- PKNCA.choose.option(name="conc.na", value=conc.na, options=options)
conc.blq <- PKNCA.choose.option(name="conc.blq", value=conc.blq, options=options)
if (check) {
assert_conc_time(conc = conc, time = time)
data_conc <-
clean.conc.blq(conc, time,
conc.blq=conc.blq, conc.na=conc.na,
check=FALSE)
} else {
data_conc <- data.frame(conc, time)
}
# Check other inputs
if (!is.character(route.dose)) {
route.dose <- as.character(route.dose)
}
if (!(all(route.dose %in% c("extravascular", "intravascular")))) {
stop("route.dose must be either 'extravascular' or 'intravascular'")
}
if (!(length(route.dose) %in% c(1, length(time.dose)))) {
stop("route.dose must either be a scalar or the same length as time.dose")
}
if (!all(is.na(duration.dose) | (is.numeric(duration.dose) & !is.factor(duration.dose)))) {
stop("duration.dose must be NA or a number.")
}
if (!(length(duration.dose) %in% c(1, length(time.dose)))) {
stop("duration.dose must either be a scalar or the same length as time.dose")
}
# Generate a single timeline
# Concentrations are assumed to occur before dosing
data_conc$out_after <- FALSE
data_dose <-
merge(
data.frame(dose=TRUE,
time=time.dose,
route=route.dose,
duration=duration.dose,
iv_bolus=route.dose %in% "intravascular" & duration.dose %in% 0,
stringsAsFactors=FALSE),
# Expand IV bolus dosing to have a before and after concentration
data.frame(iv_bolus=c(FALSE, TRUE, TRUE),
out_after=c(FALSE, FALSE, TRUE)),
all.x=TRUE)
data_out <-
data.frame(out=TRUE,
out_after=out.after,
out_order=seq_along(time.out),
time=time.out)
data_all <-
merge(merge(data_conc,
data_dose,
all=TRUE),
data_out,
all=TRUE)
data_all$dose_event <- data_all$dose %in% TRUE
data_all$conc_event <- !is.na(data_all$conc)
data_all$iv_bolus <- data_all$iv_bolus %in% TRUE
data_all$out <- data_all$out %in% TRUE
data_all$dose_count <- cumsum(data_all$dose_event)
mask_include_before <- data_all$dose_event & data_all$conc_event & !data_all$out_after
data_all$dose_count_prev <- data_all$dose_count - mask_include_before
data_all$event <- dplyr::case_when(
data_all$dose_event & data_all$conc_event & data_all$iv_bolus & data_all$out_after~event_choices_interp.extrap.conc.dose$conc_dose_iv_bolus_after,
data_all$dose_event & data_all$conc_event~event_choices_interp.extrap.conc.dose$conc_dose,
data_all$dose_event & data_all$iv_bolus & data_all$out_after~event_choices_interp.extrap.conc.dose$dose_iv_bolus_after,
data_all$dose_event~event_choices_interp.extrap.conc.dose$dose,
data_all$conc_event~event_choices_interp.extrap.conc.dose$conc,
data_all$out~event_choices_interp.extrap.conc.dose$output_only, # interpolation/extrapolation-only row
TRUE~"unknown") # should never happen
if (any(mask_unknown <- data_all$event %in% "unknown")) {
# All events should be accounted for already
stop( # nocov
"Unknown event in interp.extrap.conc.dose at time(s): ", # nocov
paste(unique(data_all$time[mask_unknown]), collapse=", "), # nocov
" (Please report this as a bug)" # nocov
) # nocov
}
# Remove "output_only" from event_before and event_after
simple_locf <- function(x, missing_val) {
mask_found <- !(x %in% missing_val)
ret <- x[mask_found]
ret[cumsum(mask_found)]
}
data_all$event_before <- simple_locf(c(event_choices_interp.extrap.conc.dose$none, data_all$event[-nrow(data_all)]),
"output_only")
data_all$event_after <- rev(simple_locf(rev(c(data_all$event[-1], event_choices_interp.extrap.conc.dose$none)),
"output_only"))
# Loop through the methods until all have been tested or no missing
# values remain.
data_all$method <- NA_character_
for (nm in names(interp.extrap.conc.dose.select)) {
mask <- is.na(data_all$method) &
do.call(interp.extrap.conc.dose.select[[nm]]$select, list(x=data_all))
if (any(mask)) {
if ("warning" %in% names(interp.extrap.conc.dose.select[[nm]])) {
warning(sprintf("%s: %d data points",
interp.extrap.conc.dose.select[[nm]]$warning,
sum(mask)))
data_all$method[mask] <- nm
} else {
for (current_idx in which(mask)) {
data_all$conc[current_idx] <-
do.call(interp.extrap.conc.dose.select[[nm]]$value,
list(data_all=data_all,
current_idx=current_idx,
options=options,
...))
data_all$method[current_idx] <- nm
}
}
}
}
if (any(mask_no_method <- is.na(data_all$method))) {
# This should never happen, all eventualities should be covered
stop("No method for imputing concentration at time(s): ", # nocov
paste(unique(data_all$time[mask_no_method]), collapse=", ")) # nocov
}
# Filter to the requested time points and output
data_out <- data_all[data_all$out,,drop=FALSE]
data_out <- data_out[order(data_out$out_order),,drop=FALSE]
ret <- data_out$conc
attr(ret, "Method") <- data_out$method
ret
}
# Dose-aware interpolation/extrapolation functions ####
# Impossible combinations ####
iecd_impossible_select <- function(x) {
x$event_before %in% "output_only" | # Restricted in code
x$event %in% "none" | # "none" events do not occur, they are before or after the timeline
x$event_after %in% "output_only" | # Restricted in code
(x$event %in% "output_only" &
x$event_after %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after")) |
(x$event_before %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after") &
x$event %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after")) |
(x$event %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after") &
x$event_after %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after")) |
(x$event_before %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after") &
x$event %in% c("none", "output_only") &
x$event_after %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after"))
}
iecd_impossible_value <- function(data_all, current_idx, ...) {
stop(sprintf( # nocov
"Impossible combination requested for interp.extrap.conc.dose (please report this as a bug). event_before: %s, event: %s, event_after: %s", # nocov
data_all$event_before[current_idx], # nocov
data_all$event[current_idx], # nocov
data_all$event_after[current_idx] # nocov
)) # nocov
}
# Observed concentration ####
iecd_observed_select <- function(x) {
x$event %in% c("conc_dose_iv_bolus_after", "conc_dose", "conc") &
!do.call(interp.extrap.conc.dose.select[["Impossible combinations"]]$select, list(x=x))
}
iecd_observed_value <- function(data_all, current_idx, ...) {
data_all$conc[current_idx]
}
# Before all events ####
iecd_before_select <- function(x) {
x$event_before %in% "none" &
!(x$event %in% c("conc_dose_iv_bolus_after", "conc_dose", "conc", "dose_iv_bolus_after", "none")) &
!(x$event_after %in% "output_only" |
(x$event %in% "output_only" &
x$event_after %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after"))) # because these are impossible
}
iecd_before_value <- function(data_all, current_idx, conc.origin=0, ...) {
conc.origin
}
# Interpolation ####
iecd_interp_select <- function(x) {
x$event_before %in% c("conc_dose_iv_bolus_after", "conc_dose", "conc") &
x$event %in% "output_only" &
x$event_after %in% c("conc_dose", "conc") &
!(x$event_before %in% "conc_dose" &
x$event_after %in% "conc_dose")
}
iecd_interp_value <- function(data_all, current_idx, ...) {
tmp_conc <- data_all[!is.na(data_all$conc) &
data_all$dose_count %in% data_all$dose_count[current_idx],]
interpolate.conc(conc=tmp_conc$conc, time=tmp_conc$time,
time.out=data_all$time[current_idx],
check=FALSE, ...)
}
# Extrapolation ####
iecd_extrap_select <- function(x) {
extrap_output_only <-
x$event_before %in% c("conc_dose_iv_bolus_after", "conc") &
x$event %in% "output_only" &
x$event_after %in% c("dose", "none")
extrap_dose <-
x$event_before %in% c("conc_dose_iv_bolus_after", "conc") &
x$event %in% "dose" &
!(x$event_after %in% "output_only")
extrap_output_only | extrap_dose
}
iecd_extrap_value <- function(data_all, current_idx, lambda.z, ...) {
last_conc <- data_all[data_all$time < data_all$time[current_idx] &
!is.na(data_all$conc),]
last_conc <- last_conc[nrow(last_conc),]
if (last_conc$conc %in% 0) {
# BLQ continues to be BLQ
0
} else {
if (missing(lambda.z)) {
lambda.z <- NA_real_
}
args <- list(conc=last_conc$conc[nrow(last_conc)],
time=last_conc$time[nrow(last_conc)],
time.out=data_all$time[current_idx], lambda.z=lambda.z,
...)
if (!("clast" %in% names(args))) {
args$clast <- last_conc$conc[nrow(last_conc)]
}
do.call(extrapolate.conc, args)
}
}
# Immediately after an IV bolus with a concentration next ####
iecd_iv_conc_select <- function(x) {
!(x$event_before %in% c("conc_dose_iv_bolus_after", "dose_iv_bolus_after", "output_only")) &
x$event %in% "dose_iv_bolus_after" &
x$event_after %in% c("conc_dose", "conc")
}
iecd_iv_conc_value <- function(data_all, current_idx, ...) {
tmp_conc <- data_all[data_all$conc_event &
(data_all$dose_count %in% data_all$dose_count[current_idx] |
data_all$dose_count_prev %in% data_all$dose_count[current_idx]),]
tmp_dose <- data_all[data_all$dose_event &
data_all$dose_count %in% data_all$dose_count[current_idx],]
pk.calc.c0(conc=tmp_conc$conc, time=tmp_conc$time,
time.dose=tmp_dose$time,
method=c("logslope", "c1"))
}
# Immediately after an IV bolus without a concentration next ####
iecd_iv_noconc_select <- function(x) {
bolus_is_current <-
x$event_before %in% c("conc", "conc_dose", "dose", "none") &
x$event %in% "dose_iv_bolus_after" &
x$event_after %in% c("dose", "none")
bolus_is_previous <-
x$event_before %in% "dose_iv_bolus_after" &
x$event %in% "dose" &
x$event_after %in% c("conc_dose_iv_bolus_after", "conc_dose", "dose_iv_bolus_after", "dose", "conc", "none")
bolus_is_current | bolus_is_previous
}
# After an IV bolus with a concentration next ####
iecd_afteriv_conc_select <- function(x) {
x$event_before %in% "dose_iv_bolus_after" &
x$event %in% "output_only" &
x$event_after %in% c("conc_dose", "conc")
}
iecd_afteriv_conc_value <- function(data_all, current_idx, ...) {
tmp_conc <- data_all[data_all$conc_event &
(data_all$dose_count %in% data_all$dose_count[current_idx] |
data_all$dose_count_prev %in% data_all$dose_count[current_idx]),
c("conc", "time")]
tmp_dose <- data_all[data_all$dose_event &
data_all$dose_count %in% data_all$dose_count[current_idx],]
tmp_conc <- rbind(
data.frame(
time=tmp_dose$time,
conc=
pk.calc.c0(conc=tmp_conc$conc, time=tmp_conc$time,
time.dose=tmp_dose$time,
method=c("logslope", "c1"))),
tmp_conc)
interpolate.conc(conc=tmp_conc$conc,
time=tmp_conc$time,
time.out=data_all$time[current_idx],
check=FALSE, ...)
}
# After an IV bolus without a concentration next ####
iecd_afteriv_noconc_select <- function(x) {
x$event_before %in% "dose_iv_bolus_after" &
x$event %in% "output_only" &
x$event_after %in% c("dose", "none")
}
# Doses with no concentrations between ####
iecd_dose_noconc_select <- function(x) {
dose_current <-
x$event_before %in% c("conc_dose", "dose") &
x$event %in% "dose" &
!(x$event_after %in% "output_only")
dose_around <-
x$event_before %in% c("dose", "conc_dose") &
x$event %in% "output_only" &
x$event_after %in% c("dose", "conc_dose")
dose_current | dose_around
}
# Dose as the last event in the timeline and requesting a concentration after ####
iecd_dose_last_select <- function(x) {
x$event_before %in% c("conc_dose", "dose") &
x$event %in% "output_only" &
x$event_after %in% "none"
}
# Dose before, concentration after without a dose ####
iecd_dose_conc_select <- function(x) {
x$event_before %in% "dose" &
x$event %in% "output_only" &
x$event_after %in% "conc"
}
iecd_dose_conc_value <- function(data_all, current_idx, ...) {
data_tmp <- data_all[data_all$dose_event | data_all$conc_event,]
interpolate.conc(conc=data_tmp$conc, time=data_tmp$time,
time.out=data_all$time[current_idx], ...,
check=FALSE)
}
interp.extrap.conc.dose.select <-
list(
"Impossible combinations"=
list(
select="iecd_impossible_select",
value="iecd_impossible_value",
description="The event combination cannot exist."),
"Observed concentration"=
list(
select="iecd_observed_select",
value="iecd_observed_value",
description="Copy the input concentration at the given time to the output."),
"Before all events"=
list(
select="iecd_before_select",
value="iecd_before_value",
description=paste("Interpolation before any events is NA or zero (0)",
"depending on the value of conc.origin. conc.origin",
"defaults to zero which is the implicit assumption",
"that a complete washout occurred and there is no",
"endogenous source of the analyte.")),
"Interpolation"=
list(
select="iecd_interp_select",
value="iecd_interp_value",
description=paste("With concentrations before and after and not an IV",
"bolus before, interpolate between observed concentrations.")),
"Extrapolation"=
list(
select="iecd_extrap_select",
value="iecd_extrap_value",
description="Extrapolate from a concentration to a dose"),
"Immediately after an IV bolus with a concentration next"=
list(
select="iecd_iv_conc_select",
value="iecd_iv_conc_value",
description=paste("Calculate C0 for the time immediately after an IV",
"bolus. First, attempt using log slope",
"back-extrapolation. If that fails, use the first",
"concentration after the dose as C0.")),
"Immediately after an IV bolus without a concentration next"=
list(
select="iecd_iv_noconc_select",
warning="Cannot interpolate immediately after an IV bolus without a concentration next.",
description="Cannot calculate C0 without a concentration after an IV bolus; return NA."),
"After an IV bolus with a concentration next"=
list(
select="iecd_afteriv_conc_select",
value="iecd_afteriv_conc_value",
description=paste("First, calculate C0 using log slope back-extrapolation",
"(falling back to the first post-dose concentration",
"if that fails). Then, interpolate between C0 and",
"the first post-dose concentration.")),
"After an IV bolus without a concentration next"=
list(
select="iecd_afteriv_noconc_select",
warning="Cannot interpolate after an IV bolus without a concentration next.",
description=paste("Between an IV bolus and anything other than a",
"concentration, interpolation cannot occur. Return NA")),
"Doses with no concentrations between"=
list(
select="iecd_dose_noconc_select",
warning="Cannot interpolate between two doses or after a dose without a concentration after the first dose.",
description="Two doses with no concentrations between them, return NA."),
"Dose as the last event in the timeline and requesting a concentration after"=
list(
select="iecd_dose_last_select",
warning="Cannot extrapolate from a dose without any concentrations after it.",
description=paste("Cannot estimate the concentration after a dose",
"without concentrations after the dose, return NA.")),
"Dose before, concentration after without a dose"=list(
select="iecd_dose_conc_select",
value="iecd_dose_conc_value",
description="If the concentration at the dose is estimable, interpolate. Otherwise, NA.")
)