Skip to content

Commit b8bdcec

Browse files
luffmarkluffmark
committed
Implement user input for day window between peaks
1 parent 938b8e3 commit b8bdcec

3 files changed

Lines changed: 186 additions & 143 deletions

File tree

‎R/check_call_auto.R‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,8 @@
55
# dv.edish::mod_edish
66
check_mod_edish_auto <- function(afmm, datasets, module_id, subject_level_dataset_name, lab_dataset_name,
77
subjectid_var, arm_var, arm_default_vals, visit_var, baseline_visit_val, lb_test_var, at_choices,
8-
tbili_choice, alp_choice, lb_date_var, lb_result_var, ref_range_upper_lim_var, receiver_id, warn,
9-
err) {
8+
at_default_val, tbili_choice, alp_choice, lb_date_var, lb_result_var, ref_range_upper_lim_var, window_days,
9+
receiver_id, warn, err) {
1010
OK <- logical(0)
1111
used_dataset_names <- new.env(parent = emptyenv())
1212
OK[["module_id"]] <- CM$check_module_id("module_id", module_id, warn, err)
@@ -43,6 +43,9 @@ check_mod_edish_auto <- function(afmm, datasets, module_id, subject_level_datase
4343
flags <- list(one_or_more = TRUE)
4444
OK[["at_choices"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("at_choices", at_choices,
4545
flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn, err)
46+
flags <- list(optional = TRUE)
47+
OK[["at_default_val"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("at_default_val",
48+
at_default_val, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn, err)
4649
flags <- structure(list(), names = character(0))
4750
OK[["tbili_choice"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("tbili_choice",
4851
tbili_choice, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn, err)
@@ -62,6 +65,9 @@ check_mod_edish_auto <- function(afmm, datasets, module_id, subject_level_datase
6265
OK[["ref_range_upper_lim_var"]] <- OK[["lab_dataset_name"]] && CM$check_dataset_colum_name("ref_range_upper_lim_var",
6366
ref_range_upper_lim_var, subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], warn,
6467
err)
68+
"NOTE: window_days (numeric) has no associated automated checks"
69+
" The expectation is that it either does not require them or that"
70+
" the caller of this function has written manual checks near the call site."
6571
"NOTE: receiver_id (character) has no associated automated checks"
6672
" The expectation is that it either does not require them or that"
6773
" the caller of this function has written manual checks near the call site."

‎R/helper_functions.R‎

Lines changed: 94 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -17,9 +17,6 @@ utils::globalVariables(".")
1717
#' @param visit_var `[character(1)]`
1818
#'
1919
#' Name of the variable containing the visit information.
20-
#' @param baseline_visit_val `[character(1)]`
21-
#'
22-
#' Character indicating which visit should be used as baseline visit.
2320
#' @param lb_test_var `[character(1)]`
2421
#'
2522
#' Name of the variable containing the laboratory test information.
@@ -41,21 +38,17 @@ utils::globalVariables(".")
4138
#'
4239
#' @importFrom rlang .data
4340
#' @keywords internal
44-
prepare_initial_data <- function(
45-
dataset_list,
46-
subjectid_var,
47-
arm_var,
48-
visit_var,
49-
baseline_visit_val,
50-
lb_test_var,
51-
at_choices,
52-
tbili_choice,
53-
plot_type,
54-
window_days,
55-
alp_choice,
56-
lb_date_var,
57-
lb_result_var,
58-
ref_range_upper_lim_var) {
41+
prepare_initial_data <- function(dataset_list,
42+
subjectid_var,
43+
arm_var,
44+
visit_var,
45+
lb_test_var,
46+
at_choices,
47+
tbili_choice,
48+
alp_choice,
49+
lb_date_var,
50+
lb_result_var,
51+
ref_range_upper_lim_var) {
5952

6053
# Keep only the necessary variables
6154
sel_dataset_list <- lapply(dataset_list, function(x) {
@@ -71,44 +64,90 @@ prepare_initial_data <- function(
7164
x[intersect(vars, names(x))]
7265
})
7366

74-
# # Return if subject-level dataset has zero rows
75-
# if (nrow(sel_dataset_list[[1]]) == 0) {
76-
# return(NULL)
77-
# }
78-
79-
#browser()
80-
## !!! What if date is NA? Should such rows be dropped with warning?
81-
## ! Need tests for this function
82-
## ! Do not forget: POSIXct needs to be converted to Date
83-
8467
# Join subject-level dataset with lab dataset keeping only max value at each visit
8568
combined_dataset <- Reduce(dplyr::full_join, sel_dataset_list) |>
8669
dplyr::filter(.data[[lb_test_var]] %in% c(at_choices, tbili_choice, alp_choice)) |>
8770
dplyr::group_by(.data[[subjectid_var]], .data[[arm_var]], .data[[lb_test_var]], .data[[visit_var]]) |>
8871
dplyr::filter(!all(is.na(.data[[lb_result_var]]))) |> # Filter out groups with all NA to avoid warning
89-
#dplyr::filter(.data[[lb_result_var]] == max(.data[[lb_result_var]], na.rm = TRUE)) |>
9072
dplyr::slice_max(.data[[lb_result_var]], n = 1, with_ties = FALSE) |>
9173
dplyr::ungroup()
9274

75+
return(combined_dataset)
76+
}
77+
78+
#' Derive required variables for plotting
79+
#'
80+
#' @param dataset `[data.frame]`
81+
#'
82+
#' A data frame containing the data from `prepare_initial_data()`.
83+
#' @param baseline_visit_val `[character(1)]`
84+
#'
85+
#' String indicating which visit should be used as baseline visit.
86+
#' @param norm_ref_type `[character(1)]`
87+
#'
88+
#' String indicating normalization reference type, either `ULN` or `Baseline`.
89+
#' @param window_days `[integer(1)]`
90+
#'
91+
#' Window of the number of days considered between peaks.
92+
#'
93+
#' @return A data frame with the following derived variables:
94+
#' - `.ref_val`: ULN or baseline as the reference value for normalization.
95+
#' - `.visit_at`: Visit of peak aminotransferase value.
96+
#' - `.date_at`: Date of peak aminotransferase value.
97+
#' - `.norm_at`: Normalized peak aminotransferase value.
98+
#' - `.visit_tbili`: Visit of peak total bilirubin value.
99+
#' - `.date_tbili`: Date of peak total bilirubin value.
100+
#' - `.norm_tbili`: Normalized peak total bilirubin value.
101+
#' - `.norm_alp`: Normalized alkaline phosphotase value at same visit as aminotransferase value.
102+
#' - `.offset_days`: Number of days from aminotransferase visit to total bilirubin visit.
103+
#' - `.norm_ref_type`: Normalization reference type, copied from `norm_ref_type` argument.
104+
#'
105+
#' @inheritParams prepare_initial_data
106+
#' @keywords internal
107+
derive_req_vars <- function(dataset,
108+
subjectid_var,
109+
arm_var,
110+
visit_var,
111+
baseline_visit_val,
112+
lb_test_var,
113+
at_choices,
114+
tbili_choice,
115+
norm_ref_type,
116+
alp_choice,
117+
lb_date_var,
118+
lb_result_var,
119+
ref_range_upper_lim_var,
120+
window_days) {
121+
122+
# If window not specified then ensure all data are included in peak comparisons
123+
if (is.na(window_days)) window_days <- Inf
124+
125+
#browser()
126+
## !!! What if date is NA? Should such rows be dropped with warning?
127+
## ! Need tests for this function
128+
## ! Do not forget: POSIXct needs to be converted to Date
129+
130+
ref_dataset <- dataset
131+
93132
# Set either ULN or baseline as the reference value for normalization
94-
if (plot_type == "ULN") {
95-
combined_dataset[[".ref_val"]] <- combined_dataset[[ref_range_upper_lim_var]]
133+
if (norm_ref_type == "ULN") {
134+
ref_dataset[[".ref_val"]] <- ref_dataset[[ref_range_upper_lim_var]]
96135
} else {
97136
# Process baseline data
98-
base_data <- combined_dataset[combined_dataset[[visit_var]] == baseline_visit_val, ]
137+
base_data <- ref_dataset[ref_dataset[[visit_var]] == baseline_visit_val, ]
99138
base_data[[".ref_val"]] <- base_data[[lb_result_var]]
100139
base_data <- base_data[, c(subjectid_var, arm_var, lb_test_var, ".ref_val")]
101140

102141
# Merge on baseline values
103-
combined_dataset <- combined_dataset |>
142+
ref_dataset <- ref_dataset |>
104143
dplyr::left_join(base_data, by = c(subjectid_var, arm_var, lb_test_var))
105144
}
106145

107146
# Normalize lab values
108-
combined_dataset[[".norm_val"]] <- combined_dataset[[lb_result_var]] / combined_dataset[[".ref_val"]]
147+
ref_dataset[[".norm_val"]] <- ref_dataset[[lb_result_var]] / ref_dataset[[".ref_val"]]
109148

110149
# Get peak values of post-baseline aminotransferase (AT) rows
111-
peak_at_data <- combined_dataset |>
150+
peak_at_data <- ref_dataset |>
112151
dplyr::filter(.data[[lb_test_var]] %in% at_choices,
113152
.data[[visit_var]] != baseline_visit_val) |>
114153
dplyr::group_by(.data[[subjectid_var]], .data[[arm_var]], .data[[lb_test_var]]) |>
@@ -121,7 +160,7 @@ prepare_initial_data <- function(
121160
.norm_at = ".norm_val")
122161

123162
# Get post-baseline total bilirubin (TBILI) rows
124-
tbili_data <- combined_dataset |>
163+
tbili_data <- ref_dataset |>
125164
dplyr::filter(.data[[lb_test_var]] == tbili_choice,
126165
.data[[visit_var]] != baseline_visit_val) |>
127166
dplyr::select(subjectid_var, arm_var,
@@ -144,7 +183,7 @@ prepare_initial_data <- function(
144183
dplyr::ungroup()
145184

146185
# Get alkaline phosphatase (ALP) values
147-
alp_data <- combined_dataset |>
186+
alp_data <- ref_dataset |>
148187
dplyr::filter(.data[[lb_test_var]] == alp_choice) |>
149188
dplyr::select(subjectid_var, arm_var, visit_var, .norm_alp = ".norm_val")
150189

@@ -153,13 +192,11 @@ prepare_initial_data <- function(
153192
dplyr::left_join(alp_data, by = c(subjectid_var, arm_var, ".visit_at" = visit_var))
154193

155194
# Set plot type
156-
final_dataset[[".plot_type"]] <- plot_type
195+
final_dataset[[".norm_ref_type"]] <- norm_ref_type
157196

158197
return(final_dataset)
159198
}
160199

161-
162-
163200
#' Filter data
164201
#'
165202
#' `filter_data()` filters `dataset` to only contain the values of `sel_lb_test`
@@ -179,10 +216,10 @@ prepare_initial_data <- function(
179216
#'
180217
#' @inheritParams prepare_initial_data
181218
#' @keywords internal
182-
filter_data <- function(dataset, plot_type, arm_var, sel_arm, lb_test_var, sel_lb_test) {
219+
filter_data <- function(dataset, norm_ref_type, arm_var, sel_arm, lb_test_var, sel_lb_test) {
183220
dataset <- dataset |>
184221
dplyr::filter(
185-
.data[[".plot_type"]] == plot_type,
222+
.data[[".norm_ref_type"]] == norm_ref_type,
186223
.data[[lb_test_var]] == sel_lb_test,
187224
.data[[arm_var]] %in% sel_arm
188225
)
@@ -468,19 +505,18 @@ filter_data <- function(dataset, plot_type, arm_var, sel_arm, lb_test_var, sel_l
468505
#' return(plt_obj)
469506
#' }
470507

471-
generate_plot <- function(
472-
dataset,
473-
subjectid_var,
474-
arm_var,
475-
sel_x,
476-
sel_y,
477-
plot_type,
478-
x_ref_line_num,
479-
y_ref_line_num,
480-
x_rng_lower,
481-
x_rng_upper,
482-
y_rng_lower,
483-
y_rng_upper) {
508+
generate_plot <- function(dataset,
509+
subjectid_var,
510+
arm_var,
511+
sel_x,
512+
sel_y,
513+
norm_ref_type,
514+
x_ref_line_num,
515+
y_ref_line_num,
516+
x_rng_lower,
517+
x_rng_upper,
518+
y_rng_lower,
519+
y_rng_upper) {
484520

485521
dataset[["hover_date_x"]] <- gsub(
486522
"NA", "",
@@ -508,7 +544,7 @@ generate_plot <- function(
508544
"<br>---<br>", sel_x, ": ", sprintf("%.3f", dataset[[".norm_at"]]),
509545
"<br> Visit: ", dataset[[".visit_at"]],
510546
"<br> Date: ", dataset[["hover_date_x"]],
511-
"<br> ALP/", plot_type, ": ", dataset[["hover_alp"]],
547+
"<br> ALP/", norm_ref_type, ": ", dataset[["hover_alp"]],
512548
"<br>---<br>", sel_y, ": ", sprintf("%.3f", dataset[[".norm_tbili"]]),
513549
"<br> Visit: ", dataset[[".visit_tbili"]],
514550
"<br> Date: ", dataset[["hover_date_y"]],
@@ -556,8 +592,8 @@ generate_plot <- function(
556592
size = 2,
557593
alpha = 0.8,
558594
stroke = 0) +
559-
ggplot2::labs(x = paste0(sel_x, "/", plot_type),
560-
y = paste0(sel_y, "/", plot_type),
595+
ggplot2::labs(x = paste0(sel_x, "/", norm_ref_type),
596+
y = paste0(sel_y, "/", norm_ref_type),
561597
color = "") +
562598
ggplot2::theme_minimal(base_family = "Arial",
563599
base_size = 9)

0 commit comments

Comments
 (0)