-
Notifications
You must be signed in to change notification settings - Fork 23
/
cleaners.R
142 lines (141 loc) · 5.39 KB
/
cleaners.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
#' Handle NA values in the concentration measurements as requested by the user.
#'
#' NA concentrations (and their associated times) will be removed then the BLQ
#' values in the middle
#'
#' @inheritParams assert_conc_time
#' @inheritParams PKNCA.choose.option
#' @param \dots Additional items to add to the data frame
#' @param conc.na How to handle NA concentrations? Either 'drop' or a number to
#' impute.
#' @param check Run [assert_conc_time()]?
#' @returns The concentration and time measurements (data frame) filtered
#' and cleaned as requested relative to NA in the concentration.
#' @family Data cleaners
#' @export
clean.conc.na <- function(conc, time, ...,
options=list(),
conc.na=NULL,
check=TRUE) {
conc.na <- PKNCA.choose.option(name="conc.na", value=conc.na, options=options)
if (check)
assert_conc_time(conc, time)
# Prep it as a data frame
ret <- data.frame(conc, time, ..., stringsAsFactors=FALSE)
if (conc.na %in% "drop") {
# If it is set to "drop" then omit the NA concentrations
ret <- ret[!is.na(conc),]
} else if (is.numeric(conc.na)) {
ret$conc[is.na(conc)] <- conc.na
} else {
# This case should already have been captured by the PKNCA.options
# call above.
stop("Unknown how to handle conc.na") # nocov
}
ret
}
#' Handle BLQ values in the concentration measurements as requested by the user.
#'
#' @inheritParams assert_conc_time
#' @inheritParams PKNCA.choose.option
#' @param \dots Additional arguments passed to clean.conc.na
#' @param conc.blq How to handle a BLQ value that is between above LOQ values?
#' See details for description.
#' @param conc.na How to handle NA concentrations. (See [clean.conc.na()])
#' @param check Run [assert_conc_time()]?
#' @returns The concentration and time measurements (data frame) filtered and
#' cleaned as requested relative to BLQ in the middle.
#'
#' @details `NA` concentrations (and their associated times) will be handled as
#' described in [clean.conc.na()] before working with the BLQ values. The
#' method for handling NA concentrations can affect the output of which points
#' are considered BLQ and which are considered "middle". Values are
#' considered BLQ if they are 0.
#'
#' `conc.blq` can be set either a scalar indicating what should be done for
#' all BLQ values or a list with elements named "first", "middle", and "last"
#' each set to a scalar.
#'
#' The meaning of each of the list elements is:
#' \describe{
#' \item{first}{Values up to the first non-BLQ value. Note
#' that if all values are BLQ, this includes all values.}
#' \item{middle}{Values that are BLQ between the first and last
#' non-BLQ values.}
#' \item{last}{Values that are BLQ after the last non-BLQ value}
#' }
#'
#' The valid settings for each are:
#' \describe{
#' \item{"drop"}{Drop the BLQ values}
#' \item{"keep"}{Keep the BLQ values}
#' \item{a number}{Set the BLQ values to that number}
#' }
#'
#' @family Data cleaners
#' @export
clean.conc.blq <- function(conc, time,
...,
options=list(),
conc.blq=NULL,
conc.na=NULL,
check=TRUE) {
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)
}
# Handle NA concentrations and make the data frame
ret <- clean.conc.na(conc, time, ..., conc.na=conc.na, check=FALSE)
# If all data has been excluded, then don't do anything
if (nrow(ret) > 0) {
tfirst <- pk.calc.tfirst(ret$conc, ret$time, check=FALSE)
if (is.na(tfirst)) {
# All measurements are BLQ; so apply the "first" BLQ rule to
# everyting.
tfirst <- max(ret$time)
tlast <- tfirst + 1
} else {
# There is at least one above LOQ concentration
tlast <- pk.calc.tlast(ret$conc, ret$time, check=FALSE)
}
# For each of the first, middle, and last, do the right thing to
# the values in that set.
for (n in c("first", "middle", "last")) {
# Set the mask to apply the rule to
if (n == "first") {
mask <- (ret$time <= tfirst &
ret$conc %in% 0)
} else if (n == "middle") {
mask <- (tfirst < ret$time &
ret$time < tlast &
ret$conc %in% 0)
} else if (n == "last") {
mask <- (tlast <= ret$time &
ret$conc %in% 0)
} else {
stop("There is a bug in cleaning the conc.blq with position names") # nocov
}
# Choose the rule to apply
this_rule <-
if (is.list(conc.blq)) {
conc.blq[[n]]
} else {
conc.blq
}
if (this_rule %in% "keep") {
# Do nothing
} else if (this_rule %in% "drop") {
ret <- ret[!mask,]
} else if (is.numeric(this_rule)) {
ret$conc[mask] <- this_rule
} else {
# This case should already have been captured by the PKNCA.options
# call above.
stop(sprintf("Unknown how to handle conc.blq rule %s", # nocov
as.character(this_rule))) # nocov
}
}
}
ret
}