1 |
#' Function to create a spaghetti plot. |
|
2 |
#' |
|
3 |
#' This function is rendered by teal.goshawk module |
|
4 |
#' |
|
5 |
#' @param data data frame with variables to be summarized and generate statistics which will display |
|
6 |
#' in the plot. |
|
7 |
#' @param subj_id unique subject id variable name. |
|
8 |
#' @param biomarker_var name of variable containing biomarker names. |
|
9 |
#' @param biomarker_var_label name of variable containing biomarker labels. |
|
10 |
#' @param biomarker biomarker name to be analyzed. |
|
11 |
#' @param value_var name of variable containing biomarker results. |
|
12 |
#' @param unit_var name of variable containing biomarker units. |
|
13 |
#' @param trt_group name of variable representing treatment group. |
|
14 |
#' @param trt_group_level vector that can be used to define the factor level of `trt_group`. |
|
15 |
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. |
|
16 |
#' @param time name of variable containing visit names. |
|
17 |
#' @param time_level vector that can be used to define the factor level of time. Only use it when |
|
18 |
#' x-axis variable is character or factor. |
|
19 |
#' @param color_manual vector of colors. |
|
20 |
#' @param color_comb name or hex value for combined treatment color. |
|
21 |
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis |
|
22 |
#' if the default limits are not suitable. |
|
23 |
#' @param alpha subject line transparency (0 = transparent, 1 = opaque) |
|
24 |
#' @param facet_ncol number of facets per row. |
|
25 |
#' @param facet_scales passed to `scales` in [`ggplot2::facet_wrap`]. Should scales be fixed (`"fixed"`, |
|
26 |
#' the default), free (`"free"`), or free in one dimension (`"free_x"`, `"free_y"`)? |
|
27 |
#' @param xtick a vector to define the tick values of time in x-axis. |
|
28 |
#' Default value is `ggplot2::waiver()`. |
|
29 |
#' @param xlabel vector with same length of `xtick` to define the label of x-axis tick values. Default |
|
30 |
#' value is `ggplot2::waiver()`. |
|
31 |
#' @param rotate_xlab boolean whether to rotate x-axis labels. |
|
32 |
#' @param font_size control font size for title, x-axis, y-axis and legend font. |
|
33 |
#' @param dot_size plot dot size. Default to 2. |
|
34 |
#' @param group_stats control group mean or median overlay. |
|
35 |
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines. |
|
36 |
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines. |
|
37 |
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines. |
|
38 |
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values. |
|
39 |
#' The data inside of the `ggplot2` object must also contain the columns with these variable names |
|
40 |
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables. |
|
41 |
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables. |
|
42 |
#' |
|
43 |
#' |
|
44 |
#' @author Wenyi Liu (wenyi.liu@roche.com) |
|
45 |
#' |
|
46 |
#' @return \code{ggplot} object |
|
47 |
#' |
|
48 |
#' @export |
|
49 |
#' |
|
50 |
#' @examples |
|
51 |
#' # Example using ADaM structure analysis dataset. |
|
52 |
#' |
|
53 |
#' library(stringr) |
|
54 |
#' |
|
55 |
#' # original ARM value = dose value |
|
56 |
#' arm_mapping <- list( |
|
57 |
#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination" |
|
58 |
#' ) |
|
59 |
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C") |
|
60 |
#' |
|
61 |
#' ADLB <- rADLB |
|
62 |
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label) |
|
63 |
#' ADLB <- ADLB %>% |
|
64 |
#' mutate(AVISITCD = case_when( |
|
65 |
#' AVISIT == "SCREENING" ~ "SCR", |
|
66 |
#' AVISIT == "BASELINE" ~ "BL", |
|
67 |
#' grepl("WEEK", AVISIT) ~ |
|
68 |
#' paste( |
|
69 |
#' "W", |
|
70 |
#' trimws( |
|
71 |
#' substr( |
|
72 |
#' AVISIT, |
|
73 |
#' start = 6, |
|
74 |
#' stop = str_locate(AVISIT, "DAY") - 1 |
|
75 |
#' ) |
|
76 |
#' ) |
|
77 |
#' ), |
|
78 |
#' TRUE ~ NA_character_ |
|
79 |
#' )) %>% |
|
80 |
#' mutate(AVISITCDN = case_when( |
|
81 |
#' AVISITCD == "SCR" ~ -2, |
|
82 |
#' AVISITCD == "BL" ~ 0, |
|
83 |
#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)), |
|
84 |
#' TRUE ~ NA_real_ |
|
85 |
#' )) %>% |
|
86 |
#' # use ARMCD values to order treatment in visualization legend |
|
87 |
#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1, |
|
88 |
#' ifelse(grepl("B", ARMCD), 2, |
|
89 |
#' ifelse(grepl("A", ARMCD), 3, NA) |
|
90 |
#' ) |
|
91 |
#' )) %>% |
|
92 |
#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>% |
|
93 |
#' mutate(ARM = factor(ARM) %>% |
|
94 |
#' reorder(TRTORD)) %>% |
|
95 |
#' mutate(ANRLO = .5, ANRHI = 1) %>% |
|
96 |
#' rowwise() %>% |
|
97 |
#' group_by(PARAMCD) %>% |
|
98 |
#' mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE), |
|
99 |
#' paste("<", round(runif(1, min = .5, max = .7))), LBSTRESC |
|
100 |
#' )) %>% |
|
101 |
#' mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE), |
|
102 |
#' paste(">", round(runif(1, min = .9, max = 1.2))), LBSTRESC |
|
103 |
#' )) %>% |
|
104 |
#' ungroup() |
|
105 |
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]] |
|
106 |
#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit" |
|
107 |
#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit" |
|
108 |
#' |
|
109 |
#' # add LLOQ and ULOQ variables |
|
110 |
#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") |
|
111 |
#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM") |
|
112 |
#' |
|
113 |
#' g_spaghettiplot( |
|
114 |
#' data = ADLB, |
|
115 |
#' subj_id = "USUBJID", |
|
116 |
#' biomarker_var = "PARAMCD", |
|
117 |
#' biomarker = "CRP", |
|
118 |
#' value_var = "AVAL", |
|
119 |
#' trt_group = "ARM", |
|
120 |
#' time = "AVISITCD", |
|
121 |
#' color_manual = color_manual, |
|
122 |
#' color_comb = "#39ff14", |
|
123 |
#' alpha = .02, |
|
124 |
#' xtick = c("BL", "W 1", "W 4"), |
|
125 |
#' xlabel = c("Baseline", "Week 1", "Week 4"), |
|
126 |
#' rotate_xlab = FALSE, |
|
127 |
#' group_stats = "median", |
|
128 |
#' hline_vars = c("ANRHI", "ANRLO"), |
|
129 |
#' hline_vars_colors = c("pink", "brown") |
|
130 |
#' ) |
|
131 |
#' |
|
132 |
#' g_spaghettiplot( |
|
133 |
#' data = ADLB, |
|
134 |
#' subj_id = "USUBJID", |
|
135 |
#' biomarker_var = "PARAMCD", |
|
136 |
#' biomarker = "CRP", |
|
137 |
#' value_var = "AVAL", |
|
138 |
#' trt_group = "ARM", |
|
139 |
#' time = "AVISITCD", |
|
140 |
#' color_manual = color_manual, |
|
141 |
#' color_comb = "#39ff14", |
|
142 |
#' alpha = .02, |
|
143 |
#' xtick = c("BL", "W 1", "W 4"), |
|
144 |
#' xlabel = c("Baseline", "Week 1", "Week 4"), |
|
145 |
#' rotate_xlab = FALSE, |
|
146 |
#' group_stats = "median", |
|
147 |
#' hline_arb = 1.3, |
|
148 |
#' hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"), |
|
149 |
#' hline_vars_colors = c("pink", "brown", "purple", "gray"), |
|
150 |
#' dot_size = 3 |
|
151 |
#' ) |
|
152 |
#' |
|
153 |
#' g_spaghettiplot( |
|
154 |
#' data = ADLB, |
|
155 |
#' subj_id = "USUBJID", |
|
156 |
#' biomarker_var = "PARAMCD", |
|
157 |
#' biomarker = "CRP", |
|
158 |
#' value_var = "AVAL", |
|
159 |
#' trt_group = "ARM", |
|
160 |
#' time = "AVISITCDN", |
|
161 |
#' color_manual = color_manual, |
|
162 |
#' color_comb = "#39ff14", |
|
163 |
#' alpha = .02, |
|
164 |
#' xtick = c(0, 1, 4), |
|
165 |
#' xlabel = c("Baseline", "Week 1", "Week 4"), |
|
166 |
#' rotate_xlab = FALSE, |
|
167 |
#' group_stats = "median", |
|
168 |
#' hline_arb = c(.5, .7, 1), |
|
169 |
#' hline_arb_color = c("blue", "red", "green"), |
|
170 |
#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"), |
|
171 |
#' hline_vars = c("ANRHI", "ANRLO"), |
|
172 |
#' dot_size = 4 |
|
173 |
#' ) |
|
174 |
#' |
|
175 |
#' # removing missing levels from the plot with facet_scales |
|
176 |
#' |
|
177 |
#' g_spaghettiplot( |
|
178 |
#' data = ADLB, |
|
179 |
#' subj_id = "USUBJID", |
|
180 |
#' biomarker_var = "PARAMCD", |
|
181 |
#' biomarker = "CRP", |
|
182 |
#' value_var = "AVAL", |
|
183 |
#' trt_group = "ARM", |
|
184 |
#' time = "RACE", |
|
185 |
#' color_manual = color_manual, |
|
186 |
#' color_comb = "#39ff14", |
|
187 |
#' alpha = .02, |
|
188 |
#' facet_scales = "fixed", |
|
189 |
#' rotate_xlab = FALSE, |
|
190 |
#' group_stats = "median", |
|
191 |
#' hline_arb = c(.5, .7, 1), |
|
192 |
#' hline_arb_color = c("blue", "red", "green"), |
|
193 |
#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"), |
|
194 |
#' hline_vars = c("ANRHI", "ANRLO") |
|
195 |
#' ) |
|
196 |
#' |
|
197 |
#' g_spaghettiplot( |
|
198 |
#' data = ADLB, |
|
199 |
#' subj_id = "USUBJID", |
|
200 |
#' biomarker_var = "PARAMCD", |
|
201 |
#' biomarker = "CRP", |
|
202 |
#' value_var = "AVAL", |
|
203 |
#' trt_group = "ARM", |
|
204 |
#' time = "RACE", |
|
205 |
#' color_manual = color_manual, |
|
206 |
#' color_comb = "#39ff14", |
|
207 |
#' alpha = .02, |
|
208 |
#' facet_scales = "free_x", |
|
209 |
#' rotate_xlab = FALSE, |
|
210 |
#' group_stats = "median", |
|
211 |
#' hline_arb = c(.5, .7, 1), |
|
212 |
#' hline_arb_color = c("blue", "red", "green"), |
|
213 |
#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"), |
|
214 |
#' hline_vars = c("ANRHI", "ANRLO"), |
|
215 |
#' dot_size = 1 |
|
216 |
#' ) |
|
217 |
#' |
|
218 |
g_spaghettiplot <- function(data, |
|
219 |
subj_id = "USUBJID", |
|
220 |
biomarker_var = "PARAMCD", |
|
221 |
biomarker_var_label = "PARAM", |
|
222 |
biomarker, |
|
223 |
value_var = "AVAL", |
|
224 |
unit_var = "AVALU", |
|
225 |
trt_group, |
|
226 |
trt_group_level = NULL, |
|
227 |
loq_flag_var = "LOQFL", |
|
228 |
time, |
|
229 |
time_level = NULL, |
|
230 |
color_manual = NULL, |
|
231 |
color_comb = "#39ff14", |
|
232 |
ylim = c(NA, NA), |
|
233 |
alpha = 1.0, |
|
234 |
facet_ncol = 2, |
|
235 |
facet_scales = c("fixed", "free", "free_x", "free_y"), |
|
236 |
xtick = ggplot2::waiver(), |
|
237 |
xlabel = xtick, |
|
238 |
rotate_xlab = FALSE, |
|
239 |
font_size = 12, |
|
240 |
dot_size = 2, |
|
241 |
group_stats = "NONE", |
|
242 |
hline_arb = numeric(0), |
|
243 |
hline_arb_color = "red", |
|
244 |
hline_arb_label = "Horizontal line", |
|
245 |
hline_vars = character(0), |
|
246 |
hline_vars_colors = "green", |
|
247 |
hline_vars_labels = hline_vars) { |
|
248 | ! |
checkmate::assert_numeric(ylim, len = 2) |
249 | ! |
facet_scales <- match.arg(facet_scales) |
250 | ||
251 |
## Pre-process data |
|
252 | ! |
label_trt_group <- attr(data[[trt_group]], "label") |
253 | ! |
data[[trt_group]] <- if (!is.null(trt_group_level)) { |
254 | ! |
factor(data[[trt_group]], levels = trt_group_level) |
255 |
} else { |
|
256 | ! |
factor(data[[trt_group]]) |
257 |
} |
|
258 | ! |
attr(data[[trt_group]], "label") <- label_trt_group |
259 | ||
260 | ||
261 | ! |
xtype <- ifelse(is.factor(data[[time]]) | is.character(data[[time]]), "discrete", "continuous") |
262 | ! |
gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label") |
263 | ! |
if (xtype == "discrete") { |
264 | ! |
data[[time]] <- if (!is.null(time_level)) { |
265 | ! |
factor(data[[time]], levels = time_level) |
266 |
} else { |
|
267 | ! |
factor(data[[time]]) |
268 |
} |
|
269 |
} |
|
270 | ||
271 |
# Plot |
|
272 | ! |
plot_data <- data %>% |
273 | ! |
filter(!!sym(biomarker_var) %in% biomarker) |
274 | ! |
unit <- plot_data %>% |
275 | ! |
select(!!sym(unit_var)) %>% |
276 | ! |
unique() %>% |
277 | ! |
magrittr::extract2(1) |
278 | ! |
unit1 <- ifelse(is.na(unit) | unit == "", " ", paste0(" (", unit, ") ")) |
279 | ! |
biomarker1 <- plot_data %>% |
280 | ! |
select(!!sym(biomarker_var_label)) %>% |
281 | ! |
unique() %>% |
282 | ! |
magrittr::extract2(1) |
283 | ! |
gtitle <- paste0(biomarker1, unit1, " Values by Treatment @ Visits") |
284 | ! |
gylab <- paste0(biomarker1, " ", value_var, " Values") |
285 | ||
286 |
# Setup legend label |
|
287 | ! |
trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label")) |
288 | ||
289 |
# Add footnote to identify LLOQ and ULOQ values pulled from data |
|
290 | ! |
caption_loqs_label <- h_caption_loqs_label(loqs_data = plot_data, flag_var = loq_flag_var) |
291 | ||
292 | ! |
plot <- ggplot2::ggplot( |
293 | ! |
data = plot_data, |
294 | ! |
ggplot2::aes(x = !!sym(time), y = !!sym(value_var), color = !!sym(trt_group), group = !!sym(subj_id)) |
295 |
) + |
|
296 | ! |
ggplot2::geom_point(size = dot_size, na.rm = TRUE, ggplot2::aes(shape = !!sym(loq_flag_var))) + |
297 | ! |
ggplot2::geom_line(linewidth = 0.4, alpha = alpha, na.rm = TRUE) + |
298 | ! |
ggplot2::facet_wrap(trt_group, ncol = facet_ncol, scales = facet_scales) + |
299 | ! |
ggplot2::labs(caption = caption_loqs_label) + |
300 | ! |
ggplot2::theme_bw() + |
301 | ! |
ggplot2::ggtitle(gtitle) + |
302 | ! |
ggplot2::xlab(gxlab) + |
303 | ! |
ggplot2::ylab(gylab) + |
304 | ! |
ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, margin = ggplot2::margin(), hjust = 0.5)) |
305 | ||
306 |
# Apply y-axis zoom range |
|
307 | ! |
plot <- plot + ggplot2::coord_cartesian(ylim = ylim) |
308 | ||
309 |
# add group statistics |
|
310 |
# can't use stat_summary() because of presenting values for groups with all missings |
|
311 | ! |
if (group_stats != "NONE") { |
312 | ! |
if (group_stats == "MEAN") { |
313 | ! |
plot_data_groupped <- plot_data %>% |
314 | ! |
group_by(!!sym(trt_group), !!sym(time)) %>% |
315 | ! |
transmute(AGG_VAL = mean(!!sym(value_var), na.rm = TRUE)) |
316 | ||
317 | ! |
plot_data_groupped$metric <- "Mean" |
318 |
} else { |
|
319 | ! |
plot_data_groupped <- plot_data %>% |
320 | ! |
group_by(!!sym(trt_group), !!sym(time)) %>% |
321 | ! |
transmute(AGG_VAL = stats::median(!!sym(value_var), na.rm = TRUE)) |
322 | ||
323 | ! |
plot_data_groupped$metric <- "Median" |
324 |
} |
|
325 | ! |
plot <- plot + |
326 | ! |
ggplot2::geom_line( |
327 | ! |
ggplot2::aes(x = !!sym(time), y = .data$AGG_VAL, group = 1, linetype = .data$metric), |
328 | ! |
data = plot_data_groupped, |
329 | ! |
lwd = 1, |
330 | ! |
color = color_comb, |
331 | ! |
na.rm = TRUE |
332 |
) + |
|
333 | ! |
ggplot2::guides(linetype = ggplot2::guide_legend("Group statistic", order = 2)) |
334 |
} |
|
335 |
# Format x-label |
|
336 | ! |
if (xtype == "continuous") { |
337 | ! |
plot <- plot + |
338 | ! |
ggplot2::scale_x_continuous(breaks = xtick, labels = xlabel, limits = c(NA, NA)) |
339 | ! |
} else if (xtype == "discrete") { |
340 | ! |
plot <- plot + |
341 | ! |
ggplot2::scale_x_discrete(breaks = xtick, labels = xlabel) |
342 |
} |
|
343 | ! |
if (rotate_xlab) { |
344 | ! |
plot <- plot + |
345 | ! |
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) |
346 |
} |
|
347 |
# Add manual color |
|
348 | ! |
if (!is.null(color_manual)) { |
349 | ! |
plot <- plot + |
350 | ! |
ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1)) |
351 |
} else { |
|
352 | ! |
plot + |
353 | ! |
ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1)) |
354 |
} |
|
355 | ||
356 | ||
357 |
# Format font size |
|
358 | ! |
if (!is.null(font_size)) { |
359 | ! |
plot <- plot + |
360 | ! |
ggplot2::theme( |
361 | ! |
plot.title = ggplot2::element_text(size = font_size, margin = ggplot2::margin()), |
362 | ! |
axis.title.x = ggplot2::element_text(size = font_size), |
363 | ! |
axis.text.x = ggplot2::element_text(size = font_size), |
364 | ! |
axis.title.y = ggplot2::element_text(size = font_size), |
365 | ! |
axis.text.y = ggplot2::element_text(size = font_size), |
366 | ! |
legend.title = ggplot2::element_text(size = font_size), |
367 | ! |
legend.text = ggplot2::element_text(size = font_size), |
368 | ! |
strip.text.x = ggplot2::element_text(size = font_size), |
369 | ! |
strip.text.y = ggplot2::element_text(size = font_size) |
370 |
) |
|
371 |
} |
|
372 |
# Add horizontal line for range based on option |
|
373 | ! |
plot + geom_axes_lines( |
374 | ! |
plot_data, |
375 | ! |
hline_arb = hline_arb, |
376 | ! |
hline_arb_color = hline_arb_color, |
377 | ! |
hline_arb_label = hline_arb_label, |
378 | ! |
hline_vars = hline_vars, |
379 | ! |
hline_vars_colors = hline_vars_colors, |
380 | ! |
hline_vars_labels = hline_vars_labels |
381 |
) |
|
382 |
} |
1 |
#' Function to create a scatter plot. |
|
2 |
#' |
|
3 |
#' @description |
|
4 |
#' `r lifecycle::badge("deprecated")` |
|
5 |
#' |
|
6 |
#' `g_scatterplot()` is deprecated. Please use |
|
7 |
#' [g_correlationplot()] instead. Default plot displays scatter facetted by |
|
8 |
#' visit with color attributed treatment arms and symbol attributed `LOQ` values. |
|
9 |
#' |
|
10 |
#' @param label text string to used to identify plot. |
|
11 |
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`. |
|
12 |
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`. |
|
13 |
#' @param param biomarker to visualize e.g. `IGG`. |
|
14 |
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `BASE`. |
|
15 |
#' @param yaxis_var name of variable containing biomarker results displayed on Y-axis e.g. `AVAL`. |
|
16 |
#' @param trt_group name of variable representing treatment group e.g. `ARM`. |
|
17 |
#' @param visit name of variable containing nominal visits e.g. `AVISITCD`. |
|
18 |
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. |
|
19 |
#' @param unit name of variable containing biomarker unit e.g. `AVALU`. |
|
20 |
#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis |
|
21 |
#' if the default limits are not suitable. |
|
22 |
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis |
|
23 |
#' if the default limits are not suitable. |
|
24 |
#' @param color_manual vector of colors applied to treatment values. |
|
25 |
#' @param shape_manual vector of symbols applied to `LOQ` values. |
|
26 |
#' @param facet_ncol number of facets per row. |
|
27 |
#' @param facet set layout to use treatment facetting. |
|
28 |
#' @param facet_var variable to use for treatment facetting. |
|
29 |
#' @param reg_line include regression line and annotations for slope and coefficient in |
|
30 |
#' visualization. Use with facet = TRUE. |
|
31 |
#' @param hline y-axis value to position a horizontal line. |
|
32 |
#' @param vline x-axis value to position a vertical line. |
|
33 |
#' @param rotate_xlab 45 degree rotation of x-axis label values. |
|
34 |
#' @param font_size font size control for title, x-axis label, y-axis label and legend. |
|
35 |
#' @param dot_size plot dot size. |
|
36 |
#' @param reg_text_size font size control for regression line annotations. |
|
37 |
#' |
|
38 |
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com |
|
39 |
#' @author Balazs Toth (tothb2) toth.balazs@gene.com |
|
40 |
#' |
|
41 |
#' @details Regression uses `deming` model. |
|
42 |
#' |
|
43 |
#' @export |
|
44 |
#' |
|
45 |
#' @examples |
|
46 |
#' # Example using ADaM structure analysis dataset. |
|
47 |
#' |
|
48 |
#' library(stringr) |
|
49 |
#' |
|
50 |
#' # original ARM value = dose value |
|
51 |
#' arm_mapping <- list( |
|
52 |
#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination" |
|
53 |
#' ) |
|
54 |
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C") |
|
55 |
#' # assign LOQ flag symbols: circles for "N" and triangles for "Y", squares for "NA" |
|
56 |
#' shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0) |
|
57 |
#' |
|
58 |
#' ADLB <- rADLB |
|
59 |
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label) |
|
60 |
#' ADLB <- ADLB %>% |
|
61 |
#' mutate(AVISITCD = case_when( |
|
62 |
#' AVISIT == "SCREENING" ~ "SCR", |
|
63 |
#' AVISIT == "BASELINE" ~ "BL", |
|
64 |
#' grepl("WEEK", AVISIT) ~ |
|
65 |
#' paste( |
|
66 |
#' "W", |
|
67 |
#' trimws( |
|
68 |
#' substr( |
|
69 |
#' AVISIT, |
|
70 |
#' start = 6, |
|
71 |
#' stop = str_locate(AVISIT, "DAY") - 1 |
|
72 |
#' ) |
|
73 |
#' ) |
|
74 |
#' ), |
|
75 |
#' TRUE ~ NA_character_ |
|
76 |
#' )) %>% |
|
77 |
#' mutate(AVISITCDN = case_when( |
|
78 |
#' AVISITCD == "SCR" ~ -2, |
|
79 |
#' AVISITCD == "BL" ~ 0, |
|
80 |
#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)), |
|
81 |
#' TRUE ~ NA_real_ |
|
82 |
#' )) %>% |
|
83 |
#' # use ARMCD values to order treatment in visualization legend |
|
84 |
#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1, |
|
85 |
#' ifelse(grepl("B", ARMCD), 2, |
|
86 |
#' ifelse(grepl("A", ARMCD), 3, NA) |
|
87 |
#' ) |
|
88 |
#' )) %>% |
|
89 |
#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>% |
|
90 |
#' mutate(ARM = factor(ARM) %>% |
|
91 |
#' reorder(TRTORD)) |
|
92 |
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]] |
|
93 |
#' |
|
94 |
#' g_scatterplot( |
|
95 |
#' label = "Scatter Plot", |
|
96 |
#' data = ADLB, |
|
97 |
#' param_var = "PARAMCD", |
|
98 |
#' param = c("ALT"), |
|
99 |
#' xaxis_var = "BASE", |
|
100 |
#' yaxis_var = "AVAL", |
|
101 |
#' trt_group = "ARM", |
|
102 |
#' visit = "AVISITCD", |
|
103 |
#' loq_flag_var = "LOQFL", |
|
104 |
#' unit = "AVALU", |
|
105 |
#' color_manual = color_manual, |
|
106 |
#' shape_manual = shape_manual, |
|
107 |
#' facet_ncol = 2, |
|
108 |
#' facet = TRUE, |
|
109 |
#' facet_var = "ARM", |
|
110 |
#' reg_line = TRUE, |
|
111 |
#' hline = NULL, |
|
112 |
#' vline = .5, |
|
113 |
#' rotate_xlab = TRUE, |
|
114 |
#' font_size = 14, |
|
115 |
#' dot_size = 2, |
|
116 |
#' reg_text_size = 3 |
|
117 |
#' ) |
|
118 |
g_scatterplot <- function(label = "Scatter Plot", |
|
119 |
data, |
|
120 |
param_var = "PARAMCD", |
|
121 |
param = "CRP", |
|
122 |
xaxis_var = "BASE", |
|
123 |
yaxis_var = "AVAL", |
|
124 |
trt_group = "ARM", |
|
125 |
visit = "AVISITCD", |
|
126 |
loq_flag_var = "LOQFL", |
|
127 |
unit = "AVALU", |
|
128 |
xlim = c(NA, NA), |
|
129 |
ylim = c(NA, NA), |
|
130 |
color_manual = NULL, |
|
131 |
shape_manual = NULL, |
|
132 |
facet_ncol = 2, |
|
133 |
facet = FALSE, |
|
134 |
facet_var = "ARM", |
|
135 |
reg_line = FALSE, |
|
136 |
hline = NULL, |
|
137 |
vline = NULL, |
|
138 |
rotate_xlab = FALSE, |
|
139 |
font_size = 12, |
|
140 |
dot_size = NULL, |
|
141 |
reg_text_size = 3) { |
|
142 | ! |
lifecycle::deprecate_soft( |
143 | ! |
when = "0.1.15", |
144 | ! |
what = "g_scatterplot()", |
145 | ! |
details = "You should use goshawk::g_correlationplot instead of goshawk::g_scatterplot" |
146 |
) |
|
147 | ||
148 | ! |
checkmate::assert_numeric(xlim, len = 2) |
149 | ! |
checkmate::assert_numeric(ylim, len = 2) |
150 | ||
151 |
# create scatter plot over time pairwise per treatment arm |
|
152 | ! |
plot_data <- data %>% |
153 | ! |
filter(!!sym(param_var) == param) |
154 |
# Setup the ggtitle label. Combine the biomarker and the units (if available) |
|
155 | ! |
ggtitle_label <- ifelse(is.null(unit), paste0(plot_data$PARAM, "@ Visits"), |
156 | ! |
ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, "@ Visits"), |
157 | ! |
paste0(plot_data$PARAM, " (", plot_data[[unit]], ") @ Visits") |
158 |
) |
|
159 |
) |
|
160 |
# Setup the x-axis label. Combine the biomarker and the units (if available) |
|
161 | ! |
x_axis_label <- ifelse(is.null(unit), paste(plot_data$PARAM, xaxis_var, "Values"), |
162 | ! |
ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, xaxis_var, "Values"), |
163 | ! |
paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", xaxis_var, " Values") |
164 |
) |
|
165 |
) |
|
166 |
# Setup the y-axis label. Combine the biomarker and the units (if available) |
|
167 | ! |
y_axis_label <- ifelse(is.null(unit), paste(plot_data$PARAM, yaxis_var, "Values"), |
168 | ! |
ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, yaxis_var, "Values"), |
169 | ! |
paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", yaxis_var, " Values") |
170 |
) |
|
171 |
) |
|
172 |
# Setup legend label |
|
173 | ! |
trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label")) |
174 |
# create plot foundation |
|
175 | ! |
plot1 <- ggplot2::ggplot( |
176 | ! |
data = plot_data, |
177 | ! |
ggplot2::aes( |
178 | ! |
x = !!sym(xaxis_var), |
179 | ! |
y = !!sym(yaxis_var), |
180 | ! |
color = !!sym(trt_group) |
181 |
) |
|
182 |
) + |
|
183 | ! |
ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE) + |
184 | ! |
ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) + |
185 | ! |
ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", visit)), ncol = facet_ncol) + |
186 | ! |
ggplot2::theme_bw() + |
187 | ! |
ggplot2::ggtitle(ggtitle_label) + |
188 | ! |
ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) + |
189 | ! |
ggplot2::xlab(x_axis_label) + |
190 | ! |
ggplot2::ylab(y_axis_label) |
191 |
# add grid faceting to foundation |
|
192 | ! |
if (facet) { |
193 | ! |
plot1 <- plot1 + |
194 | ! |
ggplot2::facet_grid(stats::as.formula(paste0(facet_var, " ~ ", visit))) |
195 |
} |
|
196 |
# add regression line |
|
197 | ! |
if (reg_line) { |
198 | ! |
slope <- function(x, y) { |
199 | ! |
ratio <- stats::sd(x) / stats::sd(y) |
200 | ! |
res <- if (!is.na(ratio) && ratio > 0) { |
201 | ! |
reg <- mc.deming(y, x, ratio) |
202 |
# return the evaluation of the ratio condition as third value in numeric vector |
|
203 |
# for conttroling downstream processing |
|
204 | ! |
c( |
205 | ! |
round(reg$b0, 2), round(reg$b1, 2), |
206 | ! |
ifelse(!is.na(ratio) && ratio > 0, stats::cor(y, x, method = "spearman", use = "complete.obs"), NA_real_) |
207 |
) |
|
208 |
} else { |
|
209 |
# if ratio condition is not met then assign NA to returned vector |
|
210 |
# so that NULL condition does not throw error below |
|
211 | ! |
as.numeric(c(NA, NA, NA)) |
212 |
} |
|
213 | ! |
return(as_tibble(stats::setNames(as.list(res), c("intercept", "slope", "corr")))) |
214 |
} |
|
215 | ! |
sub_data <- plot_data %>% |
216 | ! |
select(!!sym(trt_group), !!sym(visit), !!sym(xaxis_var), !!sym(yaxis_var)) %>% |
217 | ! |
filter(!is.na(!!sym(yaxis_var)) & !is.na(!!sym(xaxis_var))) %>% |
218 | ! |
group_by(!!sym(trt_group), !!sym(visit)) %>% |
219 | ! |
do(slope(.data[[yaxis_var]], .data[[xaxis_var]])) |
220 | ||
221 | ! |
if (!(all(is.na(sub_data$intercept)) && all(is.na(sub_data$slope)))) { |
222 | ! |
plot1 <- plot1 + |
223 | ! |
ggplot2::geom_abline( |
224 | ! |
data = sub_data, |
225 |
# has to put some neutral values for missings, i.e. big & negative intercept + 0 slope |
|
226 | ! |
ggplot2::aes( |
227 | ! |
intercept = vapply(.data$intercept, function(x) if (!is.na(x)) x else numeric(1), FUN.VALUE = -9999), |
228 | ! |
slope = vapply(.data$slope, function(x) if (!is.na(x)) x else numeric(1), FUN.VALUE = 0), |
229 | ! |
color = !!sym(trt_group) |
230 |
) |
|
231 |
) |
|
232 |
} |
|
233 | ! |
plot1 <- plot1 + |
234 | ! |
ggplot2::geom_text( |
235 | ! |
data = filter(sub_data, row_number() == 1), |
236 | ! |
ggplot2::aes( |
237 | ! |
x = -Inf, |
238 | ! |
y = Inf, |
239 | ! |
hjust = 0, |
240 | ! |
vjust = 1, |
241 | ! |
label = ifelse( |
242 | ! |
!is.na(.data$intercept) & !is.na(.data$slope) & !is.na(.data$corr), |
243 | ! |
sprintf("y = %.2f+%.2fX\ncor = %.2f", .data$intercept, .data$slope, .data$corr), |
244 | ! |
paste0("Insufficient Data For Regression") |
245 |
), |
|
246 | ! |
color = !!sym(trt_group) |
247 |
), |
|
248 | ! |
size = reg_text_size |
249 |
) + |
|
250 | ! |
ggplot2::labs(caption = paste("Deming Regression Model, Spearman Correlation Method")) |
251 |
} |
|
252 |
# Add abline |
|
253 | ! |
if (yaxis_var %in% c("AVAL", "AVALL2", "BASE2", "BASE2L2", "BASE", "BASEL2")) { |
254 | ! |
plot1 <- plot1 + ggplot2::geom_abline(intercept = 0, slope = 1) |
255 |
} |
|
256 | ! |
if (yaxis_var %in% c("CHG2", "CHG")) { |
257 | ! |
plot1 <- plot1 + ggplot2::geom_abline(intercept = 0, slope = 0) |
258 |
} |
|
259 | ! |
if (yaxis_var %in% c("PCHG2", "PCHG")) { |
260 | ! |
plot1 <- plot1 + ggplot2::geom_abline(intercept = 100, slope = 0) |
261 |
} |
|
262 |
# Format font size |
|
263 | ! |
if (!is.null(font_size)) { |
264 | ! |
plot1 <- plot1 + |
265 | ! |
ggplot2::theme( |
266 | ! |
axis.title.x = ggplot2::element_text(size = font_size), |
267 | ! |
axis.text.x = ggplot2::element_text(size = font_size), |
268 | ! |
axis.title.y = ggplot2::element_text(size = font_size), |
269 | ! |
axis.text.y = ggplot2::element_text(size = font_size), |
270 | ! |
legend.title = ggplot2::element_text(size = font_size), |
271 | ! |
legend.text = ggplot2::element_text(size = font_size), |
272 | ! |
strip.text.x = ggplot2::element_text(size = font_size), |
273 | ! |
strip.text.y = ggplot2::element_text(size = font_size) |
274 |
) |
|
275 |
} |
|
276 |
# Format treatment color |
|
277 | ! |
if (!is.null(color_manual)) { |
278 | ! |
plot1 <- plot1 + |
279 | ! |
ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1)) |
280 |
} else { |
|
281 | ! |
plot1 + |
282 | ! |
ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1)) |
283 |
} |
|
284 | ||
285 |
# Format LOQ flag symbol shape |
|
286 | ! |
if (!is.null(shape_manual)) { |
287 | ! |
plot1 <- plot1 + |
288 | ! |
ggplot2::scale_shape_manual(values = shape_manual, name = "LOQ") |
289 |
} |
|
290 |
# Format dot size |
|
291 | ! |
if (!is.null(dot_size)) { |
292 | ! |
plot1 <- plot1 + |
293 | ! |
ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE) |
294 |
} |
|
295 |
# Format x-label |
|
296 | ! |
if (rotate_xlab) { |
297 | ! |
plot1 <- plot1 + |
298 | ! |
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) |
299 |
} |
|
300 |
# Add horizontal line |
|
301 | ! |
if (!is.null(hline)) { |
302 | ! |
plot1 <- plot1 + |
303 | ! |
ggplot2::geom_hline(ggplot2::aes(yintercept = hline), color = "red", linetype = "dashed", size = 0.5) |
304 |
} |
|
305 |
# Add vertical line |
|
306 | ! |
if (!is.null(vline)) { |
307 | ! |
plot1 <- plot1 + |
308 | ! |
ggplot2::geom_vline(ggplot2::aes(xintercept = vline), color = "red", linetype = "dashed", size = 0.5) |
309 |
} |
|
310 | ! |
plot1 |
311 |
} |
1 |
#' Helper for identifying any `LLOQ` and `ULOQ` values in `LBSTRESC`. Outcome drives |
|
2 |
#' horizontal line functionality display and legend labeling along with display |
|
3 |
#' of values in footnote. |
|
4 |
#' |
|
5 |
#' @details Biomarker Sciences would like to have `LLOQ` and `ULOQ` values available for |
|
6 |
#' reference in the visualizations. This also aids in setting the data constraint |
|
7 |
#' ranges when `goshawk` functions are run from `teal.goshawk` `UI`. |
|
8 |
#' |
|
9 |
#' @param loqs_data (`data frame`)\cr `loqs_data` data set containing assay data with potential `LOQ` values |
|
10 |
#' |
|
11 |
#' @import dplyr |
|
12 |
#' @keywords internal |
|
13 |
#' |
|
14 |
#' @examples |
|
15 |
#' goshawk:::h_identify_loq_values(loqs_data = goshawk::rADLB, flag_var = "LOQFL") |
|
16 |
h_identify_loq_values <- function(loqs_data, flag_var) { |
|
17 | ! |
ifelse( |
18 | ! |
!grep("PARAM", names(loqs_data)), |
19 | ! |
stop("Assay dataset must include variable PARAM to use the caption_loqs_label function."), |
20 | ! |
1 |
21 |
) |
|
22 | ! |
ifelse( |
23 | ! |
!grep("LBSTRESC", names(loqs_data)), |
24 | ! |
stop("Assay dataset must include variable LBSTRESC to use the caption_loqs_label function."), |
25 | ! |
1 |
26 |
) |
|
27 | ||
28 |
# filter for records only relevant to loq. |
|
29 |
# get LLOQ value |
|
30 | ! |
lloq <- loqs_data %>% |
31 | ! |
filter(!!sym(flag_var) == "Y") %>% |
32 | ! |
select("PARAM", "LBSTRESC") %>% |
33 | ! |
filter(grepl("<", .data$LBSTRESC, fixed = FALSE)) %>% |
34 | ! |
mutate(LLOQC = .data$LBSTRESC, LLOQN = as.numeric(gsub("[^0-9.-]", "", .data$LBSTRESC))) %>% |
35 | ! |
group_by(.data$PARAM) %>% |
36 | ! |
slice(1) %>% |
37 | ! |
ungroup() %>% |
38 | ! |
select(-"LBSTRESC") |
39 | ||
40 | ||
41 |
# get ULOQ value |
|
42 | ! |
uloq <- loqs_data %>% |
43 | ! |
filter(!!sym(flag_var) == "Y") %>% |
44 | ! |
select("PARAM", "LBSTRESC") %>% |
45 | ! |
filter(grepl(">", .data$LBSTRESC, fixed = FALSE)) %>% |
46 | ! |
mutate(ULOQC = .data$LBSTRESC, ULOQN = as.numeric(gsub("[^0-9.-]", "", .data$LBSTRESC))) %>% |
47 | ! |
group_by(.data$PARAM) %>% |
48 | ! |
slice(1) %>% |
49 | ! |
ungroup() %>% |
50 | ! |
select(-"LBSTRESC") |
51 | ||
52 | ||
53 |
# return LOQ data |
|
54 | ! |
loq_values <- merge(lloq, uloq, by = "PARAM", all = TRUE) |
55 | ! |
if (nrow(loq_values) == 0) { |
56 | ! |
loq_values <- data.frame( |
57 | ! |
PARAM = names(table(droplevels(as.factor(loqs_data$PARAM)))), |
58 | ! |
LLOQC = NA, |
59 | ! |
LLOQN = NA, |
60 | ! |
ULOQC = NA, |
61 | ! |
ULOQN = NA |
62 |
) |
|
63 |
} |
|
64 | ||
65 | ! |
attr(loq_values[["PARAM"]], "label") <- "Parameter" |
66 | ! |
attr(loq_values[["LLOQC"]], "label") <- "Lower Limit of Quantitation (C)" |
67 | ! |
attr(loq_values[["LLOQN"]], "label") <- "Lower Limit of Quantitation" |
68 | ! |
attr(loq_values[["ULOQC"]], "label") <- "Upper Limit of Quantitation (C)" |
69 | ! |
attr(loq_values[["ULOQN"]], "label") <- "Upper Limit of Quantitation" |
70 | ||
71 | ! |
return(loq_values) |
72 |
} |
|
73 | ||
74 |
#' Add footnote to identify `LLOQ` and `ULOQ` values identified from data |
|
75 |
#' |
|
76 |
#' @param loqs_data (`data frame`)\cr `loqs_data` data set containing assay data with potential `LOQ` values |
|
77 |
#' |
|
78 |
#' @import dplyr |
|
79 |
#' @keywords internal |
|
80 |
#' |
|
81 |
#' @examples |
|
82 |
#' caption_label <- goshawk:::h_caption_loqs_label(loqs_data = goshawk::rADLB, flag_var = "LOQFL") |
|
83 |
h_caption_loqs_label <- function(loqs_data, flag_var) { |
|
84 | ! |
loq_values <- h_identify_loq_values(loqs_data, flag_var) |
85 | ||
86 | ! |
lloqc <- ifelse(is.na(loq_values$LLOQC), "NA", as.character(loq_values$LLOQC)) |
87 | ! |
uloqc <- ifelse(is.na(loq_values$ULOQC), "NA", as.character(loq_values$ULOQC)) |
88 | ||
89 |
# create caption |
|
90 | ! |
caption_loqs_label <- paste0( |
91 | ! |
"Limits of quantification read from study data for ", |
92 | ! |
loqs_data$PARAM, |
93 | ! |
": LLOQ is ", |
94 | ! |
lloqc, |
95 | ! |
", ULOQ is ", |
96 | ! |
uloqc |
97 |
) |
|
98 | ||
99 | ! |
return(caption_loqs_label) |
100 |
} |
|
101 | ||
102 |
#' Check that argument is a valid color |
|
103 |
#' |
|
104 |
#' Checks if the argument can be converted to valid RGB values space. See `grDevices::col2rgb`. |
|
105 |
#' |
|
106 |
#' @inheritParams checkmate::checkCharacter |
|
107 |
#' @param color (`character`)\cr |
|
108 |
#' Valid color convertible to RGB scale by [grDevices::col2rgb()] |
|
109 |
#' |
|
110 |
#' @inherit checkmate::checkCharacter return |
|
111 |
#' @keywords internal |
|
112 |
check_color <- function(color, |
|
113 |
min.len = NULL, # nolint |
|
114 |
max.len = NULL, # nolint |
|
115 |
any.missing = TRUE, # nolint |
|
116 |
all.missing = TRUE, # nolint |
|
117 |
len = NULL, |
|
118 |
null.ok = FALSE) { # nolint |
|
119 | ! |
string_check <- checkmate::check_character( |
120 | ! |
color, |
121 | ! |
min.len = min.len, max.len = max.len, any.missing = any.missing, len = len, null.ok = null.ok |
122 |
) |
|
123 | ! |
if (!isTRUE(string_check)) { |
124 | ! |
return(string_check) |
125 |
} |
|
126 | ||
127 | ! |
res <- sapply(color, function(col) { |
128 | ! |
tryCatch( |
129 | ! |
is.matrix(grDevices::col2rgb(col)), |
130 | ! |
error = function(e) FALSE |
131 |
) |
|
132 |
}) |
|
133 | ||
134 | ! |
if (any(!res)) { |
135 | ! |
"Must be a valid color, convertible to rgb by 'col2rgb'" |
136 |
} else { |
|
137 | ! |
TRUE |
138 |
} |
|
139 |
} |
|
140 | ||
141 |
#' @rdname check_color |
|
142 |
assert_color <- checkmate::makeAssertionFunction(check_color) |
1 |
#' Add horizontal and/or vertical lines and their legend labels to a plot |
|
2 |
#' |
|
3 |
#' This function is currently designed to be used with \code{\link{g_boxplot}}, \code{\link{g_correlationplot}}, |
|
4 |
#' \code{\link{g_spaghettiplot}}, and ('g_density_distribution_plot'), but may also work in general. |
|
5 |
#' |
|
6 |
#' @param data ('data.frame') data where `hline_vars` and `vline_var` columns are taken from. |
|
7 |
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines. |
|
8 |
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines. |
|
9 |
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines. |
|
10 |
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values. |
|
11 |
#' Needs `data` to be specified. |
|
12 |
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables. |
|
13 |
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables. |
|
14 |
#' @param vline_arb ('numeric vector') value identifying intercept for arbitrary vertical lines. |
|
15 |
#' @param vline_arb_color ('character vector') optional, color for the arbitrary vertical lines. |
|
16 |
#' @param vline_arb_label ('character vector') optional, label for the legend to the arbitrary vertical lines. |
|
17 |
#' @param vline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values. |
|
18 |
#' Needs `data` to be specified. |
|
19 |
#' @param vline_vars_colors ('character vector') colors for the vertical lines defined by variables. |
|
20 |
#' @param vline_vars_labels ('character vector') labels for the legend to the vertical lines defined by variables. |
|
21 |
#' |
|
22 |
#' @examples |
|
23 |
#' p <- ggplot2::ggplot(mtcars, ggplot2::aes(wt, mpg)) + |
|
24 |
#' ggplot2::geom_point() + |
|
25 |
#' goshawk:::geom_axes_lines( |
|
26 |
#' hline_arb = c(20, 25, 30), |
|
27 |
#' hline_arb_color = "red", |
|
28 |
#' hline_arb_label = "Hori Line" |
|
29 |
#' ) |
|
30 |
#' @return \code{ggplot} object |
|
31 |
#' @keywords internal |
|
32 |
#' |
|
33 |
geom_axes_lines <- function(data, |
|
34 |
hline_arb = numeric(0), |
|
35 |
hline_arb_color = "red", |
|
36 |
hline_arb_label = "Horizontal line", |
|
37 |
hline_vars = character(0), |
|
38 |
hline_vars_colors = "green", |
|
39 |
hline_vars_labels = hline_vars, |
|
40 |
vline_arb = numeric(0), |
|
41 |
vline_arb_color = "red", |
|
42 |
vline_arb_label = "Vertical line", |
|
43 |
vline_vars = character(0), |
|
44 |
vline_vars_colors = "green", |
|
45 |
vline_vars_labels = vline_vars) { |
|
46 | ! |
arb_hlines <- if (length(hline_arb) > 0) { |
47 | ! |
geom_arb_hline( |
48 | ! |
yintercept = hline_arb, |
49 | ! |
color = hline_arb_color, |
50 | ! |
label = hline_arb_label, |
51 | ! |
legend_title = "Horizontal arbitrary line(s)", |
52 | ! |
linetype = 2 |
53 |
) |
|
54 |
} |
|
55 | ||
56 | ! |
range_hlines <- if (length(hline_vars > 0)) { |
57 | ! |
geom_range_hline( |
58 | ! |
data = data, |
59 | ! |
vars = hline_vars, |
60 | ! |
color = hline_vars_colors, |
61 | ! |
label = hline_vars_labels, |
62 | ! |
linetype = 2 |
63 |
) |
|
64 |
} |
|
65 | ||
66 | ! |
arb_vlines <- if (length(vline_arb) > 0) { |
67 | ! |
geom_arb_vline( |
68 | ! |
xintercept = vline_arb, |
69 | ! |
color = vline_arb_color, |
70 | ! |
label = vline_arb_label, |
71 | ! |
legend_title = "Vertical arbitrary line(s)", |
72 | ! |
linetype = 2 |
73 |
) |
|
74 |
} |
|
75 | ||
76 | ! |
range_vlines <- if (length(vline_vars) > 0) { |
77 | ! |
geom_range_vline( |
78 | ! |
data = data, |
79 | ! |
vars = vline_vars, |
80 | ! |
color = vline_vars_colors, |
81 | ! |
label = vline_vars_labels, |
82 | ! |
linetype = 2 |
83 |
) |
|
84 |
} |
|
85 | ||
86 | ! |
Filter( |
87 | ! |
function(x) !is.null(x) || !is.na(x), |
88 | ! |
list( |
89 | ! |
arb_hlines, |
90 | ! |
range_hlines, |
91 | ! |
arb_vlines, |
92 | ! |
range_vlines |
93 |
) |
|
94 |
) |
|
95 |
} |
|
96 | ||
97 |
#' Validate line arguments given in the parameters against the data. |
|
98 |
#' |
|
99 |
#' helper function to be called by [geom_axes_lines()] |
|
100 |
#' |
|
101 |
#' @param data (`data.frame`)\cr |
|
102 |
#' should contain `vars` which will be used to create the plot. |
|
103 |
#' @param vars (`character`)\cr |
|
104 |
#' names of variables to take the values from. Only first value from the variable will be |
|
105 |
#' applied. |
|
106 |
#' @param color (`character`)\cr |
|
107 |
#' colors for the lines defined by variables. |
|
108 |
#' @param label (`character`)\cr |
|
109 |
#' labels for the legend to the lines defined by variables. |
|
110 |
#' |
|
111 |
#' @return (`data.frame`) containing the `values`,`colors` and `labels` fields defining attributes |
|
112 |
#' for horizontal or vertical lines. |
|
113 |
#' @keywords internal |
|
114 |
#' |
|
115 |
validate_line_args <- function(data, |
|
116 |
vars = character(0), |
|
117 |
color = "green", |
|
118 |
label = vars) { |
|
119 | ! |
if (length(vars) > 0) { |
120 | ! |
stopifnot(all(vars %in% names(data))) |
121 | ! |
checkmate::assert_data_frame(data[vars], types = "numeric") |
122 | ! |
checkmate::assert( |
123 | ! |
check_color(color, len = 1), |
124 | ! |
check_color(color, len = length(vars)) |
125 |
) |
|
126 | ! |
checkmate::assert_character(label, len = length(vars)) |
127 | ||
128 | ||
129 | ! |
label <- vapply( |
130 | ! |
vars, |
131 | ! |
FUN.VALUE = character(1), |
132 | ! |
USE.NAMES = FALSE, |
133 | ! |
FUN = function(x) { |
134 | ! |
if (is.null(attributes(data[[x]])$label)) { |
135 | ! |
x |
136 |
} else { |
|
137 | ! |
attributes(data[[x]])$label |
138 |
} |
|
139 |
} |
|
140 |
) |
|
141 | ||
142 | ! |
vars <- sapply( |
143 | ! |
vars, |
144 | ! |
USE.NAMES = FALSE, |
145 | ! |
function(name) { |
146 | ! |
x <- data[[name]] |
147 | ! |
vals <- unique(x) |
148 | ! |
if (!checkmate::test_number(vals)) { |
149 | ! |
warning(sprintf("First value is taken from variable '%s' to draw the straight line", name)) |
150 |
} |
|
151 | ! |
vals[1] |
152 |
} |
|
153 |
) |
|
154 |
} else { |
|
155 | ! |
vars <- numeric(0) |
156 | ! |
color <- character(0) |
157 | ! |
label <- character(0) |
158 |
} |
|
159 | ||
160 | ! |
data.frame( |
161 | ! |
values = vars, |
162 | ! |
colors = color, |
163 | ! |
labels = label |
164 |
) |
|
165 |
} |
|
166 | ||
167 |
#' Straight lines for `ggplot2` |
|
168 |
#' |
|
169 |
#' Arbitrary lines for `ggplot2` |
|
170 |
#' @name geom_straight_lines |
|
171 |
#' @param vars (`character`)\cr |
|
172 |
#' names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values. |
|
173 |
#' @param xintercept (`numeric`)\cr |
|
174 |
#' Position of the vertical line(s) on the x-axis |
|
175 |
#' @param yintercept (`numeric`)\cr |
|
176 |
#' Position of the horizontal line(s) on the y-axis |
|
177 |
#' @param label (`character`)\cr |
|
178 |
#' Label to be rendered in the legend. |
|
179 |
#' Should be a single string or vector of length equal to length of `xintercept`. |
|
180 |
#' @param color (`character`)\cr |
|
181 |
#' Valid color convertible to RGB scale by [grDevices::col2rgb()]. |
|
182 |
#' Should be a single string or vector of length equal to length of `xintercept`. |
|
183 |
#' |
|
184 |
#' @inherit ggplot2::geom_hline return |
|
185 |
#' |
|
186 |
#' @keywords internal |
|
187 |
#' |
|
188 |
NULL |
|
189 | ||
190 |
#' @rdname geom_straight_lines |
|
191 |
#' @examples |
|
192 |
#' # horizontal arbitrary lines |
|
193 |
#' data <- data.frame(x = seq_len(10), y = seq_len(10), color = rep(c("a", "b"), each = 5)) |
|
194 |
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) + |
|
195 |
#' ggplot2::geom_point() + |
|
196 |
#' goshawk:::geom_arb_hline( |
|
197 |
#' yintercept = c(2, 5), color = "blue", label = c("h1", "h2"), linetype = 2 |
|
198 |
#' ) |
|
199 |
geom_arb_hline <- function(yintercept, |
|
200 |
label = "Horizontal line", |
|
201 |
color = "red", |
|
202 |
legend_title = "Horizontal line(s)", |
|
203 |
...) { |
|
204 | ! |
checkmate::assert_numeric(yintercept, min.len = 1) |
205 | ! |
checkmate::assert( |
206 | ! |
check_color(color, len = 1), |
207 | ! |
check_color(color, len = length(yintercept)) |
208 |
) |
|
209 | ! |
checkmate::assert( |
210 | ! |
checkmate::check_string(label), |
211 | ! |
checkmate::check_character(label, len = length(yintercept)) |
212 |
) |
|
213 | ! |
data <- data.frame(yintercept, color, label, color_var = paste(color, label)) |
214 | ||
215 | ! |
list( |
216 | ! |
ggnewscale::new_scale_color(), |
217 | ! |
ggplot2::geom_hline( |
218 | ! |
data = data, |
219 | ! |
mapping = ggplot2::aes( |
220 | ! |
yintercept = yintercept, |
221 | ! |
color = .data[["color_var"]], # need legend entry for each color-label combination |
222 |
), |
|
223 |
... |
|
224 |
), |
|
225 | ! |
ggplot2::scale_color_manual( |
226 | ! |
name = legend_title, |
227 | ! |
values = stats::setNames(data$color, data$color_var), |
228 | ! |
labels = data$label, |
229 | ! |
limits = data$color_var, |
230 | ! |
guide = ggplot2::guide_legend(order = 11) # high order to be put after main plot items |
231 |
) |
|
232 |
) |
|
233 |
} |
|
234 | ||
235 |
#' @rdname geom_straight_lines |
|
236 |
#' @examples |
|
237 |
#' # vertical arbitrary lines |
|
238 |
#' data <- data.frame(x = seq_len(10), y = seq_len(10), color = rep(c("a", "b"), each = 5)) |
|
239 |
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) + |
|
240 |
#' ggplot2::geom_point() + |
|
241 |
#' goshawk:::geom_arb_vline( |
|
242 |
#' xintercept = c(2, 5), color = "blue", label = c("h1", "h2"), linetype = 2 |
|
243 |
#' ) |
|
244 |
geom_arb_vline <- function(xintercept, |
|
245 |
label = "Vertical line", |
|
246 |
color = "red", |
|
247 |
legend_title = "Vertical line(s)", |
|
248 |
...) { |
|
249 | ! |
checkmate::assert_numeric(xintercept, min.len = 1) |
250 | ! |
checkmate::assert( |
251 | ! |
check_color(color, len = 1), |
252 | ! |
check_color(color, len = length(xintercept)) |
253 |
) |
|
254 | ! |
checkmate::assert( |
255 | ! |
checkmate::check_character(label, len = 1), |
256 | ! |
checkmate::check_character(label, len = length(xintercept)) |
257 |
) |
|
258 | ||
259 | ! |
data <- data.frame(xintercept, color, label, color_var = paste(color, label)) |
260 | ||
261 | ! |
list( |
262 | ! |
ggnewscale::new_scale_color(), |
263 | ! |
ggplot2::geom_vline( |
264 | ! |
data = data, |
265 | ! |
mapping = ggplot2::aes( |
266 | ! |
xintercept = xintercept, |
267 | ! |
color = .data[["color_var"]], # need legend entry for each color-label combination |
268 |
), |
|
269 |
... |
|
270 |
), |
|
271 | ! |
ggplot2::scale_color_manual( |
272 | ! |
name = legend_title, |
273 | ! |
values = stats::setNames(data$color, data$color_var), |
274 | ! |
labels = data$label, |
275 | ! |
limits = data$color_var, |
276 | ! |
guide = ggplot2::guide_legend(order = 12) # high order to be put after main plot items |
277 |
) |
|
278 |
) |
|
279 |
} |
|
280 | ||
281 | ||
282 |
#' @rdname geom_straight_lines |
|
283 |
#' @examples |
|
284 |
#' # horizontal range |
|
285 |
#' |
|
286 |
#' data <- data.frame( |
|
287 |
#' x = seq_len(10), |
|
288 |
#' y = seq_len(10), |
|
289 |
#' color = rep(c("a", "b"), each = 5), |
|
290 |
#' lower = rep(c(2, 3), each = 5), |
|
291 |
#' upper = rep(c(7, 8), each = 5) |
|
292 |
#' ) |
|
293 |
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) + |
|
294 |
#' ggplot2::geom_point() + |
|
295 |
#' goshawk:::geom_range_hline( |
|
296 |
#' vars = c("lower", "upper"), |
|
297 |
#' data = data.frame(lower = 2, upper = 7), |
|
298 |
#' color = "blue", |
|
299 |
#' linetype = 2 |
|
300 |
#' ) |
|
301 |
geom_range_hline <- function(vars, |
|
302 |
data, |
|
303 |
color = "green", |
|
304 |
label = vars, |
|
305 |
legend_title = "Horizontal range line(s)", |
|
306 |
...) { |
|
307 | ! |
line_data <- validate_line_args( |
308 | ! |
data = data, |
309 | ! |
vars = vars, |
310 | ! |
label = label, |
311 | ! |
color = color |
312 |
) |
|
313 | ! |
geom_arb_hline( |
314 | ! |
yintercept = line_data$values, |
315 | ! |
label = line_data$labels, |
316 | ! |
color = line_data$colors, |
317 | ! |
legend_title = legend_title, |
318 |
... |
|
319 |
) |
|
320 |
} |
|
321 | ||
322 |
#' @rdname geom_straight_lines |
|
323 |
#' @examples |
|
324 |
#' # vertical range |
|
325 |
#' data <- data.frame( |
|
326 |
#' x = seq_len(10), |
|
327 |
#' y = seq_len(10), |
|
328 |
#' color = rep(c("a", "b"), each = 5), |
|
329 |
#' lower = rep(c(2, 3), each = 5), |
|
330 |
#' upper = rep(c(7, 8), each = 5) |
|
331 |
#' ) |
|
332 |
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) + |
|
333 |
#' ggplot2::geom_point() + |
|
334 |
#' goshawk:::geom_range_vline( |
|
335 |
#' vars = c("lower", "upper"), |
|
336 |
#' data = data.frame(lower = 2, upper = 7), |
|
337 |
#' color = "blue", |
|
338 |
#' linetype = 2 |
|
339 |
#' ) |
|
340 |
geom_range_vline <- function(vars, |
|
341 |
data, |
|
342 |
color = "green", |
|
343 |
label = vars, |
|
344 |
legend_title = "Vertical range line(s)", |
|
345 |
...) { |
|
346 | ! |
line_data <- validate_line_args( |
347 | ! |
data = data, |
348 | ! |
vars = vars, |
349 | ! |
label = label, |
350 | ! |
color = color |
351 |
) |
|
352 | ! |
geom_arb_vline( |
353 | ! |
xintercept = line_data$values, |
354 | ! |
label = line_data$labels, |
355 | ! |
color = line_data$colors, |
356 | ! |
legend_title = legend_title, |
357 |
... |
|
358 |
) |
|
359 |
} |
1 |
#' Function to create a boxplot. |
|
2 |
#' |
|
3 |
#' A box plot is a method for graphically depicting groups of numerical data |
|
4 |
#' through their quartiles. Box plots may also have lines extending vertically |
|
5 |
#' from the boxes (whiskers) indicating variability outside the upper and lower |
|
6 |
#' quartiles, hence the term box-and-whisker. Outliers may be plotted as |
|
7 |
#' individual points. Box plots are non-parametric: they display variation in |
|
8 |
#' samples of a statistical population without making any assumptions of the |
|
9 |
#' underlying statistical distribution. The spacings between the different parts |
|
10 |
#' of the box indicate the degree of dispersion (spread) and skewness in the |
|
11 |
#' data, and show outliers. In addition to the points themselves, they allow one |
|
12 |
#' to visually estimate various L-estimators, notably the interquartile range, |
|
13 |
#' midhinge, range, mid-range, and trimean. |
|
14 |
#' |
|
15 |
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`. |
|
16 |
#' @param biomarker biomarker to visualize e.g. `IGG`. |
|
17 |
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`. |
|
18 |
#' @param yaxis_var name of variable containing biomarker results displayed on |
|
19 |
#' Y-axis e.g. `AVAL`. |
|
20 |
#' @param trt_group name of variable representing treatment `trt_group` e.g. `ARM`. |
|
21 |
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. |
|
22 |
#' @param loq_legend `logical` whether to include `LoQ` legend. |
|
23 |
#' @param unit biomarker unit label e.g. (U/L) |
|
24 |
#' @param color_manual vector of color for `trt_group` |
|
25 |
#' @param shape_manual vector of shapes (used with `loq_flag_var`) |
|
26 |
#' @param box add boxes to the plot (boolean) |
|
27 |
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis |
|
28 |
#' if the default limits are not suitable. |
|
29 |
#' @param facet_var variable to facet the plot by, or `"None"` if no faceting |
|
30 |
#' required. |
|
31 |
#' @param xaxis_var variable used to group the data on the x-axis. |
|
32 |
#' @param facet_ncol number of facets per row. NULL = Use the default for `ggplot2::facet_wrap` |
|
33 |
#' @param rotate_xlab 45 degree rotation of x-axis label values. |
|
34 |
#' @param font_size point size of text to use. NULL is use default size |
|
35 |
#' @param dot_size plot dot size. |
|
36 |
#' @param alpha dot transparency (0 = transparent, 1 = opaque) |
|
37 |
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines. |
|
38 |
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines. |
|
39 |
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines. |
|
40 |
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values. |
|
41 |
#' The data inside of the `ggplot2` object must also contain the columns with these variable names |
|
42 |
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables. |
|
43 |
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables. |
|
44 |
#' |
|
45 |
#' @author Balazs Toth |
|
46 |
#' @author Jeff Tomlinson (tomlinsj) jeffrey.tomlinson@roche.com |
|
47 |
#' |
|
48 |
#' @return \code{ggplot} object |
|
49 |
#' |
|
50 |
#' @export |
|
51 |
#' |
|
52 |
#' @examplesIf require("nestcolor") |
|
53 |
#' # Example using ADaM structure analysis dataset. |
|
54 |
#' |
|
55 |
#' library(nestcolor) |
|
56 |
#' |
|
57 |
#' ADLB <- rADLB |
|
58 |
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label) |
|
59 |
#' ADLB <- ADLB %>% |
|
60 |
#' mutate(AVISITCD = case_when( |
|
61 |
#' AVISIT == "SCREENING" ~ "SCR", |
|
62 |
#' AVISIT == "BASELINE" ~ "BL", |
|
63 |
#' grepl("WEEK", AVISIT) ~ |
|
64 |
#' paste( |
|
65 |
#' "W", |
|
66 |
#' trimws( |
|
67 |
#' substr( |
|
68 |
#' AVISIT, |
|
69 |
#' start = 6, |
|
70 |
#' stop = stringr::str_locate(AVISIT, "DAY") - 1 |
|
71 |
#' ) |
|
72 |
#' ) |
|
73 |
#' ), |
|
74 |
#' TRUE ~ NA_character_ |
|
75 |
#' )) %>% |
|
76 |
#' mutate(AVISITCDN = case_when( |
|
77 |
#' AVISITCD == "SCR" ~ -2, |
|
78 |
#' AVISITCD == "BL" ~ 0, |
|
79 |
#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)), |
|
80 |
#' TRUE ~ NA_real_ |
|
81 |
#' )) %>% |
|
82 |
#' mutate(ANRLO = .5, ANRHI = 1) %>% |
|
83 |
#' rowwise() %>% |
|
84 |
#' group_by(PARAMCD) %>% |
|
85 |
#' mutate(LBSTRESC = ifelse( |
|
86 |
#' USUBJID %in% sample(USUBJID, 1, replace = TRUE), |
|
87 |
#' paste("<", round(runif(1, min = .5, max = 1))), LBSTRESC |
|
88 |
#' )) %>% |
|
89 |
#' mutate(LBSTRESC = ifelse( |
|
90 |
#' USUBJID %in% sample(USUBJID, 1, replace = TRUE), |
|
91 |
#' paste(">", round(runif(1, min = 1, max = 1.5))), LBSTRESC |
|
92 |
#' )) %>% |
|
93 |
#' ungroup() |
|
94 |
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]] |
|
95 |
#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit" |
|
96 |
#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit" |
|
97 |
#' |
|
98 |
#' # add LLOQ and ULOQ variables |
|
99 |
#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") |
|
100 |
#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM") |
|
101 |
#' |
|
102 |
#' g_boxplot(ADLB, |
|
103 |
#' biomarker = "CRP", |
|
104 |
#' param_var = "PARAMCD", |
|
105 |
#' yaxis_var = "AVAL", |
|
106 |
#' trt_group = "ARM", |
|
107 |
#' loq_flag_var = "LOQFL", |
|
108 |
#' loq_legend = FALSE, |
|
109 |
#' unit = "AVALU", |
|
110 |
#' shape_manual = c("N" = 1, "Y" = 2, "NA" = NULL), |
|
111 |
#' facet_var = "AVISIT", |
|
112 |
#' xaxis_var = "STUDYID", |
|
113 |
#' alpha = 0.5, |
|
114 |
#' rotate_xlab = TRUE, |
|
115 |
#' hline_arb = c(.9, 1.2), |
|
116 |
#' hline_arb_color = "blue", |
|
117 |
#' hline_arb_label = "Hori_line_label", |
|
118 |
#' hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"), |
|
119 |
#' hline_vars_colors = c("pink", "brown", "purple", "gray"), |
|
120 |
#' hline_vars_labels = c("A", "B", "C", "D") |
|
121 |
#' ) |
|
122 |
g_boxplot <- function(data, |
|
123 |
biomarker, |
|
124 |
param_var = "PARAMCD", |
|
125 |
yaxis_var, |
|
126 |
trt_group, |
|
127 |
xaxis_var = NULL, |
|
128 |
loq_flag_var = "LOQFL", |
|
129 |
loq_legend = TRUE, |
|
130 |
unit = NULL, |
|
131 |
color_manual = NULL, |
|
132 |
shape_manual = NULL, |
|
133 |
box = TRUE, |
|
134 |
ylim = c(NA, NA), |
|
135 |
dot_size = 2, |
|
136 |
alpha = 1.0, |
|
137 |
facet_ncol = NULL, |
|
138 |
rotate_xlab = FALSE, |
|
139 |
font_size = NULL, |
|
140 |
facet_var = NULL, |
|
141 |
hline_arb = numeric(0), |
|
142 |
hline_arb_color = "red", |
|
143 |
hline_arb_label = "Horizontal line", |
|
144 |
hline_vars = character(0), |
|
145 |
hline_vars_colors = "green", |
|
146 |
hline_vars_labels = hline_vars) { |
|
147 | ! |
if (is.null(data[[param_var]])) { |
148 | ! |
stop(paste("param_var", param_var, "is not in data.")) |
149 |
} |
|
150 | ||
151 | ! |
if (!any(data[[param_var]] == biomarker)) { |
152 | ! |
stop(paste("biomarker", biomarker, "is not found in param_var", param_var, ".")) |
153 |
} |
|
154 | ! |
checkmate::assert_flag(loq_legend) |
155 | ! |
checkmate::assert_number(dot_size) |
156 | ! |
checkmate::assert_numeric(ylim, len = 2) |
157 | ||
158 |
# filter input data |
|
159 | ! |
data <- data %>% |
160 | ! |
filter(!!sym(param_var) == biomarker) |
161 | ||
162 | ! |
if (!is.null(unit)) { |
163 |
# check unit is in the dataset |
|
164 | ! |
if (is.null(data[[unit]])) { |
165 | ! |
stop(paste("unit variable", unit, "is not in data.")) |
166 |
} |
|
167 |
# extract the most common unit |
|
168 |
# if there are ties, take the use alphabetic order |
|
169 | ! |
tmp_unit <- data %>% |
170 | ! |
count(!!sym(unit)) %>% |
171 | ! |
top_n(1, n) %>% |
172 | ! |
arrange(!!sym(unit)) %>% |
173 | ! |
slice(1) %>% |
174 | ! |
select(!!sym(unit)) %>% |
175 | ! |
as.character() |
176 | ! |
if (is.factor(data[[unit]])) { |
177 | ! |
unit <- levels(data[[unit]])[as.numeric(tmp_unit)] |
178 |
} else { |
|
179 | ! |
unit <- tmp_unit |
180 |
} |
|
181 |
} |
|
182 |
# Setup the Y axis label. Combine the biomarker and the units (if available) |
|
183 | ! |
y_axis_label <- ifelse(is.null(unit), paste(data$PARAM[1], yaxis_var, "Values"), |
184 | ! |
ifelse(unit == "", paste(data$PARAM[1], yaxis_var, "Values"), |
185 | ! |
paste0(data$PARAM[1], " (", unit, ") ", yaxis_var, " Values") |
186 |
) |
|
187 |
) |
|
188 |
# Setup the ggtitle label. Combine the biomarker and the units (if available) |
|
189 | ! |
ggtitle_label <- ifelse(is.null(unit), paste(data$PARAM[1], "Distribution by Treatment @ Visits"), |
190 | ! |
ifelse(unit == "", paste(data$PARAM[1], "Distribution by Treatment @ Visits"), |
191 | ! |
paste0(data$PARAM[1], " (", unit, ") Distribution by Treatment @ Visits") |
192 |
) |
|
193 |
) |
|
194 |
# Setup legend label |
|
195 | ! |
trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label")) |
196 | ||
197 |
# add footnote to identify LLOQ and ULOQ values pulled from data |
|
198 | ! |
caption_loqs_label <- h_caption_loqs_label(loqs_data = data, flag_var = loq_flag_var) |
199 |
# Base plot |
|
200 | ! |
plot1 <- ggplot2::ggplot(data) |
201 |
# Add boxes if required |
|
202 | ! |
if (box) { |
203 | ! |
plot1 <- plot1 + |
204 | ! |
ggplot2::geom_boxplot( |
205 | ! |
data = data, |
206 | ! |
ggplot2::aes( |
207 | ! |
x = !!sym(xaxis_var), |
208 | ! |
y = !!sym(yaxis_var), |
209 | ! |
fill = NULL |
210 |
), |
|
211 | ! |
outlier.shape = NA, |
212 | ! |
na.rm = TRUE |
213 |
) |
|
214 |
} |
|
215 |
# Extend is.infinite to include zero length objects. |
|
216 | ! |
is_finite <- function(x) { |
217 | ! |
if (length(x) == 0) { |
218 | ! |
return(FALSE) |
219 |
} |
|
220 | ! |
return(is.finite(x)) |
221 |
} |
|
222 | ||
223 | ! |
plot1 <- plot1 + |
224 | ! |
ggplot2::labs(color = trt_label, x = NULL, y = y_axis_label, caption = caption_loqs_label) + |
225 | ! |
ggplot2::theme_bw() + |
226 | ! |
ggplot2::ggtitle(ggtitle_label) + |
227 | ! |
ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) |
228 |
# Colors supplied? Use color_manual, otherwise default ggplot coloring. |
|
229 | ! |
plot1 <- if (!is.null(color_manual)) { |
230 | ! |
plot1 + |
231 | ! |
ggplot2::scale_color_manual(values = color_manual, guide = ggplot2::guide_legend(order = 1)) |
232 |
} else { |
|
233 | ! |
plot1 + |
234 | ! |
ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1)) |
235 |
} |
|
236 | ||
237 |
# Format LOQ flag symbol shape |
|
238 | ! |
if (is.null(shape_manual)) { |
239 | ! |
shape_names <- unique(data[!is.na(data[[loq_flag_var]]), ][[loq_flag_var]]) |
240 | ! |
shape_manual <- seq_along(shape_names) |
241 | ! |
names(shape_manual) <- shape_names |
242 |
} |
|
243 |
# add LOQ legend conditionally |
|
244 | ! |
plot1 <- if (!loq_legend) { |
245 | ! |
plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = "none") |
246 |
} else { |
|
247 | ! |
plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = ggplot2::guide_legend(order = 2)) |
248 |
} |
|
249 | ||
250 | ! |
plot1 <- plot1 + |
251 | ! |
ggplot2::geom_jitter( |
252 | ! |
data = data, |
253 | ! |
ggplot2::aes( |
254 | ! |
x = !!sym(xaxis_var), |
255 | ! |
y = !!sym(yaxis_var), |
256 | ! |
shape = !!sym(loq_flag_var), |
257 | ! |
color = !!sym(trt_group) |
258 |
), |
|
259 | ! |
alpha = alpha, |
260 | ! |
position = ggplot2::position_jitter(width = 0.1, height = 0), |
261 | ! |
size = dot_size, |
262 | ! |
na.rm = TRUE |
263 |
) |
|
264 | ||
265 |
# Any limits for the Y axis? |
|
266 | ! |
plot1 <- plot1 + ggplot2::coord_cartesian(ylim = ylim) |
267 | ||
268 | ||
269 |
# Add facetting. |
|
270 | ! |
if (!is.null(facet_var)) { |
271 | ! |
if (facet_var != "None" & facet_var %in% names(data)) { # nolint |
272 | ! |
if (!is_finite(facet_ncol)) facet_ncol <- 0 |
273 | ! |
if (facet_ncol >= 1) { |
274 | ! |
plot1 <- plot1 + |
275 | ! |
ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = round(facet_ncol)) |
276 |
} else { |
|
277 | ! |
plot1 <- plot1 + |
278 | ! |
ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var))) |
279 |
} |
|
280 |
} |
|
281 |
} |
|
282 | ||
283 | ||
284 | ||
285 | ||
286 |
# Format font size |
|
287 | ! |
if (is_finite(font_size)) { |
288 | ! |
plot1 <- plot1 + |
289 | ! |
ggplot2::theme( |
290 | ! |
axis.title.x = ggplot2::element_text(size = font_size), |
291 | ! |
axis.text.x = ggplot2::element_text(size = font_size), |
292 | ! |
axis.title.y = ggplot2::element_text(size = font_size), |
293 | ! |
axis.text.y = ggplot2::element_text(size = font_size), |
294 | ! |
legend.title = ggplot2::element_text(size = font_size), |
295 | ! |
legend.text = ggplot2::element_text(size = font_size), |
296 | ! |
strip.text.x = ggplot2::element_text(size = font_size), |
297 | ! |
strip.text.y = ggplot2::element_text(size = font_size) |
298 |
) |
|
299 |
} |
|
300 |
# Format x-label |
|
301 | ! |
if (rotate_xlab) { |
302 | ! |
plot1 <- plot1 + |
303 | ! |
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) |
304 |
} |
|
305 | ||
306 |
# Add horizontal line for range based on option |
|
307 | ! |
plot1 + geom_axes_lines(data, |
308 | ! |
hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label, |
309 | ! |
hline_vars = hline_vars, hline_vars_colors = hline_vars_colors, hline_vars_labels = hline_vars_labels |
310 |
) |
|
311 |
} |
1 |
#' Function to create a table of descriptive summary statistics to accompany plots. |
|
2 |
#' |
|
3 |
#' Output descriptive summary statistics table as a data frame. Includes biomarker, treatment, |
|
4 |
#' visit, |
|
5 |
#' n, mean, median, SD, min, max, %missing values, % `LOQ` values. |
|
6 |
#' |
|
7 |
#' @param data name of data frame to summarize. |
|
8 |
#' @param trt_group treatment group variable name e.g. `ARM`. |
|
9 |
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`. |
|
10 |
#' @param param biomarker to visualize e.g. `IGG`. |
|
11 |
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `AVAL`. |
|
12 |
#' @param facet_var name of variable facetted on typically containing visit values e.g. `AVISITCD`. |
|
13 |
#' If NULL then ignored. It defaults to `"AVISITCD"` when not provided. |
|
14 |
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. Defaults to `"LOQFL"`. |
|
15 |
#' @param ... additional options |
|
16 |
#' |
|
17 |
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com |
|
18 |
#' @author Balazs Toth (tothb2) toth.balazs@gene.com |
|
19 |
#' |
|
20 |
#' @details provide additional information as needed. link to specification file |
|
21 |
#' \url{https://posit.co/} |
|
22 |
#' |
|
23 |
#' @export |
|
24 |
#' |
|
25 |
#' @examples |
|
26 |
#' # Example using ADaM structure analysis dataset. |
|
27 |
#' |
|
28 |
#' library(stringr) |
|
29 |
#' |
|
30 |
#' # original ARM value = dose value |
|
31 |
#' arm_mapping <- list( |
|
32 |
#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination" |
|
33 |
#' ) |
|
34 |
#' |
|
35 |
#' ADLB <- rADLB |
|
36 |
#' ADLB <- ADLB %>% |
|
37 |
#' mutate(AVISITCD = case_when( |
|
38 |
#' AVISIT == "SCREENING" ~ "SCR", |
|
39 |
#' AVISIT == "BASELINE" ~ "BL", |
|
40 |
#' grepl("WEEK", AVISIT) ~ |
|
41 |
#' paste( |
|
42 |
#' "W", |
|
43 |
#' trimws( |
|
44 |
#' substr( |
|
45 |
#' AVISIT, |
|
46 |
#' start = 6, |
|
47 |
#' stop = str_locate(AVISIT, "DAY") - 1 |
|
48 |
#' ) |
|
49 |
#' ) |
|
50 |
#' ), |
|
51 |
#' TRUE ~ NA_character_ |
|
52 |
#' )) %>% |
|
53 |
#' mutate(AVISITCDN = case_when( |
|
54 |
#' AVISITCD == "SCR" ~ -2, |
|
55 |
#' AVISITCD == "BL" ~ 0, |
|
56 |
#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)), |
|
57 |
#' TRUE ~ NA_real_ |
|
58 |
#' )) %>% |
|
59 |
#' # use ARMCD values to order treatment in visualization legend |
|
60 |
#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1, |
|
61 |
#' ifelse(grepl("B", ARMCD), 2, |
|
62 |
#' ifelse(grepl("A", ARMCD), 3, NA) |
|
63 |
#' ) |
|
64 |
#' )) %>% |
|
65 |
#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>% |
|
66 |
#' mutate(ARM = factor(ARM) %>% |
|
67 |
#' reorder(TRTORD)) |
|
68 |
#' |
|
69 |
#' tbl <- t_summarytable( |
|
70 |
#' data = ADLB, |
|
71 |
#' trt_group = "ARM", |
|
72 |
#' param_var = "PARAMCD", |
|
73 |
#' param = c("CRP"), |
|
74 |
#' xaxis_var = "AVAL", |
|
75 |
#' facet_var = "AVISITCD", |
|
76 |
#' loq_flag_var = "LOQFL" |
|
77 |
#' ) |
|
78 |
#' tbl |
|
79 |
t_summarytable <- function(data, |
|
80 |
trt_group, |
|
81 |
param_var, |
|
82 |
param, |
|
83 |
xaxis_var, |
|
84 |
facet_var = "AVISITCD", |
|
85 |
loq_flag_var = "LOQFL", |
|
86 |
...) { |
|
87 | ! |
if (!is.null(facet_var) && trt_group == facet_var) { |
88 | ! |
data[paste0(facet_var, "_")] <- data[facet_var] |
89 | ! |
facet_var <- paste0(facet_var, "_") |
90 |
} |
|
91 | ||
92 | ! |
table_data <- data %>% |
93 | ! |
filter(!!sym(param_var) == param) |
94 | ||
95 |
# get unique study id or unique study ids if multiple study data |
|
96 | ! |
study_id <- as.data.frame(table(table_data$STUDYID)) %>% |
97 | ! |
mutate(STUDYID = paste(.data$Var1, collapse = "/")) %>% |
98 | ! |
rename(StudyID = "STUDYID") %>% |
99 | ! |
select("StudyID") %>% |
100 | ! |
slice(1) |
101 | ||
102 |
# get analysis variable name |
|
103 | ! |
anl_var <- as.data.frame(xaxis_var) %>% |
104 | ! |
rename("AnlVar" = xaxis_var) |
105 | ||
106 | ! |
min_max_ignore_na <- function(x, type = c("min", "max")) { |
107 | ! |
type <- match.arg(type) |
108 | ! |
if (all(is.na(x))) { |
109 | ! |
return(NA) |
110 |
} |
|
111 | ! |
return( |
112 | ! |
switch(type, |
113 | ! |
min = min, |
114 | ! |
max = max |
115 | ! |
)(x, na.rm = TRUE) |
116 |
) |
|
117 |
} |
|
118 | ||
119 |
# by treatment group table |
|
120 | ||
121 | ! |
sum_data_by_arm <- table_data %>% filter(!!sym(param_var) == param) |
122 | ! |
if (!is.null(facet_var)) { |
123 | ! |
sum_data_by_arm <- sum_data_by_arm %>% |
124 | ! |
group_by(!!sym(param_var), !!sym(trt_group), .data$TRTORD, !!sym(facet_var)) |
125 |
} else { |
|
126 | ! |
sum_data_by_arm <- sum_data_by_arm %>% |
127 | ! |
group_by(!!sym(param_var), !!sym(trt_group), .data$TRTORD) |
128 |
} |
|
129 | ||
130 | ! |
sum_data_by_arm <- sum_data_by_arm %>% |
131 | ! |
summarise( |
132 | ! |
n = sum(!is.na(!!sym(xaxis_var))), |
133 | ! |
Mean = round(mean(!!sym(xaxis_var), na.rm = TRUE), digits = 2), |
134 | ! |
Median = round(stats::median(!!sym(xaxis_var), na.rm = TRUE), digits = 2), |
135 | ! |
StdDev = round(stats::sd(!!sym(xaxis_var), na.rm = TRUE), digits = 2), |
136 | ! |
Min = round(min_max_ignore_na(!!sym(xaxis_var), type = "min"), digits = 2), |
137 | ! |
Max = round(min_max_ignore_na(!!sym(xaxis_var), type = "max"), digits = 2), |
138 | ! |
PctMiss = round(100 * sum(is.na(!!sym(xaxis_var))) / length(!!sym(xaxis_var)), digits = 2), |
139 | ! |
PctLOQ = round(100 * sum(!!sym(loq_flag_var) == "Y", na.rm = TRUE) / length(!!sym(loq_flag_var)), digits = 2) |
140 |
) |
|
141 | ||
142 | ! |
if (!is.null(facet_var)) { |
143 | ! |
sum_data_by_arm <- sum_data_by_arm %>% |
144 | ! |
select( |
145 | ! |
all_of(c(param_var, trt_group, facet_var)), "n", "Mean", "Median", "StdDev", |
146 | ! |
"Min", "Max", "PctMiss", "PctLOQ", "TRTORD" |
147 |
) %>% |
|
148 | ! |
ungroup() |
149 |
} else { |
|
150 | ! |
sum_data_by_arm <- sum_data_by_arm %>% |
151 | ! |
select( |
152 | ! |
all_of(c(param_var, trt_group)), "n", "Mean", "Median", "StdDev", |
153 | ! |
"Min", "Max", "PctMiss", "PctLOQ", "TRTORD" |
154 |
) %>% |
|
155 | ! |
ungroup() |
156 |
} |
|
157 | ||
158 |
# by combined treatment group table |
|
159 | ! |
sum_data_combined_arm <- table_data %>% |
160 | ! |
filter(!!sym(param_var) == param) |
161 | ||
162 | ! |
if (!is.null(facet_var)) { |
163 | ! |
sum_data_combined_arm <- sum_data_combined_arm %>% |
164 | ! |
group_by(!!sym(param_var), !!sym(facet_var)) |
165 |
} else { |
|
166 | ! |
sum_data_combined_arm <- sum_data_combined_arm %>% |
167 | ! |
group_by(!!sym(param_var)) |
168 |
} |
|
169 | ||
170 | ! |
sum_data_combined_arm <- sum_data_combined_arm %>% |
171 | ! |
summarise( |
172 | ! |
n = sum(!is.na(!!sym(xaxis_var))), |
173 | ! |
Mean = round(mean(!!sym(xaxis_var), na.rm = TRUE), digits = 2), |
174 | ! |
Median = round(stats::median(!!sym(xaxis_var), na.rm = TRUE), digits = 2), |
175 | ! |
StdDev = round(stats::sd(!!sym(xaxis_var), na.rm = TRUE), digits = 2), |
176 | ! |
Min = round(min_max_ignore_na(!!sym(xaxis_var), type = "min"), digits = 2), |
177 | ! |
Max = round(min_max_ignore_na(!!sym(xaxis_var), type = "max"), digits = 2), |
178 | ! |
PctMiss = round(100 * sum(is.na(!!sym(xaxis_var))) / length(!!sym(xaxis_var)), digits = 2), |
179 | ! |
PctLOQ = round(100 * sum(!!sym(loq_flag_var) == "Y", na.rm = TRUE) / length(!!sym(loq_flag_var)), digits = 2), |
180 | ! |
MAXTRTORDVIS = max(.data$TRTORD) # identifies the maximum treatment order within visits |
181 | ! |
) %>% # additional use of max function identifies maximum treatment order across all visits. |
182 | ! |
mutate(!!trt_group := "Comb.", TRTORD = max(.data$MAXTRTORDVIS) + 1) |
183 | ||
184 |
# select only those columns needed to prop |
|
185 | ! |
if (!is.null(facet_var)) { |
186 | ! |
sum_data_combined_arm <- sum_data_combined_arm %>% |
187 | ! |
select( |
188 | ! |
all_of(c(param_var, trt_group, facet_var)), "n", "Mean", "Median", "StdDev", |
189 | ! |
"Min", "Max", "PctMiss", "PctLOQ", "TRTORD" |
190 |
) %>% |
|
191 | ! |
ungroup() |
192 | ||
193 |
# combine the two data sets and apply some formatting. Note that R coerces treatment group into |
|
194 |
# character since it is a factor and character |
|
195 | ! |
sum_data <- rbind(sum_data_by_arm, sum_data_combined_arm) %>% # concatenate |
196 |
# reorder variables |
|
197 | ! |
select( |
198 | ! |
all_of(c(Biomarker = param_var, Treatment = trt_group, Facet = facet_var)), |
199 | ! |
"n", "Mean", "Median", "StdDev", "Min", "Max", "PctMiss", "PctLOQ", "TRTORD" |
200 |
) %>% |
|
201 | ! |
arrange(.data$Biomarker, .data$Facet, .data$TRTORD) %>% # drop variable |
202 | ! |
select(-"TRTORD") |
203 |
} else { |
|
204 | ! |
sum_data_combined_arm <- sum_data_combined_arm %>% |
205 | ! |
select( |
206 | ! |
all_of(c(param_var, trt_group)), "n", "Mean", "Median", "StdDev", |
207 | ! |
"Min", "Max", "PctMiss", "PctLOQ", "TRTORD" |
208 |
) %>% |
|
209 | ! |
ungroup() |
210 | ||
211 |
# combine the two data sets and apply some formatting. Note that R coerces treatment group into |
|
212 |
# character since it is a factor and character |
|
213 | ! |
sum_data <- rbind(sum_data_by_arm, sum_data_combined_arm) %>% # concatenate |
214 |
# reorder variables |
|
215 | ! |
select( |
216 | ! |
all_of(c(Biomarker = param_var, Treatment = trt_group)), |
217 | ! |
"n", "Mean", "Median", "StdDev", "Min", "Max", "PctMiss", "PctLOQ", "TRTORD" |
218 |
) %>% |
|
219 | ! |
arrange(.data$Biomarker, .data$TRTORD) %>% # drop variable |
220 | ! |
select(-"TRTORD") |
221 |
} |
|
222 | ||
223 |
# add analysis variable as first column |
|
224 | ! |
sum_data <- cbind(study_id, anl_var, sum_data) |
225 |
} |
1 |
#' Function to create line plot of summary statistics over time. |
|
2 |
#' |
|
3 |
#' @param label text string to be displayed as plot label. |
|
4 |
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`. |
|
5 |
#' @param biomarker_var name of variable containing biomarker names. |
|
6 |
#' @param biomarker_var_label name of variable containing biomarker labels. |
|
7 |
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. |
|
8 |
#' @param biomarker biomarker name to be analyzed. |
|
9 |
#' @param value_var name of variable containing biomarker results. |
|
10 |
#' @param unit_var name of variable containing biomarker result unit. |
|
11 |
#' @param trt_group name of variable representing treatment group. |
|
12 |
#' @param trt_group_level vector that can be used to define the factor level of `trt_group`. |
|
13 |
#' @param shape categorical variable whose levels are used to split the plot lines. |
|
14 |
#' @param shape_type vector of symbol types. |
|
15 |
#' @param time name of variable containing visit names. |
|
16 |
#' @param time_level vector that can be used to define the factor level of time. Only use it when |
|
17 |
#' x-axis variable is character or factor. |
|
18 |
#' @param color_manual vector of colors. |
|
19 |
#' @param line_type vector of line types. |
|
20 |
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis |
|
21 |
#' if the default limits are not suitable. |
|
22 |
#' @param median boolean whether to display median results. |
|
23 |
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines. |
|
24 |
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines. |
|
25 |
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines. |
|
26 |
#' @param xtick a vector to define the tick values of time in x-axis. |
|
27 |
#' Default value is `ggplot2::waiver()`. |
|
28 |
#' @param xlabel vector with same length of `xtick` to define the label of x-axis tick values. |
|
29 |
#' Default value is `ggplot2::waiver()`. |
|
30 |
#' @param rotate_xlab boolean whether to rotate x-axis labels. |
|
31 |
#' @param plot_font_size control font size for title, x-axis, y-axis and legend font. |
|
32 |
#' @param dot_size plot dot size. Default to 3. |
|
33 |
#' @param dodge control position dodge. |
|
34 |
#' @param plot_height height of produced plot. 989 pixels by default. |
|
35 |
#' @param count_threshold \code{integer} minimum number observations needed to show the appropriate |
|
36 |
#' bar and point on the plot. Default: 0 |
|
37 |
#' @param table_font_size \code{float} controls the font size of the values printed in the table. |
|
38 |
#' Default: 12 |
|
39 |
#' @param display_center_tbl boolean whether to include table of means or medians |
|
40 |
#' |
|
41 |
#' |
|
42 |
#' @author Balazs Toth (toth.balazs@gene.com) |
|
43 |
#' @author Wenyi Liu (wenyi.liu@roche.com) |
|
44 |
#' |
|
45 |
#' @details Currently, the output plot can display mean and median of input value. For mean, the |
|
46 |
#' error bar denotes |
|
47 |
#' 95\% confidence interval. For median, the error bar denotes median-25% quartile to median+75% |
|
48 |
#' quartile. |
|
49 |
#' |
|
50 |
#' @return \code{ggplot} object |
|
51 |
#' |
|
52 |
#' @export |
|
53 |
#' |
|
54 |
#' @examplesIf require("nestcolor") |
|
55 |
#' # Example using ADaM structure analysis dataset. |
|
56 |
#' |
|
57 |
#' library(stringr) |
|
58 |
#' library(dplyr) |
|
59 |
#' library(nestcolor) |
|
60 |
#' |
|
61 |
#' # original ARM value = dose value |
|
62 |
#' arm_mapping <- list( |
|
63 |
#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination" |
|
64 |
#' ) |
|
65 |
#' color_manual <- c("150mg QD" = "thistle", "Placebo" = "orange", "Combination" = "steelblue") |
|
66 |
#' type_manual <- c("150mg QD" = "solid", "Placebo" = "dashed", "Combination" = "dotted") |
|
67 |
#' |
|
68 |
#' ADSL <- rADSL %>% filter(!(ARM == "B: Placebo" & AGE < 40)) |
|
69 |
#' ADLB <- rADLB |
|
70 |
#' ADLB <- right_join(ADLB, ADSL[, c("STUDYID", "USUBJID")]) |
|
71 |
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label) |
|
72 |
#' |
|
73 |
#' ADLB <- ADLB %>% |
|
74 |
#' mutate(AVISITCD = case_when( |
|
75 |
#' AVISIT == "SCREENING" ~ "SCR", |
|
76 |
#' AVISIT == "BASELINE" ~ "BL", |
|
77 |
#' grepl("WEEK", AVISIT) ~ |
|
78 |
#' paste( |
|
79 |
#' "W", |
|
80 |
#' trimws( |
|
81 |
#' substr( |
|
82 |
#' AVISIT, |
|
83 |
#' start = 6, |
|
84 |
#' stop = str_locate(AVISIT, "DAY") - 1 |
|
85 |
#' ) |
|
86 |
#' ) |
|
87 |
#' ), |
|
88 |
#' TRUE ~ NA_character_ |
|
89 |
#' )) %>% |
|
90 |
#' mutate(AVISITCDN = case_when( |
|
91 |
#' AVISITCD == "SCR" ~ -2, |
|
92 |
#' AVISITCD == "BL" ~ 0, |
|
93 |
#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)), |
|
94 |
#' TRUE ~ NA_real_ |
|
95 |
#' )) %>% |
|
96 |
#' # use ARMCD values to order treatment in visualization legend |
|
97 |
#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1, |
|
98 |
#' ifelse(grepl("B", ARMCD), 2, |
|
99 |
#' ifelse(grepl("A", ARMCD), 3, NA) |
|
100 |
#' ) |
|
101 |
#' )) %>% |
|
102 |
#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>% |
|
103 |
#' mutate(ARM = factor(ARM) %>% |
|
104 |
#' reorder(TRTORD)) |
|
105 |
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]] |
|
106 |
#' |
|
107 |
#' g_lineplot( |
|
108 |
#' label = "Line Plot", |
|
109 |
#' data = ADLB, |
|
110 |
#' biomarker_var = "PARAMCD", |
|
111 |
#' biomarker = "CRP", |
|
112 |
#' value_var = "AVAL", |
|
113 |
#' trt_group = "ARM", |
|
114 |
#' shape = NULL, |
|
115 |
#' time = "AVISITCDN", |
|
116 |
#' color_manual = color_manual, |
|
117 |
#' line_type = type_manual, |
|
118 |
#' median = FALSE, |
|
119 |
#' hline_arb = c(.9, 1.1, 1.2, 1.5), |
|
120 |
#' hline_arb_color = c("green", "red", "blue", "pink"), |
|
121 |
#' hline_arb_label = c("A", "B", "C", "D"), |
|
122 |
#' xtick = c(0, 1, 5), |
|
123 |
#' xlabel = c("Baseline", "Week 1", "Week 5"), |
|
124 |
#' rotate_xlab = FALSE, |
|
125 |
#' plot_height = 600 |
|
126 |
#' ) |
|
127 |
#' |
|
128 |
#' g_lineplot( |
|
129 |
#' label = "Line Plot", |
|
130 |
#' data = ADLB, |
|
131 |
#' biomarker_var = "PARAMCD", |
|
132 |
#' biomarker = "CRP", |
|
133 |
#' value_var = "AVAL", |
|
134 |
#' trt_group = "ARM", |
|
135 |
#' shape = NULL, |
|
136 |
#' time = "AVISITCD", |
|
137 |
#' color_manual = NULL, |
|
138 |
#' line_type = type_manual, |
|
139 |
#' median = TRUE, |
|
140 |
#' hline_arb = c(.9, 1.1, 1.2, 1.5), |
|
141 |
#' hline_arb_color = c("green", "red", "blue", "pink"), |
|
142 |
#' hline_arb_label = c("A", "B", "C", "D"), |
|
143 |
#' xtick = c("BL", "W 1", "W 5"), |
|
144 |
#' xlabel = c("Baseline", "Week 1", "Week 5"), |
|
145 |
#' rotate_xlab = FALSE, |
|
146 |
#' plot_height = 600 |
|
147 |
#' ) |
|
148 |
#' |
|
149 |
#' g_lineplot( |
|
150 |
#' label = "Line Plot", |
|
151 |
#' data = ADLB, |
|
152 |
#' biomarker_var = "PARAMCD", |
|
153 |
#' biomarker = "CRP", |
|
154 |
#' value_var = "AVAL", |
|
155 |
#' trt_group = "ARM", |
|
156 |
#' shape = NULL, |
|
157 |
#' time = "AVISITCD", |
|
158 |
#' color_manual = color_manual, |
|
159 |
#' line_type = type_manual, |
|
160 |
#' median = FALSE, |
|
161 |
#' hline_arb = c(.9, 1.1, 1.2, 1.5), |
|
162 |
#' hline_arb_color = c("green", "red", "blue", "pink"), |
|
163 |
#' hline_arb_label = c("A", "B", "C", "D"), |
|
164 |
#' xtick = c("BL", "W 1", "W 5"), |
|
165 |
#' xlabel = c("Baseline", "Week 1", "Week 5"), |
|
166 |
#' rotate_xlab = FALSE, |
|
167 |
#' plot_height = 600, |
|
168 |
#' count_threshold = 90, |
|
169 |
#' table_font_size = 15 |
|
170 |
#' ) |
|
171 |
#' |
|
172 |
#' g_lineplot( |
|
173 |
#' label = "Line Plot", |
|
174 |
#' data = ADLB, |
|
175 |
#' biomarker_var = "PARAMCD", |
|
176 |
#' biomarker = "CRP", |
|
177 |
#' value_var = "AVAL", |
|
178 |
#' trt_group = "ARM", |
|
179 |
#' shape = NULL, |
|
180 |
#' time = "AVISITCDN", |
|
181 |
#' color_manual = color_manual, |
|
182 |
#' line_type = type_manual, |
|
183 |
#' median = TRUE, |
|
184 |
#' hline_arb = c(.9, 1.1, 1.2, 1.5), |
|
185 |
#' hline_arb_color = c("green", "red", "blue", "pink"), |
|
186 |
#' hline_arb_label = c("A", "B", "C", "D"), |
|
187 |
#' xtick = c(0, 1, 5), |
|
188 |
#' xlabel = c("Baseline", "Week 1", "Week 5"), |
|
189 |
#' rotate_xlab = FALSE, |
|
190 |
#' plot_height = 600 |
|
191 |
#' ) |
|
192 |
#' |
|
193 |
#' g_lineplot( |
|
194 |
#' label = "Line Plot", |
|
195 |
#' data = subset(ADLB, SEX %in% c("M", "F")), |
|
196 |
#' biomarker_var = "PARAMCD", |
|
197 |
#' biomarker = "CRP", |
|
198 |
#' value_var = "AVAL", |
|
199 |
#' trt_group = "ARM", |
|
200 |
#' shape = "SEX", |
|
201 |
#' time = "AVISITCDN", |
|
202 |
#' color_manual = color_manual, |
|
203 |
#' line_type = type_manual, |
|
204 |
#' median = FALSE, |
|
205 |
#' hline_arb = c(.9, 1.1, 1.2, 1.5), |
|
206 |
#' hline_arb_color = c("green", "red", "blue", "pink"), |
|
207 |
#' hline_arb_label = c("A", "B", "C", "D"), |
|
208 |
#' xtick = c(0, 1, 5), |
|
209 |
#' xlabel = c("Baseline", "Week 1", "Week 5"), |
|
210 |
#' rotate_xlab = FALSE, |
|
211 |
#' plot_height = 1500, |
|
212 |
#' dot_size = 1 |
|
213 |
#' ) |
|
214 |
#' |
|
215 |
#' g_lineplot( |
|
216 |
#' label = "Line Plot", |
|
217 |
#' data = subset(ADLB, SEX %in% c("M", "F")), |
|
218 |
#' biomarker_var = "PARAMCD", |
|
219 |
#' biomarker = "CRP", |
|
220 |
#' value_var = "AVAL", |
|
221 |
#' trt_group = "ARM", |
|
222 |
#' shape = "SEX", |
|
223 |
#' time = "AVISITCDN", |
|
224 |
#' color_manual = NULL, |
|
225 |
#' median = FALSE, |
|
226 |
#' hline_arb = c(.9, 1.1, 1.2, 1.5), |
|
227 |
#' hline_arb_color = c("green", "red", "blue", "pink"), |
|
228 |
#' hline_arb_label = c("A", "B", "C", "D"), |
|
229 |
#' xtick = c(0, 1, 5), |
|
230 |
#' xlabel = c("Baseline", "Week 1", "Week 5"), |
|
231 |
#' rotate_xlab = FALSE, |
|
232 |
#' plot_height = 1500, |
|
233 |
#' dot_size = 4 |
|
234 |
#' ) |
|
235 |
g_lineplot <- function(label = "Line Plot", |
|
236 |
data, |
|
237 |
biomarker_var = "PARAMCD", |
|
238 |
biomarker_var_label = "PARAM", |
|
239 |
biomarker, |
|
240 |
value_var = "AVAL", |
|
241 |
unit_var = "AVALU", |
|
242 |
loq_flag_var = "LOQFL", |
|
243 |
ylim = c(NA, NA), |
|
244 |
trt_group, |
|
245 |
trt_group_level = NULL, |
|
246 |
shape = NULL, |
|
247 |
shape_type = NULL, |
|
248 |
time, |
|
249 |
time_level = NULL, |
|
250 |
color_manual = NULL, |
|
251 |
line_type = NULL, |
|
252 |
median = FALSE, |
|
253 |
hline_arb = numeric(0), |
|
254 |
hline_arb_color = "red", |
|
255 |
hline_arb_label = "Horizontal line", |
|
256 |
xtick = ggplot2::waiver(), |
|
257 |
xlabel = xtick, |
|
258 |
rotate_xlab = FALSE, |
|
259 |
plot_font_size = 12, |
|
260 |
dot_size = 3, |
|
261 |
dodge = 0.4, |
|
262 |
plot_height = 989, |
|
263 |
count_threshold = 0, |
|
264 |
table_font_size = 12, |
|
265 |
display_center_tbl = TRUE) { |
|
266 | ! |
checkmate::assert_numeric(ylim, len = 2) |
267 | ||
268 |
## Pre-process data |
|
269 | ! |
table_font_size <- grid::convertX(grid::unit(table_font_size, "points"), "mm", valueOnly = TRUE) |
270 | ||
271 |
## - convert to factors |
|
272 | ! |
label_trt_group <- attr(data[[trt_group]], "label") |
273 | ! |
data[[trt_group]] <- if (is.null(trt_group_level)) { |
274 | ! |
factor(data[[trt_group]]) |
275 |
} else { |
|
276 | ! |
factor(data[[trt_group]], levels = trt_group_level) |
277 |
} |
|
278 | ! |
attr(data[[trt_group]], "label") <- label_trt_group |
279 | ||
280 | ! |
color_manual <- if (is.null(color_manual)) { |
281 | ! |
temp <- if (!is.null(getOption("ggplot2.discrete.colour"))) { |
282 | ! |
getOption("ggplot2.discrete.colour")[1:nlevels(data[[trt_group]])] |
283 |
} else { |
|
284 | ! |
gg_color_hue(nlevels(data[[trt_group]])) |
285 |
} |
|
286 | ! |
names(temp) <- levels(data[[trt_group]]) |
287 | ! |
temp |
288 |
} else { |
|
289 | ! |
stopifnot(all(levels(data[[trt_group]]) %in% names(color_manual))) |
290 | ! |
color_manual |
291 |
} |
|
292 | ||
293 | ! |
line_type <- if (is.null(line_type)) { |
294 | ! |
stats::setNames(rep("dashed", nlevels(data[[trt_group]])), levels(data[[trt_group]])) |
295 |
} else { |
|
296 | ! |
stopifnot(all(levels(data[[trt_group]]) %in% names(line_type))) |
297 | ! |
line_type |
298 |
} |
|
299 | ||
300 | ! |
shape_type <- if (is.null(shape)) { |
301 | ! |
NULL |
302 |
} else { |
|
303 | ! |
if (is.null(shape_type)) { |
304 | ! |
default_shapes <- c(15:18, 3:14, 0:2) |
305 | ! |
res <- if (nlevels(data[[shape]]) > length(default_shapes)) { |
306 | ! |
rep(default_shapes, ceiling(nlevels(data[[shape]]) / length(default_shapes))) |
307 |
} else { |
|
308 | ! |
default_shapes[seq_len(nlevels(data[[shape]]))] |
309 |
} |
|
310 | ! |
stats::setNames(res, levels(data[[shape]])) |
311 |
} else { |
|
312 | ! |
stopifnot(all(levels(data[[shape]]) %in% names(shape_type))) |
313 | ! |
shape_type |
314 |
} |
|
315 |
} |
|
316 | ||
317 | ! |
xtype <- if (is.factor(data[[time]]) || is.character(data[[time]])) { |
318 | ! |
"discrete" |
319 |
} else { |
|
320 | ! |
"continuous" |
321 |
} |
|
322 | ! |
if (xtype == "discrete") { |
323 | ! |
data[[time]] <- if (is.null(time_level)) { |
324 | ! |
factor(data[[time]]) |
325 |
} else { |
|
326 | ! |
factor(data[[time]], levels = time_level) |
327 |
} |
|
328 |
} |
|
329 | ||
330 | ! |
groupings <- c(time, trt_group, shape) |
331 |
## Summary statistics |
|
332 | ! |
sum_data <- data %>% |
333 | ! |
filter(!!sym(biomarker_var) == biomarker) %>% |
334 | ! |
group_by_at(groupings) %>% |
335 | ! |
summarise( |
336 | ! |
count = sum(!is.na(!!sym(value_var))), |
337 | ! |
mean = mean(!!sym(value_var), na.rm = TRUE), |
338 | ! |
CIup = mean(!!sym(value_var), na.rm = TRUE) + 1.96 * stats::sd(!!sym(value_var), na.rm = TRUE) / sqrt(n()), |
339 | ! |
CIdown = mean(!!sym(value_var), na.rm = TRUE) - 1.96 * stats::sd(!!sym(value_var), na.rm = TRUE) / sqrt(n()), |
340 | ! |
median = stats::median(!!sym(value_var), na.rm = TRUE), |
341 | ! |
quant25 = stats::quantile(!!sym(value_var), 0.25, na.rm = TRUE), |
342 | ! |
quant75 = stats::quantile(!!sym(value_var), 0.75, na.rm = TRUE) |
343 |
) %>% |
|
344 | ! |
arrange_at(c(trt_group, shape)) |
345 | ||
346 |
## Filter out rows with insufficient number of counts |
|
347 | ! |
listin <- list() |
348 | ! |
listin[[trt_group]] <- sum_data[[trt_group]] |
349 | ||
350 | ! |
if (!is.null(shape)) { |
351 | ! |
listin[[shape]] <- sum_data[[shape]] |
352 |
} |
|
353 | ||
354 | ! |
int <- unique_name("int", names(sum_data)) |
355 | ! |
sum_data[[int]] <- new_interaction(listin, sep = " ") |
356 | ! |
sum_data[[int]] <- stringr::str_wrap(sum_data[[int]], 12) |
357 | ! |
sum_data[[int]] <- factor(sum_data[[int]], sort(unique(sum_data[[int]]))) |
358 | ||
359 | ! |
unfiltered_data <- sum_data %>% mutate("met_threshold" = count >= count_threshold) |
360 | ! |
sum_data <- unfiltered_data %>% filter(.data[["met_threshold"]]) |
361 | ||
362 |
## Base plot |
|
363 | ! |
pd <- ggplot2::position_dodge(dodge) |
364 | ! |
if (median) { |
365 | ! |
line <- "median" |
366 | ! |
up_limit <- "quant75" |
367 | ! |
down_limit <- "quant25" |
368 |
} else { |
|
369 | ! |
line <- "mean" |
370 | ! |
up_limit <- "CIup" |
371 | ! |
down_limit <- "CIdown" |
372 |
} |
|
373 | ||
374 | ! |
filtered_data <- data %>% |
375 | ! |
filter(!!sym(biomarker_var) == biomarker) |
376 | ||
377 | ! |
unit <- filtered_data %>% |
378 | ! |
pull(unit_var) %>% |
379 | ! |
unique() |
380 | ||
381 | ! |
unit1 <- if (is.na(unit) || unit == "") { |
382 |
" " |
|
383 |
} else { |
|
384 | ! |
paste0(" (", unit, ") ") |
385 |
} |
|
386 | ||
387 | ! |
biomarker1 <- filtered_data %>% |
388 | ! |
pull(biomarker_var_label) %>% |
389 | ! |
unique() |
390 | ||
391 | ! |
gtitle <- paste0(biomarker1, unit1, stringr::str_to_title(line), " by Treatment @ Visits") |
392 | ! |
gylab <- paste0(biomarker1, " ", stringr::str_to_title(line), " of ", value_var, " Values") |
393 | ! |
gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label") |
394 | ||
395 |
# Setup legend label |
|
396 | ! |
trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label")) |
397 | ||
398 |
# Add footnote to identify LLOQ and ULOQ values pulled from data |
|
399 | ! |
caption_loqs_label <- h_caption_loqs_label(loqs_data = filtered_data, flag_var = loq_flag_var) |
400 | ||
401 | ! |
if (is.null(shape)) { |
402 | ! |
plot1 <- ggplot2::ggplot( |
403 | ! |
data = sum_data, |
404 | ! |
ggplot2::aes( |
405 | ! |
x = !!sym(time), |
406 | ! |
y = !!sym(line), |
407 | ! |
color = !!sym(trt_group), |
408 | ! |
linetype = !!sym(trt_group), |
409 | ! |
group = !!sym(int) |
410 |
) |
|
411 |
) + |
|
412 | ! |
ggplot2::theme_bw() + |
413 | ! |
ggplot2::geom_point(position = pd, size = dot_size) + |
414 | ! |
ggplot2::scale_color_manual( |
415 | ! |
values = color_manual, name = trt_label, guide = ggplot2::guide_legend(ncol = 3, order = 1) |
416 |
) + |
|
417 | ! |
ggplot2::scale_linetype_manual( |
418 | ! |
values = line_type, name = trt_label, guide = ggplot2::guide_legend(ncol = 3, order = 1) |
419 |
) |
|
420 |
} else { |
|
421 | ! |
mappings <- sum_data %>% |
422 | ! |
ungroup() %>% |
423 | ! |
select(!!sym(trt_group), !!sym(shape), int) %>% |
424 | ! |
distinct() %>% |
425 | ! |
mutate( |
426 | ! |
cols = color_manual[as.character(!!sym(trt_group))], |
427 | ! |
types = line_type[as.character(!!sym(trt_group))], |
428 | ! |
shps = shape_type[!!sym(shape)] |
429 |
) |
|
430 | ||
431 | ! |
col_mapping <- stats::setNames(mappings$cols, mappings$int) |
432 | ! |
shape_mapping <- stats::setNames(mappings$shps, mappings$int) |
433 | ! |
type_mapping <- stats::setNames(mappings$types, mappings$int) |
434 | ||
435 | ! |
plot1 <- ggplot2::ggplot( |
436 | ! |
data = sum_data, |
437 | ! |
ggplot2::aes( |
438 | ! |
x = !!sym(time), |
439 | ! |
y = !!sym(line), |
440 | ! |
color = !!sym(int), |
441 | ! |
linetype = !!sym(int), |
442 | ! |
group = !!sym(int), |
443 | ! |
shape = !!sym(int) |
444 |
) |
|
445 |
) + |
|
446 | ! |
ggplot2::theme_bw() + |
447 | ! |
ggplot2::scale_color_manual(" ", values = col_mapping, guide = ggplot2::guide_legend(ncol = 3, order = 1)) + |
448 | ! |
ggplot2::scale_linetype_manual(" ", values = type_mapping, guide = ggplot2::guide_legend(ncol = 3, order = 1)) + |
449 | ! |
ggplot2::scale_shape_manual(" ", values = shape_mapping, guide = ggplot2::guide_legend(ncol = 3, order = 1)) + |
450 | ! |
ggplot2::theme(legend.key.size = grid::unit(1, "cm")) + |
451 | ! |
ggplot2::geom_point(position = pd, size = dot_size) |
452 |
} |
|
453 | ||
454 | ! |
plot1 <- plot1 + |
455 | ! |
ggplot2::geom_line(position = pd) + |
456 | ! |
ggplot2::geom_errorbar( |
457 | ! |
ggplot2::aes(ymin = !!sym(down_limit), ymax = !!sym(up_limit)), |
458 | ! |
width = 0.45, position = pd, linetype = "solid" |
459 |
) + |
|
460 | ! |
ggplot2::ggtitle(gtitle) + |
461 | ! |
ggplot2::labs(caption = paste( |
462 | ! |
"The output plot can display mean and median of input value.", |
463 | ! |
"For mean, the error bar denotes 95% confidence interval.", |
464 | ! |
"For median, the bar denotes the first to third quartile.\n", |
465 | ! |
caption_loqs_label |
466 |
)) + |
|
467 | ! |
ggplot2::xlab(gxlab) + |
468 | ! |
ggplot2::ylab(gylab) + |
469 | ! |
ggplot2::theme( |
470 | ! |
legend.box = "vertical", |
471 | ! |
legend.position = "bottom", |
472 | ! |
legend.direction = "horizontal", |
473 | ! |
plot.title = ggplot2::element_text(size = plot_font_size, margin = ggplot2::margin(), hjust = 0.5), |
474 | ! |
axis.title.y = ggplot2::element_text(margin = ggplot2::margin(r = 20)) |
475 |
) |
|
476 | ||
477 |
# Apply y-axis zoom range |
|
478 | ! |
plot1 <- plot1 + |
479 | ! |
ggplot2::coord_cartesian(ylim = ylim) |
480 | ||
481 |
# Format x-label |
|
482 | ! |
if (xtype == "continuous") { |
483 | ! |
plot1 <- plot1 + |
484 | ! |
ggplot2::scale_x_continuous(breaks = xtick, labels = xlabel, limits = c(NA, NA)) |
485 | ! |
} else if (xtype == "discrete") { |
486 | ! |
plot1 <- plot1 + |
487 | ! |
ggplot2::scale_x_discrete(breaks = xtick, labels = xlabel) |
488 |
} |
|
489 | ||
490 | ! |
if (rotate_xlab) { |
491 | ! |
plot1 <- plot1 + |
492 | ! |
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) |
493 |
} |
|
494 | ||
495 | ||
496 | ! |
plot1 <- plot1 + geom_axes_lines( |
497 | ! |
sum_data, |
498 | ! |
hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label |
499 |
) |
|
500 | ||
501 |
# Format font size |
|
502 | ! |
if (!is.null(plot_font_size)) { |
503 | ! |
plot1 <- plot1 + |
504 | ! |
ggplot2::theme( |
505 | ! |
axis.title.x = ggplot2::element_text(size = plot_font_size), |
506 | ! |
axis.text.x = ggplot2::element_text(size = plot_font_size), |
507 | ! |
axis.title.y = ggplot2::element_text(size = plot_font_size), |
508 | ! |
axis.text.y = ggplot2::element_text(size = plot_font_size), |
509 | ! |
legend.title = ggplot2::element_text(size = plot_font_size), |
510 | ! |
legend.text = ggplot2::element_text(size = plot_font_size) |
511 |
) |
|
512 |
} |
|
513 | ||
514 | ! |
labels <- levels(unfiltered_data[[int]]) |
515 | ! |
lines <- sum(stringr::str_count(unique(labels), "\n")) / 2 + length(unique(labels)) |
516 | ! |
minline <- 36 |
517 | ! |
tabletotal <- lines * minline * ifelse(display_center_tbl, 2, 1) |
518 | ! |
plotsize <- plot_height - tabletotal |
519 | ! |
if (plotsize <= 250) { |
520 | ! |
stop("Due to number of line splitting levels the current plot height is not sufficient to display plot. |
521 | ! |
If applicable, please try a combination of: |
522 | ! |
* increasing the plot height using the Plot Aesthetic Settings, |
523 | ! |
* increasing the relative height of plot to table(s), |
524 | ! |
* increasing the initial maximum plot_height argument during creation of this app, |
525 | ! |
* and / or consider removing the mean / median table.") |
526 |
} |
|
527 | ||
528 | ! |
if (display_center_tbl) { |
529 | ! |
unfiltered_data$center <- if (median) { |
530 | ! |
sprintf(ifelse(unfiltered_data$count > 0, "%.2f", ""), unfiltered_data$median) |
531 |
} else { |
|
532 | ! |
sprintf(ifelse(unfiltered_data$count > 0, "%.2f", ""), unfiltered_data$mean) |
533 |
} |
|
534 | ! |
tbl_central_value_title <- if (median) "Median" else "Mean" |
535 | ! |
tbl_central_value <- ggplot2::ggplot( |
536 | ! |
unfiltered_data, |
537 | ! |
ggplot2::aes(x = !!sym(time), y = !!sym(int), label = .data[["center"]]) |
538 |
) + |
|
539 | ! |
ggplot2::geom_text(ggplot2::aes(color = .data[["met_threshold"]]), size = table_font_size) + |
540 | ! |
ggplot2::ggtitle(tbl_central_value_title) + |
541 | ! |
ggplot2::theme_minimal() + |
542 | ! |
ggplot2::scale_y_discrete(labels = labels) + |
543 | ! |
ggplot2::theme( |
544 | ! |
panel.grid.major = ggplot2::element_blank(), |
545 | ! |
legend.position = "none", |
546 | ! |
panel.grid.minor = ggplot2::element_blank(), |
547 | ! |
panel.border = ggplot2::element_blank(), axis.text.x = ggplot2::element_blank(), |
548 | ! |
axis.ticks = ggplot2::element_blank(), |
549 | ! |
axis.title.x = ggplot2::element_blank(), |
550 | ! |
axis.title.y = ggplot2::element_blank(), |
551 | ! |
axis.text.y = ggplot2::element_text(size = plot_font_size), |
552 | ! |
plot.title = ggplot2::element_text(face = "bold", size = plot_font_size) |
553 |
) + |
|
554 | ! |
ggplot2::scale_color_manual(values = c("FALSE" = "red", "TRUE" = "black")) |
555 |
} |
|
556 | ||
557 | ! |
tbl <- ggplot2::ggplot( |
558 | ! |
unfiltered_data, |
559 | ! |
ggplot2::aes(x = !!sym(time), y = !!sym(int), label = .data[["count"]]) |
560 |
) + |
|
561 | ! |
ggplot2::geom_text(ggplot2::aes(color = .data[["met_threshold"]]), size = table_font_size) + |
562 | ! |
ggplot2::ggtitle("Number of observations") + |
563 | ! |
ggplot2::theme_minimal() + |
564 | ! |
ggplot2::scale_y_discrete(labels = labels) + |
565 | ! |
ggplot2::theme( |
566 | ! |
panel.grid.major = ggplot2::element_blank(), |
567 | ! |
legend.position = "none", |
568 | ! |
panel.grid.minor = ggplot2::element_blank(), |
569 | ! |
panel.border = ggplot2::element_blank(), axis.text.x = ggplot2::element_blank(), |
570 | ! |
axis.ticks = ggplot2::element_blank(), |
571 | ! |
axis.title.x = ggplot2::element_blank(), |
572 | ! |
axis.title.y = ggplot2::element_blank(), |
573 | ! |
axis.text.y = ggplot2::element_text(size = plot_font_size), |
574 | ! |
plot.title = ggplot2::element_text(face = "bold", size = plot_font_size) |
575 |
) + |
|
576 | ! |
ggplot2::scale_color_manual(values = c("FALSE" = "red", "TRUE" = "black")) |
577 | ||
578 |
# Plot the grobs using plot_grid |
|
579 | ! |
if (display_center_tbl) { |
580 | ! |
cowplot::plot_grid(plot1, tbl_central_value, tbl, |
581 | ! |
align = "v", ncol = 1, |
582 | ! |
rel_heights = c(plotsize, tabletotal / 2, tabletotal / 2) |
583 |
) |
|
584 |
} else { |
|
585 | ! |
cowplot::plot_grid(plot1, tbl, align = "v", ncol = 1, rel_heights = c(plotsize, tabletotal)) |
586 |
} |
|
587 |
} |
|
588 | ||
589 |
new_interaction <- function(args, drop = FALSE, sep = ".", lex.order = FALSE) { # nolint |
|
590 | ! |
for (i in seq_along(args)) { |
591 | ! |
if (is.null(args[[i]])) { |
592 | ! |
args[[i]] <- NULL |
593 |
} |
|
594 |
} |
|
595 | ! |
if (length(args) == 1) { |
596 | ! |
return(paste0(names(args), ":", args[[1]])) |
597 |
} |
|
598 | ! |
args <- mapply(function(n, val) paste0(n, ":", val), names(args), args, SIMPLIFY = FALSE) |
599 | ! |
interaction(args, drop = drop, sep = sep, lex.order = lex.order) |
600 |
} |
|
601 | ||
602 |
unique_name <- function(newname, old_names) { |
|
603 | ! |
if (newname %in% old_names) { |
604 | ! |
unique_name(paste0(newname, "1"), old_names) |
605 |
} |
|
606 | ! |
newname |
607 |
} |
|
608 | ||
609 |
gg_color_hue <- function(n) { |
|
610 | ! |
hues <- seq(15, 375, length = n + 1) |
611 | ! |
grDevices::hcl(h = hues, l = 65, c = 100)[1:n] |
612 |
} |
1 |
#' Function to create a correlation plot. |
|
2 |
#' |
|
3 |
#' Default plot displays correlation facetted by visit with color attributed treatment arms and |
|
4 |
#' symbol attributed `LOQ` values. |
|
5 |
#' |
|
6 |
#' @param label text string to used to identify plot. |
|
7 |
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`. |
|
8 |
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`. |
|
9 |
#' @param xaxis_param x-axis biomarker to visualize e.g. `IGG`. |
|
10 |
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `BASE`. |
|
11 |
#' @param xvar x-axis analysis variable from transposed data set. |
|
12 |
#' @param yaxis_param y-axis biomarker to visualize e.g. `IGG`. |
|
13 |
#' @param yaxis_var name of variable containing biomarker results displayed on Y-axis.g. `AVAL`. |
|
14 |
#' @param yvar y-axis analysis variable from transposed data set. |
|
15 |
#' @param trt_group name of variable representing treatment group e.g. `ARM`. |
|
16 |
#' @param visit name of variable containing nominal visits e.g. `AVISITCD`. |
|
17 |
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL_COMB`. |
|
18 |
#' @param visit_facet visit facet toggle. |
|
19 |
#' @param loq_legend `logical` whether to include `LoQ` legend. |
|
20 |
#' @param unit name of variable containing biomarker unit e.g. `AVALU`. |
|
21 |
#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis |
|
22 |
#' if the default limits are not suitable. |
|
23 |
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis |
|
24 |
#' if the default limits are not suitable. |
|
25 |
#' @param title_text plot title. |
|
26 |
#' @param xaxis_lab x-axis label. |
|
27 |
#' @param yaxis_lab y-axis label. |
|
28 |
#' @param color_manual vector of colors applied to treatment values. |
|
29 |
#' @param shape_manual vector of symbols applied to `LOQ` values. (used with `loq_flag_var`). |
|
30 |
#' @param facet_ncol number of facets per row. |
|
31 |
#' @param facet set layout to use treatment facetting. |
|
32 |
#' @param facet_var variable to use for treatment facetting. |
|
33 |
#' @param reg_line include regression line and annotations for slope and coefficient. |
|
34 |
#' Use with facet = TRUE. |
|
35 |
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines. |
|
36 |
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines. |
|
37 |
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines. |
|
38 |
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values. |
|
39 |
#' The data inside of the `ggplot2` object must also contain the columns with these variable names |
|
40 |
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables. |
|
41 |
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables. |
|
42 |
#' @param vline_arb ('numeric vector') value identifying intercept for arbitrary vertical lines. |
|
43 |
#' @param vline_arb_color ('character vector') optional, color for the arbitrary vertical lines. |
|
44 |
#' @param vline_arb_label ('character vector') optional, label for the legend to the arbitrary vertical lines. |
|
45 |
#' @param vline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values. |
|
46 |
#' The data inside of the `ggplot2` object must also contain the columns with these variable names |
|
47 |
#' @param vline_vars_colors ('character vector') colors for the vertical lines defined by variables. |
|
48 |
#' @param vline_vars_labels ('character vector') labels for the legend to the vertical lines defined by variables. |
|
49 |
#' @param rotate_xlab 45 degree rotation of x-axis label values. |
|
50 |
#' @param font_size font size control for title, x-axis label, y-axis label and legend. |
|
51 |
#' @param dot_size plot dot size. |
|
52 |
#' @param reg_text_size font size control for regression line annotations. |
|
53 |
#' |
|
54 |
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com |
|
55 |
#' @author Balazs Toth (tothb2) toth.balazs@gene.com |
|
56 |
#' |
|
57 |
#' @details Regression uses `deming` model. |
|
58 |
#' |
|
59 |
#' @export |
|
60 |
#' |
|
61 |
#' @examplesIf require("tidyr") |
|
62 |
#' # Example using ADaM structure analysis dataset. |
|
63 |
#' |
|
64 |
#' library(stringr) |
|
65 |
#' library(tidyr) |
|
66 |
#' |
|
67 |
#' # original ARM value = dose value |
|
68 |
#' arm_mapping <- list( |
|
69 |
#' "A: Drug X" = "150mg QD", |
|
70 |
#' "B: Placebo" = "Placebo", |
|
71 |
#' "C: Combination" = "Combination" |
|
72 |
#' ) |
|
73 |
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C") |
|
74 |
#' # assign LOQ flag symbols: circles for "N" and triangles for "Y", squares for "NA" |
|
75 |
#' shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0) |
|
76 |
#' |
|
77 |
#' ADLB <- rADLB |
|
78 |
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label) |
|
79 |
#' ADLB <- ADLB %>% |
|
80 |
#' mutate(AVISITCD = case_when( |
|
81 |
#' AVISIT == "SCREENING" ~ "SCR", |
|
82 |
#' AVISIT == "BASELINE" ~ "BL", |
|
83 |
#' grepl("WEEK", AVISIT) ~ |
|
84 |
#' paste( |
|
85 |
#' "W", |
|
86 |
#' trimws( |
|
87 |
#' substr( |
|
88 |
#' AVISIT, |
|
89 |
#' start = 6, |
|
90 |
#' stop = str_locate(AVISIT, "DAY") - 1 |
|
91 |
#' ) |
|
92 |
#' ) |
|
93 |
#' ), |
|
94 |
#' TRUE ~ NA_character_ |
|
95 |
#' )) %>% |
|
96 |
#' mutate(AVISITCDN = case_when( |
|
97 |
#' AVISITCD == "SCR" ~ -2, |
|
98 |
#' AVISITCD == "BL" ~ 0, |
|
99 |
#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)), |
|
100 |
#' TRUE ~ NA_real_ |
|
101 |
#' )) %>% |
|
102 |
#' # use ARMCD values to order treatment in visualization legend |
|
103 |
#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1, |
|
104 |
#' ifelse(grepl("B", ARMCD), 2, |
|
105 |
#' ifelse(grepl("A", ARMCD), 3, NA) |
|
106 |
#' ) |
|
107 |
#' )) %>% |
|
108 |
#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>% |
|
109 |
#' mutate(ARM = factor(ARM) %>% |
|
110 |
#' reorder(TRTORD)) %>% |
|
111 |
#' mutate( |
|
112 |
#' ANRHI = case_when( |
|
113 |
#' PARAMCD == "ALT" ~ 60, |
|
114 |
#' PARAMCD == "CRP" ~ 70, |
|
115 |
#' PARAMCD == "IGA" ~ 80, |
|
116 |
#' TRUE ~ NA_real_ |
|
117 |
#' ), |
|
118 |
#' ANRLO = case_when( |
|
119 |
#' PARAMCD == "ALT" ~ 20, |
|
120 |
#' PARAMCD == "CRP" ~ 30, |
|
121 |
#' PARAMCD == "IGA" ~ 40, |
|
122 |
#' TRUE ~ NA_real_ |
|
123 |
#' ) |
|
124 |
#' ) %>% |
|
125 |
#' rowwise() %>% |
|
126 |
#' group_by(PARAMCD) %>% |
|
127 |
#' mutate(LBSTRESC = ifelse( |
|
128 |
#' USUBJID %in% sample(USUBJID, 1, replace = TRUE), |
|
129 |
#' paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC |
|
130 |
#' )) %>% |
|
131 |
#' mutate(LBSTRESC = ifelse( |
|
132 |
#' USUBJID %in% sample(USUBJID, 1, replace = TRUE), |
|
133 |
#' paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC |
|
134 |
#' )) %>% |
|
135 |
#' ungroup() |
|
136 |
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]] |
|
137 |
#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit" |
|
138 |
#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit" |
|
139 |
#' |
|
140 |
#' # add LLOQ and ULOQ variables |
|
141 |
#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, flag_var = "LOQFL") |
|
142 |
#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM") |
|
143 |
#' |
|
144 |
#' # given the 2 param and 2 analysis vars we need to transform the data |
|
145 |
#' plot_data_t1 <- ADLB %>% |
|
146 |
#' gather( |
|
147 |
#' ANLVARS, ANLVALS, PARAM, LBSTRESC, BASE2, BASE, AVAL, BASE, LOQFL, |
|
148 |
#' ANRHI, ANRLO, ULOQN, LLOQN |
|
149 |
#' ) %>% |
|
150 |
#' mutate(ANL.PARAM = ifelse(ANLVARS %in% c("PARAM", "LBSTRESC", "LOQFL"), |
|
151 |
#' paste0(ANLVARS, "_", PARAMCD), |
|
152 |
#' paste0(ANLVARS, ".", PARAMCD) |
|
153 |
#' )) %>% |
|
154 |
#' select(USUBJID, ARM, ARMCD, AVISITN, AVISITCD, ANL.PARAM, ANLVALS) %>% |
|
155 |
#' spread(ANL.PARAM, ANLVALS) |
|
156 |
#' |
|
157 |
#' # the transformed analysis value variables are character and need to be converted to numeric for |
|
158 |
#' # ggplot |
|
159 |
#' # remove records where either of the analysis variables are NA since they will not appear on the |
|
160 |
#' # plot and will ensure that LOQFL = NA level is removed |
|
161 |
#' plot_data_t2 <- plot_data_t1 %>% |
|
162 |
#' filter(!is.na(BASE.CRP) & !is.na(AVAL.ALT)) %>% |
|
163 |
#' mutate_at(vars(contains(".")), as.numeric) %>% |
|
164 |
#' mutate( |
|
165 |
#' LOQFL_COMB = ifelse(LOQFL_CRP == "Y" | LOQFL_ALT == "Y", "Y", "N") |
|
166 |
#' ) |
|
167 |
#' |
|
168 |
#' g_correlationplot( |
|
169 |
#' label = "Correlation Plot", |
|
170 |
#' data = plot_data_t2, |
|
171 |
#' param_var = "PARAMCD", |
|
172 |
#' xaxis_param = c("CRP"), |
|
173 |
#' xaxis_var = "AVAL", |
|
174 |
#' xvar = "AVAL.CRP", |
|
175 |
#' yaxis_param = c("ALT"), |
|
176 |
#' yaxis_var = "BASE", |
|
177 |
#' yvar = "BASE.ALT", |
|
178 |
#' trt_group = "ARM", |
|
179 |
#' visit = "AVISITCD", |
|
180 |
#' visit_facet = TRUE, |
|
181 |
#' loq_legend = TRUE, |
|
182 |
#' unit = "AVALU", |
|
183 |
#' title_text = "Correlation of ALT to CRP", |
|
184 |
#' xaxis_lab = "CRP", |
|
185 |
#' yaxis_lab = "ALT", |
|
186 |
#' color_manual = color_manual, |
|
187 |
#' shape_manual = shape_manual, |
|
188 |
#' facet_ncol = 4, |
|
189 |
#' facet = FALSE, |
|
190 |
#' facet_var = "ARM", |
|
191 |
#' reg_line = FALSE, |
|
192 |
#' hline_arb = c(15, 25), |
|
193 |
#' hline_arb_color = c("gray", "green"), |
|
194 |
#' hline_arb_label = "Hori_line_label", |
|
195 |
#' vline_arb = c(.5, 1), |
|
196 |
#' vline_arb_color = c("red", "black"), |
|
197 |
#' vline_arb_label = c("Vertical Line A", "Vertical Line B"), |
|
198 |
#' hline_vars = c("ANRHI.ALT", "ANRLO.ALT", "ULOQN.ALT", "LLOQN.ALT"), |
|
199 |
#' hline_vars_colors = c("green", "blue", "purple", "cyan"), |
|
200 |
#' hline_vars_labels = c("ANRHI ALT Label", "ANRLO ALT Label", "ULOQN ALT Label", "LLOQN ALT Label"), |
|
201 |
#' vline_vars = c("ANRHI.CRP", "ANRLO.CRP", "ULOQN.CRP", "LLOQN.CRP"), |
|
202 |
#' vline_vars_colors = c("yellow", "orange", "brown", "gold"), |
|
203 |
#' vline_vars_labels = c("ANRHI CRP Label", "ANRLO CRP Label", "ULOQN CRP Label", "LLOQN CRP Label"), |
|
204 |
#' rotate_xlab = FALSE, |
|
205 |
#' font_size = 14, |
|
206 |
#' dot_size = 2, |
|
207 |
#' reg_text_size = 3 |
|
208 |
#' ) |
|
209 |
g_correlationplot <- function(label = "Correlation Plot", |
|
210 |
data, |
|
211 |
param_var = "PARAMCD", |
|
212 |
xaxis_param = "CRP", |
|
213 |
xaxis_var = "BASE", |
|
214 |
xvar, |
|
215 |
yaxis_param = "IGG", |
|
216 |
yaxis_var = "AVAL", |
|
217 |
yvar, |
|
218 |
trt_group = "ARM", |
|
219 |
visit = "AVISITCD", |
|
220 |
loq_flag_var = "LOQFL_COMB", |
|
221 |
visit_facet = TRUE, |
|
222 |
loq_legend = TRUE, |
|
223 |
unit = "AVALU", |
|
224 |
xlim = c(NA, NA), |
|
225 |
ylim = c(NA, NA), |
|
226 |
title_text = title_text, |
|
227 |
xaxis_lab = xaxis_lab, |
|
228 |
yaxis_lab = yaxis_lab, |
|
229 |
color_manual = NULL, |
|
230 |
shape_manual = NULL, |
|
231 |
facet_ncol = 2, |
|
232 |
facet = FALSE, |
|
233 |
facet_var = "ARM", |
|
234 |
reg_line = FALSE, |
|
235 |
hline_arb = numeric(0), |
|
236 |
hline_arb_color = "red", |
|
237 |
hline_arb_label = "Horizontal line", |
|
238 |
hline_vars = character(0), |
|
239 |
hline_vars_colors = "green", |
|
240 |
hline_vars_labels = hline_vars, |
|
241 |
vline_arb = numeric(0), |
|
242 |
vline_arb_color = "red", |
|
243 |
vline_arb_label = "Vertical line", |
|
244 |
vline_vars = character(0), |
|
245 |
vline_vars_colors = "green", |
|
246 |
vline_vars_labels = vline_vars, |
|
247 |
rotate_xlab = FALSE, |
|
248 |
font_size = 12, |
|
249 |
dot_size = 2, |
|
250 |
reg_text_size = 3) { |
|
251 | ! |
checkmate::assert_flag(loq_legend) |
252 | ! |
checkmate::assert_number(dot_size, lower = 1) |
253 | ! |
checkmate::assert_numeric(xlim, len = 2) |
254 | ! |
checkmate::assert_numeric(ylim, len = 2) |
255 | ||
256 |
# create correlation plot over time pairwise per treatment arm |
|
257 | ! |
plot_data <- data |
258 | ||
259 |
# identify param and lbstresc combinations in transposed data variable name |
|
260 | ! |
t_param_var_x <- paste("PARAM", xaxis_param, sep = "_") |
261 | ! |
t_lbstresc_var_x <- paste("LBSTRESC", xaxis_param, sep = "_") |
262 | ! |
t_param_var_y <- paste("PARAM", yaxis_param, sep = "_") |
263 | ! |
t_lbstresc_var_y <- paste("LBSTRESC", yaxis_param, sep = "_") |
264 | ||
265 | ! |
xaxis_param_loqs_data <- data %>% |
266 | ! |
mutate( |
267 | ! |
PARAM = !!sym(t_param_var_x), LBSTRESC = !!sym(t_lbstresc_var_x), |
268 | ! |
sym(loq_flag_var) == !!sym(loq_flag_var) |
269 |
) %>% |
|
270 | ! |
select("PARAM", "LBSTRESC", loq_flag_var) |
271 | ||
272 | ! |
yaxis_param_loqs_data <- data %>% |
273 | ! |
mutate( |
274 | ! |
PARAM = !!sym(t_param_var_y), LBSTRESC = !!sym(t_lbstresc_var_y), |
275 | ! |
sym(loq_flag_var) == !!sym(loq_flag_var) |
276 |
) %>% |
|
277 | ! |
select("PARAM", "LBSTRESC", loq_flag_var) |
278 | ||
279 |
# add footnote to identify xaxis assay LLOQ and ULOQ values pulled from data |
|
280 | ! |
caption_loqs_label_x <- h_caption_loqs_label(loqs_data = xaxis_param_loqs_data, flag_var = loq_flag_var) |
281 | ! |
caption_loqs_label_y <- h_caption_loqs_label(loqs_data = yaxis_param_loqs_data, flag_var = loq_flag_var) |
282 | ! |
caption_loqs_label_x_y <- paste0(union(caption_loqs_label_x, caption_loqs_label_y), collapse = "\n") |
283 | ||
284 |
# Setup legend label |
|
285 | ! |
trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label")) |
286 | ||
287 |
# create plot foundation - titles and axes labels are defined in |
|
288 |
# teal.goshawk.tm_g_correlationplot.R |
|
289 | ! |
plot1 <- ggplot2::ggplot( |
290 | ! |
data = plot_data, |
291 | ! |
ggplot2::aes( |
292 | ! |
x = !!sym(xvar), |
293 | ! |
y = !!sym(yvar), |
294 | ! |
color = !!sym(trt_group) |
295 |
) |
|
296 |
) + |
|
297 | ! |
ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) + |
298 | ! |
ggplot2::theme_bw() + |
299 | ! |
ggplot2::labs(caption = caption_loqs_label_x_y) + |
300 | ! |
ggplot2::ggtitle(title_text) + |
301 | ! |
ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) + |
302 | ! |
ggplot2::xlab(xaxis_lab) + |
303 | ! |
ggplot2::ylab(yaxis_lab) |
304 | ||
305 |
# conditionally facet |
|
306 | ! |
plot1 <- if (visit_facet && facet) { |
307 | ! |
plot1 + |
308 | ! |
ggplot2::facet_grid(stats::as.formula(paste0(facet_var, " ~ ", visit))) |
309 | ! |
} else if (visit_facet) { |
310 | ! |
plot1 + |
311 | ! |
ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", visit)), ncol = facet_ncol) |
312 | ! |
} else if (facet) { |
313 | ! |
plot1 + |
314 | ! |
ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = facet_ncol) |
315 |
} else { |
|
316 | ! |
plot1 |
317 |
} |
|
318 | ||
319 | ! |
plot1 <- plot1 + |
320 | ! |
ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE) |
321 | ||
322 |
# add regression line |
|
323 | ! |
if (reg_line) { |
324 | ! |
slope <- function(x, y) { |
325 | ! |
if (stats::sd(y) != 0) { |
326 | ! |
ratio <- stats::sd(x) / stats::sd(y) |
327 | ! |
if (!is.na(ratio) && ratio > 0) { |
328 | ! |
reg <- mc.deming(y, x, ratio) |
329 |
# return the evaluation of the ratio condition as third value in numeric vector to control |
|
330 |
# downstream processing |
|
331 | ! |
return(c(round(reg$b0, 2), round(reg$b1, 2), !is.na(ratio) & ratio > 0)) |
332 |
} |
|
333 |
} |
|
334 |
# if ratio condition is not met then assign NA to vector so that NULL condition does not throw |
|
335 |
# the error below |
|
336 | ! |
return(as.numeric(c(NA, NA, NA))) |
337 |
} |
|
338 | ||
339 | ! |
sub_data <- filter(plot_data, !is.na(!!sym(yvar)) & !is.na(!!sym(xvar))) %>% |
340 | ! |
group_by(!!sym(trt_group), !!sym(visit)) %>% |
341 | ! |
mutate(intercept = slope(!!sym(yvar), !!sym(xvar))[1]) %>% |
342 | ! |
mutate(slope = slope(!!sym(yvar), !!sym(xvar))[2]) %>% |
343 | ! |
mutate(corr = ifelse( |
344 | ! |
slope(!!sym(yvar), !!sym(xvar))[3], |
345 | ! |
stats::cor(!!sym(yvar), !!sym(xvar), method = "spearman", use = "complete.obs"), |
346 | ! |
NA |
347 |
)) |
|
348 | ! |
plot1 <- plot1 + |
349 | ! |
ggplot2::geom_abline( |
350 | ! |
data = filter(sub_data, row_number() == 1), # only need to return 1 row within group_by |
351 | ! |
ggplot2::aes(intercept = .data$intercept, slope = .data$slope, color = !!sym(trt_group)) |
352 |
) + |
|
353 | ! |
ggplot2::geom_text( |
354 | ! |
data = filter(sub_data, row_number() == 1), |
355 | ! |
ggplot2::aes_( |
356 | ! |
x = -Inf, |
357 | ! |
y = Inf, |
358 | ! |
hjust = 0, |
359 | ! |
vjust = 1, |
360 | ! |
label = ~ ifelse( |
361 | ! |
!is.na(intercept) & !is.na(slope) & !is.na(corr), |
362 | ! |
sprintf("y = %.2f+%.2fX\ncor = %.2f", intercept, slope, corr), |
363 | ! |
paste0("Insufficient Data For Regression") |
364 |
), |
|
365 | ! |
color = sym(trt_group) |
366 |
), |
|
367 | ! |
size = reg_text_size, |
368 | ! |
show.legend = FALSE |
369 |
) + |
|
370 | ! |
ggplot2::labs(caption = paste0( |
371 | ! |
"Deming Regression Model, Spearman Correlation Method.\n", |
372 | ! |
caption_loqs_label_x_y |
373 |
)) |
|
374 |
} |
|
375 |
# Format font size |
|
376 | ! |
if (!is.null(font_size)) { |
377 | ! |
plot1 <- plot1 + ggplot2::theme( |
378 | ! |
axis.title.x = ggplot2::element_text(size = font_size), |
379 | ! |
axis.text.x = ggplot2::element_text(size = font_size), |
380 | ! |
axis.title.y = ggplot2::element_text(size = font_size), |
381 | ! |
axis.text.y = ggplot2::element_text(size = font_size), |
382 | ! |
legend.title = ggplot2::element_text(size = font_size), |
383 | ! |
legend.text = ggplot2::element_text(size = font_size), |
384 | ! |
strip.text.x = ggplot2::element_text(size = font_size), |
385 | ! |
strip.text.y = ggplot2::element_text(size = font_size) |
386 |
) |
|
387 |
} |
|
388 |
# Format treatment color |
|
389 | ! |
plot1 <- if (!is.null(color_manual)) { |
390 | ! |
plot1 + |
391 | ! |
ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1)) |
392 |
} else { |
|
393 | ! |
plot1 + |
394 | ! |
ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1)) |
395 |
} |
|
396 | ||
397 |
# Format LOQ flag symbol shape |
|
398 | ! |
if (is.null(shape_manual)) { |
399 | ! |
shape_names <- unique(data[!is.na(data[[loq_flag_var]]), ][[loq_flag_var]]) |
400 | ! |
shape_manual <- seq_along(shape_names) |
401 | ! |
names(shape_manual) <- shape_names |
402 |
} |
|
403 |
# add LOQ legend conditionally |
|
404 | ! |
plot1 <- if (!loq_legend) { |
405 | ! |
plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = "none") |
406 |
} else { |
|
407 | ! |
plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = ggplot2::guide_legend(order = 2)) |
408 |
} |
|
409 |
# Format x-label |
|
410 | ! |
if (rotate_xlab) { |
411 | ! |
plot1 <- plot1 + |
412 | ! |
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) |
413 |
} |
|
414 | ||
415 | ! |
plot1 + geom_axes_lines( |
416 | ! |
plot_data, |
417 | ! |
hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label, |
418 | ! |
hline_vars = hline_vars, hline_vars_colors = hline_vars_colors, hline_vars_labels = hline_vars_labels, |
419 | ! |
vline_arb = vline_arb, vline_arb_color = vline_arb_color, vline_arb_label = vline_arb_label, |
420 | ! |
vline_vars = vline_vars, vline_vars_colors = vline_vars_colors, vline_vars_labels = vline_vars_labels |
421 |
) |
|
422 |
} |
1 |
#' Function to create a density distribution plot. |
|
2 |
#' |
|
3 |
#' Default plot displays overall density facetted by visit with treatment arms and combined |
|
4 |
#' treatment overlaid. |
|
5 |
#' |
|
6 |
#' @param label text string used to identify plot. |
|
7 |
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`. |
|
8 |
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`. |
|
9 |
#' @param param biomarker to visualize e.g. `IGG`. |
|
10 |
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `AVAL`. |
|
11 |
#' @param trt_group name of variable representing treatment group e.g. `ARM`. |
|
12 |
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. |
|
13 |
#' @param unit name of variable containing biomarker unit e.g. `AVALU`. |
|
14 |
#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis |
|
15 |
#' if the default limits are not suitable. |
|
16 |
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis |
|
17 |
#' if the default limits are not suitable. |
|
18 |
#' @param color_manual vector of colors applied to treatment values. |
|
19 |
#' @param color_comb name or hex value for combined treatment color. |
|
20 |
#' @param comb_line display combined treatment line toggle. |
|
21 |
#' @param facet_var variable to use for facetting. |
|
22 |
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines. |
|
23 |
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines. |
|
24 |
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines. |
|
25 |
#' @param facet_ncol number of facets per row. |
|
26 |
#' @param rotate_xlab 45 degree rotation of x-axis label values. |
|
27 |
#' @param font_size font size control for title, x-axis label, y-axis label and legend. |
|
28 |
#' @param line_size plot line thickness. |
|
29 |
#' @param rug_plot should a rug plot be displayed under the density plot. Note this |
|
30 |
#' option is most useful if the data only contains a single treatment group. |
|
31 |
#' |
|
32 |
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com |
|
33 |
#' @author Balazs Toth (tothb2) toth.balazs@gene.com |
|
34 |
#' |
|
35 |
#' @export |
|
36 |
#' |
|
37 |
#' @examples |
|
38 |
#' # Example using ADaM structure analysis dataset. |
|
39 |
#' |
|
40 |
#' library(stringr) |
|
41 |
#' |
|
42 |
#' # original ARM value = dose value |
|
43 |
#' arm_mapping <- list( |
|
44 |
#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination" |
|
45 |
#' ) |
|
46 |
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C") |
|
47 |
#' |
|
48 |
#' ADLB <- rADLB |
|
49 |
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label) |
|
50 |
#' ADLB <- ADLB %>% |
|
51 |
#' mutate(AVISITCD = case_when( |
|
52 |
#' AVISIT == "SCREENING" ~ "SCR", |
|
53 |
#' AVISIT == "BASELINE" ~ "BL", |
|
54 |
#' grepl("WEEK", AVISIT) ~ |
|
55 |
#' paste( |
|
56 |
#' "W", |
|
57 |
#' trimws( |
|
58 |
#' substr( |
|
59 |
#' AVISIT, |
|
60 |
#' start = 6, |
|
61 |
#' stop = str_locate(AVISIT, "DAY") - 1 |
|
62 |
#' ) |
|
63 |
#' ) |
|
64 |
#' ), |
|
65 |
#' TRUE ~ NA_character_ |
|
66 |
#' )) %>% |
|
67 |
#' mutate(AVISITCDN = case_when( |
|
68 |
#' AVISITCD == "SCR" ~ -2, |
|
69 |
#' AVISITCD == "BL" ~ 0, |
|
70 |
#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)), |
|
71 |
#' TRUE ~ NA_real_ |
|
72 |
#' )) %>% |
|
73 |
#' # use ARMCD values to order treatment in visualization legend |
|
74 |
#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1, |
|
75 |
#' ifelse(grepl("B", ARMCD), 2, |
|
76 |
#' ifelse(grepl("A", ARMCD), 3, NA) |
|
77 |
#' ) |
|
78 |
#' )) %>% |
|
79 |
#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>% |
|
80 |
#' mutate(ARM = factor(ARM) %>% |
|
81 |
#' reorder(TRTORD)) |
|
82 |
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]] |
|
83 |
#' |
|
84 |
#' g_density_distribution_plot( |
|
85 |
#' label = "Density Distribution Plot", |
|
86 |
#' data = ADLB, |
|
87 |
#' param_var = "PARAMCD", |
|
88 |
#' param = c("CRP"), |
|
89 |
#' xaxis_var = "AVAL", |
|
90 |
#' unit = "AVALU", |
|
91 |
#' color_manual = color_manual, |
|
92 |
#' color_comb = "#39ff14", |
|
93 |
#' comb_line = FALSE, |
|
94 |
#' facet_var = "AVISITCD", |
|
95 |
#' hline_arb = 1.75, |
|
96 |
#' hline_arb_color = "black", |
|
97 |
#' hline_arb_label = "Horizontal Line A", |
|
98 |
#' facet_ncol = 2, |
|
99 |
#' rotate_xlab = FALSE, |
|
100 |
#' font_size = 10, |
|
101 |
#' line_size = .5 |
|
102 |
#' ) |
|
103 |
g_density_distribution_plot <- function(label = "Density Distribution Plot", |
|
104 |
data, |
|
105 |
param_var = "PARAMCD", |
|
106 |
param = "CRP", |
|
107 |
xaxis_var = "AVAL", |
|
108 |
trt_group = "ARM", |
|
109 |
unit = "AVALU", |
|
110 |
loq_flag_var = "LOQFL", |
|
111 |
xlim = c(NA, NA), |
|
112 |
ylim = c(NA, NA), |
|
113 |
color_manual = NULL, |
|
114 |
color_comb = "#39ff14", |
|
115 |
comb_line = TRUE, |
|
116 |
facet_var = "AVISITCD", |
|
117 |
hline_arb = character(0), |
|
118 |
hline_arb_color = "red", |
|
119 |
hline_arb_label = "Horizontal line", |
|
120 |
facet_ncol = 2, |
|
121 |
rotate_xlab = FALSE, |
|
122 |
font_size = 12, |
|
123 |
line_size = 2, |
|
124 |
rug_plot = FALSE) { |
|
125 | ! |
checkmate::assert_numeric(xlim, len = 2) |
126 | ! |
checkmate::assert_numeric(ylim, len = 2) |
127 | ||
128 | ! |
plot_data <- data %>% |
129 | ! |
filter(!!sym(param_var) == param) |
130 | ||
131 |
# Setup the ggtitle label. Combine the biomarker and the units (if available) |
|
132 | ! |
ggtitle_label <- ifelse( |
133 | ! |
is.null(unit), |
134 | ! |
paste(plot_data$PARAM, "Density: Combined Treatment (Comb.) & by Treatment @ Visits"), |
135 | ! |
ifelse( |
136 | ! |
plot_data[[unit]] == "", |
137 | ! |
paste(plot_data$PARAM, "Density: Combined Treatment (Comb.) & by Treatment @ Visits"), |
138 | ! |
paste0(plot_data$PARAM, " (", plot_data[[unit]], ") Density: Combined Treatment (Comb.) & by Treatment @ Visits") |
139 |
) |
|
140 |
) |
|
141 | ||
142 |
# Setup the x-axis label. Combine the biomarker and the units (if available) |
|
143 | ! |
x_axis_label <- ifelse( |
144 | ! |
is.null(unit), |
145 | ! |
paste(plot_data$PARAM, xaxis_var, "Values"), |
146 | ! |
ifelse( |
147 | ! |
plot_data[[unit]] == "", |
148 | ! |
paste(plot_data$PARAM, xaxis_var, "Values"), |
149 | ! |
paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", xaxis_var, " Values") |
150 |
) |
|
151 |
) |
|
152 | ||
153 |
# Setup legend label |
|
154 | ! |
trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label")) |
155 | ||
156 | ! |
if (comb_line) { |
157 | ! |
plot_data <- dplyr::bind_rows( |
158 | ! |
plot_data, |
159 | ! |
plot_data %>% |
160 | ! |
dplyr::mutate(!!sym(trt_group) := "Combined Dose") |
161 |
) |
|
162 |
} |
|
163 | ||
164 | ! |
color_manual <- if (is.null(color_manual)) { |
165 | ! |
group_names <- unique(plot_data[[trt_group]]) |
166 | ! |
color_values <- seq_along(group_names) |
167 | ! |
if (!is.null(getOption("ggplot2.discrete.colour"))) { |
168 | ! |
color_values <- getOption("ggplot2.discrete.colour")[color_values] |
169 |
} |
|
170 | ! |
names(color_values) <- group_names |
171 | ! |
color_values |
172 |
} else { |
|
173 | ! |
color_manual |
174 |
} |
|
175 | ||
176 | ! |
if (comb_line) { |
177 | ! |
if (!is.null(color_comb)) { |
178 | ! |
color_manual["Combined Dose"] <- color_comb |
179 | ! |
} else if (!"Combined Dose" %in% names(color_manual)) { |
180 | ! |
color_manual["Combined Dose"] <- length(color_manual) + 1 |
181 |
} |
|
182 |
} |
|
183 | ||
184 |
# Add footnote to identify LLOQ and ULOQ values pulled from data |
|
185 | ! |
caption_loqs_label <- h_caption_loqs_label(loqs_data = plot_data, flag_var = loq_flag_var) |
186 | ||
187 | ! |
plot1 <- ggplot2::ggplot(plot_data) + |
188 | ! |
ggplot2::stat_density( |
189 | ! |
ggplot2::aes(x = !!sym(xaxis_var), colour = !!sym(trt_group)), |
190 | ! |
linewidth = line_size, |
191 | ! |
geom = "line", |
192 | ! |
position = "identity" |
193 |
) + |
|
194 | ! |
ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) + |
195 | ! |
ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = facet_ncol) + |
196 | ! |
ggplot2::labs(caption = caption_loqs_label) + |
197 | ! |
ggplot2::theme_bw() + |
198 | ! |
ggplot2::ggtitle(ggtitle_label) + |
199 | ! |
ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) + |
200 | ! |
ggplot2::xlab(paste(x_axis_label)) + |
201 | ! |
ggplot2::ylab(paste("Density")) + |
202 | ! |
ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1)) |
203 | ||
204 | ! |
if (rug_plot) { |
205 | ! |
plot1 <- plot1 + |
206 | ! |
ggplot2::geom_rug(ggplot2::aes(x = !!sym(xaxis_var), colour = !!sym(trt_group))) |
207 |
} |
|
208 | ||
209 |
# Format font size |
|
210 | ! |
if (!is.null(font_size)) { |
211 | ! |
plot1 <- plot1 + |
212 | ! |
ggplot2::theme( |
213 | ! |
axis.title.x = ggplot2::element_text(size = font_size), |
214 | ! |
axis.text.x = ggplot2::element_text(size = font_size), |
215 | ! |
axis.title.y = ggplot2::element_text(size = font_size), |
216 | ! |
axis.text.y = ggplot2::element_text(size = font_size), |
217 | ! |
legend.title = ggplot2::element_text(size = font_size), |
218 | ! |
legend.text = ggplot2::element_text(size = font_size), |
219 | ! |
strip.text.x = ggplot2::element_text(size = font_size), |
220 | ! |
strip.text.y = ggplot2::element_text(size = font_size) |
221 |
) |
|
222 |
} |
|
223 | ||
224 |
# Format x-label |
|
225 | ! |
if (rotate_xlab) { |
226 | ! |
plot1 <- plot1 + |
227 | ! |
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) |
228 |
} |
|
229 | ||
230 |
# Add horizontal line |
|
231 | ! |
plot1 + geom_axes_lines( |
232 | ! |
plot_data, |
233 | ! |
hline_arb = hline_arb, |
234 | ! |
hline_arb_color = hline_arb_color, |
235 | ! |
hline_arb_label = hline_arb_label |
236 |
) |
|
237 |
} |