-
Notifications
You must be signed in to change notification settings - Fork 0
/
assess_reduced_doses.R
226 lines (192 loc) · 10.7 KB
/
assess_reduced_doses.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
#' Analyze physicians' compliance to dosing guidelines: REDUCE DOSE
#'
#' @description Evaluate number of times blood counts did not support physicians' REDUCE DOSE decision
#'
#' @param input_files_path path to a file or a folder with MT csv files (in quotes).
#' @param anc_range Absolute neutrophil count (ANC) range between which doses should be reduce. NOTE: Ensure that values are represented with same unit as of the input ANC data.
#' @param plt_range Platelet (PLT) range between which doses should be reduce. NOTE: Ensure that values are represented with same unit as of the input PLT data.
#' @param hb_range Hemoglobin (HB) range between which doses should be stopped. NOTE: Ensure that values are represented with same unit as of the input Hb data.
#' @param reduction_factor Percentage of 6MP starting dose (first visit dose) dose that will be called as "reduced" dose. Default = 50% of starting dose.
#'
#' @return Returns a list with (1) the 'REDUCE DOSE' analysis for each patient as listed below,
#' (2) analysis summary as dataframe (3) analysis summary as HTML table in viewer.
#' \enumerate{
#' \item{Pat ID}
#' \item{Number of decisions where the physician reduced dose (a)}
#' \item{Number of times blood counts did not support dose reduction (b)}
#' \item{Discordance (%) = (\eqn{(b/a)*100)}}
#' }
#'
#'#' @note
#' \enumerate{
#' \item{Atleast one of the threshold parameters (anc_threshold, plt_threshold, hb_threshold) must be provided to carry out analysis. Missing threshold parameter will not be considered.}
#' \item{If the function is used for cohort analysis then a and b will be represented as median and interquartile range (IQR) (25%-75%). The median and IQR is rounded off to upper integer value if decimal value is greater or equal to 0.5, else to lower integer value Example 1.4->1 and 3.75->4}
#' \item{User may save the result as a list, if required, to analyze each patient separately - use 1st element of list. Please refer to examples from \link[allMT]{assess_anemia}}
#'}
#'
#' @include rounding_off.R
#' @seealso [assess_stop_doses()], [assess_increased_doses()]
#'
#' @examples
#' pat_data <- system.file("extdata/processed_data/", "UPN_915.csv", package = "allMT")
#' assess_reduced_doses(input_files_path = pat_data,
#' anc_range = c(0.5,0.75), plt_range = c(50,75),
#' hb_range = c(7,8), reduction_factor = 50)
#'
#' \donttest{
#' cohort_path = paste0(system.file("extdata/processed_data/", package = "allMT"), "/")
#' assess_reduced_doses(input_files_path = cohort_path,
#' anc_range = c(0.5,0.75), plt_range = c(50,75),
#' hb_range = c(7,8), reduction_factor = 50)
#' }
#'
#' @importFrom dplyr %>%
#' @export
#'
assess_reduced_doses <- function(input_files_path, anc_range = NA, plt_range = NA, hb_range = NA, reduction_factor){
tryCatch(
expr = {
ANC <- MP <- MTX <- PLT <- Hb <- NULL
reduce_doses_df <- NULL
# Check if "input_files_path" is provided or not
if(missing(input_files_path)){
stop("Please provide a file or folder path for the 'input_files_path' argument")
}
# If folder path provided, read all the files; else read single patient file; else stop
if(utils::file_test("-d", input_files_path)){
message("NOTE: Analyzing provided input file only")
pat_list <- lapply(list.files(input_files_path), function(x){utils::read.csv(paste0(input_files_path, x))})
names(pat_list) <- list.files(input_files_path)
}else if(utils::file_test("-f", input_files_path)){
message("NOTE: Analyzing provided input file only")
pat_list <- list(utils::read.csv(input_files_path))
file_name <- basename(input_files_path)
}else{
stop("Please provide a valid file or folder path for the 'input_files_path' argument")
}
# Check which range parameters are provided by the user to carry out analysis
range_vector <- c(anc_range[1], plt_range[1], hb_range[1])
range_vector_index <- c("anc_range", "plt_range", "hb_range")
code <- NULL
if(missing(anc_range) & missing(plt_range) & missing(hb_range)){
stop("Please provide atleast one of the arguments: 'anc_range', 'plt_range', 'hb_range'")
}else if(length(which(!is.na(range_vector))) == 1){
code <- "A"
message(paste0("NOTE: Analysis will be carried out with provided parameter: ", range_vector_index[which(!is.na(range_vector))]))
}else if(length(which(!is.na(range_vector))) == 2){
code <- "B"
message(paste0("NOTE: Analysis will be carried out with provided parameter: ",
range_vector_index[which(!is.na(range_vector))][1], " and ",
range_vector_index[which(!is.na(range_vector))][2]))
}else{
code <- "C"
message("NOTE: Analysis will be carried out with provided parameters: anc_range, plt_range and hb_range")
}
if(missing(reduction_factor)){
stop("Please provide a value for the 'reduction_factor' argument. (Ex: 25% should be entered as 25)")
}
temp_df <- data.frame(matrix(ncol = 4, nrow = 1))
x <- c("ID", "No. of 'dose reduce' decisions", "No. of times the counts did not support dose decision",
"Discordance (%)")
colnames(temp_df) <- x
for(i in seq(pat_list)) {
B2_n <- NULL
B2_d <- NULL
# B2_n_s <- NULL
# B2_n_c <- NULL
# Reading MT csv sheet for each patient
MR <- pat_list[[i]]
# Identifying starting dose (to be considered as max dose)
max_dose <- MR$MP[1]
# B2: dose decreased (Denominator), but the counts do not support it (Numerator)
#Filtering rows where physician's decision IS to reduce dose (denominator)
# This frame (B2_a) will be used as parent frame for below filters
B2_a <- dplyr::filter(MR, (MP <= (dplyr::lag(MP, n = 1) - ((reduction_factor/100)*dplyr::lag(MP, n = 1))) & MP > 0))
B2_d <- rbind(B2_d, dplyr::count(B2_a))
# Filtering rows where blood counts do NOT support a reduce dose decision (numerator)
# B2_b <- dplyr::filter(B2_a, (ANC <= anc_range[1] | ANC > anc_range[2]))%>%
# dplyr::filter(PLT <= plt_range[1] | PLT > plt_range[2])
if(code == "A"){
if(all(which(!is.na(range_vector)) == "1")){
B2_b <- dplyr::filter(B2_a, (ANC <= anc_range[1] | ANC > anc_range[2]))
}else if(all(which(!is.na(range_vector)) == "2")){
B2_b <- dplyr::filter(B2_a, (PLT <= plt_range[1] | PLT > plt_range[2]))
}else if(all(which(!is.na(range_vector)) == "3")){
B2_b <- dplyr::filter(B2_a, (Hb <= hb_range[1] | Hb > hb_range[2]))
}
} else if(code == "B"){
if(all(which(!is.na(range_vector)) %in% c("1", "2"))){
B2_b <- dplyr::filter(B2_a, (ANC <= anc_range[1] | ANC > anc_range[2]))%>%
dplyr::filter(PLT <= plt_range[1] | PLT > plt_range[2])
}else if(all(which(!is.na(range_vector)) %in% c("1", "3"))){
B2_b <- dplyr::filter(B2_a, (ANC <= anc_range[1] | ANC > anc_range[2]))%>%
dplyr::filter(Hb <= hb_range[1] | Hb > hb_range[2])
}else if(all(which(!is.na(range_vector)) %in% c("3", "2"))){
B2_b <- dplyr::filter(B2_a, (Hb <= hb_range[1] | Hb > hb_range[2]))%>%
dplyr::filter(PLT <= plt_range[1] | PLT > plt_range[2])
}
}else{
B2_b <- dplyr::filter(B2_a, (ANC <= anc_range[1] | ANC > anc_range[2]))%>%
dplyr::filter(PLT <= plt_range[1] | PLT > plt_range[2]) %>%
dplyr::filter(Hb <= hb_range[1] | Hb > hb_range[2])
}
B2_n <- rbind(B2_n, dplyr::count(B2_b))
if(length(pat_list) <=1){
temp_df$ID <- tools::file_path_sans_ext(file_name)
temp_df$`No. of 'dose reduce' decisions` <- sum(B2_d)
temp_df$`No. of times the counts did not support dose decision` <- sum(B2_n)
temp_df$`Discordance (%)` <- paste0(round(((sum(B2_n)/sum(B2_d))*100),2), "%")
}
if(length(pat_list) > 1){
temp_df$ID <- tools::file_path_sans_ext(names(pat_list)[i])
temp_df$`No. of 'dose reduce' decisions` <- sum(B2_d)
temp_df$`No. of times the counts did not support dose decision` <- sum(B2_n)
temp_df$`Discordance (%)` <- paste0(round(((sum(B2_n)/sum(B2_d))*100),2), "%")
}
reduce_doses_df <- rbind(reduce_doses_df, temp_df)
} # end of for loop
result <- NULL
if(length(pat_list) > 1){
med_res <- sapply(reduce_doses_df[,2:3], rounding_off)
df <- data.frame(Parameter = c("No. of patients analyzed",
"Total no. of 'REDUCED DOSE' decisions",
"Total no. of time counts did not support dose decision",
"'REDUCED DOSE' decisions: median [IQR]",
"Counts did not support dose decision: median [IQR]"),
Results = c(nrow(reduce_doses_df), sum(reduce_doses_df$`No. of 'dose reduce' decisions`),
sum(reduce_doses_df$`No. of times the counts did not support dose decision`),
med_res[1], med_res[2]))
result[[1]] <- reduce_doses_df
result[[2]] <- df %>% knitr::kable(format = "rst", caption = "'Reduced dose' decision analysis for given cohort")
result[[3]] <- df %>% htmlTable::addHtmlTableStyle(align = "lc", col.rgroup = c("white", "#e6e6e6"),
css.cell = "width: 250px", css.header = "background-color: #e6e6e6") %>%
htmlTable::htmlTable(caption = "Table: 'REDUCED DOSE' analysis", rnames = FALSE)
return(result)
}else{
b <- as.data.frame(t(reduce_doses_df))
colnames(b) <- "Result"
b <- b %>%
tibble::rownames_to_column("Parameter")
result[[1]] <- reduce_doses_df
result[[2]] <- b %>% knitr::kable(format = "rst")
result[[3]] <- b %>% htmlTable::addHtmlTableStyle(align = "lc", col.rgroup = c("white", "#e6e6e6"),
css.cell = "width: 200px", css.header = "background-color: #e6e6e6") %>%
htmlTable::htmlTable(caption = "Table: 'REDUCED DOSE' analysis", rnames = FALSE)
return(result)
}
message("'REDUCED DOSE' decisions analyzed")
},
error = function(e) {
message("Error")
print(e)
},
warning = function(w) {
message("Warning")
print(w)
},
finally = {
message("Quitting")
message("Bye Bye: Did you know that sunset on Mars is blue :)?")
}
)
}