| 1 |
#' Teal Module for `Swimlane` Plot |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' This is teal module that generates a `swimlane` plot (bar plot with markers) for `ADaM` data |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param dataname analysis data used for plotting, needs to be available in the list passed to the `data` |
|
| 11 |
#' argument of [teal::init()]. If no markers are to be plotted in the module, `"ADSL"` should be |
|
| 12 |
#' the input. If markers are to be plotted, data name for the marker data should be the input |
|
| 13 |
#' @param bar_var [teal.transform::choices_selected] subject-level numeric variable from dataset |
|
| 14 |
#' to plot as the bar length |
|
| 15 |
#' @param bar_color_var [teal.transform::choices_selected] color by variable (subject-level) |
|
| 16 |
#' @param sort_var `choices_selected` sort by variable (subject-level) |
|
| 17 |
#' @param marker_pos_var [teal.transform::choices_selected] variable for marker position from marker data |
|
| 18 |
#' (Note: make sure that marker position has the same relative start day as bar length variable `bar_var` |
|
| 19 |
#' @param marker_shape_var [teal.transform::choices_selected] marker shape variable from marker data |
|
| 20 |
#' @param marker_shape_opt aesthetic values to map shape values (named vector to map shape values to each name). |
|
| 21 |
#' If not `NULL`, please make sure this contains all possible values for `marker_shape_var` values, |
|
| 22 |
#' otherwise shape will be assigned by `ggplot` default |
|
| 23 |
#' @param marker_color_var marker color variable from marker data |
|
| 24 |
#' @param marker_color_opt aesthetic values to map color values (named vector to map color values to each name). |
|
| 25 |
#' If not `NULL`, please make sure this contains all possible values for `marker_color_var` values, |
|
| 26 |
#' otherwise color will be assigned by `ggplot` default |
|
| 27 |
#' @param vref_line vertical reference lines |
|
| 28 |
#' @param anno_txt_var character vector with subject-level variable names that are selected as annotation |
|
| 29 |
#' @param x_label the label of the x axis |
|
| 30 |
#' |
|
| 31 |
#' @inherit argument_convention return |
|
| 32 |
#' @inheritSection teal::example_module Reporting |
|
| 33 |
#' |
|
| 34 |
#' @export |
|
| 35 |
#' |
|
| 36 |
#' @template author_qit3 |
|
| 37 |
#' |
|
| 38 |
#' @examples |
|
| 39 |
#' # Example using stream (ADaM) dataset |
|
| 40 |
#' data <- teal_data() |> |
|
| 41 |
#' within({
|
|
| 42 |
#' library(nestcolor) |
|
| 43 |
#' library(dplyr) |
|
| 44 |
#' ADSL <- rADSL %>% |
|
| 45 |
#' mutate(TRTDURD = as.integer(TRTEDTM - TRTSDTM) + 1) %>% |
|
| 46 |
#' filter(STRATA1 == "A" & ARMCD == "ARM A") |
|
| 47 |
#' ADRS <- rADRS %>% |
|
| 48 |
#' filter(PARAMCD == "LSTASDI" & DCSREAS == "Death") %>% |
|
| 49 |
#' mutate(AVALC = DCSREAS, ADY = EOSDY) %>% |
|
| 50 |
#' rbind(rADRS %>% filter(PARAMCD == "OVRINV" & AVALC != "NE")) %>% |
|
| 51 |
#' arrange(USUBJID) |
|
| 52 |
#' }) |
|
| 53 |
#' |
|
| 54 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 55 |
#' |
|
| 56 |
#' ADSL <- data[["ADSL"]] |
|
| 57 |
#' ADRS <- data[["ADRS"]] |
|
| 58 |
#' |
|
| 59 |
#' app <- init( |
|
| 60 |
#' data = data, |
|
| 61 |
#' modules = modules( |
|
| 62 |
#' tm_g_swimlane( |
|
| 63 |
#' label = "Swimlane Plot", |
|
| 64 |
#' dataname = "ADRS", |
|
| 65 |
#' bar_var = choices_selected( |
|
| 66 |
#' selected = "TRTDURD", |
|
| 67 |
#' choices = c("TRTDURD", "EOSDY")
|
|
| 68 |
#' ), |
|
| 69 |
#' bar_color_var = choices_selected( |
|
| 70 |
#' selected = "EOSSTT", |
|
| 71 |
#' choices = c("EOSSTT", "ARM", "ARMCD", "ACTARM", "ACTARMCD", "SEX")
|
|
| 72 |
#' ), |
|
| 73 |
#' sort_var = choices_selected( |
|
| 74 |
#' selected = "ACTARMCD", |
|
| 75 |
#' choices = c("USUBJID", "SITEID", "ACTARMCD", "TRTDURD")
|
|
| 76 |
#' ), |
|
| 77 |
#' marker_pos_var = choices_selected( |
|
| 78 |
#' selected = "ADY", |
|
| 79 |
#' choices = c("ADY")
|
|
| 80 |
#' ), |
|
| 81 |
#' marker_shape_var = choices_selected( |
|
| 82 |
#' selected = "AVALC", |
|
| 83 |
#' c("AVALC", "AVISIT")
|
|
| 84 |
#' ), |
|
| 85 |
#' marker_shape_opt = c("CR" = 16, "PR" = 17, "SD" = 18, "PD" = 15, "Death" = 8),
|
|
| 86 |
#' marker_color_var = choices_selected( |
|
| 87 |
#' selected = "AVALC", |
|
| 88 |
#' choices = c("AVALC", "AVISIT")
|
|
| 89 |
#' ), |
|
| 90 |
#' marker_color_opt = c( |
|
| 91 |
#' "CR" = "green", "PR" = "blue", "SD" = "goldenrod", |
|
| 92 |
#' "PD" = "red", "Death" = "black" |
|
| 93 |
#' ), |
|
| 94 |
#' vref_line = c(30, 60), |
|
| 95 |
#' anno_txt_var = choices_selected( |
|
| 96 |
#' selected = c("ACTARM", "SEX"),
|
|
| 97 |
#' choices = c( |
|
| 98 |
#' "ARM", "ARMCD", "ACTARM", "ACTARMCD", "AGEGR1", |
|
| 99 |
#' "SEX", "RACE", "COUNTRY", "DCSREAS", "DCSREASP" |
|
| 100 |
#' ) |
|
| 101 |
#' ) |
|
| 102 |
#' ) |
|
| 103 |
#' ) |
|
| 104 |
#' ) |
|
| 105 |
#' if (interactive()) {
|
|
| 106 |
#' shinyApp(app$ui, app$server) |
|
| 107 |
#' } |
|
| 108 |
#' |
|
| 109 |
tm_g_swimlane <- function(label, |
|
| 110 |
dataname, |
|
| 111 |
bar_var, |
|
| 112 |
bar_color_var = NULL, |
|
| 113 |
sort_var = NULL, |
|
| 114 |
marker_pos_var = NULL, |
|
| 115 |
marker_shape_var = NULL, |
|
| 116 |
marker_shape_opt = NULL, |
|
| 117 |
marker_color_var = NULL, |
|
| 118 |
marker_color_opt = NULL, |
|
| 119 |
anno_txt_var = NULL, |
|
| 120 |
vref_line = NULL, |
|
| 121 |
plot_height = c(1200L, 400L, 5000L), |
|
| 122 |
plot_width = NULL, |
|
| 123 |
pre_output = NULL, |
|
| 124 |
post_output = NULL, |
|
| 125 |
x_label = "Time from First Treatment (Day)", |
|
| 126 |
transformators = list()) {
|
|
| 127 | ! |
message("Initializing tm_g_swimlane")
|
| 128 | ! |
args <- as.list(environment()) |
| 129 | ||
| 130 | ! |
checkmate::assert_string(label) |
| 131 | ! |
checkmate::assert_string(dataname) |
| 132 | ! |
checkmate::assert_class(bar_var, classes = "choices_selected") |
| 133 | ! |
checkmate::assert_class(bar_color_var, classes = "choices_selected") |
| 134 | ! |
checkmate::assert_class(marker_pos_var, classes = "choices_selected") |
| 135 | ! |
checkmate::assert_class(marker_shape_var, classes = "choices_selected") |
| 136 | ! |
checkmate::assert_numeric(marker_shape_opt, min.len = 1, any.missing = FALSE) |
| 137 | ! |
checkmate::assert_class(marker_color_var, classes = "choices_selected") |
| 138 | ! |
checkmate::assert_character(marker_color_opt, min.len = 1, any.missing = FALSE, null.ok = TRUE) |
| 139 | ! |
checkmate::assert_class(anno_txt_var, classes = "choices_selected") |
| 140 | ! |
checkmate::assert_numeric(vref_line, min.len = 1, null.ok = TRUE, any.missing = FALSE) |
| 141 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 142 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 143 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 144 | ! |
checkmate::assert_numeric( |
| 145 | ! |
plot_width[1], |
| 146 | ! |
lower = plot_width[2], |
| 147 | ! |
upper = plot_width[3], |
| 148 | ! |
null.ok = TRUE, |
| 149 | ! |
.var.name = "plot_width" |
| 150 |
) |
|
| 151 | ! |
checkmate::assert_string(x_label) |
| 152 | ||
| 153 | ||
| 154 | ! |
module( |
| 155 | ! |
label = label, |
| 156 | ! |
ui = ui_g_swimlane, |
| 157 | ! |
ui_args = args, |
| 158 | ! |
server = srv_g_swimlane, |
| 159 | ! |
server_args = list( |
| 160 | ! |
dataname = dataname, |
| 161 | ! |
marker_pos_var = marker_pos_var, |
| 162 | ! |
marker_shape_var = marker_shape_var, |
| 163 | ! |
marker_shape_opt = marker_shape_opt, |
| 164 | ! |
marker_color_var = marker_color_var, |
| 165 | ! |
marker_color_opt = marker_color_opt, |
| 166 | ! |
label = label, |
| 167 | ! |
plot_height = plot_height, |
| 168 | ! |
plot_width = plot_width, |
| 169 | ! |
x_label = x_label |
| 170 |
), |
|
| 171 | ! |
transformators = transformators, |
| 172 | ! |
datanames = c("ADSL", dataname)
|
| 173 |
) |
|
| 174 |
} |
|
| 175 | ||
| 176 | ||
| 177 |
ui_g_swimlane <- function(id, ...) {
|
|
| 178 | ! |
a <- list(...) |
| 179 | ! |
ns <- NS(id) |
| 180 | ||
| 181 | ! |
shiny::tagList( |
| 182 | ! |
teal.widgets::standard_layout( |
| 183 | ! |
output = teal.widgets::white_small_well( |
| 184 | ! |
teal.widgets::plot_with_settings_ui(id = ns("swimlaneplot"))
|
| 185 |
), |
|
| 186 | ! |
encoding = tags$div( |
| 187 | ! |
tags$label("Encodings", class = "text-primary"),
|
| 188 | ! |
helpText("Analysis data:", tags$code(a$dataname)),
|
| 189 | ! |
left_bordered_div( |
| 190 | ! |
teal.widgets::optionalSelectInput( |
| 191 | ! |
ns("bar_var"),
|
| 192 | ! |
"Bar Length", |
| 193 | ! |
choices = get_choices(a$bar_var$choices), |
| 194 | ! |
selected = a$bar_var$selected, |
| 195 | ! |
multiple = FALSE, |
| 196 | ! |
label_help = helpText("from ", tags$code("ADSL"))
|
| 197 |
), |
|
| 198 | ! |
teal.widgets::optionalSelectInput( |
| 199 | ! |
ns("bar_color_var"),
|
| 200 | ! |
"Bar Color", |
| 201 | ! |
choices = get_choices(a$bar_color_var$choices), |
| 202 | ! |
selected = a$bar_color_var$selected, |
| 203 | ! |
multiple = FALSE, |
| 204 | ! |
label_help = helpText("from ", tags$code("ADSL"))
|
| 205 |
) |
|
| 206 |
), |
|
| 207 | ! |
teal.widgets::optionalSelectInput( |
| 208 | ! |
ns("sort_var"),
|
| 209 | ! |
"Sort by", |
| 210 | ! |
choices = get_choices(a$sort_var$choices), |
| 211 | ! |
selected = a$sort_var$selected, |
| 212 | ! |
multiple = FALSE, |
| 213 | ! |
label_help = helpText("from ", tags$code("ADSL"))
|
| 214 |
), |
|
| 215 | ! |
left_bordered_div( |
| 216 | ! |
if (a$dataname == "ADSL") {
|
| 217 | ! |
NULL |
| 218 | ! |
} else if (is.null(a$marker_pos_var)) {
|
| 219 | ! |
NULL |
| 220 |
} else {
|
|
| 221 | ! |
teal.widgets::optionalSelectInput( |
| 222 | ! |
ns("marker_pos_var"),
|
| 223 | ! |
"Marker Position", |
| 224 | ! |
choices = get_choices(a$marker_pos_var$choices), |
| 225 | ! |
selected = a$marker_pos_var$selected, |
| 226 | ! |
multiple = FALSE, |
| 227 | ! |
label_help = helpText("from ", tags$code(a$dataname))
|
| 228 |
) |
|
| 229 |
}, |
|
| 230 | ! |
uiOutput(ns("marker_shape_sel")),
|
| 231 | ! |
uiOutput(ns("marker_color_sel"))
|
| 232 |
), |
|
| 233 | ! |
teal.widgets::optionalSelectInput( |
| 234 | ! |
ns("anno_txt_var"),
|
| 235 | ! |
"Annotation Variables", |
| 236 | ! |
choices = get_choices(a$anno_txt_var$choices), |
| 237 | ! |
selected = a$anno_txt_var$selected, |
| 238 | ! |
multiple = TRUE, |
| 239 | ! |
label_help = helpText("from ", tags$code("ADSL"))
|
| 240 |
), |
|
| 241 | ! |
textInput( |
| 242 | ! |
ns("vref_line"),
|
| 243 | ! |
label = tags$div( |
| 244 | ! |
"Vertical Reference Line(s)", |
| 245 | ! |
tags$br(), |
| 246 | ! |
helpText("Enter numeric value(s) of reference lines, separated by comma (eg. 100, 200)")
|
| 247 |
), |
|
| 248 | ! |
value = paste(a$vref_line, collapse = ", ") |
| 249 |
) |
|
| 250 |
), |
|
| 251 | ! |
pre_output = a$pre_output, |
| 252 | ! |
post_output = a$post_output |
| 253 |
) |
|
| 254 |
) |
|
| 255 |
} |
|
| 256 | ||
| 257 |
srv_g_swimlane <- function(id, |
|
| 258 |
data, |
|
| 259 |
dataname, |
|
| 260 |
marker_pos_var, |
|
| 261 |
marker_shape_var, |
|
| 262 |
marker_shape_opt, |
|
| 263 |
marker_color_var, |
|
| 264 |
marker_color_opt, |
|
| 265 |
label, |
|
| 266 |
plot_height, |
|
| 267 |
plot_width, |
|
| 268 |
x_label) {
|
|
| 269 | ! |
checkmate::assert_class(data, "reactive") |
| 270 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 271 | ||
| 272 | ! |
moduleServer(id, function(input, output, session) {
|
| 273 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 274 | ! |
iv <- reactive({
|
| 275 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 276 | ! |
iv$add_rule("bar_var", shinyvalidate::sv_required(
|
| 277 | ! |
message = "Bar Length is required" |
| 278 |
)) |
|
| 279 |
# If reference lines are requested |
|
| 280 | ! |
iv$add_rule("vref_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
| 281 | ! |
"Vertical Reference Line(s) are invalid" |
| 282 |
}) |
|
| 283 | ! |
iv$enable() |
| 284 | ! |
iv |
| 285 |
}) |
|
| 286 | ||
| 287 |
# if marker position is NULL, then hide options for marker shape and color |
|
| 288 | ! |
output$marker_shape_sel <- renderUI({
|
| 289 | ! |
if (dataname == "ADSL" || is.null(marker_shape_var) || is.null(input$marker_pos_var)) {
|
| 290 | ! |
NULL |
| 291 |
} else {
|
|
| 292 | ! |
ns <- session$ns |
| 293 | ! |
teal.widgets::optionalSelectInput( |
| 294 | ! |
ns("marker_shape_var"), "Marker Shape",
|
| 295 | ! |
choices = get_choices(marker_shape_var$choices), |
| 296 | ! |
selected = marker_shape_var$selected, multiple = FALSE, |
| 297 | ! |
label_help = helpText("from ", tags$code(dataname))
|
| 298 |
) |
|
| 299 |
} |
|
| 300 |
}) |
|
| 301 | ! |
output$marker_color_sel <- renderUI({
|
| 302 | ! |
if (dataname == "ADSL" || is.null(marker_color_var) || is.null(input$marker_pos_var)) {
|
| 303 | ! |
NULL |
| 304 |
} else {
|
|
| 305 | ! |
ns <- session$ns |
| 306 | ! |
teal.widgets::optionalSelectInput( |
| 307 | ! |
ns("marker_color_var"), "Marker Color",
|
| 308 | ! |
choices = get_choices(marker_color_var$choices), |
| 309 | ! |
selected = marker_color_var$selected, multiple = FALSE, |
| 310 | ! |
label_help = helpText("from ", tags$code(dataname))
|
| 311 |
) |
|
| 312 |
} |
|
| 313 |
}) |
|
| 314 | ||
| 315 |
# create plot |
|
| 316 | ! |
output_q <- reactive({
|
| 317 | ! |
obj <- data() |
| 318 | ! |
teal.reporter::teal_card(obj) <- |
| 319 | ! |
c( |
| 320 | ! |
teal.reporter::teal_card(obj), |
| 321 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 322 |
) |
|
| 323 | ||
| 324 | ! |
teal::validate_inputs(iv()) |
| 325 | ||
| 326 | ! |
validate(need("ADSL" %in% names(obj), "'ADSL' not included in data"))
|
| 327 | ! |
validate(need( |
| 328 | ! |
(length(obj) == 1 && dataname == "ADSL") || |
| 329 | ! |
(length(obj) >= 2 && dataname != "ADSL"), paste( |
| 330 | ! |
"Please either add just 'ADSL' as dataname when just ADSL is available.", |
| 331 | ! |
"In case 2 datasets are available ADSL is not supposed to be the dataname." |
| 332 |
) |
|
| 333 |
)) |
|
| 334 | ||
| 335 | ! |
ADSL <- obj[["ADSL"]] |
| 336 | ||
| 337 | ! |
anl_vars <- unique(c( |
| 338 | ! |
"USUBJID", "STUDYID", |
| 339 | ! |
input$marker_pos_var, input$marker_shape_var, input$marker_color_var |
| 340 |
)) |
|
| 341 | ! |
adsl_vars <- unique(c( |
| 342 | ! |
"USUBJID", "STUDYID", |
| 343 | ! |
input$bar_var, input$bar_color_var, input$sort_var, input$anno_txt_var |
| 344 |
)) |
|
| 345 | ||
| 346 | ! |
if (dataname == "ADSL") {
|
| 347 | ! |
teal::validate_has_data(ADSL, min_nrow = 3) |
| 348 | ! |
teal::validate_has_variable(ADSL, adsl_vars) |
| 349 |
} else {
|
|
| 350 | ! |
anl <- obj[[dataname]] |
| 351 | ! |
teal::validate_has_data(anl, min_nrow = 3) |
| 352 | ! |
teal::validate_has_variable(anl, anl_vars) |
| 353 | ||
| 354 | ! |
validate(need( |
| 355 | ! |
!any(c(marker_pos_var, marker_shape_var, marker_color_var) %in% adsl_vars), |
| 356 | ! |
"marker-related variables need to come from marker data" |
| 357 |
)) |
|
| 358 |
} |
|
| 359 | ||
| 360 |
# VARIABLE GETTERS |
|
| 361 |
# lookup bar variables |
|
| 362 | ! |
bar_var <- input$bar_var |
| 363 | ! |
bar_color_var <- input$bar_color_var |
| 364 | ! |
sort_var <- input$sort_var |
| 365 | ! |
anno_txt_var <- input$anno_txt_var |
| 366 | ||
| 367 |
# Check if marker inputs can be used |
|
| 368 | ! |
if (dataname == "ADSL") {
|
| 369 | ! |
marker_pos_var <- NULL |
| 370 | ! |
marker_shape_var <- NULL |
| 371 | ! |
marker_color_var <- NULL |
| 372 |
} else {
|
|
| 373 | ! |
marker_pos_var <- input$marker_pos_var |
| 374 | ! |
marker_shape_var <- input$marker_shape_var |
| 375 | ! |
marker_color_var <- input$marker_color_var |
| 376 |
} |
|
| 377 | ! |
vref_line <- suppressWarnings(as_numeric_from_comma_sep_str(debounce(reactive(input$vref_line), 1500)())) |
| 378 | ||
| 379 | ! |
q1 <- obj |
| 380 | ||
| 381 | ! |
q2 <- teal.code::eval_code( |
| 382 | ! |
q1, |
| 383 | ! |
code = bquote({
|
| 384 | ! |
bar_var <- .(bar_var) |
| 385 | ! |
bar_color_var <- .(bar_color_var) |
| 386 | ! |
sort_var <- .(sort_var) |
| 387 | ! |
marker_pos_var <- .(marker_pos_var) |
| 388 | ! |
marker_shape_var <- .(marker_shape_var) |
| 389 | ! |
marker_color_var <- .(marker_color_var) |
| 390 | ! |
anno_txt_var <- .(anno_txt_var) |
| 391 |
}) |
|
| 392 |
) |
|
| 393 | ||
| 394 |
# WRITE DATA SELECTION TO qenv |
|
| 395 | ! |
q3 <- if (dataname == "ADSL") {
|
| 396 | ! |
teal.code::eval_code( |
| 397 | ! |
q2, |
| 398 | ! |
code = bquote({
|
| 399 | ! |
ADSL_p <- ADSL |
| 400 | ! |
ADSL <- ADSL_p[, .(adsl_vars)] |
| 401 |
# only take last part of USUBJID |
|
| 402 | ! |
ADSL$USUBJID <- unlist(lapply(strsplit(ADSL$USUBJID, "-", fixed = TRUE), tail, 1)) |
| 403 |
}) |
|
| 404 |
) |
|
| 405 |
} else {
|
|
| 406 | ! |
teal.code::eval_code( |
| 407 | ! |
q2, |
| 408 | ! |
code = bquote({
|
| 409 | ! |
ADSL_p <- ADSL |
| 410 | ! |
ANL_p <- .(as.name(dataname)) |
| 411 | ||
| 412 | ! |
ADSL <- ADSL_p[, .(adsl_vars)] |
| 413 | ! |
ANL <- merge( |
| 414 | ! |
x = ADSL, |
| 415 | ! |
y = ANL_p[, .(anl_vars)], |
| 416 | ! |
all.x = FALSE, all.y = FALSE, |
| 417 | ! |
by = c("USUBJID", "STUDYID")
|
| 418 |
) |
|
| 419 |
# only take last part of USUBJID |
|
| 420 | ! |
ADSL$USUBJID <- unlist(lapply(strsplit(ADSL$USUBJID, "-", fixed = TRUE), tail, 1)) |
| 421 | ! |
ANL$USUBJID <- unlist(lapply(strsplit(ANL$USUBJID, "-", fixed = TRUE), tail, 1)) |
| 422 |
}) |
|
| 423 |
) |
|
| 424 |
} |
|
| 425 | ||
| 426 | ! |
plot_call <- if (dataname == "ADSL") {
|
| 427 | ! |
bquote( |
| 428 | ! |
plot <- osprey::g_swimlane( |
| 429 | ! |
bar_id = ADSL[["USUBJID"]], |
| 430 | ! |
bar_length = ADSL[[bar_var]], |
| 431 | ! |
sort_by = .(if (length(sort_var) > 0) quote(ADSL[[sort_var]]) else NULL), |
| 432 | ! |
col_by = .(if (length(bar_color_var) > 0) quote(ADSL[[bar_color_var]]) else NULL), |
| 433 | ! |
marker_id = NULL, |
| 434 | ! |
marker_pos = NULL, |
| 435 | ! |
marker_shape = NULL, |
| 436 | ! |
marker_shape_opt = NULL, |
| 437 | ! |
marker_color = NULL, |
| 438 | ! |
marker_color_opt = NULL, |
| 439 | ! |
anno_txt = .(if (length(anno_txt_var) > 0) quote(ADSL[, anno_txt_var]) else NULL), |
| 440 | ! |
xref_line = .(vref_line), |
| 441 | ! |
xtick_at = ggplot2::waiver(), |
| 442 | ! |
xlab = .(x_label), |
| 443 | ! |
title = "Swimlane Plot" |
| 444 |
) |
|
| 445 |
) |
|
| 446 |
} else {
|
|
| 447 | ! |
bquote( |
| 448 | ! |
plot <- osprey::g_swimlane( |
| 449 | ! |
bar_id = ADSL[["USUBJID"]], |
| 450 | ! |
bar_length = ADSL[[bar_var]], |
| 451 | ! |
sort_by = .(if (length(sort_var) > 0) {
|
| 452 | ! |
quote(ADSL[[sort_var]]) |
| 453 |
} else {
|
|
| 454 | ! |
NULL |
| 455 |
}), |
|
| 456 | ! |
col_by = .(if (length(bar_color_var) > 0) {
|
| 457 | ! |
quote(ADSL[[bar_color_var]]) |
| 458 |
} else {
|
|
| 459 | ! |
NULL |
| 460 |
}), |
|
| 461 | ! |
marker_id = ANL[["USUBJID"]], |
| 462 | ! |
marker_pos = .(if (length(marker_pos_var) > 0) {
|
| 463 | ! |
quote(ANL[[marker_pos_var]]) |
| 464 |
} else {
|
|
| 465 | ! |
NULL |
| 466 |
}), |
|
| 467 | ! |
marker_shape = .(if (length(marker_shape_var) > 0) {
|
| 468 | ! |
quote(ANL[[marker_shape_var]]) |
| 469 |
} else {
|
|
| 470 | ! |
NULL |
| 471 |
}), |
|
| 472 | ! |
marker_shape_opt = .(if (length(marker_shape_var) == 0) {
|
| 473 | ! |
NULL |
| 474 | ! |
} else if (length(marker_shape_var) > 0 && all(unique(anl[[marker_shape_var]]) %in% names(marker_shape_opt))) { # nolint: line_length.
|
| 475 | ! |
bquote(.(marker_shape_opt)) |
| 476 |
} else {
|
|
| 477 | ! |
NULL |
| 478 |
}), |
|
| 479 | ! |
marker_color = .(if (length(marker_color_var) > 0) {
|
| 480 | ! |
quote(ANL[[marker_color_var]]) |
| 481 |
} else {
|
|
| 482 | ! |
NULL |
| 483 |
}), |
|
| 484 | ! |
marker_color_opt = .(if (length(marker_color_var) == 0) {
|
| 485 | ! |
NULL |
| 486 | ! |
} else if (length(marker_color_var) > 0 && all(unique(anl[[marker_color_var]]) %in% names(marker_color_opt))) { # nolint: line_length.
|
| 487 | ! |
bquote(.(marker_color_opt)) |
| 488 |
} else {
|
|
| 489 | ! |
NULL |
| 490 |
}), |
|
| 491 | ! |
anno_txt = .(if (length(anno_txt_var) > 0) {
|
| 492 | ! |
quote(ADSL[, anno_txt_var]) |
| 493 |
} else {
|
|
| 494 | ! |
NULL |
| 495 |
}), |
|
| 496 | ! |
xref_line = .(vref_line), |
| 497 | ! |
xtick_at = ggplot2::waiver(), |
| 498 | ! |
xlab = .(x_label), |
| 499 | ! |
title = "Swimlane Plot" |
| 500 |
) |
|
| 501 |
) |
|
| 502 |
} |
|
| 503 | ||
| 504 | ! |
teal.reporter::teal_card(q3) <- c(teal.reporter::teal_card(q3), "### Plot") |
| 505 | ||
| 506 | ! |
if (!is.null(input$sort_var)) {
|
| 507 | ! |
teal.reporter::teal_card(q3) <- c(teal.reporter::teal_card(q3), "### Selected Options") |
| 508 | ! |
teal.reporter::teal_card(q3) <- c(teal.reporter::teal_card(q3), paste("Sorted by:", input$sort_var))
|
| 509 |
} |
|
| 510 | ||
| 511 | ! |
teal.code::eval_code(q3, code = plot_call) |
| 512 |
}) |
|
| 513 | ||
| 514 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 515 | ||
| 516 |
# Insert the plot into a plot_with_settings module from teal.widgets |
|
| 517 | ! |
pws <- teal.widgets::plot_with_settings_srv( |
| 518 | ! |
id = "swimlaneplot", |
| 519 | ! |
plot_r = plot_r, |
| 520 | ! |
height = plot_height, |
| 521 | ! |
width = plot_width |
| 522 |
) |
|
| 523 | ||
| 524 | ! |
set_chunk_dims(pws, output_q) |
| 525 |
}) |
|
| 526 |
} |
| 1 |
.onLoad <- function(libname, pkgname) {
|
|
| 2 |
# Fixes R CMD check note on "All declared Imports should be used." |
|
| 3 |
# teal.data is necessary to access S3 method names.teal_data |
|
| 4 | ! |
teal.data::teal_data |
| 5 | ||
| 6 | ! |
teal.logger::register_logger(namespace = "teal.osprey") |
| 7 | ! |
teal.logger::register_handlers("teal.osprey")
|
| 8 |
} |
| 1 |
#' teal module for the `AE` by subgroups |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' Display the `AE` by subgroups plot as a teal module |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param group_var (`choices_selected`) subgroups variables. See [teal.transform::choices_selected()] for details. |
|
| 11 |
#' |
|
| 12 |
#' @author Liming Li (Lil128) \email{liming.li@roche.com}
|
|
| 13 |
#' @author Molly He (hey59) \email{hey59@gene.com}
|
|
| 14 |
#' |
|
| 15 |
#' @inherit argument_convention return |
|
| 16 |
#' @inheritSection teal::example_module Reporting |
|
| 17 |
#' |
|
| 18 |
#' @export |
|
| 19 |
#' |
|
| 20 |
#' @examples |
|
| 21 |
#' # Example using stream (ADaM) dataset |
|
| 22 |
#' data <- teal_data() |> |
|
| 23 |
#' within({
|
|
| 24 |
#' ADSL <- rADSL |
|
| 25 |
#' ADAE <- rADAE |
|
| 26 |
#' }) |
|
| 27 |
#' |
|
| 28 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 29 |
#' |
|
| 30 |
#' app <- init( |
|
| 31 |
#' data = data, |
|
| 32 |
#' modules = modules( |
|
| 33 |
#' tm_g_ae_sub( |
|
| 34 |
#' label = "AE by Subgroup", |
|
| 35 |
#' dataname = "ADAE", |
|
| 36 |
#' arm_var = choices_selected( |
|
| 37 |
#' selected = "ACTARMCD", |
|
| 38 |
#' choices = c("ACTARM", "ACTARMCD")
|
|
| 39 |
#' ), |
|
| 40 |
#' group_var = choices_selected( |
|
| 41 |
#' selected = c("SEX", "REGION1", "RACE"),
|
|
| 42 |
#' choices = c("SEX", "REGION1", "RACE")
|
|
| 43 |
#' ), |
|
| 44 |
#' plot_height = c(600, 200, 2000) |
|
| 45 |
#' ) |
|
| 46 |
#' ) |
|
| 47 |
#' ) |
|
| 48 |
#' if (interactive()) {
|
|
| 49 |
#' shinyApp(app$ui, app$server) |
|
| 50 |
#' } |
|
| 51 |
#' |
|
| 52 |
tm_g_ae_sub <- function(label, |
|
| 53 |
dataname, |
|
| 54 |
arm_var, |
|
| 55 |
group_var, |
|
| 56 |
plot_height = c(600L, 200L, 2000L), |
|
| 57 |
plot_width = NULL, |
|
| 58 |
fontsize = c(5, 3, 7), |
|
| 59 |
transformators = list()) {
|
|
| 60 | ! |
message("Initializing tm_g_ae_sub")
|
| 61 | ! |
checkmate::assert_class(arm_var, classes = "choices_selected") |
| 62 | ! |
checkmate::assert_class(group_var, classes = "choices_selected") |
| 63 | ! |
checkmate::assert( |
| 64 | ! |
checkmate::check_number(fontsize, finite = TRUE), |
| 65 | ! |
checkmate::assert( |
| 66 | ! |
combine = "and", |
| 67 | ! |
.var.name = "fontsize", |
| 68 | ! |
checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE), |
| 69 | ! |
checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
| 70 |
) |
|
| 71 |
) |
|
| 72 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 73 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 74 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 75 | ! |
checkmate::assert_numeric( |
| 76 | ! |
plot_width[1], |
| 77 | ! |
lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" |
| 78 |
) |
|
| 79 | ||
| 80 | ! |
module( |
| 81 | ! |
label = label, |
| 82 | ! |
server = srv_g_ae_sub, |
| 83 | ! |
server_args = list( |
| 84 | ! |
label = label, |
| 85 | ! |
dataname = dataname, |
| 86 | ! |
plot_height = plot_height, |
| 87 | ! |
plot_width = plot_width |
| 88 |
), |
|
| 89 | ! |
ui = ui_g_ae_sub, |
| 90 | ! |
ui_args = list( |
| 91 | ! |
arm_var = arm_var, |
| 92 | ! |
group_var = group_var, |
| 93 | ! |
fontsize = fontsize |
| 94 |
), |
|
| 95 | ! |
transformators = transformators, |
| 96 | ! |
datanames = c("ADSL", dataname)
|
| 97 |
) |
|
| 98 |
} |
|
| 99 | ||
| 100 |
ui_g_ae_sub <- function(id, ...) {
|
|
| 101 | ! |
ns <- NS(id) |
| 102 | ! |
args <- list(...) |
| 103 | ! |
teal.widgets::standard_layout( |
| 104 | ! |
output = teal.widgets::white_small_well( |
| 105 | ! |
plot_decorate_output(id = ns(NULL)) |
| 106 |
), |
|
| 107 | ! |
encoding = tags$div( |
| 108 | ! |
tags$label("Encodings", class = "text-primary"),
|
| 109 | ! |
helpText("Analysis data:", tags$code("ADAE")),
|
| 110 | ! |
teal.widgets::optionalSelectInput( |
| 111 | ! |
ns("arm_var"),
|
| 112 | ! |
"Arm Variable", |
| 113 | ! |
choices = get_choices(args$arm_var$choices), |
| 114 | ! |
selected = args$arm_var$selected |
| 115 |
), |
|
| 116 | ! |
selectInput( |
| 117 | ! |
ns("arm_trt"),
|
| 118 | ! |
"Treatment", |
| 119 | ! |
choices = get_choices(args$arm_var$choices), |
| 120 | ! |
selected = args$arm_var$selected |
| 121 |
), |
|
| 122 | ! |
selectInput( |
| 123 | ! |
ns("arm_ref"),
|
| 124 | ! |
"Control", |
| 125 | ! |
choices = get_choices(args$arm_var$choices), |
| 126 | ! |
selected = args$arm_var$selected |
| 127 |
), |
|
| 128 | ! |
checkboxInput( |
| 129 | ! |
ns("arm_n"),
|
| 130 | ! |
"Show N in each arm", |
| 131 | ! |
value = args$arm_n |
| 132 |
), |
|
| 133 | ! |
teal.widgets::optionalSelectInput( |
| 134 | ! |
ns("groups"),
|
| 135 | ! |
"Group Variable", |
| 136 | ! |
choices = get_choices(args$group_var$choices), |
| 137 | ! |
selected = args$group_var$selected, |
| 138 | ! |
multiple = TRUE |
| 139 |
), |
|
| 140 | ! |
teal.widgets::panel_item( |
| 141 | ! |
"Change group labels", |
| 142 | ! |
uiOutput(ns("grouplabel_output"))
|
| 143 |
), |
|
| 144 | ! |
teal.widgets::panel_item( |
| 145 | ! |
"Additional plot settings", |
| 146 | ! |
teal.widgets::optionalSelectInput( |
| 147 | ! |
ns("ci"),
|
| 148 | ! |
"CI method", |
| 149 | ! |
choices = ci_choices, |
| 150 | ! |
selected = ci_choices[1] |
| 151 |
), |
|
| 152 | ! |
teal.widgets::optionalSliderInput( |
| 153 | ! |
ns("conf_level"),
|
| 154 | ! |
"Significant Level", |
| 155 | ! |
min = 0.5, |
| 156 | ! |
max = 1, |
| 157 | ! |
value = 0.95 |
| 158 |
), |
|
| 159 | ! |
ui_g_decorate( |
| 160 | ! |
ns(NULL), |
| 161 | ! |
fontsize = args$fontsize, |
| 162 | ! |
titles = "AE Table with Subgroups", |
| 163 | ! |
footnotes = "" |
| 164 |
) |
|
| 165 |
) |
|
| 166 |
) |
|
| 167 |
) |
|
| 168 |
} |
|
| 169 | ||
| 170 |
srv_g_ae_sub <- function(id, |
|
| 171 |
data, |
|
| 172 |
dataname, |
|
| 173 |
label, |
|
| 174 |
plot_height, |
|
| 175 |
plot_width) {
|
|
| 176 | ! |
checkmate::assert_class(data, "reactive") |
| 177 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 178 | ||
| 179 | ! |
moduleServer(id, function(input, output, session) {
|
| 180 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 181 | ! |
iv <- reactive({
|
| 182 | ! |
ANL <- data()[[dataname]] |
| 183 | ! |
ADSL <- data()[["ADSL"]] |
| 184 | ||
| 185 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 186 | ! |
iv$add_rule("arm_var", shinyvalidate::sv_required(
|
| 187 | ! |
message = "Arm Variable is required" |
| 188 |
)) |
|
| 189 | ! |
iv$add_rule("arm_var", ~ if (!is.factor(ANL[[.]])) {
|
| 190 | ! |
"Arm Var must be a factor variable, contact developer" |
| 191 |
}) |
|
| 192 | ! |
rule_diff <- function(value, other) {
|
| 193 | ! |
if (isTRUE(value == other)) "Control and Treatment must be different" |
| 194 |
} |
|
| 195 | ! |
iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
|
| 196 | ! |
iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
|
| 197 | ! |
iv$add_rule("groups", shinyvalidate::sv_in_set(
|
| 198 | ! |
names(ANL), |
| 199 | ! |
message_fmt = sprintf("Groups must be a variable in %s", dataname)
|
| 200 |
)) |
|
| 201 | ! |
iv$add_rule("groups", shinyvalidate::sv_in_set(
|
| 202 | ! |
names(ADSL), |
| 203 | ! |
message_fmt = "Groups must be a variable in ADSL" |
| 204 |
)) |
|
| 205 | ! |
iv$enable() |
| 206 | ! |
iv |
| 207 |
}) |
|
| 208 | ||
| 209 | ! |
decorate_output <- srv_g_decorate( |
| 210 | ! |
id = NULL, |
| 211 | ! |
plt = plot_r, |
| 212 | ! |
plot_height = plot_height, |
| 213 | ! |
plot_width = plot_width |
| 214 |
) |
|
| 215 | ! |
font_size <- decorate_output$font_size |
| 216 | ! |
pws <- decorate_output$pws |
| 217 | ||
| 218 | ! |
observeEvent(input$arm_var, ignoreNULL = TRUE, {
|
| 219 | ! |
arm_var <- input$arm_var |
| 220 | ! |
ANL <- data()[[dataname]] |
| 221 | ||
| 222 | ! |
anl_val <- ANL[[arm_var]] |
| 223 | ! |
choices <- levels(anl_val) |
| 224 | ||
| 225 | ! |
if (length(choices) == 1) {
|
| 226 | ! |
ref_index <- 1 |
| 227 |
} else {
|
|
| 228 | ! |
ref_index <- 2 |
| 229 |
} |
|
| 230 | ||
| 231 | ! |
updateSelectInput( |
| 232 | ! |
session, |
| 233 | ! |
"arm_trt", |
| 234 | ! |
selected = choices[1], |
| 235 | ! |
choices = choices |
| 236 |
) |
|
| 237 | ! |
updateSelectInput( |
| 238 | ! |
session, |
| 239 | ! |
"arm_ref", |
| 240 | ! |
selected = choices[ref_index], |
| 241 | ! |
choices = choices |
| 242 |
) |
|
| 243 |
}) |
|
| 244 | ||
| 245 | ! |
observeEvent(list(input$ci, input$conf_level, input$arm_trt, input$arm_ref), {
|
| 246 | ! |
diff_ci_method <- input$ci |
| 247 | ! |
conf_level <- input$conf_level |
| 248 | ! |
trt <- input$arm_trt |
| 249 | ! |
ref <- input$arm_ref |
| 250 | ! |
updateTextAreaInput( |
| 251 | ! |
session, |
| 252 | ! |
"foot", |
| 253 | ! |
value = sprintf( |
| 254 | ! |
"Note: %d%% CI is calculated using %s\nTRT: %s; CONT: %s", |
| 255 | ! |
round(conf_level * 100), |
| 256 | ! |
name_ci(diff_ci_method), |
| 257 | ! |
trt, |
| 258 | ! |
ref |
| 259 |
) |
|
| 260 |
) |
|
| 261 |
}) |
|
| 262 | ||
| 263 | ! |
observeEvent(input$groups, {
|
| 264 | ! |
ANL <- data()[[dataname]] |
| 265 | ! |
output$grouplabel_output <- renderUI({
|
| 266 | ! |
grps <- input$groups |
| 267 | ! |
lo <- lapply(seq_along(grps), function(index) {
|
| 268 | ! |
grp <- grps[index] |
| 269 | ! |
choices <- levels(ANL[[grp]]) |
| 270 | ! |
sel <- teal.widgets::optionalSelectInput( |
| 271 | ! |
session$ns(sprintf("groups__%s", index)),
|
| 272 | ! |
grp, |
| 273 | ! |
choices, |
| 274 | ! |
multiple = TRUE, |
| 275 | ! |
selected = choices |
| 276 |
) |
|
| 277 | ! |
textname <- sprintf("text_%s_out", index)
|
| 278 | ! |
txt <- uiOutput(session$ns(textname)) |
| 279 | ! |
observeEvent( |
| 280 | ! |
eventExpr = input[[sprintf("groups__%s", index)]],
|
| 281 | ! |
handlerExpr = {
|
| 282 | ! |
output[[textname]] <- renderUI({
|
| 283 | ! |
if (!is.null(input[[sprintf("groups__%s", index)]])) {
|
| 284 | ! |
l <- input[[sprintf("groups__%s", index)]]
|
| 285 | ! |
l2 <- lapply(seq_along(l), function(i) {
|
| 286 | ! |
nm <- sprintf("groups__%s__level__%s", index, i)
|
| 287 | ! |
label <- sprintf("Label for %s, Level %s", grp, l[i])
|
| 288 | ! |
textInput(session$ns(nm), label, l[i]) |
| 289 |
}) |
|
| 290 | ! |
tagList(textInput( |
| 291 | ! |
session$ns( |
| 292 | ! |
sprintf("groups__%s__level__%s", index, "all")
|
| 293 |
), |
|
| 294 | ! |
sprintf("Label for %s", grp), grp
|
| 295 | ! |
), l2) |
| 296 |
} |
|
| 297 |
}) |
|
| 298 |
} |
|
| 299 |
) |
|
| 300 | ! |
tagList(sel, txt) |
| 301 |
}) |
|
| 302 | ! |
ret <- tagList(lo) |
| 303 | ! |
ret |
| 304 |
}) |
|
| 305 |
}) |
|
| 306 | ||
| 307 | ! |
output_q <- shiny::debounce( |
| 308 | ! |
millis = 200, |
| 309 | ! |
r = reactive({
|
| 310 | ! |
obj <- data() |
| 311 | ! |
teal.reporter::teal_card(obj) <- |
| 312 | ! |
c( |
| 313 | ! |
teal.reporter::teal_card(obj), |
| 314 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 315 |
) |
|
| 316 | ||
| 317 | ! |
ANL <- obj[[dataname]] |
| 318 | ! |
ADSL <- obj[["ADSL"]] |
| 319 | ||
| 320 | ! |
teal::validate_has_data(ANL, min_nrow = 10, msg = sprintf("%s has not enough data", dataname))
|
| 321 | ||
| 322 | ! |
teal::validate_inputs(iv()) |
| 323 | ||
| 324 | ! |
validate(need( |
| 325 | ! |
input$arm_trt %in% ANL[[input$arm_var]] && input$arm_ref %in% ANL[[input$arm_var]], |
| 326 | ! |
"Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?" |
| 327 |
)) |
|
| 328 | ||
| 329 | ! |
group_labels <- lapply(seq_along(input$groups), function(x) {
|
| 330 | ! |
items <- input[[sprintf("groups__%s", x)]]
|
| 331 | ! |
if (length(items) > 0) {
|
| 332 | ! |
l <- lapply(seq_along(items), function(y) {
|
| 333 | ! |
input[[sprintf("groups__%s__level__%s", x, y)]]
|
| 334 |
}) |
|
| 335 | ! |
names(l) <- items |
| 336 | ! |
l[["Total"]] <- input[[sprintf("groups__%s__level__%s", x, "all")]]
|
| 337 | ! |
l |
| 338 |
} |
|
| 339 |
}) |
|
| 340 | ||
| 341 | ! |
group_labels_call <- if (length(unlist(group_labels)) == 0) {
|
| 342 | ! |
quote(group_labels <- NULL) |
| 343 |
} else {
|
|
| 344 | ! |
bquote(group_labels <- setNames(.(group_labels), .(input$groups))) |
| 345 |
} |
|
| 346 | ||
| 347 | ! |
q1 <- teal.code::eval_code(obj, code = group_labels_call) %>% |
| 348 | ! |
teal.code::eval_code(code = "") |
| 349 | ||
| 350 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot") |
| 351 | ||
| 352 | ! |
teal.code::eval_code( |
| 353 | ! |
q1, |
| 354 | ! |
code = as.expression(c( |
| 355 | ! |
bquote( |
| 356 | ! |
plot <- osprey::g_ae_sub( |
| 357 | ! |
id = .(as.name(dataname))$USUBJID, |
| 358 | ! |
arm = as.factor(.(as.name(dataname))[[.(input$arm_var)]]), |
| 359 | ! |
arm_sl = as.character(ADSL[[.(input$arm_var)]]), |
| 360 | ! |
trt = .(input$arm_trt), |
| 361 | ! |
ref = .(input$arm_ref), |
| 362 | ! |
subgroups = .(as.name(dataname))[.(input$groups)], |
| 363 | ! |
subgroups_sl = ADSL[.(input$groups)], |
| 364 | ! |
subgroups_levels = group_labels, |
| 365 | ! |
conf_level = .(input$conf_level), |
| 366 | ! |
diff_ci_method = .(input$ci), |
| 367 | ! |
fontsize = .(font_size()), |
| 368 | ! |
arm_n = .(input$arm_n), |
| 369 | ! |
draw = TRUE |
| 370 |
) |
|
| 371 |
) |
|
| 372 |
)) |
|
| 373 |
) |
|
| 374 |
}) |
|
| 375 |
) |
|
| 376 | ||
| 377 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 378 | ! |
set_chunk_dims(pws, output_q) |
| 379 |
}) |
|
| 380 |
} |
| 1 |
#' Events by Term Plot Teal Module |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' Display Events by Term plot as a shiny module |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param term_var [teal.transform::choices_selected] object with all available choices |
|
| 11 |
#' and pre-selected option names that can be used to specify the term for events |
|
| 12 |
#' |
|
| 13 |
#' @inherit argument_convention return |
|
| 14 |
#' @inheritSection teal::example_module Reporting |
|
| 15 |
#' |
|
| 16 |
#' @export |
|
| 17 |
#' |
|
| 18 |
#' @author Liming Li (lil128) \email{liming.li@roche.com}
|
|
| 19 |
#' @author Molly He (hey59) \email{hey59@gene.com}
|
|
| 20 |
#' |
|
| 21 |
#' @examples |
|
| 22 |
#' data <- teal_data() |> |
|
| 23 |
#' within({
|
|
| 24 |
#' ADSL <- rADSL |
|
| 25 |
#' ADAE <- rADAE |
|
| 26 |
#' }) |
|
| 27 |
#' |
|
| 28 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 29 |
#' |
|
| 30 |
#' app <- init( |
|
| 31 |
#' data = data, |
|
| 32 |
#' modules = modules( |
|
| 33 |
#' tm_g_events_term_id( |
|
| 34 |
#' label = "Common AE", |
|
| 35 |
#' dataname = "ADAE", |
|
| 36 |
#' term_var = choices_selected( |
|
| 37 |
#' selected = "AEDECOD", |
|
| 38 |
#' choices = c( |
|
| 39 |
#' "AEDECOD", "AETERM", |
|
| 40 |
#' "AEHLT", "AELLT", "AEBODSYS" |
|
| 41 |
#' ) |
|
| 42 |
#' ), |
|
| 43 |
#' arm_var = choices_selected( |
|
| 44 |
#' selected = "ACTARMCD", |
|
| 45 |
#' choices = c("ACTARM", "ACTARMCD")
|
|
| 46 |
#' ), |
|
| 47 |
#' plot_height = c(600, 200, 2000) |
|
| 48 |
#' ) |
|
| 49 |
#' ) |
|
| 50 |
#' ) |
|
| 51 |
#' if (interactive()) {
|
|
| 52 |
#' shinyApp(app$ui, app$server) |
|
| 53 |
#' } |
|
| 54 |
#' |
|
| 55 |
tm_g_events_term_id <- function(label, |
|
| 56 |
dataname, |
|
| 57 |
term_var, |
|
| 58 |
arm_var, |
|
| 59 |
fontsize = c(5, 3, 7), |
|
| 60 |
plot_height = c(600L, 200L, 2000L), |
|
| 61 |
plot_width = NULL, |
|
| 62 |
transformators = list()) {
|
|
| 63 | ! |
message("Initializing tm_g_events_term_id")
|
| 64 | ! |
checkmate::assert_string(label) |
| 65 | ! |
checkmate::assert_class(term_var, classes = "choices_selected") |
| 66 | ! |
checkmate::assert_class(arm_var, classes = "choices_selected") |
| 67 | ! |
checkmate::assert( |
| 68 | ! |
checkmate::check_number(fontsize, finite = TRUE), |
| 69 | ! |
checkmate::assert( |
| 70 | ! |
combine = "and", |
| 71 | ! |
.var.name = "fontsize", |
| 72 | ! |
checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE), |
| 73 | ! |
checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
| 74 |
) |
|
| 75 |
) |
|
| 76 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 77 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 78 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 79 | ! |
checkmate::assert_numeric( |
| 80 | ! |
plot_width[1], |
| 81 | ! |
lower = plot_width[2], |
| 82 | ! |
upper = plot_width[3], |
| 83 | ! |
null.ok = TRUE, |
| 84 | ! |
.var.name = "plot_width" |
| 85 |
) |
|
| 86 | ||
| 87 | ! |
args <- as.list(environment()) |
| 88 | ||
| 89 | ! |
module( |
| 90 | ! |
label = label, |
| 91 | ! |
server = srv_g_events_term_id, |
| 92 | ! |
server_args = list(label = label, dataname = dataname, plot_height = plot_height, plot_width = plot_width), |
| 93 | ! |
ui = ui_g_events_term_id, |
| 94 | ! |
ui_args = args, |
| 95 | ! |
transformators = transformators, |
| 96 | ! |
datanames = c("ADSL", dataname)
|
| 97 |
) |
|
| 98 |
} |
|
| 99 | ||
| 100 |
ui_g_events_term_id <- function(id, ...) {
|
|
| 101 | ! |
ns <- NS(id) |
| 102 | ! |
args <- list(...) |
| 103 | ! |
teal.widgets::standard_layout( |
| 104 | ! |
output = teal.widgets::white_small_well( |
| 105 | ! |
plot_decorate_output(id = ns(NULL)) |
| 106 |
), |
|
| 107 | ! |
encoding = tags$div( |
| 108 | ! |
teal.widgets::optionalSelectInput( |
| 109 | ! |
ns("term"),
|
| 110 | ! |
"Term Variable", |
| 111 | ! |
choices = get_choices(args$term_var$choices), |
| 112 | ! |
selected = args$term_var$selected |
| 113 |
), |
|
| 114 | ! |
teal.widgets::optionalSelectInput( |
| 115 | ! |
ns("arm_var"),
|
| 116 | ! |
"Arm Variable", |
| 117 | ! |
choices = get_choices(args$arm_var$choices), |
| 118 | ! |
selected = args$arm_var$selected |
| 119 |
), |
|
| 120 | ! |
selectInput( |
| 121 | ! |
ns("arm_ref"),
|
| 122 | ! |
"Control", |
| 123 | ! |
choices = get_choices(args$arm_var$choices), |
| 124 | ! |
selected = args$arm_var$selected |
| 125 |
), |
|
| 126 | ! |
selectInput( |
| 127 | ! |
ns("arm_trt"),
|
| 128 | ! |
"Treatment", |
| 129 | ! |
choices = get_choices(args$arm_var$choices), |
| 130 | ! |
selected = args$arm_var$selected |
| 131 |
), |
|
| 132 | ! |
teal.widgets::optionalSelectInput( |
| 133 | ! |
ns("sort"),
|
| 134 | ! |
"Sort By", |
| 135 | ! |
choices = c( |
| 136 | ! |
"Term" = "term", |
| 137 | ! |
"Risk Difference" = "riskdiff", |
| 138 | ! |
"Mean Risk" = "meanrisk" |
| 139 |
), |
|
| 140 | ! |
selected = NULL |
| 141 |
), |
|
| 142 | ! |
teal.widgets::panel_item( |
| 143 | ! |
"Confidence interval settings", |
| 144 | ! |
teal.widgets::optionalSelectInput( |
| 145 | ! |
ns("diff_ci_method"),
|
| 146 | ! |
"Method for Difference of Proportions CI", |
| 147 | ! |
choices = ci_choices, |
| 148 | ! |
selected = ci_choices[1] |
| 149 |
), |
|
| 150 | ! |
teal.widgets::optionalSliderInput( |
| 151 | ! |
ns("conf_level"),
|
| 152 | ! |
"Confidence Level", |
| 153 | ! |
min = 0.5, |
| 154 | ! |
max = 1, |
| 155 | ! |
value = 0.95 |
| 156 |
) |
|
| 157 |
), |
|
| 158 | ! |
teal.widgets::panel_item( |
| 159 | ! |
"Additional plot settings", |
| 160 | ! |
teal.widgets::optionalSelectInput( |
| 161 | ! |
ns("axis"),
|
| 162 | ! |
"Axis Side", |
| 163 | ! |
choices = c("Left" = "left", "Right" = "right"),
|
| 164 | ! |
selected = "left" |
| 165 |
), |
|
| 166 | ! |
sliderInput( |
| 167 | ! |
ns("raterange"),
|
| 168 | ! |
"Overall Rate Range", |
| 169 | ! |
min = 0, |
| 170 | ! |
max = 1, |
| 171 | ! |
value = c(0.1, 1), |
| 172 | ! |
step = 0.01 |
| 173 |
), |
|
| 174 | ! |
sliderInput( |
| 175 | ! |
ns("diffrange"),
|
| 176 | ! |
"Rate Difference Range", |
| 177 | ! |
min = -1, |
| 178 | ! |
max = 1, |
| 179 | ! |
value = c(-0.5, 0.5), |
| 180 | ! |
step = 0.01 |
| 181 |
), |
|
| 182 | ! |
checkboxInput(ns("reverse"),
|
| 183 | ! |
"Reverse Order", |
| 184 | ! |
value = FALSE |
| 185 |
) |
|
| 186 |
), |
|
| 187 | ! |
ui_g_decorate( |
| 188 | ! |
ns(NULL), |
| 189 | ! |
fontsize = args$fontsize, |
| 190 | ! |
titles = "Common AE Table", |
| 191 | ! |
footnotes = "" |
| 192 |
) |
|
| 193 |
) |
|
| 194 |
) |
|
| 195 |
} |
|
| 196 | ||
| 197 |
srv_g_events_term_id <- function(id, |
|
| 198 |
data, |
|
| 199 |
dataname, |
|
| 200 |
label, |
|
| 201 |
plot_height, |
|
| 202 |
plot_width) {
|
|
| 203 | ! |
checkmate::assert_class(data, "reactive") |
| 204 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 205 | ||
| 206 | ! |
moduleServer(id, function(input, output, session) {
|
| 207 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 208 | ! |
iv <- reactive({
|
| 209 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 210 | ! |
iv$add_rule("term", shinyvalidate::sv_required(
|
| 211 | ! |
message = "Term Variable is required" |
| 212 |
)) |
|
| 213 | ! |
iv$add_rule("arm_var", shinyvalidate::sv_required(
|
| 214 | ! |
message = "Arm Variable is required" |
| 215 |
)) |
|
| 216 | ! |
rule_diff <- function(value, other) {
|
| 217 | ! |
if (isTRUE(value == other)) "Control and Treatment must be different" |
| 218 |
} |
|
| 219 | ! |
iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
|
| 220 | ! |
iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
|
| 221 | ! |
iv$enable() |
| 222 | ! |
iv |
| 223 |
}) |
|
| 224 | ||
| 225 | ! |
decorate_output <- srv_g_decorate( |
| 226 | ! |
id = NULL, plt = plot_r, plot_height = plot_height, plot_width = plot_width |
| 227 |
) |
|
| 228 | ! |
font_size <- decorate_output$font_size |
| 229 | ! |
pws <- decorate_output$pws |
| 230 | ||
| 231 | ! |
observeEvent(list(input$diff_ci_method, input$conf_level), {
|
| 232 | ! |
req(!is.null(input$diff_ci_method) && !is.null(input$conf_level)) |
| 233 | ! |
diff_ci_method <- input$diff_ci_method |
| 234 | ! |
conf_level <- input$conf_level |
| 235 | ! |
updateTextAreaInput( |
| 236 | ! |
session, |
| 237 | ! |
"foot", |
| 238 | ! |
value = sprintf( |
| 239 | ! |
"Note: %d%% CI is calculated using %s", |
| 240 | ! |
round(conf_level * 100), |
| 241 | ! |
name_ci(diff_ci_method) |
| 242 |
) |
|
| 243 |
) |
|
| 244 |
}) |
|
| 245 | ||
| 246 | ! |
observeEvent(input$sort, |
| 247 |
{
|
|
| 248 | ! |
sort <- if (is.null(input$sort)) " " else input$sort |
| 249 | ! |
updateTextInput( |
| 250 | ! |
session, |
| 251 | ! |
"title", |
| 252 | ! |
value = sprintf( |
| 253 | ! |
"Common AE Table %s", |
| 254 | ! |
c( |
| 255 | ! |
"term" = "Sorted by Term", |
| 256 | ! |
"riskdiff" = "Sorted by Risk Difference", |
| 257 | ! |
"meanrisk" = "Sorted by Mean Risk", |
| 258 |
" " = "" |
|
| 259 | ! |
)[sort] |
| 260 |
) |
|
| 261 |
) |
|
| 262 |
}, |
|
| 263 | ! |
ignoreNULL = FALSE |
| 264 |
) |
|
| 265 | ||
| 266 | ! |
observeEvent(input$arm_var, |
| 267 |
{
|
|
| 268 | ! |
arm_var <- input$arm_var |
| 269 | ! |
ANL <- data()[[dataname]] |
| 270 | ||
| 271 | ! |
choices <- levels(ANL[[arm_var]]) |
| 272 | ||
| 273 | ! |
if (length(choices) == 1) {
|
| 274 | ! |
trt_index <- 1 |
| 275 |
} else {
|
|
| 276 | ! |
trt_index <- 2 |
| 277 |
} |
|
| 278 | ||
| 279 | ! |
updateSelectInput( |
| 280 | ! |
session, |
| 281 | ! |
"arm_ref", |
| 282 | ! |
selected = choices[1], |
| 283 | ! |
choices = choices |
| 284 |
) |
|
| 285 | ! |
updateSelectInput( |
| 286 | ! |
session, |
| 287 | ! |
"arm_trt", |
| 288 | ! |
selected = choices[trt_index], |
| 289 | ! |
choices = choices |
| 290 |
) |
|
| 291 |
}, |
|
| 292 | ! |
ignoreNULL = TRUE |
| 293 |
) |
|
| 294 | ||
| 295 | ! |
output_q <- reactive({
|
| 296 | ! |
obj <- data() |
| 297 | ! |
teal.reporter::teal_card(obj) <- |
| 298 | ! |
c( |
| 299 | ! |
teal.reporter::teal_card(obj), |
| 300 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 301 |
) |
|
| 302 | ||
| 303 | ! |
ANL <- obj[[dataname]] |
| 304 | ||
| 305 | ! |
teal::validate_inputs(iv()) |
| 306 | ||
| 307 | ! |
shiny::validate( |
| 308 | ! |
shiny::need(is.factor(ANL[[input$arm_var]]), "Arm Var must be a factor variable. Contact developer."), |
| 309 | ! |
shiny::need( |
| 310 | ! |
input$arm_trt %in% ANL[[req(input$arm_var)]] && input$arm_ref %in% ANL[[req(input$arm_var)]], |
| 311 | ! |
"Cannot generate plot. The dataset does not contain subjects from both the control and treatment arms." |
| 312 |
) |
|
| 313 |
) |
|
| 314 | ||
| 315 | ! |
adsl_vars <- unique(c("USUBJID", "STUDYID", input$arm_var))
|
| 316 | ! |
anl_vars <- c("USUBJID", "STUDYID", input$term)
|
| 317 | ||
| 318 | ! |
q1 <- teal.code::eval_code( |
| 319 | ! |
obj, |
| 320 | ! |
code = bquote( |
| 321 | ! |
ANL <- merge( |
| 322 | ! |
x = ADSL[, .(adsl_vars), drop = FALSE], |
| 323 | ! |
y = .(as.name(dataname))[, .(anl_vars), drop = FALSE], |
| 324 | ! |
all.x = FALSE, |
| 325 | ! |
all.y = FALSE, |
| 326 | ! |
by = c("USUBJID", "STUDYID")
|
| 327 |
) |
|
| 328 |
) |
|
| 329 |
) |
|
| 330 | ||
| 331 | ! |
teal::validate_has_data(q1[["ANL"]], |
| 332 | ! |
min_nrow = 10, |
| 333 | ! |
msg = "Analysis data set must have at least 10 data points" |
| 334 |
) |
|
| 335 | ||
| 336 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot") |
| 337 | ||
| 338 | ! |
q2 <- teal.code::eval_code( |
| 339 | ! |
q1, |
| 340 | ! |
code = bquote( |
| 341 | ! |
plot <- osprey::g_events_term_id( |
| 342 | ! |
term = ANL[[.(input$term)]], |
| 343 | ! |
id = ANL$USUBJID, |
| 344 | ! |
arm = ANL[[.(input$arm_var)]], |
| 345 | ! |
arm_N = table(ADSL[[.(input$arm_var)]]), |
| 346 | ! |
ref = .(input$arm_ref), |
| 347 | ! |
trt = .(input$arm_trt), |
| 348 | ! |
sort_by = .(input$sort), |
| 349 | ! |
rate_range = .(input$raterange), |
| 350 | ! |
diff_range = .(input$diffrange), |
| 351 | ! |
reversed = .(input$reverse), |
| 352 | ! |
conf_level = .(input$conf_level), |
| 353 | ! |
diff_ci_method = .(input$diff_ci_method), |
| 354 | ! |
axis_side = .(input$axis), |
| 355 | ! |
fontsize = .(font_size()), |
| 356 | ! |
draw = TRUE |
| 357 |
) |
|
| 358 |
) |
|
| 359 |
) |
|
| 360 |
}) |
|
| 361 | ||
| 362 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 363 | ! |
set_chunk_dims(pws, output_q) |
| 364 |
}) |
|
| 365 |
} |
| 1 |
#' Butterfly plot Teal Module |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' Display butterfly plot as a shiny module |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param filter_var (`choices_selected`) variable name of data filter, please see details regarding |
|
| 11 |
#' expected values, default is`NULL`.`choices` |
|
| 12 |
#' vector with `filter_var` choices, default is |
|
| 13 |
#' `NULL` |
|
| 14 |
#' @param right_var (`choices_selected`) dichotomization variable for right side |
|
| 15 |
#' @param left_var (`choices_selected`) dichotomization variable for left side |
|
| 16 |
#' @param category_var (`choices_selected`) category (y axis) variable |
|
| 17 |
#' @param color_by_var (`choices_selected`) variable defines color blocks within each bar |
|
| 18 |
#' @param count_by_var (`choices_selected`) variable defines how x axis is calculated |
|
| 19 |
#' @param facet_var (`choices_selected`) variable for row facets |
|
| 20 |
#' @param sort_by_var (`choices_selected`) argument for order of class and term elements in table, |
|
| 21 |
#' default here is "count" |
|
| 22 |
#' @param legend_on (`boolean`) value for whether legend is displayed |
|
| 23 |
#' |
|
| 24 |
#' @details `filter_var` option is designed to work in conjunction with |
|
| 25 |
#' filtering function provided by `teal` (encoding panel on the right |
|
| 26 |
#' hand side of the shiny app). It can be used as quick access to predefined |
|
| 27 |
#' subsets of the domain datasets (not subject-level dataset) to be used for |
|
| 28 |
#' analysis, denoted by an value of "Y". Each variable within the |
|
| 29 |
#' `filter_var_choices` is expected to contain values of either "Y" or |
|
| 30 |
#' "N". If multiple variables are selected as `filter_var`, only |
|
| 31 |
#' observations with "Y" value in each and every selected variables will be |
|
| 32 |
#' used for subsequent analysis. Flag variables (from `ADaM` datasets) can be |
|
| 33 |
#' used directly as filter. |
|
| 34 |
#' |
|
| 35 |
#' @inherit argument_convention return |
|
| 36 |
#' @inheritSection teal::example_module Reporting |
|
| 37 |
#' |
|
| 38 |
#' @export |
|
| 39 |
#' |
|
| 40 |
#' @template author_zhanc107 |
|
| 41 |
#' @template author_liaoc10 |
|
| 42 |
#' |
|
| 43 |
#' @examples |
|
| 44 |
#' # Example using stream (ADaM) dataset |
|
| 45 |
#' data <- teal_data() |> |
|
| 46 |
#' eval_code("set.seed(23) # @linksto ADSL") |>
|
|
| 47 |
#' within({
|
|
| 48 |
#' library(nestcolor) |
|
| 49 |
#' library(dplyr) |
|
| 50 |
#' ADSL <- rADSL |
|
| 51 |
#' ADAE <- rADAE |
|
| 52 |
#' ADSL <- mutate(ADSL, DOSE = paste(sample(1:3, n(), replace = TRUE), "UG")) |
|
| 53 |
#' ADAE <- mutate( |
|
| 54 |
#' ADAE, |
|
| 55 |
#' flag1 = ifelse(AETOXGR == 1, 1, 0), |
|
| 56 |
#' flag2 = ifelse(AETOXGR == 2, 1, 0), |
|
| 57 |
#' flag3 = ifelse(AETOXGR == 3, 1, 0), |
|
| 58 |
#' flag1_filt = rep("Y", n())
|
|
| 59 |
#' ) |
|
| 60 |
#' }) |
|
| 61 |
#' |
|
| 62 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 63 |
#' |
|
| 64 |
#' app <- init( |
|
| 65 |
#' data = data, |
|
| 66 |
#' modules = modules( |
|
| 67 |
#' tm_g_butterfly( |
|
| 68 |
#' label = "Butterfly Plot", |
|
| 69 |
#' dataname = "ADAE", |
|
| 70 |
#' right_var = choices_selected( |
|
| 71 |
#' selected = "SEX", |
|
| 72 |
#' choices = c("SEX", "ARM", "RACE")
|
|
| 73 |
#' ), |
|
| 74 |
#' left_var = choices_selected( |
|
| 75 |
#' selected = "RACE", |
|
| 76 |
#' choices = c("SEX", "ARM", "RACE")
|
|
| 77 |
#' ), |
|
| 78 |
#' category_var = choices_selected( |
|
| 79 |
#' selected = "AEBODSYS", |
|
| 80 |
#' choices = c("AEDECOD", "AEBODSYS")
|
|
| 81 |
#' ), |
|
| 82 |
#' color_by_var = choices_selected( |
|
| 83 |
#' selected = "AETOXGR", |
|
| 84 |
#' choices = c("AETOXGR", "None")
|
|
| 85 |
#' ), |
|
| 86 |
#' count_by_var = choices_selected( |
|
| 87 |
#' selected = "# of patients", |
|
| 88 |
#' choices = c("# of patients", "# of AEs")
|
|
| 89 |
#' ), |
|
| 90 |
#' facet_var = choices_selected( |
|
| 91 |
#' selected = NULL, |
|
| 92 |
#' choices = c("RACE", "SEX", "ARM")
|
|
| 93 |
#' ), |
|
| 94 |
#' sort_by_var = choices_selected( |
|
| 95 |
#' selected = "count", |
|
| 96 |
#' choices = c("count", "alphabetical")
|
|
| 97 |
#' ), |
|
| 98 |
#' legend_on = TRUE, |
|
| 99 |
#' plot_height = c(600, 200, 2000) |
|
| 100 |
#' ) |
|
| 101 |
#' ) |
|
| 102 |
#' ) |
|
| 103 |
#' if (interactive()) {
|
|
| 104 |
#' shinyApp(app$ui, app$server) |
|
| 105 |
#' } |
|
| 106 |
#' |
|
| 107 |
tm_g_butterfly <- function(label, |
|
| 108 |
dataname, |
|
| 109 |
filter_var = NULL, |
|
| 110 |
right_var, |
|
| 111 |
left_var, |
|
| 112 |
category_var, |
|
| 113 |
color_by_var, |
|
| 114 |
count_by_var, |
|
| 115 |
facet_var = NULL, |
|
| 116 |
sort_by_var = teal.transform::choices_selected( |
|
| 117 |
selected = "count", choices = c("count", "alphabetical")
|
|
| 118 |
), |
|
| 119 |
legend_on = TRUE, |
|
| 120 |
plot_height = c(600L, 200L, 2000L), |
|
| 121 |
plot_width = NULL, |
|
| 122 |
pre_output = NULL, |
|
| 123 |
post_output = NULL, |
|
| 124 |
transformators = list()) {
|
|
| 125 | ! |
message("Initializing tm_g_butterfly")
|
| 126 | ! |
checkmate::assert_string(label) |
| 127 | ! |
checkmate::assert_string(dataname) |
| 128 | ! |
checkmate::assert_class(filter_var, classes = "choices_selected", null.ok = TRUE) |
| 129 | ! |
checkmate::assert_class(right_var, classes = "choices_selected") |
| 130 | ! |
checkmate::assert_class(left_var, classes = "choices_selected") |
| 131 | ! |
checkmate::assert_class(category_var, classes = "choices_selected") |
| 132 | ! |
checkmate::assert_class(color_by_var, classes = "choices_selected") |
| 133 | ! |
checkmate::assert_class(count_by_var, classes = "choices_selected") |
| 134 | ! |
checkmate::assert_class(facet_var, classes = "choices_selected", null.ok = TRUE) |
| 135 | ! |
checkmate::assert_class(sort_by_var, classes = "choices_selected") |
| 136 | ! |
checkmate::assert_flag(legend_on) |
| 137 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 138 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 139 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 140 | ! |
checkmate::assert_numeric( |
| 141 | ! |
plot_width[1], |
| 142 | ! |
lower = plot_width[2], |
| 143 | ! |
upper = plot_width[3], |
| 144 | ! |
null.ok = TRUE, |
| 145 | ! |
.var.name = "plot_width" |
| 146 |
) |
|
| 147 | ||
| 148 | ! |
args <- as.list(environment()) |
| 149 | ||
| 150 | ! |
module( |
| 151 | ! |
label = label, |
| 152 | ! |
datanames = c("ADSL", dataname),
|
| 153 | ! |
server = srv_g_butterfly, |
| 154 | ! |
server_args = list(dataname = dataname, label = label, plot_height = plot_height, plot_width = plot_width), |
| 155 | ! |
ui = ui_g_butterfly, |
| 156 | ! |
ui_args = args, |
| 157 | ! |
transformators = transformators |
| 158 |
) |
|
| 159 |
} |
|
| 160 | ||
| 161 |
ui_g_butterfly <- function(id, ...) {
|
|
| 162 | ! |
ns <- NS(id) |
| 163 | ! |
a <- list(...) |
| 164 | ||
| 165 | ! |
teal.widgets::standard_layout( |
| 166 | ! |
output = teal.widgets::white_small_well( |
| 167 | ! |
teal.widgets::plot_with_settings_ui(id = ns("butterflyplot"))
|
| 168 |
), |
|
| 169 | ! |
encoding = tags$div( |
| 170 | ! |
tags$label("Encodings", class = "text-primary"),
|
| 171 | ! |
helpText("Dataset is:", tags$code(a$dataname)),
|
| 172 | ! |
if (!is.null(a$filter_var)) {
|
| 173 | ! |
teal.widgets::optionalSelectInput( |
| 174 | ! |
ns("filter_var"),
|
| 175 | ! |
label = |
| 176 | ! |
"Preset Data Filters Observations with value of 'Y' for selected variable(s) will be used for analysis", |
| 177 | ! |
choices = get_choices(a$filter_var$choices), |
| 178 | ! |
selected = a$filter_var$selected, |
| 179 | ! |
multiple = TRUE |
| 180 |
) |
|
| 181 |
}, |
|
| 182 | ! |
teal.widgets::optionalSelectInput( |
| 183 | ! |
ns("right_var"),
|
| 184 | ! |
"Right Dichotomization Variable", |
| 185 | ! |
get_choices(a$right_var$choices), |
| 186 | ! |
a$right_var$selected, |
| 187 | ! |
multiple = FALSE |
| 188 |
), |
|
| 189 | ! |
teal.widgets::optionalSelectInput( |
| 190 | ! |
ns("right_val"),
|
| 191 | ! |
"Choose Up To 2:", |
| 192 | ! |
multiple = TRUE, |
| 193 | ! |
options = list( |
| 194 | ! |
`max-options` = 2L, |
| 195 | ! |
`max-options-text` = "no more than 2", |
| 196 | ! |
`actions-box` = FALSE |
| 197 |
) |
|
| 198 |
), |
|
| 199 | ! |
teal.widgets::optionalSelectInput( |
| 200 | ! |
ns("left_var"),
|
| 201 | ! |
"Left Dichotomization Variable", |
| 202 | ! |
get_choices(a$left_var$choices), |
| 203 | ! |
a$left_var$selected, |
| 204 | ! |
multiple = FALSE |
| 205 |
), |
|
| 206 | ! |
teal.widgets::optionalSelectInput( |
| 207 | ! |
ns("left_val"),
|
| 208 | ! |
"Choose Up To 2:", |
| 209 | ! |
multiple = TRUE, |
| 210 | ! |
options = list( |
| 211 | ! |
`max-options` = 2L, |
| 212 | ! |
`max-options-text` = "no more than 2", |
| 213 | ! |
`actions-box` = FALSE |
| 214 |
) |
|
| 215 |
), |
|
| 216 | ! |
teal.widgets::optionalSelectInput( |
| 217 | ! |
ns("category_var"),
|
| 218 | ! |
"Category Variable", |
| 219 | ! |
get_choices(a$category_var$choices), |
| 220 | ! |
a$category_var$selected, |
| 221 | ! |
multiple = FALSE |
| 222 |
), |
|
| 223 | ! |
radioButtons( |
| 224 | ! |
ns("color_by_var"),
|
| 225 | ! |
"Color Block By Variable", |
| 226 | ! |
get_choices(a$color_by_var$choices), |
| 227 | ! |
a$color_by_var$selected |
| 228 |
), |
|
| 229 | ! |
radioButtons( |
| 230 | ! |
ns("count_by_var"),
|
| 231 | ! |
"Count By Variable", |
| 232 | ! |
get_choices(a$count_by_var$choices), |
| 233 | ! |
a$count_by_var$selected |
| 234 |
), |
|
| 235 | ! |
if (!is.null(a$facet_var)) {
|
| 236 | ! |
teal.widgets::optionalSelectInput( |
| 237 | ! |
ns("facet_var"),
|
| 238 | ! |
"Facet By Variable", |
| 239 | ! |
get_choices(a$facet_var$choices), |
| 240 | ! |
a$facet_var$selected, |
| 241 | ! |
multiple = TRUE |
| 242 |
) |
|
| 243 |
}, |
|
| 244 | ! |
radioButtons( |
| 245 | ! |
ns("sort_by_var"),
|
| 246 | ! |
"Sort By Variable", |
| 247 | ! |
get_choices(a$sort_by_var$choices), |
| 248 | ! |
a$sort_by_var$selected |
| 249 |
), |
|
| 250 | ! |
checkboxInput( |
| 251 | ! |
ns("legend_on"),
|
| 252 | ! |
"Add legend", |
| 253 | ! |
value = a$legend_on |
| 254 |
) |
|
| 255 |
), |
|
| 256 | ! |
pre_output = a$pre_output, |
| 257 | ! |
post_output = a$post_output |
| 258 |
) |
|
| 259 |
} |
|
| 260 | ||
| 261 |
srv_g_butterfly <- function(id, data, dataname, label, plot_height, plot_width) {
|
|
| 262 | ! |
checkmate::assert_class(data, "reactive") |
| 263 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 264 | ||
| 265 | ! |
moduleServer(id, function(input, output, session) {
|
| 266 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 267 | ! |
iv <- reactive({
|
| 268 | ! |
ADSL <- data()[["ADSL"]] |
| 269 | ! |
ANL <- data()[[dataname]] |
| 270 | ||
| 271 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 272 | ! |
iv$add_rule("category_var", shinyvalidate::sv_required(
|
| 273 | ! |
message = "Category Variable is required" |
| 274 |
)) |
|
| 275 | ! |
iv$add_rule("right_var", shinyvalidate::sv_required(
|
| 276 | ! |
message = "Right Dichotomization Variable is required" |
| 277 |
)) |
|
| 278 | ! |
iv$add_rule("left_var", shinyvalidate::sv_required(
|
| 279 | ! |
message = "Left Dichotomization Variable is required" |
| 280 |
)) |
|
| 281 | ! |
iv$add_rule("right_var", ~ if (!is.factor(ANL[[.]])) {
|
| 282 | ! |
"Right Dichotomization Variable must be a factor variable, contact developer" |
| 283 |
}) |
|
| 284 | ! |
iv$add_rule("left_var", ~ if (!is.factor(ANL[[.]])) {
|
| 285 | ! |
"Left Dichotomization Variable must be a factor variable, contact developer" |
| 286 |
}) |
|
| 287 | ! |
iv$add_rule("right_val", shinyvalidate::sv_required(
|
| 288 | ! |
message = "At least one value of Right Dichotomization Variable must be selected" |
| 289 |
)) |
|
| 290 | ! |
iv$add_rule("left_val", shinyvalidate::sv_required(
|
| 291 | ! |
message = "At least one value of Left Dichotomization Variable must be selected" |
| 292 |
)) |
|
| 293 | ! |
iv$enable() |
| 294 | ! |
iv |
| 295 |
}) |
|
| 296 | ||
| 297 | ! |
options <- reactiveValues(r = NULL, l = NULL) |
| 298 | ! |
vars <- reactiveValues(r = NULL, l = NULL) |
| 299 | ||
| 300 |
# dynamic options for dichotomization variable |
|
| 301 | ! |
observeEvent(input$right_var, |
| 302 | ! |
handlerExpr = {
|
| 303 | ! |
right_var <- input$right_var |
| 304 | ! |
right_val <- isolate(input$right_val) |
| 305 | ! |
current_r_var <- isolate(vars$r) |
| 306 | ! |
if (is.null(right_var)) {
|
| 307 | ! |
teal.widgets::updateOptionalSelectInput( |
| 308 | ! |
session, |
| 309 | ! |
"right_val", |
| 310 | ! |
choices = character(0), |
| 311 | ! |
selected = character(0) |
| 312 |
) |
|
| 313 |
} else {
|
|
| 314 | ! |
options$r <- if (right_var %in% names(data()[["ADSL"]])) {
|
| 315 | ! |
levels(data()[["ADSL"]][[right_var]]) |
| 316 |
} else {
|
|
| 317 | ! |
levels(data()[[dataname]][[right_var]]) |
| 318 |
} |
|
| 319 | ||
| 320 | ! |
selected <- if (length(right_val) > 0) {
|
| 321 | ! |
left_over <- right_val[right_val %in% options$r] |
| 322 | ! |
if (length(left_over) > 0 && !is.null(current_r_var) && current_r_var == right_var) {
|
| 323 | ! |
left_over |
| 324 |
} else {
|
|
| 325 | ! |
options$r[1] |
| 326 |
} |
|
| 327 |
} else {
|
|
| 328 | ! |
options$r[1] |
| 329 |
} |
|
| 330 | ! |
teal.widgets::updateOptionalSelectInput( |
| 331 | ! |
session, "right_val", |
| 332 | ! |
choices = as.character(options$r), selected = selected, label = "Choose Up To 2:" |
| 333 |
) |
|
| 334 |
} |
|
| 335 | ! |
vars$r <- right_var |
| 336 |
}, |
|
| 337 | ! |
ignoreNULL = FALSE |
| 338 |
) |
|
| 339 | ||
| 340 | ! |
observeEvent(input$left_var, |
| 341 | ! |
handlerExpr = {
|
| 342 | ! |
left_var <- input$left_var |
| 343 | ! |
left_val <- isolate(input$left_val) |
| 344 | ! |
current_l_var <- isolate(vars$l) |
| 345 | ! |
if (is.null(left_var)) {
|
| 346 | ! |
teal.widgets::updateOptionalSelectInput( |
| 347 | ! |
session, "left_val", |
| 348 | ! |
choices = character(0), selected = character(0) |
| 349 |
) |
|
| 350 |
} else {
|
|
| 351 | ! |
options$l <- if (left_var %in% names(data()[["ADSL"]])) {
|
| 352 | ! |
levels(data()[["ADSL"]][[left_var]]) |
| 353 |
} else {
|
|
| 354 | ! |
levels(data()[[dataname]][[left_var]]) |
| 355 |
} |
|
| 356 | ||
| 357 | ! |
selected <- if (length(left_val) > 0) {
|
| 358 | ! |
left_over <- left_val[left_val %in% options$l] |
| 359 | ! |
if (length(left_over) > 0 && !is.null(current_l_var) && current_l_var == left_var) {
|
| 360 | ! |
left_over |
| 361 |
} else {
|
|
| 362 | ! |
options$l[1] |
| 363 |
} |
|
| 364 |
} else {
|
|
| 365 | ! |
options$l[1] |
| 366 |
} |
|
| 367 | ||
| 368 | ! |
teal.widgets::updateOptionalSelectInput( |
| 369 | ! |
session, "left_val", |
| 370 | ! |
choices = as.character(options$l), selected = selected, label = "Choose Up To 2:" |
| 371 |
) |
|
| 372 |
} |
|
| 373 | ! |
vars$l <- left_var |
| 374 |
}, |
|
| 375 | ! |
ignoreNULL = FALSE |
| 376 |
) |
|
| 377 | ||
| 378 | ! |
output_q <- shiny::debounce( |
| 379 | ! |
millis = 200, |
| 380 | ! |
r = reactive({
|
| 381 | ! |
obj <- data() |
| 382 | ! |
teal.reporter::teal_card(obj) <- |
| 383 | ! |
c( |
| 384 | ! |
teal.reporter::teal_card(obj), |
| 385 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 386 |
) |
|
| 387 | ! |
obj <- teal.code::eval_code(obj, "library(dplyr)") |
| 388 | ||
| 389 | ! |
ADSL <- obj[["ADSL"]] |
| 390 | ! |
ANL <- obj[[dataname]] |
| 391 | ||
| 392 | ! |
teal::validate_has_data(ADSL, min_nrow = 0, msg = sprintf("%s Data is empty", "ADSL"))
|
| 393 | ! |
teal::validate_has_data(ANL, min_nrow = 0, msg = sprintf("%s Data is empty", dataname))
|
| 394 | ||
| 395 | ! |
teal::validate_inputs(iv()) |
| 396 | ||
| 397 | ! |
validate( |
| 398 | ! |
need( |
| 399 | ! |
all(input$right_val %in% ADSL[[input$right_var]]) && |
| 400 | ! |
all(input$left_val %in% ADSL[[input$left_var]]), |
| 401 | ! |
"No observations for selected dichotomization values (filtered out?)" |
| 402 |
) |
|
| 403 |
) |
|
| 404 | ||
| 405 | ! |
right_var <- isolate(input$right_var) |
| 406 | ! |
left_var <- isolate(input$left_var) |
| 407 | ! |
right_val <- input$right_val |
| 408 | ! |
left_val <- input$left_val |
| 409 | ! |
category_var <- input$category_var |
| 410 | ! |
color_by_var <- input$color_by_var |
| 411 | ! |
count_by_var <- input$count_by_var |
| 412 | ! |
legend_on <- input$legend_on |
| 413 | ! |
facet_var <- input$facet_var |
| 414 | ! |
sort_by_var <- input$sort_by_var |
| 415 | ! |
filter_var <- input$filter_var |
| 416 | ||
| 417 |
# if variable is not in ADSL, then take from domain VADs |
|
| 418 | ! |
varlist <- c(category_var, color_by_var, facet_var, filter_var, right_var, left_var) |
| 419 | ! |
varlist_from_adsl <- intersect(varlist, names(ADSL)) |
| 420 | ! |
varlist_from_anl <- intersect(varlist, setdiff(names(ANL), names(ADSL))) |
| 421 | ||
| 422 | ! |
adsl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_adsl))
|
| 423 | ! |
anl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_anl))
|
| 424 | ||
| 425 | ! |
q1 <- teal.code::eval_code( |
| 426 | ! |
obj, |
| 427 | ! |
code = bquote({
|
| 428 | ! |
ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame() |
| 429 | ! |
ANL <- .(as.name(dataname))[, .(anl_vars)] %>% as.data.frame() |
| 430 |
}) |
|
| 431 |
) |
|
| 432 | ||
| 433 | ! |
if (!("NULL" %in% filter_var) && !is.null(filter_var)) {
|
| 434 | ! |
q1 <- teal.code::eval_code( |
| 435 | ! |
q1, |
| 436 | ! |
code = bquote( |
| 437 | ! |
ANL <- quick_filter(.(filter_var), ANL) %>% |
| 438 | ! |
droplevels() %>% |
| 439 | ! |
as.data.frame() |
| 440 |
) |
|
| 441 |
) |
|
| 442 |
} |
|
| 443 | ||
| 444 | ! |
q1 <- teal.code::eval_code( |
| 445 | ! |
q1, |
| 446 | ! |
code = bquote({
|
| 447 | ! |
ANL_f <- left_join(ADSL, ANL, by = c("USUBJID", "STUDYID")) %>% as.data.frame()
|
| 448 | ! |
ANL_f <- na.omit(ANL_f) |
| 449 |
}) |
|
| 450 |
) |
|
| 451 | ||
| 452 | ! |
if (!is.null(right_val) && !is.null(right_val)) {
|
| 453 | ! |
q1 <- teal.code::eval_code( |
| 454 | ! |
q1, |
| 455 | ! |
code = bquote({
|
| 456 | ! |
right <- ANL_f[, .(right_var)] %in% .(right_val) |
| 457 | ! |
right_name <- paste(.(right_val), collapse = " - ") |
| 458 | ! |
left <- ANL_f[, .(left_var)] %in% .(left_val) |
| 459 | ! |
left_name <- paste(.(left_val), collapse = " - ") |
| 460 |
}) |
|
| 461 |
) |
|
| 462 |
} |
|
| 463 | ||
| 464 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot") |
| 465 | ||
| 466 | ! |
if (!is.null(input$filter_var) || !is.null(input$facet_var) || !is.null(input$sort_by_var)) {
|
| 467 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Selected Options") |
| 468 |
} |
|
| 469 | ! |
if (!is.null(input$filter_var)) {
|
| 470 | ! |
teal.reporter::teal_card(q1) <- c( |
| 471 | ! |
teal.reporter::teal_card(q1), |
| 472 | ! |
sprintf("Preset Data Filters: %s.", paste(input$filter_var, collapse = ", "))
|
| 473 |
) |
|
| 474 |
} |
|
| 475 | ! |
if (!is.null(input$facet_var)) {
|
| 476 | ! |
teal.reporter::teal_card(q1) <- c( |
| 477 | ! |
teal.reporter::teal_card(q1), |
| 478 | ! |
sprintf("Faceted by: %s.", paste(input$facet_var, collapse = ", "))
|
| 479 |
) |
|
| 480 |
} |
|
| 481 | ! |
if (!is.null(input$sort_by_var)) {
|
| 482 | ! |
teal.reporter::teal_card(q1) <- c( |
| 483 | ! |
teal.reporter::teal_card(q1), |
| 484 | ! |
sprintf("Sorted by: %s.", paste(input$sort_by_var, collapse = ", "))
|
| 485 |
) |
|
| 486 |
} |
|
| 487 | ||
| 488 | ! |
if (!is.null(right_val) && !is.null(left_val)) {
|
| 489 | ! |
q1 <- teal.code::eval_code( |
| 490 | ! |
q1, |
| 491 | ! |
code = bquote( |
| 492 | ! |
plot <- osprey::g_butterfly( |
| 493 | ! |
category = ANL_f[, .(category_var)], |
| 494 | ! |
right_flag = right, |
| 495 | ! |
left_flag = left, |
| 496 | ! |
group_names = c(right_name, left_name), |
| 497 | ! |
block_count = .(count_by_var), |
| 498 | ! |
block_color = .(if (color_by_var != "None") {
|
| 499 | ! |
bquote(ANL_f[, .(color_by_var)]) |
| 500 |
} else {
|
|
| 501 | ! |
NULL |
| 502 |
}), |
|
| 503 | ! |
id = ANL_f$USUBJID, |
| 504 | ! |
facet_rows = .(if (!is.null(facet_var)) {
|
| 505 | ! |
bquote(ANL_f[, .(facet_var)]) |
| 506 |
} else {
|
|
| 507 | ! |
NULL |
| 508 |
}), |
|
| 509 | ! |
x_label = .(count_by_var), |
| 510 | ! |
y_label = .(category_var), |
| 511 | ! |
legend_label = .(color_by_var), |
| 512 | ! |
sort_by = .(sort_by_var), |
| 513 | ! |
show_legend = .(legend_on) |
| 514 |
) |
|
| 515 |
) |
|
| 516 |
) |
|
| 517 |
} |
|
| 518 | ||
| 519 | ! |
q1 |
| 520 |
}) |
|
| 521 |
) |
|
| 522 | ||
| 523 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 524 | ||
| 525 |
# Insert the plot into a plot_with_settings module from teal.widgets |
|
| 526 | ! |
pws <- teal.widgets::plot_with_settings_srv( |
| 527 | ! |
id = "butterflyplot", |
| 528 | ! |
plot_r = plot_r, |
| 529 | ! |
height = plot_height, |
| 530 | ! |
width = plot_width |
| 531 |
) |
|
| 532 | ||
| 533 | ! |
set_chunk_dims(pws, output_q) |
| 534 |
}) |
|
| 535 |
} |
| 1 |
#' Spider plot Teal Module |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' Display spider plot as a shiny module |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param x_var x-axis variables |
|
| 11 |
#' @param y_var y-axis variables |
|
| 12 |
#' @param marker_var variable dictates marker symbol |
|
| 13 |
#' @param line_colorby_var variable dictates line color |
|
| 14 |
#' @param vref_line vertical reference lines |
|
| 15 |
#' @param href_line horizontal reference lines |
|
| 16 |
#' @param anno_txt_var annotation text |
|
| 17 |
#' @param legend_on boolean value for whether legend is displayed |
|
| 18 |
#' @param xfacet_var variable for x facets |
|
| 19 |
#' @param yfacet_var variable for y facets |
|
| 20 |
#' |
|
| 21 |
#' @inherit argument_convention return |
|
| 22 |
#' @inheritSection teal::example_module Reporting |
|
| 23 |
#' @export |
|
| 24 |
#' |
|
| 25 |
#' @template author_zhanc107 |
|
| 26 |
#' @template author_liaoc10 |
|
| 27 |
#' |
|
| 28 |
#' @examples |
|
| 29 |
#' # Example using stream (ADaM) dataset |
|
| 30 |
#' data <- teal_data() |> |
|
| 31 |
#' within({
|
|
| 32 |
#' library(nestcolor) |
|
| 33 |
#' ADSL <- rADSL |
|
| 34 |
#' ADTR <- rADTR |
|
| 35 |
#' }) |
|
| 36 |
#' |
|
| 37 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 38 |
#' |
|
| 39 |
#' app <- init( |
|
| 40 |
#' data = data, |
|
| 41 |
#' modules = modules( |
|
| 42 |
#' tm_g_spiderplot( |
|
| 43 |
#' label = "Spider plot", |
|
| 44 |
#' dataname = "ADTR", |
|
| 45 |
#' paramcd = choices_selected( |
|
| 46 |
#' choices = "SLDINV", |
|
| 47 |
#' selected = "SLDINV" |
|
| 48 |
#' ), |
|
| 49 |
#' x_var = choices_selected( |
|
| 50 |
#' choices = "ADY", |
|
| 51 |
#' selected = "ADY" |
|
| 52 |
#' ), |
|
| 53 |
#' y_var = choices_selected( |
|
| 54 |
#' choices = c("PCHG", "CHG", "AVAL"),
|
|
| 55 |
#' selected = "PCHG" |
|
| 56 |
#' ), |
|
| 57 |
#' marker_var = choices_selected( |
|
| 58 |
#' choices = c("SEX", "RACE", "USUBJID"),
|
|
| 59 |
#' selected = "SEX" |
|
| 60 |
#' ), |
|
| 61 |
#' line_colorby_var = choices_selected( |
|
| 62 |
#' choices = c("SEX", "USUBJID", "RACE"),
|
|
| 63 |
#' selected = "SEX" |
|
| 64 |
#' ), |
|
| 65 |
#' xfacet_var = choices_selected( |
|
| 66 |
#' choices = c("SEX", "ARM"),
|
|
| 67 |
#' selected = "SEX" |
|
| 68 |
#' ), |
|
| 69 |
#' yfacet_var = choices_selected( |
|
| 70 |
#' choices = c("SEX", "ARM"),
|
|
| 71 |
#' selected = "ARM" |
|
| 72 |
#' ), |
|
| 73 |
#' vref_line = "10, 37", |
|
| 74 |
#' href_line = "-20, 0" |
|
| 75 |
#' ) |
|
| 76 |
#' ) |
|
| 77 |
#' ) |
|
| 78 |
#' if (interactive()) {
|
|
| 79 |
#' shinyApp(app$ui, app$server) |
|
| 80 |
#' } |
|
| 81 |
#' |
|
| 82 |
tm_g_spiderplot <- function(label, |
|
| 83 |
dataname, |
|
| 84 |
paramcd, |
|
| 85 |
x_var, |
|
| 86 |
y_var, |
|
| 87 |
marker_var, |
|
| 88 |
line_colorby_var, |
|
| 89 |
xfacet_var = NULL, |
|
| 90 |
yfacet_var = NULL, |
|
| 91 |
vref_line = NULL, |
|
| 92 |
href_line = NULL, |
|
| 93 |
anno_txt_var = TRUE, |
|
| 94 |
legend_on = FALSE, |
|
| 95 |
plot_height = c(600L, 200L, 2000L), |
|
| 96 |
plot_width = NULL, |
|
| 97 |
pre_output = NULL, |
|
| 98 |
post_output = NULL, |
|
| 99 |
transformators = list()) {
|
|
| 100 | ! |
message("Initializing tm_g_spiderplot")
|
| 101 | ! |
checkmate::assert_class(paramcd, classes = "choices_selected") |
| 102 | ! |
checkmate::assert_class(x_var, classes = "choices_selected") |
| 103 | ! |
checkmate::assert_class(y_var, classes = "choices_selected") |
| 104 | ! |
checkmate::assert_class(marker_var, classes = "choices_selected") |
| 105 | ! |
checkmate::assert_class(line_colorby_var, classes = "choices_selected") |
| 106 | ! |
checkmate::assert_class(xfacet_var, classes = "choices_selected") |
| 107 | ! |
checkmate::assert_class(yfacet_var, classes = "choices_selected") |
| 108 | ! |
checkmate::assert_string(vref_line) |
| 109 | ! |
checkmate::assert_string(href_line) |
| 110 | ! |
checkmate::assert_flag(anno_txt_var) |
| 111 | ! |
checkmate::assert_flag(legend_on) |
| 112 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 113 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 114 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 115 | ! |
checkmate::assert_numeric( |
| 116 | ! |
plot_width[1], |
| 117 | ! |
lower = plot_width[2], |
| 118 | ! |
upper = plot_width[3], |
| 119 | ! |
null.ok = TRUE, |
| 120 | ! |
.var.name = "plot_width" |
| 121 |
) |
|
| 122 | ||
| 123 | ! |
args <- as.list(environment()) |
| 124 | ! |
module( |
| 125 | ! |
label = label, |
| 126 | ! |
datanames = c("ADSL", dataname),
|
| 127 | ! |
server = srv_g_spider, |
| 128 | ! |
server_args = list( |
| 129 | ! |
dataname = dataname, |
| 130 | ! |
paramcd = paramcd, |
| 131 | ! |
label = label, |
| 132 | ! |
plot_height = plot_height, |
| 133 | ! |
plot_width = plot_width |
| 134 |
), |
|
| 135 | ! |
ui = ui_g_spider, |
| 136 | ! |
ui_args = args, |
| 137 | ! |
transformators = transformators |
| 138 |
) |
|
| 139 |
} |
|
| 140 | ||
| 141 |
ui_g_spider <- function(id, ...) {
|
|
| 142 | ! |
ns <- NS(id) |
| 143 | ! |
a <- list(...) |
| 144 | ! |
shiny::tagList( |
| 145 | ! |
teal.widgets::standard_layout( |
| 146 | ! |
output = teal.widgets::white_small_well( |
| 147 | ! |
teal.widgets::plot_with_settings_ui(id = ns("spiderplot"))
|
| 148 |
), |
|
| 149 | ! |
encoding = tags$div( |
| 150 | ! |
tags$label("Encodings", class = "text-primary"),
|
| 151 | ! |
helpText("Analysis data:", tags$code(a$dataname)),
|
| 152 | ! |
left_bordered_div( |
| 153 | ! |
teal.widgets::optionalSelectInput( |
| 154 | ! |
ns("paramcd"),
|
| 155 | ! |
paste("Parameter - from", a$dataname),
|
| 156 | ! |
multiple = FALSE |
| 157 |
), |
|
| 158 | ! |
teal.widgets::optionalSelectInput( |
| 159 | ! |
ns("x_var"),
|
| 160 | ! |
"X-axis Variable", |
| 161 | ! |
get_choices(a$x_var$choices), |
| 162 | ! |
a$x_var$selected, |
| 163 | ! |
multiple = FALSE |
| 164 |
), |
|
| 165 | ! |
teal.widgets::optionalSelectInput( |
| 166 | ! |
ns("y_var"),
|
| 167 | ! |
"Y-axis Variable", |
| 168 | ! |
get_choices(a$y_var$choices), |
| 169 | ! |
a$y_var$selected, |
| 170 | ! |
multiple = FALSE |
| 171 |
), |
|
| 172 | ! |
teal.widgets::optionalSelectInput( |
| 173 | ! |
ns("line_colorby_var"),
|
| 174 | ! |
"Color By Variable (Line)", |
| 175 | ! |
get_choices(a$line_colorby_var$choices), |
| 176 | ! |
a$line_colorby_var$selected, |
| 177 | ! |
multiple = FALSE |
| 178 |
), |
|
| 179 | ! |
teal.widgets::optionalSelectInput( |
| 180 | ! |
ns("marker_var"),
|
| 181 | ! |
"Marker Symbol By Variable", |
| 182 | ! |
get_choices(a$marker_var$choices), |
| 183 | ! |
a$marker_var$selected, |
| 184 | ! |
multiple = FALSE |
| 185 |
), |
|
| 186 | ! |
teal.widgets::optionalSelectInput( |
| 187 | ! |
ns("xfacet_var"),
|
| 188 | ! |
"X-facet By Variable", |
| 189 | ! |
get_choices(a$xfacet_var$choices), |
| 190 | ! |
a$xfacet_var$selected, |
| 191 | ! |
multiple = TRUE |
| 192 |
), |
|
| 193 | ! |
teal.widgets::optionalSelectInput( |
| 194 | ! |
ns("yfacet_var"),
|
| 195 | ! |
"Y-facet By Variable", |
| 196 | ! |
get_choices(a$yfacet_var$choices), |
| 197 | ! |
a$yfacet_var$selected, |
| 198 | ! |
multiple = TRUE |
| 199 |
) |
|
| 200 |
), |
|
| 201 | ! |
checkboxInput( |
| 202 | ! |
ns("anno_txt_var"),
|
| 203 | ! |
"Add subject ID label", |
| 204 | ! |
value = a$anno_txt_var |
| 205 |
), |
|
| 206 | ! |
checkboxInput( |
| 207 | ! |
ns("legend_on"),
|
| 208 | ! |
"Add legend", |
| 209 | ! |
value = a$legend_on |
| 210 |
), |
|
| 211 | ! |
textInput( |
| 212 | ! |
ns("vref_line"),
|
| 213 | ! |
label = tags$div( |
| 214 | ! |
"Vertical reference line(s)", |
| 215 | ! |
bslib::tooltip( |
| 216 | ! |
trigger = icon("circle-info"),
|
| 217 | ! |
tags$span( |
| 218 | ! |
"Enter numeric value(s) of vertical reference lines, separated by comma (eg. -2, 1)" |
| 219 |
) |
|
| 220 |
) |
|
| 221 |
), |
|
| 222 | ! |
value = a$vref_line |
| 223 |
), |
|
| 224 | ! |
textInput( |
| 225 | ! |
ns("href_line"),
|
| 226 | ! |
label = tags$div( |
| 227 | ! |
"Hortizontal reference line(s)", |
| 228 | ! |
bslib::tooltip( |
| 229 | ! |
trigger = icon("circle-info"),
|
| 230 | ! |
tags$span( |
| 231 | ! |
"Enter numeric value(s) of horizontal reference lines, separated by comma (eg. -2, 1)" |
| 232 |
) |
|
| 233 |
) |
|
| 234 |
), |
|
| 235 | ! |
value = a$href_line |
| 236 |
) |
|
| 237 |
), |
|
| 238 | ! |
pre_output = a$pre_output, |
| 239 | ! |
post_output = a$post_output |
| 240 |
) |
|
| 241 |
) |
|
| 242 |
} |
|
| 243 | ||
| 244 |
srv_g_spider <- function(id, data, dataname, paramcd, label, plot_height, plot_width) {
|
|
| 245 | ! |
checkmate::assert_class(data, "reactive") |
| 246 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 247 | ||
| 248 | ! |
moduleServer(id, function(input, output, session) {
|
| 249 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 250 | ||
| 251 | ! |
env <- as.list(isolate(data())) |
| 252 | ! |
resolved_paramcd <- teal.transform::resolve_delayed(paramcd, env) |
| 253 | ||
| 254 | ! |
teal.widgets::updateOptionalSelectInput( |
| 255 | ! |
session = session, |
| 256 | ! |
inputId = "paramcd", |
| 257 | ! |
choices = resolved_paramcd$choices, |
| 258 | ! |
selected = resolved_paramcd$selected |
| 259 |
) |
|
| 260 | ||
| 261 | ! |
iv <- reactive({
|
| 262 | ! |
ADSL <- data()[["ADSL"]] |
| 263 | ! |
ADTR <- data()[[dataname]] |
| 264 | ||
| 265 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 266 | ! |
iv$add_rule("paramcd", shinyvalidate::sv_required(
|
| 267 | ! |
message = "Parameter is required" |
| 268 |
)) |
|
| 269 | ! |
iv$add_rule("x_var", shinyvalidate::sv_required(
|
| 270 | ! |
message = "X Axis Variable is required" |
| 271 |
)) |
|
| 272 | ! |
iv$add_rule("y_var", shinyvalidate::sv_required(
|
| 273 | ! |
message = "Y Axis Variable is required" |
| 274 |
)) |
|
| 275 | ! |
iv$add_rule("line_colorby_var", shinyvalidate::sv_required(
|
| 276 | ! |
message = "Color Variable is required" |
| 277 |
)) |
|
| 278 | ! |
iv$add_rule("marker_var", shinyvalidate::sv_required(
|
| 279 | ! |
message = "Marker Symbol Variable is required" |
| 280 |
)) |
|
| 281 | ! |
fac_dupl <- function(value, other) {
|
| 282 | ! |
if (length(value) * length(other) > 0L && anyDuplicated(c(value, other))) {
|
| 283 | ! |
"X- and Y-facet Variables must not overlap" |
| 284 |
} |
|
| 285 |
} |
|
| 286 | ! |
iv$add_rule("xfacet_var", fac_dupl, other = input$yfacet_var)
|
| 287 | ! |
iv$add_rule("yfacet_var", fac_dupl, other = input$xfacet_var)
|
| 288 | ! |
iv$add_rule("vref_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
| 289 | ! |
"Vertical reference line(s) are invalid" |
| 290 |
}) |
|
| 291 | ! |
iv$add_rule("href_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
| 292 | ! |
"Horizontal Reference Line(s) are invalid" |
| 293 |
}) |
|
| 294 | ! |
iv$enable() |
| 295 |
}) |
|
| 296 | ||
| 297 | ! |
vals <- reactiveValues(spiderplot = NULL) |
| 298 | ||
| 299 |
# render plot |
|
| 300 | ! |
output_q <- reactive({
|
| 301 | ! |
obj <- data() |
| 302 | ! |
teal.reporter::teal_card(obj) <- |
| 303 | ! |
c( |
| 304 | ! |
teal.reporter::teal_card(obj), |
| 305 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 306 |
) |
|
| 307 | ! |
obj <- teal.code::eval_code(obj, "library(dplyr)") |
| 308 | ||
| 309 |
# get datasets --- |
|
| 310 | ! |
ADSL <- obj[["ADSL"]] |
| 311 | ! |
ADTR <- obj[[dataname]] |
| 312 | ||
| 313 | ! |
teal::validate_inputs(iv()) |
| 314 | ||
| 315 | ! |
teal::validate_has_data(ADSL, min_nrow = 1, msg = sprintf("%s data has zero rows", "ADSL"))
|
| 316 | ! |
teal::validate_has_data(ADTR, min_nrow = 1, msg = sprintf("%s data has zero rows", dataname))
|
| 317 | ||
| 318 | ! |
paramcd <- input$paramcd |
| 319 | ! |
x_var <- input$x_var |
| 320 | ! |
y_var <- input$y_var |
| 321 | ! |
marker_var <- input$marker_var |
| 322 | ! |
line_colorby_var <- input$line_colorby_var |
| 323 | ! |
anno_txt_var <- input$anno_txt_var |
| 324 | ! |
legend_on <- input$legend_on |
| 325 | ! |
xfacet_var <- input$xfacet_var |
| 326 | ! |
yfacet_var <- input$yfacet_var |
| 327 | ! |
vref_line <- input$vref_line |
| 328 | ! |
href_line <- input$href_line |
| 329 | ||
| 330 |
# reference lines preprocessing |
|
| 331 | ! |
vref_line <- as_numeric_from_comma_sep_str(vref_line) |
| 332 | ! |
href_line <- as_numeric_from_comma_sep_str(href_line) |
| 333 | ||
| 334 |
# define variables --- |
|
| 335 |
# if variable is not in ADSL, then take from domain VADs |
|
| 336 | ! |
varlist <- c(xfacet_var, yfacet_var, marker_var, line_colorby_var) |
| 337 | ! |
varlist_from_adsl <- varlist[varlist %in% names(ADSL)] |
| 338 | ! |
varlist_from_anl <- varlist[!varlist %in% names(ADSL)] |
| 339 | ||
| 340 | ! |
adsl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_adsl))
|
| 341 | ! |
adtr_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", x_var, y_var, varlist_from_anl))
|
| 342 | ||
| 343 |
# preprocessing of datasets to qenv --- |
|
| 344 | ||
| 345 |
# vars definition |
|
| 346 | ! |
adtr_vars <- adtr_vars[adtr_vars != "None"] |
| 347 | ! |
adtr_vars <- adtr_vars[!is.null(adtr_vars)] |
| 348 | ||
| 349 |
# merge |
|
| 350 | ! |
q1 <- teal.code::eval_code( |
| 351 | ! |
obj, |
| 352 | ! |
code = bquote({
|
| 353 | ! |
ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame() |
| 354 | ! |
ADTR <- .(as.name(dataname))[, .(adtr_vars)] %>% as.data.frame() |
| 355 | ! |
ANL <- merge(ADSL, ADTR, by = c("USUBJID", "STUDYID"))
|
| 356 | ! |
ANL <- ANL %>% |
| 357 | ! |
group_by(USUBJID, PARAMCD) %>% |
| 358 | ! |
arrange(ANL[, .(x_var)]) %>% |
| 359 | ! |
as.data.frame() |
| 360 |
}) |
|
| 361 |
) |
|
| 362 | ||
| 363 |
# format and filter |
|
| 364 | ! |
q1 <- teal.code::eval_code( |
| 365 | ! |
q1, |
| 366 | ! |
code = bquote({
|
| 367 | ! |
ANL$USUBJID <- unlist(lapply(strsplit(ANL$USUBJID, "-", fixed = TRUE), tail, 1)) |
| 368 | ! |
ANL_f <- ANL %>% |
| 369 | ! |
filter(PARAMCD == .(paramcd)) %>% |
| 370 | ! |
as.data.frame() |
| 371 |
}) |
|
| 372 |
) |
|
| 373 | ||
| 374 |
# label |
|
| 375 | ! |
q1 <- if (anno_txt_var) {
|
| 376 | ! |
teal.code::eval_code( |
| 377 | ! |
q1, |
| 378 | ! |
code = quote(lbl <- list(txt_ann = as.factor(ANL_f$USUBJID))) |
| 379 |
) |
|
| 380 |
} else {
|
|
| 381 | ! |
teal.code::eval_code(q1, code = quote(lbl <- NULL)) |
| 382 |
} |
|
| 383 | ||
| 384 |
# plot code to qenv --- |
|
| 385 | ||
| 386 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot") |
| 387 | ! |
if (!is.null(input$paramcd) || !is.null(input$xfacet_var) || !is.null(input$yfacet_var)) {
|
| 388 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Selected Options") |
| 389 |
} |
|
| 390 | ! |
if (!is.null(input$paramcd)) {
|
| 391 | ! |
teal.reporter::teal_card(q1) <- |
| 392 | ! |
c(teal.reporter::teal_card(q1), paste0("Parameter - (from ", dataname, "): ", input$paramcd, "."))
|
| 393 |
} |
|
| 394 | ! |
if (!is.null(input$xfacet_var)) {
|
| 395 | ! |
teal.reporter::teal_card(q1) <- c( |
| 396 | ! |
teal.reporter::teal_card(q1), |
| 397 | ! |
sprintf("Faceted horizontally by: %s.", paste(input$xfacet_var, collapse = ", "))
|
| 398 |
) |
|
| 399 |
} |
|
| 400 | ! |
if (!is.null(input$yfacet_var)) {
|
| 401 | ! |
teal.reporter::teal_card(q1) <- c( |
| 402 | ! |
teal.reporter::teal_card(q1), |
| 403 | ! |
sprintf("Faceted vertically by: %s.", paste(input$yfacet_var, collapse = ", "))
|
| 404 |
) |
|
| 405 |
} |
|
| 406 | ||
| 407 | ! |
q1 <- teal.code::eval_code( |
| 408 | ! |
q1, |
| 409 | ! |
code = bquote({
|
| 410 | ! |
plot <- osprey::g_spiderplot( |
| 411 | ! |
marker_x = ANL_f[, .(x_var)], |
| 412 | ! |
marker_id = ANL_f$USUBJID, |
| 413 | ! |
marker_y = ANL_f[, .(y_var)], |
| 414 | ! |
line_colby = .(if (line_colorby_var != "None") {
|
| 415 | ! |
bquote(ANL_f[, .(line_colorby_var)]) |
| 416 |
} else {
|
|
| 417 | ! |
NULL |
| 418 |
}), |
|
| 419 | ! |
marker_shape = .(if (marker_var != "None") {
|
| 420 | ! |
bquote(ANL_f[, .(marker_var)]) |
| 421 |
} else {
|
|
| 422 | ! |
NULL |
| 423 |
}), |
|
| 424 | ! |
marker_size = 4, |
| 425 | ! |
datalabel_txt = lbl, |
| 426 | ! |
facet_rows = .(if (!is.null(yfacet_var)) {
|
| 427 | ! |
bquote(data.frame(ANL_f[, .(yfacet_var)])) |
| 428 |
} else {
|
|
| 429 | ! |
NULL |
| 430 |
}), |
|
| 431 | ! |
facet_columns = .(if (!is.null(xfacet_var)) {
|
| 432 | ! |
bquote(data.frame(ANL_f[, .(xfacet_var)])) |
| 433 |
} else {
|
|
| 434 | ! |
NULL |
| 435 |
}), |
|
| 436 | ! |
vref_line = .(vref_line), |
| 437 | ! |
href_line = .(href_line), |
| 438 | ! |
x_label = if (is.null(formatters::var_labels(ADTR[.(x_var)], fill = FALSE))) {
|
| 439 | ! |
.(x_var) |
| 440 |
} else {
|
|
| 441 | ! |
formatters::var_labels(ADTR[.(x_var)], fill = FALSE) |
| 442 |
}, |
|
| 443 | ! |
y_label = if (is.null(formatters::var_labels(ADTR[.(y_var)], fill = FALSE))) {
|
| 444 | ! |
.(y_var) |
| 445 |
} else {
|
|
| 446 | ! |
formatters::var_labels(ADTR[.(y_var)], fill = FALSE) |
| 447 |
}, |
|
| 448 | ! |
show_legend = .(legend_on) |
| 449 |
) |
|
| 450 |
}) |
|
| 451 |
) |
|
| 452 |
}) |
|
| 453 | ||
| 454 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 455 | ||
| 456 | ! |
pws <- teal.widgets::plot_with_settings_srv( |
| 457 | ! |
id = "spiderplot", |
| 458 | ! |
plot_r = plot_r, |
| 459 | ! |
height = plot_height, |
| 460 | ! |
width = plot_width |
| 461 |
) |
|
| 462 | ||
| 463 | ! |
set_chunk_dims(pws, output_q) |
| 464 |
}) |
|
| 465 |
} |
| 1 |
#' Patient Profile plot teal module |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' Display patient profile plot as a shiny module |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param patient_id (`choices_seleced`) unique subject ID variable |
|
| 11 |
#' @param sl_dataname (`character`) subject level dataset name, |
|
| 12 |
#' needs to be available in the list passed to the `data` |
|
| 13 |
#' argument of [teal::init()] |
|
| 14 |
#' @param ex_dataname,ae_dataname,rs_dataname,cm_dataname,lb_dataname |
|
| 15 |
#' (`character(1)`) names of exposure, adverse events, response, |
|
| 16 |
#' concomitant medications, and labs datasets, respectively; |
|
| 17 |
#' must be available in the list passed to the `data` |
|
| 18 |
#' argument of [teal::init()]\cr |
|
| 19 |
#' set to NA (default) to omit from analysis |
|
| 20 |
#' @param sl_start_date `choices_selected` study start date variable, usually set to |
|
| 21 |
#' treatment start date or randomization date |
|
| 22 |
#' @param ex_var `choices_selected` exposure variable to plot as each line \cr |
|
| 23 |
#' leave unspecified or set to `NULL` if exposure data is not available |
|
| 24 |
#' @param ae_var `choices_selected` adverse event variable to plot as each line \cr |
|
| 25 |
#' leave unspecified or set to `NULL` if adverse events data is not available |
|
| 26 |
#' @param ae_line_col_var `choices_selected` variable for coloring `AE` lines \cr |
|
| 27 |
#' leave unspecified or set to `NULL` if adverse events data is not available |
|
| 28 |
#' @param ae_line_col_opt aesthetic values to map color values |
|
| 29 |
#' (named vector to map color values to each name). |
|
| 30 |
#' If not `NULL`, please make sure this contains all possible |
|
| 31 |
#' values for `ae_line_col_var` values. \cr |
|
| 32 |
#' leave unspecified or set to `NULL` if adverse events data is not available |
|
| 33 |
#' @param rs_var `choices_selected` response variable to plot as each line \cr |
|
| 34 |
#' leave unspecified or set to `NULL` if response data is not available |
|
| 35 |
#' @param cm_var `choices_selected` concomitant medication variable |
|
| 36 |
#' to plot as each line \cr |
|
| 37 |
#' leave unspecified or set to `NULL` if concomitant medications data is not available |
|
| 38 |
#' @param lb_var `choices_selected` lab variable to plot as each line \cr |
|
| 39 |
#' leave unspecified or set to `NULL` if labs data is not available |
|
| 40 |
#' @param x_limit a single `character` string with two numbers |
|
| 41 |
#' separated by a comma indicating the x-axis limit, |
|
| 42 |
#' default is "-28, 365" |
|
| 43 |
#' |
|
| 44 |
#' @author Xuefeng Hou (houx14) \email{houx14@gene.com}
|
|
| 45 |
#' @author Tina Cho (chot) \email{tina.cho@roche.com}
|
|
| 46 |
#' @author Molly He (hey59) \email{hey59@gene.com}
|
|
| 47 |
#' @template author_qit3 |
|
| 48 |
#' |
|
| 49 |
#' @inherit argument_convention return |
|
| 50 |
#' @inheritSection teal::example_module Reporting |
|
| 51 |
#' |
|
| 52 |
#' @details |
|
| 53 |
#' As the patient profile module plots different domains in one plot, the study day (x-axis) |
|
| 54 |
#' is derived for consistency based the start date of user's choice in the app (for example, |
|
| 55 |
#' `ADSL.RANDDT` or `ADSL.TRTSDT`): |
|
| 56 |
#' - In `ADAE`, `ADEX`, and `ADCM`, it would be study day based on `ASTDT` and/or |
|
| 57 |
#' `AENDT` in reference to the start date |
|
| 58 |
#' - In `ADRS` and `ADLB`, it would be study day based on `ADT` in reference to |
|
| 59 |
#' the start date |
|
| 60 |
#' |
|
| 61 |
#' @export |
|
| 62 |
#' |
|
| 63 |
#' @examples |
|
| 64 |
#' data <- teal_data() |> |
|
| 65 |
#' within({
|
|
| 66 |
#' library(nestcolor) |
|
| 67 |
#' library(dplyr) |
|
| 68 |
#' ADSL <- rADSL |
|
| 69 |
#' ADAE <- rADAE %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM)) |
|
| 70 |
#' ADCM <- rADCM %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM)) |
|
| 71 |
#' # The step below is to pre-process ADCM to legacy standard |
|
| 72 |
#' ADCM <- ADCM %>% |
|
| 73 |
#' select(-starts_with("ATC")) %>%
|
|
| 74 |
#' unique() |
|
| 75 |
#' ADRS <- rADRS %>% mutate(ADT = as.Date(ADTM)) |
|
| 76 |
#' ADEX <- rADEX %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM)) |
|
| 77 |
#' ADLB <- rADLB %>% mutate(ADT = as.Date(ADTM), LBSTRESN = as.numeric(LBSTRESC)) |
|
| 78 |
#' }) |
|
| 79 |
#' |
|
| 80 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 81 |
#' |
|
| 82 |
#' ADSL <- data[["ADSL"]] |
|
| 83 |
#' |
|
| 84 |
#' app <- init( |
|
| 85 |
#' data = data, |
|
| 86 |
#' modules = modules( |
|
| 87 |
#' tm_g_patient_profile( |
|
| 88 |
#' label = "Patient Profile Plot", |
|
| 89 |
#' patient_id = choices_selected( |
|
| 90 |
#' choices = unique(ADSL$USUBJID), |
|
| 91 |
#' selected = unique(ADSL$USUBJID)[1] |
|
| 92 |
#' ), |
|
| 93 |
#' sl_dataname = "ADSL", |
|
| 94 |
#' ex_dataname = "ADEX", |
|
| 95 |
#' ae_dataname = "ADAE", |
|
| 96 |
#' rs_dataname = "ADRS", |
|
| 97 |
#' cm_dataname = "ADCM", |
|
| 98 |
#' lb_dataname = "ADLB", |
|
| 99 |
#' sl_start_date = choices_selected( |
|
| 100 |
#' selected = "TRTSDTM", |
|
| 101 |
#' choices = c("TRTSDTM", "RANDDT")
|
|
| 102 |
#' ), |
|
| 103 |
#' ex_var = choices_selected( |
|
| 104 |
#' selected = "PARCAT2", |
|
| 105 |
#' choices = "PARCAT2" |
|
| 106 |
#' ), |
|
| 107 |
#' ae_var = choices_selected( |
|
| 108 |
#' selected = "AEDECOD", |
|
| 109 |
#' choices = c("AEDECOD", "AESOC")
|
|
| 110 |
#' ), |
|
| 111 |
#' ae_line_col_var = choices_selected( |
|
| 112 |
#' selected = "AESER", |
|
| 113 |
#' choices = c("AESER", "AEREL")
|
|
| 114 |
#' ), |
|
| 115 |
#' ae_line_col_opt = c("Y" = "red", "N" = "blue"),
|
|
| 116 |
#' rs_var = choices_selected( |
|
| 117 |
#' selected = "PARAMCD", |
|
| 118 |
#' choices = "PARAMCD" |
|
| 119 |
#' ), |
|
| 120 |
#' cm_var = choices_selected( |
|
| 121 |
#' selected = "CMDECOD", |
|
| 122 |
#' choices = c("CMDECOD", "CMCAT")
|
|
| 123 |
#' ), |
|
| 124 |
#' lb_var = choices_selected( |
|
| 125 |
#' selected = "LBTESTCD", |
|
| 126 |
#' choices = c("LBTESTCD", "LBCAT")
|
|
| 127 |
#' ), |
|
| 128 |
#' x_limit = "-28, 750", |
|
| 129 |
#' plot_height = c(1200, 400, 5000) |
|
| 130 |
#' ) |
|
| 131 |
#' ) |
|
| 132 |
#' ) |
|
| 133 |
#' if (interactive()) {
|
|
| 134 |
#' shinyApp(app$ui, app$server) |
|
| 135 |
#' } |
|
| 136 |
#' |
|
| 137 |
tm_g_patient_profile <- function(label = "Patient Profile Plot", |
|
| 138 |
patient_id, |
|
| 139 |
sl_dataname, |
|
| 140 |
ex_dataname = NA, |
|
| 141 |
ae_dataname = NA, |
|
| 142 |
rs_dataname = NA, |
|
| 143 |
cm_dataname = NA, |
|
| 144 |
lb_dataname = NA, |
|
| 145 |
sl_start_date, |
|
| 146 |
ex_var = NULL, |
|
| 147 |
ae_var = NULL, |
|
| 148 |
ae_line_col_var = NULL, |
|
| 149 |
ae_line_col_opt = NULL, |
|
| 150 |
rs_var = NULL, |
|
| 151 |
cm_var = NULL, |
|
| 152 |
lb_var = NULL, |
|
| 153 |
x_limit = "-28, 365", |
|
| 154 |
plot_height = c(1200L, 400L, 5000L), |
|
| 155 |
plot_width = NULL, |
|
| 156 |
pre_output = NULL, |
|
| 157 |
post_output = NULL, |
|
| 158 |
transformators = list()) {
|
|
| 159 | ! |
args <- as.list(environment()) |
| 160 | ! |
checkmate::assert_string(label) |
| 161 | ! |
checkmate::assert_string(sl_dataname) |
| 162 | ! |
checkmate::assert_string(ex_dataname, na.ok = TRUE) |
| 163 | ! |
checkmate::assert_string(ae_dataname, na.ok = TRUE) |
| 164 | ! |
checkmate::assert_string(rs_dataname, na.ok = TRUE) |
| 165 | ! |
checkmate::assert_string(cm_dataname, na.ok = TRUE) |
| 166 | ! |
checkmate::assert_string(lb_dataname, na.ok = TRUE) |
| 167 | ! |
checkmate::assert_character( |
| 168 | ! |
c(sl_dataname, ex_dataname, rs_dataname, cm_dataname, lb_dataname), |
| 169 | ! |
any.missing = TRUE, all.missing = FALSE |
| 170 |
) |
|
| 171 | ! |
checkmate::assert_class(sl_start_date, classes = "choices_selected") |
| 172 | ! |
checkmate::assert_class(ex_var, classes = "choices_selected", null.ok = TRUE) |
| 173 | ! |
checkmate::assert_class(ae_var, classes = "choices_selected", null.ok = TRUE) |
| 174 | ! |
checkmate::assert_class(ae_line_col_var, classes = "choices_selected", null.ok = TRUE) |
| 175 | ! |
checkmate::assert_class(rs_var, classes = "choices_selected", null.ok = TRUE) |
| 176 | ! |
checkmate::assert_class(cm_var, classes = "choices_selected", null.ok = TRUE) |
| 177 | ! |
checkmate::assert_class(lb_var, classes = "choices_selected", null.ok = TRUE) |
| 178 | ! |
checkmate::assert_string(x_limit) |
| 179 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 180 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 181 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 182 | ! |
checkmate::assert_numeric( |
| 183 | ! |
plot_width[1], |
| 184 | ! |
lower = plot_width[2], |
| 185 | ! |
upper = plot_width[3], |
| 186 | ! |
null.ok = TRUE, |
| 187 | ! |
.var.name = "plot_width" |
| 188 |
) |
|
| 189 | ||
| 190 | ! |
module( |
| 191 | ! |
label = label, |
| 192 | ! |
ui = ui_g_patient_profile, |
| 193 | ! |
ui_args = args, |
| 194 | ! |
server = srv_g_patient_profile, |
| 195 | ! |
server_args = list( |
| 196 | ! |
patient_id = patient_id, |
| 197 | ! |
sl_dataname = sl_dataname, |
| 198 | ! |
ex_dataname = ex_dataname, |
| 199 | ! |
ae_dataname = ae_dataname, |
| 200 | ! |
rs_dataname = rs_dataname, |
| 201 | ! |
cm_dataname = cm_dataname, |
| 202 | ! |
lb_dataname = lb_dataname, |
| 203 | ! |
ae_line_col_opt = ae_line_col_opt, |
| 204 | ! |
label = label, |
| 205 | ! |
plot_height = plot_height, |
| 206 | ! |
plot_width = plot_width |
| 207 |
), |
|
| 208 | ! |
transformators = transformators, |
| 209 | ! |
datanames = "all" |
| 210 |
) |
|
| 211 |
} |
|
| 212 | ||
| 213 |
ui_g_patient_profile <- function(id, ...) {
|
|
| 214 | ! |
a <- list(...) |
| 215 | ! |
ns <- NS(id) |
| 216 | ! |
checkboxes <- c(a$ex_dataname, a$ae_dataname, a$rs_dataname, a$lb_dataname, a$cm_dataname) |
| 217 | ||
| 218 | ! |
shiny::tagList( |
| 219 | ! |
teal.widgets::standard_layout( |
| 220 | ! |
output = teal.widgets::white_small_well( |
| 221 | ! |
teal.widgets::plot_with_settings_ui(id = ns("patientprofileplot"))
|
| 222 |
), |
|
| 223 | ! |
encoding = tags$div( |
| 224 | ! |
tags$label("Encodings", class = "text-primary"),
|
| 225 | ! |
selectizeInput( |
| 226 | ! |
inputId = ns("patient_id"),
|
| 227 | ! |
label = "Patient ID", |
| 228 | ! |
choices = NULL |
| 229 |
), |
|
| 230 | ! |
tags$div( |
| 231 | ! |
tagList( |
| 232 | ! |
helpText("Select", tags$code("ADaM"), "Domains"),
|
| 233 | ! |
checkboxGroupInput( |
| 234 | ! |
inputId = ns("select_ADaM"),
|
| 235 | ! |
label = NULL, |
| 236 | ! |
choices = checkboxes[!is.na(checkboxes)], |
| 237 | ! |
selected = checkboxes[!is.na(checkboxes)] |
| 238 |
) |
|
| 239 |
) |
|
| 240 |
), |
|
| 241 | ! |
teal.widgets::optionalSelectInput( |
| 242 | ! |
ns("sl_start_date"),
|
| 243 | ! |
"Start date variable", |
| 244 | ! |
choices = get_choices(a$sl_start_date$choices), |
| 245 | ! |
selected = a$sl_start_date$selected, |
| 246 | ! |
multiple = FALSE, |
| 247 | ! |
label_help = helpText( |
| 248 | ! |
"from ", tags$code("ADSL")
|
| 249 |
) |
|
| 250 |
), |
|
| 251 | ! |
conditionalPanel( |
| 252 | ! |
condition = sprintf("input['select_ADaM'].includes('%s')", a$ex_dataname),
|
| 253 | ! |
ns = ns, |
| 254 | ! |
selectInput( |
| 255 | ! |
ns("ex_var"),
|
| 256 | ! |
"Exposure variable", |
| 257 | ! |
choices = get_choices(a$ex_var$choices), |
| 258 | ! |
selected = a$ex_var$selected, |
| 259 | ! |
multiple = FALSE |
| 260 |
) |
|
| 261 |
), |
|
| 262 | ! |
conditionalPanel( |
| 263 | ! |
condition = sprintf("input['select_ADaM'].includes('%s')", a$ae_dataname),
|
| 264 | ! |
ns = ns, |
| 265 | ! |
teal.widgets::optionalSelectInput( |
| 266 | ! |
ns("ae_var"),
|
| 267 | ! |
"Adverse Event variable", |
| 268 | ! |
choices = get_choices(a$ae_var$choices), |
| 269 | ! |
selected = a$ae_var$selected, |
| 270 | ! |
multiple = FALSE |
| 271 |
), |
|
| 272 | ! |
teal.widgets::optionalSelectInput( |
| 273 | ! |
ns("ae_line_var"),
|
| 274 | ! |
"Adverse Event line color variable", |
| 275 | ! |
choices = get_choices(a$ae_line_col_var$choices), |
| 276 | ! |
selected = a$ae_line_col_var$selected, |
| 277 | ! |
multiple = FALSE |
| 278 |
) |
|
| 279 |
), |
|
| 280 | ! |
conditionalPanel( |
| 281 | ! |
condition = sprintf("input['select_ADaM'].includes('%s')", a$rs_dataname),
|
| 282 | ! |
ns = ns, |
| 283 | ! |
teal.widgets::optionalSelectInput( |
| 284 | ! |
ns("rs_var"),
|
| 285 | ! |
"Tumor response variable", |
| 286 | ! |
choices = get_choices(a$rs_var$choices), |
| 287 | ! |
selected = a$rs_var$selected, |
| 288 | ! |
multiple = FALSE |
| 289 |
) |
|
| 290 |
), |
|
| 291 | ! |
conditionalPanel( |
| 292 | ! |
condition = sprintf("input['select_ADaM'].includes('%s')", a$cm_dataname),
|
| 293 | ! |
ns = ns, |
| 294 | ! |
teal.widgets::optionalSelectInput( |
| 295 | ! |
ns("cm_var"),
|
| 296 | ! |
"Concomitant medicine variable", |
| 297 | ! |
choices = get_choices(a$cm_var$choices), |
| 298 | ! |
selected = a$cm_var$selected, |
| 299 | ! |
multiple = FALSE |
| 300 |
) |
|
| 301 |
), |
|
| 302 | ! |
conditionalPanel( |
| 303 | ! |
condition = sprintf("input['select_ADaM'].includes('%s')", a$lb_dataname),
|
| 304 | ! |
ns = ns, |
| 305 | ! |
teal.widgets::optionalSelectInput( |
| 306 | ! |
ns("lb_var"),
|
| 307 | ! |
"Lab variable", |
| 308 | ! |
choices = get_choices(a$lb_var$choices), |
| 309 | ! |
selected = a$lb_var$selected, |
| 310 | ! |
multiple = FALSE |
| 311 |
), |
|
| 312 | ! |
selectInput( |
| 313 | ! |
ns("lb_var_show"),
|
| 314 | ! |
"Lab values", |
| 315 | ! |
choices = get_choices(a$lb_var$choices), |
| 316 | ! |
selected = a$lb_var$selected, |
| 317 | ! |
multiple = TRUE |
| 318 |
) |
|
| 319 |
), |
|
| 320 | ! |
textInput( |
| 321 | ! |
ns("x_limit"),
|
| 322 | ! |
label = tags$div( |
| 323 | ! |
"Study Days Range", |
| 324 | ! |
tags$br(), |
| 325 | ! |
helpText("Enter TWO numeric values of study days range, separated by comma (eg. -28, 750)")
|
| 326 |
), |
|
| 327 | ! |
value = a$x_limit |
| 328 |
) |
|
| 329 |
), |
|
| 330 | ! |
pre_output = a$pre_output, |
| 331 | ! |
post_output = a$post_output |
| 332 |
) |
|
| 333 |
) |
|
| 334 |
} |
|
| 335 | ||
| 336 |
srv_g_patient_profile <- function(id, |
|
| 337 |
data, |
|
| 338 |
patient_id, |
|
| 339 |
sl_dataname, |
|
| 340 |
ex_dataname, |
|
| 341 |
ae_dataname, |
|
| 342 |
rs_dataname, |
|
| 343 |
lb_dataname, |
|
| 344 |
cm_dataname, |
|
| 345 |
label, |
|
| 346 |
ae_line_col_opt, |
|
| 347 |
plot_height, |
|
| 348 |
plot_width) {
|
|
| 349 | ! |
checkmate::assert_class(data, "reactive") |
| 350 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 351 | ! |
if (!is.na(ex_dataname)) checkmate::assert_names(ex_dataname, subset.of = names(data)) |
| 352 | ! |
if (!is.na(ae_dataname)) checkmate::assert_names(ae_dataname, subset.of = names(data)) |
| 353 | ! |
if (!is.na(rs_dataname)) checkmate::assert_names(rs_dataname, subset.of = names(data)) |
| 354 | ! |
if (!is.na(lb_dataname)) checkmate::assert_names(lb_dataname, subset.of = names(data)) |
| 355 | ! |
if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data)) |
| 356 | ! |
checkboxes <- c(ex_dataname, ae_dataname, rs_dataname, lb_dataname, cm_dataname) |
| 357 | ! |
moduleServer(id, function(input, output, session) {
|
| 358 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 359 | ! |
select_plot <- reactive( |
| 360 | ! |
vapply(checkboxes, function(x) x %in% input$select_ADaM, logical(1L)) |
| 361 |
) |
|
| 362 | ||
| 363 | ! |
resolved <- teal.transform::resolve_delayed(patient_id, as.list(isolate(data()))) |
| 364 | ||
| 365 | ! |
updateSelectizeInput( |
| 366 | ! |
session = session, |
| 367 | ! |
inputId = "patient_id", |
| 368 | ! |
choices = resolved$choices, |
| 369 | ! |
selected = resolved$selected |
| 370 |
) |
|
| 371 | ||
| 372 | ! |
if (!is.na(lb_dataname)) {
|
| 373 | ! |
observeEvent(input$lb_var, ignoreNULL = TRUE, {
|
| 374 | ! |
ADLB <- data()[[lb_dataname]] |
| 375 | ! |
choices <- unique(ADLB[[input$lb_var]]) |
| 376 | ! |
choices_selected <- if (length(choices) > 5) choices[1:5] else choices |
| 377 | ||
| 378 | ! |
updateSelectInput( |
| 379 | ! |
session, |
| 380 | ! |
"lb_var_show", |
| 381 | ! |
selected = choices_selected, |
| 382 | ! |
choices = choices |
| 383 |
) |
|
| 384 |
}) |
|
| 385 |
} |
|
| 386 | ||
| 387 | ! |
iv <- reactive({
|
| 388 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 389 | ! |
iv$add_rule("select_ADaM", shinyvalidate::sv_required(
|
| 390 | ! |
message = "At least one ADaM data set is required" |
| 391 |
)) |
|
| 392 | ! |
iv$add_rule("sl_start_date", shinyvalidate::sv_required(
|
| 393 | ! |
message = "Date variable is required" |
| 394 |
)) |
|
| 395 | ! |
if (isTRUE(select_plot()[ex_dataname])) {
|
| 396 | ! |
iv$add_rule("ex_var", shinyvalidate::sv_required(
|
| 397 | ! |
message = "Exposure variable is required" |
| 398 |
)) |
|
| 399 |
} |
|
| 400 | ! |
if (isTRUE(select_plot()[ae_dataname])) {
|
| 401 | ! |
iv$add_rule("ae_var", shinyvalidate::sv_required(
|
| 402 | ! |
message = "Adverse Event variable is required" |
| 403 |
)) |
|
| 404 | ! |
iv$add_rule("ae_line_var", shinyvalidate::sv_optional())
|
| 405 | ! |
iv$add_rule("ae_line_var", ~ if (length(levels(data()[[ae_dataname]][[.]])) > length(ae_line_col_opt)) {
|
| 406 | ! |
"Not enough colors provided for Adverse Event line color, unselect" |
| 407 |
}) |
|
| 408 |
} |
|
| 409 | ! |
if (isTRUE(select_plot()[rs_dataname])) {
|
| 410 | ! |
iv$add_rule("rs_var", shinyvalidate::sv_required(
|
| 411 | ! |
message = "Tumor response variable is required" |
| 412 |
)) |
|
| 413 |
} |
|
| 414 | ! |
if (isTRUE(select_plot()[cm_dataname])) {
|
| 415 | ! |
iv$add_rule("cm_var", shinyvalidate::sv_required(
|
| 416 | ! |
message = "Concomitant medicine variable is required" |
| 417 |
)) |
|
| 418 |
} |
|
| 419 | ! |
if (isTRUE(select_plot()[lb_dataname])) {
|
| 420 | ! |
iv$add_rule("lb_var", shinyvalidate::sv_required(
|
| 421 | ! |
message = "Lab variable is required" |
| 422 |
)) |
|
| 423 | ! |
iv$add_rule("lb_var_show", shinyvalidate::sv_required(
|
| 424 | ! |
message = "At least one Lab value is required" |
| 425 |
)) |
|
| 426 | ! |
rule_diff <- function(value, other) {
|
| 427 | ! |
if (isTRUE(any(value == other))) {
|
| 428 | ! |
"Lab variable and Lab value must be different" |
| 429 |
} |
|
| 430 |
} |
|
| 431 | ! |
iv$add_rule("lb_var", rule_diff, other = input$lb_var_show)
|
| 432 | ! |
iv$add_rule("lb_var_show", rule_diff, other = input$lb_var)
|
| 433 |
} |
|
| 434 | ! |
iv$add_rule("x_limit", shinyvalidate::sv_required(
|
| 435 | ! |
message = "Study Days Range is required" |
| 436 |
)) |
|
| 437 | ! |
iv$add_rule("x_limit", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
| 438 | ! |
"Study Days Range is invalid" |
| 439 |
}) |
|
| 440 | ! |
iv$add_rule("x_limit", ~ if (length(suppressWarnings(as_numeric_from_comma_sep_str(.))) != 2L) {
|
| 441 | ! |
"Study Days Range must be two values" |
| 442 |
}) |
|
| 443 | ! |
iv$add_rule("x_limit", ~ if (!identical(order(suppressWarnings(as_numeric_from_comma_sep_str(.))), 1:2)) {
|
| 444 | ! |
"Study Days Range mut be: first lower, then upper limit" |
| 445 |
}) |
|
| 446 | ! |
iv$enable() |
| 447 | ! |
iv |
| 448 |
}) |
|
| 449 | ||
| 450 |
# render plot |
|
| 451 | ! |
output_q <- shiny::debounce( |
| 452 | ! |
millis = 200, |
| 453 | ! |
r = reactive({
|
| 454 | ! |
obj <- data() |
| 455 | ! |
teal.reporter::teal_card(obj) <- |
| 456 | ! |
c( |
| 457 | ! |
teal.reporter::teal_card(obj), |
| 458 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 459 |
) |
|
| 460 | ! |
obj <- teal.code::eval_code(obj, "library(dplyr)") |
| 461 | ||
| 462 | ! |
teal::validate_inputs(iv()) |
| 463 | ||
| 464 |
# get inputs --- |
|
| 465 | ! |
patient_id <- input$patient_id |
| 466 | ! |
sl_start_date <- input$sl_start_date |
| 467 | ! |
ae_var <- input$ae_var |
| 468 | ! |
ae_line_col_var <- input$ae_line_var |
| 469 | ! |
rs_var <- input$rs_var |
| 470 | ! |
cm_var <- input$cm_var |
| 471 | ! |
ex_var <- input$ex_var |
| 472 | ! |
lb_var <- input$lb_var |
| 473 | ! |
x_limit <- input$x_limit |
| 474 | ! |
lb_var_show <- input$lb_var_show |
| 475 | ||
| 476 | ! |
adrs_vars <- unique(c( |
| 477 | ! |
"USUBJID", "STUDYID", "PARAMCD", |
| 478 | ! |
"PARAM", "AVALC", "AVAL", "ADY", |
| 479 | ! |
"ADT", rs_var |
| 480 |
)) |
|
| 481 | ! |
adae_vars <- unique(c( |
| 482 | ! |
"USUBJID", "STUDYID", "ASTDT", |
| 483 | ! |
"AENDT", "AESOC", "AEDECOD", |
| 484 | ! |
"AESER", "AETOXGR", "AEREL", |
| 485 | ! |
"ASTDY", "AENDY", |
| 486 | ! |
ae_var, ae_line_col_var |
| 487 |
)) |
|
| 488 | ! |
adcm_vars <- unique(c( |
| 489 | ! |
"USUBJID", "STUDYID", "ASTDT", |
| 490 | ! |
"AENDT", "ASTDT", "CMDECOD", |
| 491 | ! |
"ASTDY", "AENDY", "CMCAT", |
| 492 | ! |
cm_var |
| 493 |
)) |
|
| 494 | ! |
adex_vars <- unique(c( |
| 495 | ! |
"USUBJID", "STUDYID", "ASTDT", |
| 496 | ! |
"AENDT", "PARCAT2", "AVAL", |
| 497 | ! |
"AVALU", "PARAMCD", "PARCAT1", |
| 498 | ! |
"PARCAT2", ex_var |
| 499 |
)) |
|
| 500 | ! |
adlb_vars <- unique(c( |
| 501 | ! |
"USUBJID", "STUDYID", "ANRIND", "LBSEQ", |
| 502 | ! |
"PARAMCD", "BASETYPE", "ADT", "AVISITN", |
| 503 | ! |
"LBSTRESN", "LBCAT", "LBTESTCD", |
| 504 | ! |
lb_var |
| 505 |
)) |
|
| 506 | ||
| 507 |
# get ADSL dataset --- |
|
| 508 | ! |
ADSL <- obj[[sl_dataname]] |
| 509 | ||
| 510 | ! |
ADEX <- NULL |
| 511 | ! |
if (isTRUE(select_plot()[ex_dataname])) {
|
| 512 | ! |
ADEX <- obj[[ex_dataname]] |
| 513 | ! |
teal::validate_has_variable(ADEX, adex_vars) |
| 514 |
} |
|
| 515 | ! |
ADAE <- NULL |
| 516 | ! |
if (isTRUE(select_plot()[ae_dataname])) {
|
| 517 | ! |
ADAE <- obj[[ae_dataname]] |
| 518 | ! |
teal::validate_has_variable(ADAE, adae_vars) |
| 519 |
} |
|
| 520 | ! |
ADRS <- NULL |
| 521 | ! |
if (isTRUE(select_plot()[rs_dataname])) {
|
| 522 | ! |
ADRS <- obj[[rs_dataname]] |
| 523 | ! |
teal::validate_has_variable(ADRS, adrs_vars) |
| 524 |
} |
|
| 525 | ! |
ADCM <- NULL |
| 526 | ! |
if (isTRUE(select_plot()[cm_dataname])) {
|
| 527 | ! |
ADCM <- obj[[cm_dataname]] |
| 528 | ! |
teal::validate_has_variable(ADCM, adcm_vars) |
| 529 |
} |
|
| 530 | ! |
ADLB <- NULL |
| 531 | ! |
if (isTRUE(select_plot()[lb_dataname])) {
|
| 532 | ! |
ADLB <- obj[[lb_dataname]] |
| 533 | ! |
teal::validate_has_variable(ADLB, adlb_vars) |
| 534 |
} |
|
| 535 | ||
| 536 | ! |
empty_rs <- FALSE |
| 537 | ! |
empty_ae <- FALSE |
| 538 | ! |
empty_cm <- FALSE |
| 539 | ! |
empty_ex <- FALSE |
| 540 | ! |
empty_lb <- FALSE |
| 541 | ||
| 542 | ! |
q1 <- teal.code::eval_code( |
| 543 | ! |
obj, |
| 544 | ! |
code = substitute( |
| 545 | ! |
expr = {
|
| 546 | ! |
ADSL <- ADSL %>% |
| 547 | ! |
filter(USUBJID == patient_id) %>% |
| 548 | ! |
group_by(USUBJID) %>% |
| 549 | ! |
mutate( |
| 550 | ! |
max_date = pmax(as.Date(LSTALVDT), as.Date(DTHDT), na.rm = TRUE), |
| 551 | ! |
max_day = as.numeric(difftime(as.Date(max_date), as.Date(sl_start_date), units = "days")) + |
| 552 | ! |
(as.Date(max_date) >= as.Date(sl_start_date)) |
| 553 |
) |
|
| 554 |
}, |
|
| 555 | ! |
env = list( |
| 556 | ! |
ADSL = as.name(sl_dataname), |
| 557 | ! |
sl_start_date = as.name(sl_start_date), |
| 558 | ! |
patient_id = patient_id |
| 559 |
) |
|
| 560 |
) |
|
| 561 |
) |
|
| 562 | ||
| 563 |
# ADSL with single subject |
|
| 564 | ! |
validate( |
| 565 | ! |
need( |
| 566 | ! |
nrow(q1[["ADSL"]]) >= 1, |
| 567 | ! |
paste( |
| 568 | ! |
"Subject", |
| 569 | ! |
patient_id, |
| 570 | ! |
"not found in the dataset. Perhaps they have been filtered out by the filter panel?" |
| 571 |
) |
|
| 572 |
) |
|
| 573 |
) |
|
| 574 | ||
| 575 |
# name for ae_line_col |
|
| 576 | ! |
q1 <- if (!is.null(ae_line_col_var) && is.data.frame(ADAE)) {
|
| 577 | ! |
teal.code::eval_code( |
| 578 | ! |
q1, |
| 579 | ! |
code = substitute( |
| 580 | ! |
expr = ae_line_col_name <- formatters::var_labels(ADAE, fill = FALSE)[ae_line_col_var], |
| 581 | ! |
env = list(ADAE = as.name(ae_dataname), ae_line_col_var = ae_line_col_var) |
| 582 |
) |
|
| 583 |
) |
|
| 584 |
} else {
|
|
| 585 | ! |
teal.code::eval_code(q1, code = quote(ae_line_col_name <- NULL)) |
| 586 |
} |
|
| 587 | ||
| 588 | ! |
q1 <- if (isTRUE(select_plot()[ae_dataname])) {
|
| 589 | ! |
if (all(ADAE$USUBJID %in% ADSL$USUBJID)) {
|
| 590 | ! |
qq <- teal.code::eval_code( |
| 591 | ! |
q1, |
| 592 | ! |
code = substitute( |
| 593 | ! |
expr = {
|
| 594 |
# ADAE |
|
| 595 | ! |
ADAE <- ADAE[, adae_vars] |
| 596 | ||
| 597 | ! |
ADAE <- ADSL %>% |
| 598 | ! |
left_join(ADAE, by = c("STUDYID", "USUBJID")) %>%
|
| 599 | ! |
as.data.frame() %>% |
| 600 | ! |
filter(!is.na(ASTDT), !is.na(AENDT)) %>% |
| 601 | ! |
mutate( |
| 602 | ! |
ASTDY = as.numeric(difftime(ASTDT, as.Date(sl_start_date), units = "days")) + |
| 603 | ! |
(ASTDT >= as.Date(sl_start_date)), |
| 604 | ! |
AENDY = as.numeric(difftime(AENDT, as.Date(sl_start_date), units = "days")) + |
| 605 | ! |
(AENDT >= as.Date(sl_start_date)) |
| 606 |
) %>% |
|
| 607 | ! |
select(c(adae_vars, ASTDY, AENDY)) |
| 608 | ! |
formatters::var_labels(ADAE)[ae_line_col_var] <- |
| 609 | ! |
formatters::var_labels(ADAE, fill = FALSE)[ae_line_col_var] |
| 610 |
}, |
|
| 611 | ! |
env = list( |
| 612 | ! |
ADSL = as.name(sl_dataname), |
| 613 | ! |
ADAE = as.name(ae_dataname), |
| 614 | ! |
sl_start_date = as.name(sl_start_date), |
| 615 | ! |
ae_line_col_var = ae_line_col_var, |
| 616 | ! |
adae_vars = adae_vars |
| 617 |
) |
|
| 618 |
) |
|
| 619 |
) %>% |
|
| 620 | ! |
teal.code::eval_code( |
| 621 | ! |
code = substitute( |
| 622 | ! |
expr = ae <- list( |
| 623 | ! |
data = data.frame(ADAE), |
| 624 | ! |
var = as.vector(ADAE[, ae_var]), |
| 625 | ! |
line_col = line_col, |
| 626 | ! |
line_col_legend = line_col_legend, |
| 627 | ! |
line_col_opt = line_col_opt |
| 628 |
), |
|
| 629 | ! |
env = list( |
| 630 | ! |
ADAE = as.name(ae_dataname), |
| 631 | ! |
ae_var = ae_var, |
| 632 | ! |
line_col = if (!is.null(ae_line_col_var)) bquote(as.vector(ADAE[, .(ae_line_col_var)])) else NULL, |
| 633 | ! |
line_col_legend = ae_line_col_var, |
| 634 | ! |
line_col_opt = ae_line_col_opt |
| 635 |
) |
|
| 636 |
) |
|
| 637 |
) |
|
| 638 | ! |
ADAE <- qq[[ae_dataname]] |
| 639 | ! |
if (is.null(ADAE) | nrow(ADAE) == 0) {
|
| 640 | ! |
empty_ae <- TRUE |
| 641 |
} |
|
| 642 | ! |
|
| 643 |
} else {
|
|
| 644 | ! |
empty_ae <- TRUE |
| 645 | ! |
teal.code::eval_code(q1, code = quote(ae <- NULL)) |
| 646 |
} |
|
| 647 |
} else {
|
|
| 648 | ! |
teal.code::eval_code(q1, code = quote(ae <- NULL)) |
| 649 |
} |
|
| 650 | ||
| 651 | ! |
q1 <- if (isTRUE(select_plot()[rs_dataname])) {
|
| 652 | ! |
if (all(ADRS$USUBJID %in% ADSL$USUBJID)) {
|
| 653 | ! |
qq <- teal.code::eval_code( |
| 654 | ! |
q1, |
| 655 | ! |
code = substitute( |
| 656 | ! |
expr = {
|
| 657 | ! |
ADRS <- ADRS[, adrs_vars] |
| 658 | ! |
ADRS <- ADSL %>% |
| 659 | ! |
left_join(ADRS, by = c("STUDYID", "USUBJID")) %>%
|
| 660 | ! |
as.data.frame() %>% |
| 661 | ! |
mutate( |
| 662 | ! |
ADY = as.numeric(difftime(ADT, as.Date(sl_start_date), units = "days")) + |
| 663 | ! |
(ADT >= as.Date(sl_start_date)) |
| 664 |
) %>% |
|
| 665 | ! |
select(USUBJID, PARAMCD, PARAM, AVALC, AVAL, ADY, ADT) %>% |
| 666 | ! |
filter(is.na(ADY) == FALSE) |
| 667 | ! |
rs <- list(data = data.frame(ADRS), var = as.vector(ADRS[, rs_var])) |
| 668 |
}, |
|
| 669 | ! |
env = list( |
| 670 | ! |
ADRS = as.name(rs_dataname), |
| 671 | ! |
adrs_vars = adrs_vars, |
| 672 | ! |
sl_start_date = as.name(sl_start_date), |
| 673 | ! |
rs_var = rs_var |
| 674 |
) |
|
| 675 |
) |
|
| 676 |
) |
|
| 677 | ! |
ADRS <- qq[[rs_dataname]] |
| 678 | ! |
if (is.null(ADRS) || nrow(ADRS) == 0) {
|
| 679 | ! |
empty_rs <- TRUE |
| 680 |
} |
|
| 681 | ! |
|
| 682 |
} else {
|
|
| 683 | ! |
empty_rs <- TRUE |
| 684 | ! |
teal.code::eval_code(q1, expression = quote(rs <- NULL)) |
| 685 |
} |
|
| 686 |
} else {
|
|
| 687 | ! |
teal.code::eval_code(q1, code = quote(rs <- NULL)) |
| 688 |
} |
|
| 689 | ||
| 690 | ! |
q1 <- if (isTRUE(select_plot()[cm_dataname])) {
|
| 691 | ! |
if (all(ADCM$USUBJID %in% ADSL$USUBJID)) {
|
| 692 | ! |
qq <- teal.code::eval_code( |
| 693 | ! |
q1, |
| 694 | ! |
code = substitute( |
| 695 | ! |
expr = {
|
| 696 |
# ADCM |
|
| 697 | ! |
ADCM <- ADCM[, adcm_vars] |
| 698 | ! |
ADCM <- ADSL %>% |
| 699 | ! |
left_join(ADCM, by = c("STUDYID", "USUBJID")) %>%
|
| 700 | ! |
as.data.frame() %>% |
| 701 | ! |
filter(!is.na(ASTDT), !is.na(AENDT)) %>% |
| 702 | ! |
mutate( |
| 703 | ! |
ASTDY = as.numeric(difftime(ASTDT, as.Date(sl_start_date), units = "days")) + |
| 704 | ! |
(ASTDT >= as.Date(sl_start_date)), |
| 705 | ! |
AENDY = as.numeric(difftime(AENDT, as.Date(sl_start_date), units = "days")) + |
| 706 | ! |
(AENDT >= as.Date(sl_start_date)) |
| 707 |
) %>% |
|
| 708 | ! |
select(USUBJID, ASTDT, AENDT, ASTDY, AENDY, !!quo(cm_var)) |
| 709 | ! |
if (length(unique(ADCM$USUBJID)) > 0) {
|
| 710 | ! |
ADCM <- ADCM[which(ADCM$AENDY >= -28 | is.na(ADCM$AENDY) == TRUE & is.na(ADCM$ASTDY) == FALSE), ] |
| 711 |
} |
|
| 712 | ! |
cm <- list(data = data.frame(ADCM), var = as.vector(ADCM[, cm_var])) |
| 713 |
}, |
|
| 714 | ! |
env = list( |
| 715 | ! |
ADSL = as.name(sl_dataname), |
| 716 | ! |
ADCM = as.name(cm_dataname), |
| 717 | ! |
sl_start_date = as.name(sl_start_date), |
| 718 | ! |
adcm_vars = adcm_vars, |
| 719 | ! |
cm_var = cm_var |
| 720 |
) |
|
| 721 |
) |
|
| 722 |
) |
|
| 723 | ||
| 724 | ! |
ADCM <- qq[[cm_dataname]] |
| 725 | ! |
if (is.null(ADCM) | nrow(ADCM) == 0) {
|
| 726 | ! |
empty_cm <- TRUE |
| 727 |
} |
|
| 728 | ! |
|
| 729 |
} else {
|
|
| 730 | ! |
empty_cm <- TRUE |
| 731 | ! |
teal.code::eval_code(q1, code = quote(cm <- NULL)) |
| 732 |
} |
|
| 733 |
} else {
|
|
| 734 | ! |
teal.code::eval_code(q1, code = quote(cm <- NULL)) |
| 735 |
} |
|
| 736 | ||
| 737 | ! |
q1 <- if (isTRUE(select_plot()[ex_dataname])) {
|
| 738 | ! |
if (all(ADEX$USUBJID %in% ADSL$USUBJID)) {
|
| 739 | ! |
qq <- teal.code::eval_code( |
| 740 | ! |
q1, |
| 741 | ! |
code = substitute( |
| 742 | ! |
expr = {
|
| 743 |
# ADEX |
|
| 744 | ! |
ADEX <- ADEX[, adex_vars] |
| 745 | ! |
ADEX <- ADSL %>% |
| 746 | ! |
left_join(ADEX, by = c("STUDYID", "USUBJID")) %>%
|
| 747 | ! |
as.data.frame() %>% |
| 748 | ! |
filter(PARCAT1 == "INDIVIDUAL" & PARAMCD == "DOSE" & !is.na(AVAL) & !is.na(ASTDT)) %>% |
| 749 | ! |
select(USUBJID, ASTDT, PARCAT2, AVAL, AVALU, PARAMCD, sl_start_date) |
| 750 | ||
| 751 | ! |
ADEX <- split(ADEX, ADEX$USUBJID) %>% |
| 752 | ! |
lapply(function(pinfo) {
|
| 753 | ! |
pinfo %>% |
| 754 | ! |
arrange(PARCAT2, PARAMCD, ASTDT) %>% |
| 755 | ! |
ungroup() %>% |
| 756 | ! |
mutate( |
| 757 | ! |
diff = c(0, diff(AVAL, lag = 1)), |
| 758 | ! |
Modification = case_when( |
| 759 | ! |
diff < 0 ~ "Decrease", |
| 760 | ! |
diff > 0 ~ "Increase", |
| 761 | ! |
diff == 0 ~ "None" |
| 762 |
), |
|
| 763 | ! |
ASTDT_dur = as.numeric(difftime(as.Date(ASTDT), as.Date(sl_start_date), units = "days")) + |
| 764 | ! |
(as.Date(ASTDT) >= as.Date(sl_start_date)) |
| 765 |
) |
|
| 766 |
}) %>% |
|
| 767 | ! |
Reduce(rbind, .) %>% |
| 768 | ! |
as.data.frame() %>% |
| 769 | ! |
select(-diff) |
| 770 | ! |
ex <- list(data = data.frame(ADEX), var = as.vector(ADEX[, ex_var])) |
| 771 |
}, |
|
| 772 | ! |
env = list( |
| 773 | ! |
ADSL = as.name(sl_dataname), |
| 774 | ! |
ADEX = as.name(ex_dataname), |
| 775 | ! |
adex_vars = adex_vars, |
| 776 | ! |
sl_start_date = as.name(sl_start_date), |
| 777 | ! |
ex_var = ex_var |
| 778 |
) |
|
| 779 |
) |
|
| 780 |
) |
|
| 781 | ! |
ADEX <- qq[[ex_dataname]] |
| 782 | ! |
if (is.null(ADEX) | nrow(ADEX) == 0) {
|
| 783 | ! |
empty_ex <- TRUE |
| 784 |
} |
|
| 785 | ! |
|
| 786 |
} else {
|
|
| 787 | ! |
empty_ex <- TRUE |
| 788 | ! |
teal.code::eval_code(q1, code = quote(ex <- NULL)) |
| 789 |
} |
|
| 790 |
} else {
|
|
| 791 | ! |
teal.code::eval_code(q1, code = quote(ex <- NULL)) |
| 792 |
} |
|
| 793 | ||
| 794 | ! |
q1 <- if (isTRUE(select_plot()[lb_dataname])) {
|
| 795 | ! |
if (all(ADLB$USUBJID %in% ADSL$USUBJID)) {
|
| 796 | ! |
qq <- teal.code::eval_code( |
| 797 | ! |
q1, |
| 798 | ! |
code = substitute( |
| 799 | ! |
expr = {
|
| 800 | ! |
ADLB <- ADLB[, adlb_vars] |
| 801 | ! |
ADLB <- ADSL %>% |
| 802 | ! |
left_join(ADLB, by = c("STUDYID", "USUBJID")) %>%
|
| 803 | ! |
as.data.frame() %>% |
| 804 | ! |
mutate( |
| 805 | ! |
ANRIND = factor(ANRIND, levels = c("HIGH", "LOW", "NORMAL"))
|
| 806 |
) %>% |
|
| 807 | ! |
filter(!is.na(LBSTRESN) & !is.na(ANRIND) & .data[[lb_var]] %in% lb_var_show) %>% |
| 808 | ! |
as.data.frame() %>% |
| 809 | ! |
select( |
| 810 | ! |
USUBJID, STUDYID, LBSEQ, PARAMCD, BASETYPE, ADT, AVISITN, sl_start_date, LBTESTCD, ANRIND, lb_var |
| 811 |
) %>% |
|
| 812 | ! |
mutate( |
| 813 | ! |
ADY = as.numeric(difftime(ADT, as.Date(sl_start_date), units = "days")) + |
| 814 | ! |
(ADT >= as.Date(sl_start_date)) |
| 815 |
) |
|
| 816 | ! |
lb <- list(data = data.frame(ADLB), var = as.vector(ADLB[, lb_var])) |
| 817 |
}, |
|
| 818 | ! |
env = list( |
| 819 | ! |
ADLB = as.name(lb_dataname), |
| 820 | ! |
ADSL = as.name(sl_dataname), |
| 821 | ! |
adlb_vars = adlb_vars, |
| 822 | ! |
sl_start_date = as.name(sl_start_date), |
| 823 | ! |
lb_var = lb_var, |
| 824 | ! |
lb_var_show = lb_var_show |
| 825 |
) |
|
| 826 |
) |
|
| 827 |
) |
|
| 828 | ||
| 829 | ! |
ADLB <- qq[[lb_dataname]] |
| 830 | ! |
if (is.null(ADLB) | nrow(ADLB) == 0) {
|
| 831 | ! |
empty_lb <- TRUE |
| 832 |
} |
|
| 833 | ! |
|
| 834 |
} else {
|
|
| 835 | ! |
empty_lb <- TRUE |
| 836 | ! |
teal.code::eval_code(q1, code = quote(lb <- NULL)) |
| 837 |
} |
|
| 838 |
} else {
|
|
| 839 | ! |
teal.code::eval_code(q1, code = quote(lb <- NULL)) |
| 840 |
} |
|
| 841 | ||
| 842 |
# Check the subject has information in at least one selected domain |
|
| 843 | ! |
empty_data_check <- structure( |
| 844 | ! |
c(empty_ex, empty_ae, empty_rs, empty_lb, empty_cm), |
| 845 | ! |
names = checkboxes |
| 846 |
) |
|
| 847 | ||
| 848 | ! |
validate(need( |
| 849 | ! |
any(!empty_data_check & select_plot()), |
| 850 | ! |
"The subject does not have information in any selected domain." |
| 851 |
)) |
|
| 852 | ||
| 853 |
# Check the subject has information in all the selected domains |
|
| 854 | ! |
if (any(empty_data_check & select_plot())) {
|
| 855 | ! |
showNotification( |
| 856 | ! |
paste0( |
| 857 | ! |
"This subject does not have information in the ", |
| 858 | ! |
paste(checkboxes[empty_data_check & select_plot()], collapse = ", "), |
| 859 | ! |
" domain." |
| 860 |
), |
|
| 861 | ! |
duration = 8, |
| 862 | ! |
type = "warning" |
| 863 |
) |
|
| 864 |
} |
|
| 865 | ||
| 866 |
# Convert x_limit to numeric vector |
|
| 867 | ! |
if (!is.null(x_limit) || x_limit != "") {
|
| 868 | ! |
q1 <- teal.code::eval_code( |
| 869 | ! |
q1, |
| 870 | ! |
code = bquote(x_limit <- as.numeric(unlist(strsplit(.(x_limit), ",")))) |
| 871 |
) |
|
| 872 | ! |
x_limit <- q1[["x_limit"]] |
| 873 |
} |
|
| 874 | ||
| 875 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot") |
| 876 | ||
| 877 | ! |
q1 <- teal.code::eval_code( |
| 878 | ! |
q1, |
| 879 | ! |
code = substitute( |
| 880 | ! |
expr = {
|
| 881 | ! |
plot <- osprey::g_patient_profile( |
| 882 | ! |
ex = ex, |
| 883 | ! |
ae = ae, |
| 884 | ! |
rs = rs, |
| 885 | ! |
cm = cm, |
| 886 | ! |
lb = lb, |
| 887 | ! |
arrow_end_day = ADSL[["max_day"]], |
| 888 | ! |
xlim = x_limit, |
| 889 | ! |
xlab = "Study Day", |
| 890 | ! |
title = paste("Patient Profile: ", patient_id)
|
| 891 |
) |
|
| 892 | ! |
plot |
| 893 |
}, |
|
| 894 | ! |
env = list( |
| 895 | ! |
patient_id = patient_id, |
| 896 | ! |
ADSL = as.name(sl_dataname) |
| 897 |
) |
|
| 898 |
) |
|
| 899 |
) |
|
| 900 |
}) |
|
| 901 |
) |
|
| 902 | ||
| 903 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 904 | ||
| 905 | ! |
pws <- teal.widgets::plot_with_settings_srv( |
| 906 | ! |
id = "patientprofileplot", |
| 907 | ! |
plot_r = plot_r, |
| 908 | ! |
height = plot_height, |
| 909 | ! |
width = plot_width |
| 910 |
) |
|
| 911 | ||
| 912 | ! |
set_chunk_dims(pws, output_q) |
| 913 |
}) |
|
| 914 |
} |
| 1 |
#' Teal Module for Waterfall Plot |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' This is teal module that generates a waterfall plot for `ADaM` data |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param dataname_tr tumor burden analysis data used in teal module to plot as bar height, needs to |
|
| 11 |
#' be available in the list passed to the `data` argument of [teal::init()] |
|
| 12 |
#' @param dataname_rs response analysis data used in teal module to label response parameters, needs to |
|
| 13 |
#' be available in the list passed to the `data` argument of [teal::init()] |
|
| 14 |
#' @param bar_paramcd `choices_selected` parameter in tumor burden data that will be plotted as |
|
| 15 |
#' bar height |
|
| 16 |
#' @param bar_var `choices_selected` numeric variable from dataset to plot the bar height, e.g., `PCHG` |
|
| 17 |
#' @param bar_color_var `choices_selected` color by variable (subject level), `None` corresponds |
|
| 18 |
#' to `NULL` |
|
| 19 |
#' @param bar_color_opt aesthetic values to map color values (named vector to map color values to each name). |
|
| 20 |
#' If not `NULL`, please make sure this contains all possible values for `bar_color_var` values, |
|
| 21 |
#' otherwise color will be assigned by `ggplot` default, please note that `NULL` needs to be specified |
|
| 22 |
#' in this case |
|
| 23 |
#' @param sort_var `choices_selected` sort by variable (subject level), `None` corresponds |
|
| 24 |
#' to `NULL` |
|
| 25 |
#' @param add_label_var_sl `choices_selected` add label to bars (subject level), `None` |
|
| 26 |
#' corresponds to `NULL` |
|
| 27 |
#' @param add_label_paramcd_rs `choices_selected` add label to bars (response dataset), `None` |
|
| 28 |
#' corresponds to `NULL`. At least one of `add_label_var_sl` and `add_label_paramcd_rs` needs |
|
| 29 |
#' to be `NULL` |
|
| 30 |
#' @param anno_txt_var_sl `choices_selected` subject level variables to be displayed in the annotation |
|
| 31 |
#' table, default is `NULL` |
|
| 32 |
#' @param anno_txt_paramcd_rs `choices_selected` analysis dataset variables to be displayed in the |
|
| 33 |
#' annotation table, default is `NULL` |
|
| 34 |
#' @param facet_var `choices_selected` facet by variable (subject level), `None` corresponds to |
|
| 35 |
#' `NULL` |
|
| 36 |
#' @param ytick_at bar height axis interval, default is 20 |
|
| 37 |
#' @param href_line numeric vector to plot horizontal reference lines, default is `NULL` |
|
| 38 |
#' @param gap_point_val singular numeric value for adding bar break when some bars are significantly higher |
|
| 39 |
#' than others, default is `NULL` |
|
| 40 |
#' @param show_value boolean of whether value of bar height is shown, default is `TRUE` |
|
| 41 |
#' |
|
| 42 |
#' @inherit argument_convention return |
|
| 43 |
#' @inheritSection teal::example_module Reporting |
|
| 44 |
#' |
|
| 45 |
#' @export |
|
| 46 |
#' |
|
| 47 |
#' @template author_qit3 |
|
| 48 |
#' @author houx14 \email{houx14@gene.com}
|
|
| 49 |
#' |
|
| 50 |
#' @examples |
|
| 51 |
#' data <- teal_data() |> |
|
| 52 |
#' within({
|
|
| 53 |
#' library(nestcolor) |
|
| 54 |
#' ADSL <- rADSL |
|
| 55 |
#' ADRS <- rADRS |
|
| 56 |
#' ADTR <- rADTR |
|
| 57 |
#' ADSL$SEX <- factor(ADSL$SEX, levels = unique(ADSL$SEX)) |
|
| 58 |
#' }) |
|
| 59 |
#' |
|
| 60 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 61 |
#' |
|
| 62 |
#' app <- init( |
|
| 63 |
#' data = data, |
|
| 64 |
#' modules = modules( |
|
| 65 |
#' tm_g_waterfall( |
|
| 66 |
#' label = "Waterfall", |
|
| 67 |
#' dataname_tr = "ADTR", |
|
| 68 |
#' dataname_rs = "ADRS", |
|
| 69 |
#' bar_paramcd = choices_selected(c("SLDINV"), "SLDINV"),
|
|
| 70 |
#' bar_var = choices_selected(c("PCHG", "AVAL"), "PCHG"),
|
|
| 71 |
#' bar_color_var = choices_selected(c("ARMCD", "SEX"), "ARMCD"),
|
|
| 72 |
#' bar_color_opt = NULL, |
|
| 73 |
#' sort_var = choices_selected(c("ARMCD", "SEX"), NULL),
|
|
| 74 |
#' add_label_var_sl = choices_selected(c("SEX", "EOSDY"), NULL),
|
|
| 75 |
#' add_label_paramcd_rs = choices_selected(c("BESRSPI", "OBJRSPI"), NULL),
|
|
| 76 |
#' anno_txt_var_sl = choices_selected(c("SEX", "ARMCD", "BMK1", "BMK2"), NULL),
|
|
| 77 |
#' anno_txt_paramcd_rs = choices_selected(c("BESRSPI", "OBJRSPI"), NULL),
|
|
| 78 |
#' facet_var = choices_selected(c("SEX", "ARMCD", "STRATA1", "STRATA2"), NULL),
|
|
| 79 |
#' href_line = "-30, 20" |
|
| 80 |
#' ) |
|
| 81 |
#' ) |
|
| 82 |
#' ) |
|
| 83 |
#' if (interactive()) {
|
|
| 84 |
#' shinyApp(app$ui, app$server) |
|
| 85 |
#' } |
|
| 86 |
#' |
|
| 87 |
tm_g_waterfall <- function(label, |
|
| 88 |
dataname_tr = "ADTR", |
|
| 89 |
dataname_rs = "ADRS", |
|
| 90 |
bar_paramcd, |
|
| 91 |
bar_var, |
|
| 92 |
bar_color_var, |
|
| 93 |
bar_color_opt = NULL, |
|
| 94 |
sort_var, |
|
| 95 |
add_label_var_sl, |
|
| 96 |
add_label_paramcd_rs, |
|
| 97 |
anno_txt_var_sl, |
|
| 98 |
anno_txt_paramcd_rs, |
|
| 99 |
facet_var, |
|
| 100 |
ytick_at = 20, |
|
| 101 |
href_line = NULL, |
|
| 102 |
gap_point_val = NULL, |
|
| 103 |
show_value = TRUE, |
|
| 104 |
plot_height = c(1200L, 400L, 5000L), |
|
| 105 |
plot_width = NULL, |
|
| 106 |
pre_output = NULL, |
|
| 107 |
post_output = NULL, |
|
| 108 |
transformators = list()) {
|
|
| 109 | ! |
message("Initializing tm_g_waterfall")
|
| 110 | ! |
checkmate::assert_string(label) |
| 111 | ! |
checkmate::assert_string(dataname_tr) |
| 112 | ! |
checkmate::assert_string(dataname_rs) |
| 113 | ! |
checkmate::assert_class(bar_paramcd, classes = "choices_selected") |
| 114 | ! |
checkmate::assert_class(bar_var, classes = "choices_selected") |
| 115 | ! |
checkmate::assert_class(bar_color_var, classes = "choices_selected") |
| 116 | ! |
checkmate::assert_class(sort_var, classes = "choices_selected") |
| 117 | ! |
checkmate::assert_class(anno_txt_var_sl, classes = "choices_selected") |
| 118 | ! |
checkmate::assert_class(anno_txt_paramcd_rs, classes = "choices_selected") |
| 119 | ! |
checkmate::assert_class(facet_var, classes = "choices_selected") |
| 120 | ! |
checkmate::assert_class(add_label_var_sl, classes = "choices_selected") |
| 121 | ! |
checkmate::assert_class(add_label_paramcd_rs, classes = "choices_selected") |
| 122 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 123 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 124 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 125 | ! |
checkmate::assert_numeric( |
| 126 | ! |
plot_width[1], |
| 127 | ! |
lower = plot_width[2], |
| 128 | ! |
upper = plot_width[3], |
| 129 | ! |
null.ok = TRUE, |
| 130 | ! |
.var.name = "plot_width" |
| 131 |
) |
|
| 132 | ||
| 133 | ! |
args <- as.list(environment()) |
| 134 | ||
| 135 | ! |
module( |
| 136 | ! |
label = label, |
| 137 | ! |
ui = ui_g_waterfall, |
| 138 | ! |
ui_args = args, |
| 139 | ! |
server = srv_g_waterfall, |
| 140 | ! |
server_args = list( |
| 141 | ! |
dataname_tr = dataname_tr, |
| 142 | ! |
dataname_rs = dataname_rs, |
| 143 | ! |
bar_paramcd = bar_paramcd, |
| 144 | ! |
add_label_paramcd_rs = add_label_paramcd_rs, |
| 145 | ! |
anno_txt_paramcd_rs = anno_txt_paramcd_rs, |
| 146 | ! |
label = label, |
| 147 | ! |
bar_color_opt = bar_color_opt, |
| 148 | ! |
plot_height = plot_height, |
| 149 | ! |
plot_width = plot_width |
| 150 |
), |
|
| 151 | ! |
transformators = transformators, |
| 152 | ! |
datanames = c("ADSL", dataname_tr, dataname_rs)
|
| 153 |
) |
|
| 154 |
} |
|
| 155 | ||
| 156 |
ui_g_waterfall <- function(id, ...) {
|
|
| 157 | ! |
a <- list(...) |
| 158 | ! |
ns <- NS(id) |
| 159 | ! |
teal.widgets::standard_layout( |
| 160 | ! |
output = teal.widgets::white_small_well( |
| 161 | ! |
teal.widgets::plot_with_settings_ui(id = ns("waterfallplot"))
|
| 162 |
), |
|
| 163 | ! |
encoding = tags$div( |
| 164 | ! |
tags$label("Encodings", class = "text-primary"),
|
| 165 | ! |
helpText("Analysis Data: ", tags$code(a$dataname_tr), tags$code(a$dataname_rs)),
|
| 166 | ! |
teal.widgets::optionalSelectInput( |
| 167 | ! |
ns("bar_paramcd"),
|
| 168 | ! |
"Tumor Burden Parameter", |
| 169 | ! |
multiple = FALSE |
| 170 |
), |
|
| 171 | ! |
teal.widgets::optionalSelectInput( |
| 172 | ! |
ns("bar_var"),
|
| 173 | ! |
"Bar Height", |
| 174 | ! |
choices = get_choices(a$bar_var$choices), |
| 175 | ! |
selected = a$bar_var$selected, |
| 176 | ! |
multiple = FALSE, |
| 177 | ! |
label_help = helpText("Tumor change variable from ", tags$code("ADTR"))
|
| 178 |
), |
|
| 179 | ! |
teal.widgets::optionalSelectInput( |
| 180 | ! |
ns("bar_color_var"),
|
| 181 | ! |
"Bar Color", |
| 182 | ! |
choices = get_choices(a$bar_color_var$choices), |
| 183 | ! |
selected = a$bar_color_var$selected, |
| 184 | ! |
multiple = FALSE |
| 185 |
), |
|
| 186 | ! |
teal.widgets::optionalSelectInput( |
| 187 | ! |
ns("sort_var"),
|
| 188 | ! |
"Sort by", |
| 189 | ! |
choices = get_choices(a$sort_var$choices), |
| 190 | ! |
selected = a$sort_var$selected, |
| 191 | ! |
multiple = FALSE, |
| 192 | ! |
label_help = helpText("from ", tags$code("ADSL"))
|
| 193 |
), |
|
| 194 | ! |
teal.widgets::optionalSelectInput( |
| 195 | ! |
ns("add_label_var_sl"),
|
| 196 | ! |
"Add ADSL Label to Bars", |
| 197 | ! |
choices = get_choices(a$add_label_var_sl$choices), |
| 198 | ! |
selected = a$add_label_var_sl$selected, |
| 199 | ! |
multiple = FALSE |
| 200 |
), |
|
| 201 | ! |
teal.widgets::optionalSelectInput( |
| 202 | ! |
ns("add_label_paramcd_rs"),
|
| 203 | ! |
"Add ADRS Label to Bars", |
| 204 | ! |
multiple = FALSE |
| 205 |
), |
|
| 206 | ! |
teal.widgets::optionalSelectInput( |
| 207 | ! |
ns("anno_txt_var_sl"),
|
| 208 | ! |
"Annotation Variables", |
| 209 | ! |
choices = get_choices(a$anno_txt_var_sl$choices), |
| 210 | ! |
selected = a$anno_txt_var_sl$selected, |
| 211 | ! |
multiple = TRUE, |
| 212 | ! |
label_help = helpText("from ", tags$code("ADSL"))
|
| 213 |
), |
|
| 214 | ! |
teal.widgets::optionalSelectInput( |
| 215 | ! |
ns("anno_txt_paramcd_rs"),
|
| 216 | ! |
"Annotation Parameters", |
| 217 | ! |
multiple = TRUE, |
| 218 | ! |
label_help = helpText("from ", tags$code("ADRS"))
|
| 219 |
), |
|
| 220 | ! |
teal.widgets::optionalSelectInput( |
| 221 | ! |
ns("facet_var"),
|
| 222 | ! |
"Facet by", |
| 223 | ! |
choices = get_choices(a$facet_var$choices), |
| 224 | ! |
selected = NULL, |
| 225 | ! |
multiple = FALSE, |
| 226 | ! |
label_help = helpText("from ", tags$code("ADSL"))
|
| 227 |
), |
|
| 228 | ! |
checkboxInput( |
| 229 | ! |
ns("show_value"),
|
| 230 | ! |
"Add Bar Height Value", |
| 231 | ! |
value = a$show_value |
| 232 |
), |
|
| 233 | ! |
textInput( |
| 234 | ! |
ns("href_line"),
|
| 235 | ! |
label = tags$div( |
| 236 | ! |
"Horizontal Reference Line(s)", |
| 237 | ! |
tags$br(), |
| 238 | ! |
helpText("Enter numeric value(s) of reference lines, separated by comma (eg. -10, 20)")
|
| 239 |
), |
|
| 240 | ! |
value = a$href_line |
| 241 |
), |
|
| 242 | ! |
textInput( |
| 243 | ! |
ns("ytick_at"),
|
| 244 | ! |
label = tags$div( |
| 245 | ! |
"Y-axis Interval", |
| 246 | ! |
tags$br(), |
| 247 | ! |
helpText("Enter a numeric value of Y axis interval")
|
| 248 |
), |
|
| 249 | ! |
value = a$ytick_at |
| 250 |
), |
|
| 251 | ! |
textInput( |
| 252 | ! |
ns("gap_point_val"),
|
| 253 | ! |
label = tags$div( |
| 254 | ! |
"Break High Bars", |
| 255 | ! |
tags$br(), |
| 256 | ! |
helpText("Enter a numeric value to break very high bars")
|
| 257 |
), |
|
| 258 | ! |
value = a$gap_point_val |
| 259 |
) |
|
| 260 |
), |
|
| 261 | ! |
pre_output = a$pre_output, |
| 262 | ! |
post_output = a$post_output |
| 263 |
) |
|
| 264 |
} |
|
| 265 | ||
| 266 |
srv_g_waterfall <- function(id, |
|
| 267 |
data, |
|
| 268 |
bar_paramcd, |
|
| 269 |
add_label_paramcd_rs, |
|
| 270 |
anno_txt_paramcd_rs, |
|
| 271 |
dataname_tr, |
|
| 272 |
dataname_rs, |
|
| 273 |
bar_color_opt, |
|
| 274 |
label, |
|
| 275 |
plot_height, |
|
| 276 |
plot_width) {
|
|
| 277 | ! |
checkmate::assert_class(data, "reactive") |
| 278 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 279 | ||
| 280 | ! |
moduleServer(id, function(input, output, session) {
|
| 281 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 282 | ||
| 283 | ! |
env <- as.list(isolate(data())) |
| 284 | ! |
resolved_bar_paramcd <- teal.transform::resolve_delayed(bar_paramcd, env) |
| 285 | ! |
resolved_add_label_paramcd_rs <- teal.transform::resolve_delayed(add_label_paramcd_rs, env) |
| 286 | ! |
resolved_anno_txt_paramcd_rs <- teal.transform::resolve_delayed(anno_txt_paramcd_rs, env) |
| 287 | ||
| 288 | ! |
teal.widgets::updateOptionalSelectInput( |
| 289 | ! |
session = session, |
| 290 | ! |
inputId = "bar_paramcd", |
| 291 | ! |
choices = resolved_bar_paramcd$choices, |
| 292 | ! |
selected = resolved_bar_paramcd$selected |
| 293 |
) |
|
| 294 | ! |
teal.widgets::updateOptionalSelectInput( |
| 295 | ! |
session = session, |
| 296 | ! |
inputId = "add_label_paramcd_rs", |
| 297 | ! |
choices = resolved_add_label_paramcd_rs$choices, |
| 298 | ! |
selected = resolved_add_label_paramcd_rs$selected |
| 299 |
) |
|
| 300 | ! |
teal.widgets::updateOptionalSelectInput( |
| 301 | ! |
session = session, |
| 302 | ! |
inputId = "anno_txt_paramcd_rs", |
| 303 | ! |
choices = resolved_anno_txt_paramcd_rs$choices, |
| 304 | ! |
selected = resolved_anno_txt_paramcd_rs$selected |
| 305 |
) |
|
| 306 | ||
| 307 | ! |
iv <- reactive({
|
| 308 | ! |
adsl <- data()[["ADSL"]] |
| 309 | ! |
adtr <- data()[[dataname_tr]] |
| 310 | ! |
adrs <- data()[[dataname_rs]] |
| 311 | ||
| 312 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 313 | ! |
iv$add_rule("bar_var", shinyvalidate::sv_required(
|
| 314 | ! |
message = "Bar Height is required" |
| 315 |
)) |
|
| 316 | ! |
iv$add_rule("bar_paramcd", shinyvalidate::sv_required(
|
| 317 | ! |
message = "Tumor Burden Parameter is required" |
| 318 |
)) |
|
| 319 | ! |
iv$add_rule("bar_paramcd", shinyvalidate::sv_in_set(
|
| 320 | ! |
set = adtr$PARAMCD, |
| 321 | ! |
message_fmt = "All values of Tumor Burden Parameter must be elements of ADTR PARAMCD" |
| 322 |
)) |
|
| 323 | ! |
iv$add_rule("add_label_paramcd_rs", shinyvalidate::sv_optional())
|
| 324 | ! |
iv$add_rule("add_label_paramcd_rs", shinyvalidate::sv_in_set(
|
| 325 | ! |
set = adrs$PARAMCD, |
| 326 | ! |
message_fmt = "ADRS Label must be an element of ADRS PARAMCD" |
| 327 |
)) |
|
| 328 | ! |
rule_excl <- function(value, other) {
|
| 329 | ! |
if (length(value) > 0L && length(other) > 0L) {
|
| 330 | ! |
"Only one \"Label to Bars\" is allowed" |
| 331 |
} |
|
| 332 |
} |
|
| 333 | ! |
iv$add_rule("add_label_paramcd_rs", rule_excl, other = input$add_label_var_sl)
|
| 334 | ! |
iv$add_rule("add_label_var_sl", rule_excl, other = input$add_label_paramcd_rs)
|
| 335 | ! |
iv$add_rule("anno_txt_paramcd_rs", shinyvalidate::sv_optional())
|
| 336 | ! |
iv$add_rule("anno_txt_paramcd_rs", shinyvalidate::sv_in_set(
|
| 337 | ! |
set = adrs$PARAMCD, |
| 338 | ! |
message_fmt = "Annotation Parameters must be elements of ADRS PARAMCD" |
| 339 |
)) |
|
| 340 | ! |
iv$add_rule("href_line", shinyvalidate::sv_optional())
|
| 341 | ! |
iv$add_rule("href_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
| 342 | ! |
"Horizontal Reference Line(s) are invalid" |
| 343 |
}) |
|
| 344 | ! |
iv$add_rule("ytick_at", shinyvalidate::sv_required(
|
| 345 | ! |
message = "Y-axis Interval is required" |
| 346 |
)) |
|
| 347 | ! |
iv$add_rule("ytick_at", ~ if (!checkmate::test_number(suppressWarnings(as.numeric(.)), lower = 1)) {
|
| 348 | ! |
"Y-axis Interval must be a single positive number" |
| 349 |
}) |
|
| 350 | ! |
iv$add_rule("gap_point_val", shinyvalidate::sv_optional())
|
| 351 | ! |
iv$add_rule("gap_point_val", ~ if (!checkmate::test_number(suppressWarnings(as.numeric(.)), lower = 1)) {
|
| 352 | ! |
"Break High Bars must be a single positive number" |
| 353 |
}) |
|
| 354 | ! |
iv$enable() |
| 355 | ! |
iv |
| 356 |
}) |
|
| 357 | ||
| 358 | ! |
output_q <- reactive({
|
| 359 | ! |
obj <- data() |
| 360 | ! |
teal.reporter::teal_card(obj) <- |
| 361 | ! |
c( |
| 362 | ! |
teal.reporter::teal_card(obj), |
| 363 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 364 |
) |
|
| 365 | ! |
obj <- teal.code::eval_code(obj, "library(dplyr)") |
| 366 | ||
| 367 | ! |
adsl <- obj[["ADSL"]] |
| 368 | ! |
adtr <- obj[[dataname_tr]] |
| 369 | ! |
adrs <- obj[[dataname_rs]] |
| 370 | ||
| 371 |
# validate data rows |
|
| 372 | ! |
teal::validate_has_data(adsl, min_nrow = 2) |
| 373 | ! |
teal::validate_has_data(adtr, min_nrow = 2) |
| 374 | ! |
teal::validate_has_data(adrs, min_nrow = 2) |
| 375 | ||
| 376 | ! |
adsl_vars <- unique( |
| 377 | ! |
c( |
| 378 | ! |
"USUBJID", "STUDYID", |
| 379 | ! |
input$bar_color_var, input$sort_var, input$add_label_var_sl, input$anno_txt_var_sl, input$facet_var |
| 380 |
) |
|
| 381 |
) |
|
| 382 | ! |
adtr_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", input$bar_var))
|
| 383 | ! |
adrs_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", "AVALC"))
|
| 384 | ! |
adrs_paramcd <- unique(c(input$add_label_paramcd_rs, input$anno_txt_paramcd_rs)) |
| 385 | ||
| 386 |
# validate data input |
|
| 387 | ! |
teal::validate_has_variable(adsl, adsl_vars) |
| 388 | ! |
teal::validate_has_variable(adrs, adrs_vars) |
| 389 | ! |
teal::validate_has_variable(adtr, adtr_vars) |
| 390 | ||
| 391 | ! |
teal::validate_inputs(iv()) |
| 392 | ||
| 393 |
# get variables |
|
| 394 | ! |
bar_var <- input$bar_var |
| 395 | ! |
bar_paramcd <- input$bar_paramcd |
| 396 | ! |
add_label_var_sl <- input$add_label_var_sl |
| 397 | ! |
add_label_paramcd_rs <- input$add_label_paramcd_rs |
| 398 | ! |
anno_txt_var_sl <- input$anno_txt_var_sl |
| 399 | ! |
anno_txt_paramcd_rs <- input$anno_txt_paramcd_rs |
| 400 | ! |
ytick_at <- input$ytick_at |
| 401 | ! |
href_line <- input$href_line |
| 402 | ! |
gap_point_val <- input$gap_point_val |
| 403 | ! |
show_value <- input$show_value |
| 404 | ! |
href_line <- suppressWarnings(as_numeric_from_comma_sep_str(href_line)) |
| 405 | ||
| 406 | ! |
if (gap_point_val == "") {
|
| 407 | ! |
gap_point_val <- NULL |
| 408 |
} else {
|
|
| 409 | ! |
gap_point_val <- as.numeric(gap_point_val) |
| 410 |
} |
|
| 411 | ! |
ytick_at <- as.numeric(ytick_at) |
| 412 | ||
| 413 | ! |
bar_color_var <- if ( |
| 414 | ! |
!is.null(input$bar_color_var) && |
| 415 | ! |
input$bar_color_var != "None" && |
| 416 | ! |
input$bar_color_var != "" |
| 417 |
) {
|
|
| 418 | ! |
input$bar_color_var |
| 419 |
} else {
|
|
| 420 | ! |
NULL |
| 421 |
} |
|
| 422 | ! |
sort_var <- if (!is.null(input$sort_var) && input$sort_var != "None" && input$sort_var != "") {
|
| 423 | ! |
input$sort_var |
| 424 |
} else {
|
|
| 425 | ! |
NULL |
| 426 |
} |
|
| 427 | ! |
facet_var <- if (!is.null(input$facet_var) && input$facet_var != "None" && input$facet_var != "") {
|
| 428 | ! |
input$facet_var |
| 429 |
} else {
|
|
| 430 | ! |
NULL |
| 431 |
} |
|
| 432 | ||
| 433 |
# write variables to qenv |
|
| 434 | ! |
q1 <- teal.code::eval_code( |
| 435 | ! |
obj, |
| 436 | ! |
code = bquote({
|
| 437 | ! |
bar_var <- .(bar_var) |
| 438 | ! |
bar_color_var <- .(bar_color_var) |
| 439 | ! |
sort_var <- .(sort_var) |
| 440 | ! |
add_label_var_sl <- .(add_label_var_sl) |
| 441 | ! |
add_label_paramcd_rs <- .(add_label_paramcd_rs) |
| 442 | ! |
anno_txt_var_sl <- .(anno_txt_var_sl) |
| 443 | ! |
anno_txt_paramcd_rs <- .(anno_txt_paramcd_rs) |
| 444 | ! |
facet_var <- .(facet_var) |
| 445 | ! |
href_line <- .(href_line) |
| 446 | ! |
gap_point_val <- .(gap_point_val) |
| 447 | ! |
show_value <- .(show_value) |
| 448 |
}) |
|
| 449 |
) |
|
| 450 | ||
| 451 |
# data processing |
|
| 452 | ! |
q1 <- teal.code::eval_code( |
| 453 | ! |
q1, |
| 454 | ! |
code = bquote({
|
| 455 | ! |
adsl <- ADSL[, .(adsl_vars)] |
| 456 | ! |
adtr <- .(as.name(dataname_tr))[, .(adtr_vars)] |
| 457 | ! |
adrs <- .(as.name(dataname_rs))[, .(adrs_vars)] |
| 458 | ||
| 459 | ! |
bar_tr <- .(as.name(dataname_tr)) %>% |
| 460 | ! |
dplyr::filter(PARAMCD == .(bar_paramcd)) %>% |
| 461 | ! |
dplyr::select(USUBJID, .(as.name(bar_var))) %>% |
| 462 | ! |
dplyr::group_by(USUBJID) %>% |
| 463 | ! |
dplyr::slice(which.min(.(as.name(bar_var)))) |
| 464 | ! |
bar_data <- adsl %>% dplyr::inner_join(bar_tr, "USUBJID") |
| 465 |
}) |
|
| 466 |
) |
|
| 467 | ||
| 468 | ! |
q1 <- if (is.null(adrs_paramcd)) {
|
| 469 | ! |
teal.code::eval_code( |
| 470 | ! |
q1, |
| 471 | ! |
code = bquote({
|
| 472 | ! |
anl <- bar_data |
| 473 | ! |
anl$USUBJID <- unlist(lapply(strsplit(anl$USUBJID, "-", fixed = TRUE), tail, 1)) |
| 474 |
}) |
|
| 475 |
) |
|
| 476 |
} else {
|
|
| 477 | ! |
qq1 <- teal.code::eval_code( |
| 478 | ! |
q1, |
| 479 | ! |
code = bquote( |
| 480 | ! |
rs_sub <- .(as.name(dataname_rs)) %>% |
| 481 | ! |
dplyr::filter(PARAMCD %in% .(adrs_paramcd)) |
| 482 |
) |
|
| 483 |
) |
|
| 484 | ||
| 485 | ! |
teal::validate_one_row_per_id(qq1[["rs_sub"]], key = c("STUDYID", "USUBJID", "PARAMCD"))
|
| 486 | ||
| 487 | ! |
teal.code::eval_code( |
| 488 | ! |
qq1, |
| 489 | ! |
code = bquote({
|
| 490 | ! |
rs_label <- rs_sub %>% |
| 491 | ! |
dplyr::select(USUBJID, PARAMCD, AVALC) %>% |
| 492 | ! |
tidyr::pivot_wider(names_from = PARAMCD, values_from = AVALC) |
| 493 | ! |
anl <- bar_data %>% dplyr::left_join(rs_label, by = c("USUBJID"))
|
| 494 | ! |
anl$USUBJID <- unlist(lapply(strsplit(anl$USUBJID, "-", fixed = TRUE), tail, 1)) |
| 495 |
}) |
|
| 496 |
) |
|
| 497 |
} |
|
| 498 | ||
| 499 |
# write plotting code to qenv |
|
| 500 | ! |
anl <- q1[["anl"]] |
| 501 | ||
| 502 | ! |
teal.reporter::teal_card(q1) <- |
| 503 | ! |
c( |
| 504 | ! |
teal.reporter::teal_card(q1), |
| 505 | ! |
"### Selected Options", |
| 506 | ! |
paste0("Tumor Burden Parameter: ", input$bar_paramcd, ".")
|
| 507 |
) |
|
| 508 | ||
| 509 | ! |
if (!is.null(facet_var)) {
|
| 510 | ! |
teal.reporter::teal_card(q1) <- c( |
| 511 | ! |
teal.reporter::teal_card(q1), |
| 512 | ! |
paste0("Faceted by: ", paste(facet_var, collapse = ", "), ".")
|
| 513 |
) |
|
| 514 |
} |
|
| 515 | ! |
if (!is.null(sort_var)) {
|
| 516 | ! |
teal.reporter::teal_card(q1) <- c( |
| 517 | ! |
teal.reporter::teal_card(q1), |
| 518 | ! |
paste0("Sorted by: ", paste(sort_var, collapse = ", "), ".")
|
| 519 |
) |
|
| 520 |
} |
|
| 521 | ||
| 522 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot") |
| 523 | ||
| 524 | ! |
q1 <- teal.code::eval_code( |
| 525 | ! |
q1, |
| 526 | ! |
code = bquote({
|
| 527 | ! |
plot <- osprey::g_waterfall( |
| 528 | ! |
bar_id = anl[["USUBJID"]], |
| 529 | ! |
bar_height = anl[[bar_var]], |
| 530 | ! |
sort_by = .(if (length(sort_var) > 0) {
|
| 531 | ! |
quote(anl[[sort_var]]) |
| 532 |
} else {
|
|
| 533 | ! |
NULL |
| 534 |
}), |
|
| 535 | ! |
col_by = .(if (length(bar_color_var) > 0) {
|
| 536 | ! |
quote(anl[[bar_color_var]]) |
| 537 |
} else {
|
|
| 538 | ! |
NULL |
| 539 |
}), |
|
| 540 | ! |
bar_color_opt = .(if (length(bar_color_var) == 0) {
|
| 541 | ! |
NULL |
| 542 | ! |
} else if (length(bar_color_var) > 0 & all(unique(anl[[bar_color_var]]) %in% names(bar_color_opt))) {
|
| 543 | ! |
bar_color_opt |
| 544 |
} else {
|
|
| 545 | ! |
NULL |
| 546 |
}), |
|
| 547 | ! |
anno_txt = .(if (length(anno_txt_var_sl) == 0 & length(anno_txt_paramcd_rs) == 0) {
|
| 548 | ! |
NULL |
| 549 | ! |
} else if (length(anno_txt_var_sl) >= 1 & length(anno_txt_paramcd_rs) == 0) {
|
| 550 | ! |
quote(data.frame(anl[anno_txt_var_sl])) |
| 551 | ! |
} else if (length(anno_txt_paramcd_rs) >= 1 & length(anno_txt_var_sl) == 0) {
|
| 552 | ! |
quote(data.frame(anl[anno_txt_paramcd_rs])) |
| 553 |
} else {
|
|
| 554 | ! |
quote(cbind(anl[anno_txt_var_sl], anl[anno_txt_paramcd_rs])) |
| 555 |
}), |
|
| 556 | ! |
href_line = .(href_line), |
| 557 | ! |
facet_by = .(if (length(facet_var) > 0) {
|
| 558 | ! |
quote(as.factor(anl[[facet_var]])) |
| 559 |
} else {
|
|
| 560 | ! |
NULL |
| 561 |
}), |
|
| 562 | ! |
show_datavalue = .(show_value), |
| 563 | ! |
add_label = .(if (length(add_label_var_sl) > 0 & length(add_label_paramcd_rs) == 0) {
|
| 564 | ! |
quote(anl[[add_label_var_sl]]) |
| 565 | ! |
} else if (length(add_label_paramcd_rs) > 0 & length(add_label_var_sl) == 0) {
|
| 566 | ! |
quote(anl[[add_label_paramcd_rs]]) |
| 567 |
} else {
|
|
| 568 | ! |
NULL |
| 569 |
}), |
|
| 570 | ! |
gap_point = .(gap_point_val), |
| 571 | ! |
ytick_at = .(ytick_at), |
| 572 | ! |
y_label = "Tumor Burden Change from Baseline", |
| 573 | ! |
title = "Waterfall Plot" |
| 574 |
) |
|
| 575 |
}) |
|
| 576 |
) |
|
| 577 |
}) |
|
| 578 | ||
| 579 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 580 | ||
| 581 |
# Insert the plot into a plot_with_settings module from teal.widgets |
|
| 582 | ! |
pws <- teal.widgets::plot_with_settings_srv( |
| 583 | ! |
id = "waterfallplot", |
| 584 | ! |
plot_r = plot_r, |
| 585 | ! |
height = plot_height, |
| 586 | ! |
width = plot_width |
| 587 |
) |
|
| 588 | ||
| 589 | ! |
set_chunk_dims(pws, output_q) |
| 590 |
}) |
|
| 591 |
} |
| 1 |
#' Teal module for the `AE` overview |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' Display the `AE` overview plot as a shiny module |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param flag_var_anl ([`teal.transform::choices_selected`]) |
|
| 11 |
#' `choices_selected` object with variables used to count adverse event |
|
| 12 |
#' sub-groups (e.g. Serious events, Related events, etc.) |
|
| 13 |
#' |
|
| 14 |
#' @inherit argument_convention return |
|
| 15 |
#' @inheritSection teal::example_module Reporting |
|
| 16 |
#' |
|
| 17 |
#' @export |
|
| 18 |
#' |
|
| 19 |
#' @examples |
|
| 20 |
#' data <- teal_data() |> |
|
| 21 |
#' within({
|
|
| 22 |
#' library(dplyr) |
|
| 23 |
#' ADSL <- rADSL |
|
| 24 |
#' ADAE <- rADAE |
|
| 25 |
#' .add_event_flags <- function(dat) {
|
|
| 26 |
#' dat <- dat |> |
|
| 27 |
#' mutate( |
|
| 28 |
#' TMPFL_SER = AESER == "Y", |
|
| 29 |
#' TMPFL_REL = AEREL == "Y", |
|
| 30 |
#' TMPFL_GR5 = AETOXGR == "5", |
|
| 31 |
#' AEREL1 = (AEREL == "Y" & ACTARM == "A: Drug X"), |
|
| 32 |
#' AEREL2 = (AEREL == "Y" & ACTARM == "B: Placebo") |
|
| 33 |
#' ) |
|
| 34 |
#' labels <- c( |
|
| 35 |
#' "Serious AE", "Related AE", "Grade 5 AE", |
|
| 36 |
#' "AE related to A: Drug X", "AE related to B: Placebo" |
|
| 37 |
#' ) |
|
| 38 |
#' cols <- c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2")
|
|
| 39 |
#' for (i in seq_along(labels)) {
|
|
| 40 |
#' attr(dat[[cols[i]]], "label") <- labels[i] |
|
| 41 |
#' } |
|
| 42 |
#' dat |
|
| 43 |
#' } |
|
| 44 |
#' ADAE <- .add_event_flags(ADAE) |
|
| 45 |
#' }) |
|
| 46 |
#' |
|
| 47 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 48 |
#' |
|
| 49 |
#' ADAE <- data[["ADAE"]] |
|
| 50 |
#' |
|
| 51 |
#' app <- init( |
|
| 52 |
#' data = data, |
|
| 53 |
#' modules = modules( |
|
| 54 |
#' tm_g_ae_oview( |
|
| 55 |
#' label = "AE Overview", |
|
| 56 |
#' dataname = "ADAE", |
|
| 57 |
#' arm_var = choices_selected( |
|
| 58 |
#' selected = "ACTARM", |
|
| 59 |
#' choices = c("ACTARM", "ACTARMCD")
|
|
| 60 |
#' ), |
|
| 61 |
#' flag_var_anl = choices_selected( |
|
| 62 |
#' selected = "AEREL1", |
|
| 63 |
#' choices = variable_choices( |
|
| 64 |
#' ADAE, |
|
| 65 |
#' c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2")
|
|
| 66 |
#' ), |
|
| 67 |
#' ), |
|
| 68 |
#' plot_height = c(600, 200, 2000) |
|
| 69 |
#' ) |
|
| 70 |
#' ) |
|
| 71 |
#' ) |
|
| 72 |
#' if (interactive()) {
|
|
| 73 |
#' shinyApp(app$ui, app$server) |
|
| 74 |
#' } |
|
| 75 |
#' |
|
| 76 |
tm_g_ae_oview <- function(label, |
|
| 77 |
dataname, |
|
| 78 |
arm_var, |
|
| 79 |
flag_var_anl, |
|
| 80 |
fontsize = c(5, 3, 7), |
|
| 81 |
plot_height = c(600L, 200L, 2000L), |
|
| 82 |
plot_width = NULL, |
|
| 83 |
transformators = list()) {
|
|
| 84 | ! |
message("Initializing tm_g_ae_oview")
|
| 85 | ! |
checkmate::assert_class(arm_var, classes = "choices_selected") |
| 86 | ! |
checkmate::assert_class(flag_var_anl, classes = "choices_selected") |
| 87 | ! |
checkmate::assert( |
| 88 | ! |
checkmate::check_number(fontsize, finite = TRUE), |
| 89 | ! |
checkmate::assert( |
| 90 | ! |
combine = "and", |
| 91 | ! |
.var.name = "fontsize", |
| 92 | ! |
checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE), |
| 93 | ! |
checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
| 94 |
) |
|
| 95 |
) |
|
| 96 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 97 | ! |
checkmate::assert_numeric(plot_height[1], |
| 98 | ! |
lower = plot_height[2], upper = plot_height[3], |
| 99 | ! |
.var.name = "plot_height" |
| 100 |
) |
|
| 101 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 102 | ! |
checkmate::assert_numeric( |
| 103 | ! |
plot_width[1], |
| 104 | ! |
lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" |
| 105 |
) |
|
| 106 | ||
| 107 | ! |
args <- as.list(environment()) |
| 108 | ||
| 109 | ! |
module( |
| 110 | ! |
label = label, |
| 111 | ! |
server = srv_g_ae_oview, |
| 112 | ! |
server_args = list( |
| 113 | ! |
label = label, |
| 114 | ! |
dataname = dataname, |
| 115 | ! |
plot_height = plot_height, |
| 116 | ! |
plot_width = plot_width |
| 117 |
), |
|
| 118 | ! |
ui = ui_g_ae_oview, |
| 119 | ! |
ui_args = args, |
| 120 | ! |
transformators = transformators, |
| 121 | ! |
datanames = c("ADSL", dataname)
|
| 122 |
) |
|
| 123 |
} |
|
| 124 | ||
| 125 |
ui_g_ae_oview <- function(id, ...) {
|
|
| 126 | ! |
ns <- NS(id) |
| 127 | ! |
args <- list(...) |
| 128 | ! |
teal.widgets::standard_layout( |
| 129 | ! |
output = teal.widgets::white_small_well( |
| 130 | ! |
plot_decorate_output(id = ns(NULL)) |
| 131 |
), |
|
| 132 | ! |
encoding = tags$div( |
| 133 | ! |
teal.widgets::optionalSelectInput( |
| 134 | ! |
ns("arm_var"),
|
| 135 | ! |
"Arm Variable", |
| 136 | ! |
choices = get_choices(args$arm_var$choices), |
| 137 | ! |
selected = args$arm_var$selected, |
| 138 | ! |
multiple = FALSE |
| 139 |
), |
|
| 140 | ! |
selectInput( |
| 141 | ! |
ns("arm_ref"),
|
| 142 | ! |
"Control", |
| 143 | ! |
choices = get_choices(args$arm_var$choices), |
| 144 | ! |
selected = args$arm_var$selected |
| 145 |
), |
|
| 146 | ! |
selectInput( |
| 147 | ! |
ns("arm_trt"),
|
| 148 | ! |
"Treatment", |
| 149 | ! |
choices = get_choices(args$arm_var$choices), |
| 150 | ! |
selected = args$arm_var$selected |
| 151 |
), |
|
| 152 | ! |
selectInput( |
| 153 | ! |
ns("flag_var_anl"),
|
| 154 | ! |
"Flags", |
| 155 | ! |
choices = get_choices(args$flag_var_anl$choices), |
| 156 | ! |
selected = args$flag_var_anl$selected, |
| 157 | ! |
multiple = TRUE |
| 158 |
), |
|
| 159 | ! |
teal.widgets::panel_item( |
| 160 | ! |
"Confidence interval settings", |
| 161 | ! |
teal.widgets::optionalSelectInput( |
| 162 | ! |
ns("diff_ci_method"),
|
| 163 | ! |
"Method for Difference of Proportions CI", |
| 164 | ! |
choices = ci_choices, |
| 165 | ! |
selected = ci_choices[1], |
| 166 | ! |
multiple = FALSE |
| 167 |
), |
|
| 168 | ! |
teal.widgets::optionalSliderInput( |
| 169 | ! |
ns("conf_level"),
|
| 170 | ! |
"Confidence Level", |
| 171 | ! |
min = 0.5, |
| 172 | ! |
max = 1, |
| 173 | ! |
value = 0.95 |
| 174 |
) |
|
| 175 |
), |
|
| 176 | ! |
teal.widgets::optionalSelectInput( |
| 177 | ! |
ns("axis"),
|
| 178 | ! |
"Axis Side", |
| 179 | ! |
choices = c("Left" = "left", "Right" = "right"),
|
| 180 | ! |
selected = "left", |
| 181 | ! |
multiple = FALSE |
| 182 |
), |
|
| 183 | ! |
ui_g_decorate( |
| 184 | ! |
ns(NULL), |
| 185 | ! |
fontsize = args$fontsize, |
| 186 | ! |
titles = "AE Overview", |
| 187 | ! |
footnotes = "" |
| 188 |
) |
|
| 189 |
) |
|
| 190 |
) |
|
| 191 |
} |
|
| 192 | ||
| 193 |
srv_g_ae_oview <- function(id, |
|
| 194 |
data, |
|
| 195 |
dataname, |
|
| 196 |
label, |
|
| 197 |
plot_height, |
|
| 198 |
plot_width) {
|
|
| 199 | ! |
checkmate::assert_class(data, "reactive") |
| 200 | ! |
checkmate::assert_class(isolate(data()), "teal_data") |
| 201 | ||
| 202 | ! |
moduleServer(id, function(input, output, session) {
|
| 203 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 204 | ! |
iv <- reactive({
|
| 205 | ! |
ANL <- data()[[dataname]] |
| 206 | ||
| 207 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 208 | ! |
iv$add_rule("arm_var", shinyvalidate::sv_required(
|
| 209 | ! |
message = "Arm Variable is required" |
| 210 |
)) |
|
| 211 | ! |
iv$add_rule("arm_var", ~ if (!is.factor(ANL[[.]])) {
|
| 212 | ! |
"Arm Var must be a factor variable" |
| 213 |
}) |
|
| 214 | ! |
iv$add_rule("arm_var", ~ if (nlevels(ANL[[.]]) < 2L) {
|
| 215 | ! |
"Selected Arm Var must have at least two levels" |
| 216 |
}) |
|
| 217 | ! |
iv$add_rule("flag_var_anl", shinyvalidate::sv_required(
|
| 218 | ! |
message = "At least one Flag is required" |
| 219 |
)) |
|
| 220 | ! |
rule_diff <- function(value, other) {
|
| 221 | ! |
if (isTRUE(value == other)) "Control and Treatment must be different" |
| 222 |
} |
|
| 223 | ! |
iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
|
| 224 | ! |
iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
|
| 225 | ! |
iv$enable() |
| 226 | ! |
iv |
| 227 |
}) |
|
| 228 | ||
| 229 | ! |
decorate_output <- srv_g_decorate( |
| 230 | ! |
id = NULL, plt = plot_r, |
| 231 | ! |
plot_height = plot_height, plot_width = plot_width |
| 232 |
) |
|
| 233 | ! |
font_size <- decorate_output$font_size |
| 234 | ! |
pws <- decorate_output$pws |
| 235 | ||
| 236 | ! |
observeEvent(list(input$diff_ci_method, input$conf_level), {
|
| 237 | ! |
req(!is.null(input$diff_ci_method) && !is.null(input$conf_level)) |
| 238 | ! |
diff_ci_method <- input$diff_ci_method |
| 239 | ! |
conf_level <- input$conf_level |
| 240 | ! |
updateTextAreaInput(session, |
| 241 | ! |
"foot", |
| 242 | ! |
value = sprintf( |
| 243 | ! |
"Note: %d%% CI is calculated using %s", |
| 244 | ! |
round(conf_level * 100), |
| 245 | ! |
name_ci(diff_ci_method) |
| 246 |
) |
|
| 247 |
) |
|
| 248 |
}) |
|
| 249 | ||
| 250 | ! |
observeEvent(input$arm_var, ignoreNULL = TRUE, {
|
| 251 | ! |
ANL <- data()[[dataname]] |
| 252 | ! |
arm_var <- input$arm_var |
| 253 | ! |
arm_val <- ANL[[arm_var]] |
| 254 | ! |
choices <- levels(arm_val) |
| 255 | ||
| 256 | ! |
if (length(choices) == 1) {
|
| 257 | ! |
trt_index <- 1 |
| 258 |
} else {
|
|
| 259 | ! |
trt_index <- 2 |
| 260 |
} |
|
| 261 | ||
| 262 | ! |
updateSelectInput( |
| 263 | ! |
session, |
| 264 | ! |
"arm_ref", |
| 265 | ! |
selected = choices[1], |
| 266 | ! |
choices = choices |
| 267 |
) |
|
| 268 | ! |
updateSelectInput( |
| 269 | ! |
session, |
| 270 | ! |
"arm_trt", |
| 271 | ! |
selected = choices[trt_index], |
| 272 | ! |
choices = choices |
| 273 |
) |
|
| 274 |
}) |
|
| 275 | ||
| 276 | ! |
output_q <- shiny::debounce( |
| 277 | ! |
millis = 200, |
| 278 | ! |
r = reactive({
|
| 279 | ! |
obj <- data() |
| 280 | ! |
teal.reporter::teal_card(obj) <- |
| 281 | ! |
c( |
| 282 | ! |
teal.reporter::teal_card(obj), |
| 283 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 284 |
) |
|
| 285 | ! |
obj <- teal.code::eval_code(obj, "library(dplyr)") |
| 286 | ||
| 287 | ! |
ANL <- obj[[dataname]] |
| 288 | ||
| 289 | ! |
teal::validate_has_data(ANL, min_nrow = 10, msg = sprintf("%s has not enough data", dataname))
|
| 290 | ||
| 291 | ! |
teal::validate_inputs(iv()) |
| 292 | ||
| 293 | ! |
validate(need( |
| 294 | ! |
input$arm_trt %in% ANL[[input$arm_var]] && input$arm_ref %in% ANL[[input$arm_var]], |
| 295 | ! |
"Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?" |
| 296 |
)) |
|
| 297 | ||
| 298 | ! |
q1 <- obj %>% |
| 299 | ! |
teal.code::eval_code( |
| 300 | ! |
code = as.expression(c( |
| 301 | ! |
bquote(anl_labels <- formatters::var_labels(.(as.name(dataname)), fill = FALSE)), |
| 302 | ! |
bquote( |
| 303 | ! |
flags <- .(as.name(dataname)) %>% |
| 304 | ! |
select(all_of(.(input$flag_var_anl))) %>% |
| 305 | ! |
rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x])) |
| 306 |
) |
|
| 307 |
)) |
|
| 308 |
) |
|
| 309 | ||
| 310 | ! |
teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot") |
| 311 | ||
| 312 | ! |
teal.code::eval_code( |
| 313 | ! |
q1, |
| 314 | ! |
code = as.expression(c( |
| 315 | ! |
bquote( |
| 316 | ! |
plot <- osprey::g_events_term_id( |
| 317 | ! |
term = flags, |
| 318 | ! |
id = .(as.name(dataname))[["USUBJID"]], |
| 319 | ! |
arm = .(as.name(dataname))[[.(input$arm_var)]], |
| 320 | ! |
arm_N = table(ADSL[[.(input$arm_var)]]), |
| 321 | ! |
ref = .(input$arm_ref), |
| 322 | ! |
trt = .(input$arm_trt), |
| 323 | ! |
diff_ci_method = .(input$diff_ci_method), |
| 324 | ! |
conf_level = .(input$conf_level), |
| 325 | ! |
axis_side = .(input$axis), |
| 326 | ! |
fontsize = .(font_size()), |
| 327 | ! |
draw = TRUE |
| 328 |
) |
|
| 329 |
) |
|
| 330 |
)) |
|
| 331 |
) |
|
| 332 |
}) |
|
| 333 |
) |
|
| 334 | ||
| 335 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 336 | ! |
set_chunk_dims(pws, output_q) |
| 337 |
}) |
|
| 338 |
} |
| 1 |
#' Shared Parameters |
|
| 2 |
#' |
|
| 3 |
#' @description Contains arguments that are shared between multiple functions |
|
| 4 |
#' in the package to avoid repetition using `inheritParams`. |
|
| 5 |
#' |
|
| 6 |
#' @param plot_height (`numeric`) optional vector of length three with `c(value, min, max)`. Specifies |
|
| 7 |
#' the height of the main plot. |
|
| 8 |
#' @param plot_width (`numeric`) optional vector of length three with `c(value, min, max)`. Specifies |
|
| 9 |
#' the width of the main plot and renders a slider on the plot to interactively adjust the plot width. |
|
| 10 |
#' @param label (`character`) module label in the teal app. Please note that this module is developed based on |
|
| 11 |
#' `ADaM` data structure and `ADaM` variables. |
|
| 12 |
#' |
|
| 13 |
#' @name shared_params |
|
| 14 |
#' @keywords internal |
|
| 15 |
#' |
|
| 16 |
NULL |
|
| 17 | ||
| 18 |
#' Utility function for quick filter |
|
| 19 |
#' |
|
| 20 |
#' |
|
| 21 |
#' @param filter_opt vector of string names of flag variable to filter (keep Y rows only) |
|
| 22 |
#' @param ANL input dataset |
|
| 23 |
#' |
|
| 24 |
#' @return a filtered dataframe |
|
| 25 |
#' |
|
| 26 |
#' @export |
|
| 27 |
#' |
|
| 28 |
#' @template author_zhanc107 |
|
| 29 |
#' |
|
| 30 |
quick_filter <- function(filter_opt, ANL) {
|
|
| 31 | ! |
for (i in seq_along(filter_opt)) {
|
| 32 | ! |
ANL <- ANL[ANL[, filter_opt[i]] == "Y", ] |
| 33 |
} |
|
| 34 | ! |
ANL |
| 35 |
} |
|
| 36 | ||
| 37 |
#' Automatically switch variable labels for standard `AE` variables in `AE` osprey functions |
|
| 38 |
#' `r lifecycle::badge("deprecated")`
|
|
| 39 |
#' `label_aevar` is deprecated and will be unexported in the next release. |
|
| 40 |
#' |
|
| 41 |
#' @param x variable key |
|
| 42 |
#' |
|
| 43 |
#' @export |
|
| 44 |
label_aevar <- function(x) {
|
|
| 45 | ! |
lifecycle::deprecate_stop( |
| 46 | ! |
when = "0.1.15", |
| 47 | ! |
what = "label_aevar()", |
| 48 | ! |
details = "label_aevar is deprecated and will be unexported in the next release." |
| 49 |
) |
|
| 50 |
} |
|
| 51 | ||
| 52 |
#' retrieve name of ci method |
|
| 53 |
#' @param x ci method to retrieve its name |
|
| 54 |
#' @keywords internal |
|
| 55 |
#' |
|
| 56 |
name_ci <- function(x) {
|
|
| 57 |
names(ci_choices)[which(ci_choices == x)] |
|
| 58 |
} |
|
| 59 | ||
| 60 |
ci_choices <- setNames( |
|
| 61 |
c("wald", "waldcc", "ac", "scorecc", "score", "mn", "mee", "blj", "ha"),
|
|
| 62 |
c( |
|
| 63 |
"Wald", "Corrected Wald", "Agresti-Caffo", "Newcombe", |
|
| 64 |
"Score", "Miettinen and Nurminen", "Mee", |
|
| 65 |
"Brown, Li's Jeffreys", "Hauck-Anderson" |
|
| 66 |
) |
|
| 67 |
) |
|
| 68 | ||
| 69 |
#' retrieve detailed name of ci method |
|
| 70 |
#' @param x ci method to retrieve its name |
|
| 71 |
name_ci <- function(x = ci_choices) {
|
|
| 72 | ! |
x <- match.arg(x) |
| 73 | ! |
return(paste0(names(x), " (", x, ")"))
|
| 74 |
} |
|
| 75 | ||
| 76 | ||
| 77 |
#' takes input_string, splits by "," and returns a numeric vector |
|
| 78 |
#' with NAs where the split-strings are not numeric. |
|
| 79 |
#' e.g. as_numeric_from_comma_separated_string("4 ,hello,5,, 3")
|
|
| 80 |
#' is c(4, NA, 5, NA, 3). |
|
| 81 |
#' If input argument is NULL or just whitespace then NULL is returned |
|
| 82 |
#' @param input_string string to be split into numeric vector |
|
| 83 |
#' @keywords internal |
|
| 84 |
#' |
|
| 85 |
as_numeric_from_comma_sep_str <- function(input_string) {
|
|
| 86 | 10x |
if (!is.null(input_string) && trimws(input_string) != "") {
|
| 87 | 7x |
ref_line <- unlist(strsplit(trimws(input_string), ",")) |
| 88 | 7x |
ref_line <- as.numeric(ref_line) |
| 89 |
} else {
|
|
| 90 | 3x |
ref_line <- NULL |
| 91 |
} |
|
| 92 | 10x |
ref_line |
| 93 |
} |
|
| 94 | ||
| 95 |
#' Get Choices |
|
| 96 |
#' |
|
| 97 |
#' This function returns choices based on the class of the input. |
|
| 98 |
#' If the input is of class `delayed_data`, it returns the `subset` of the input. |
|
| 99 |
#' If `subset` is NULL and the input contains `var_label` and `var_choices`, |
|
| 100 |
#' it throws an error prompting to resolve delayed inputs. |
|
| 101 |
#' Otherwise, it returns the input as is. |
|
| 102 |
#' |
|
| 103 |
#' @param choices An object that contains choices. |
|
| 104 |
#' @return A vector of choices. |
|
| 105 |
#' @keywords internal |
|
| 106 |
get_choices <- function(choices) {
|
|
| 107 | ! |
if (inherits(choices, "delayed_data")) {
|
| 108 | ! |
if (is.null(choices$subset)) {
|
| 109 | ! |
if (!is.null(choices$var_label) && !is.null(choices$var_choices)) {
|
| 110 | ! |
stop( |
| 111 | ! |
"Resolve delayed inputs by evaluating the code within the provided datasets. |
| 112 | ! |
Check ?teal.transform::resolve_delayed for more information." |
| 113 |
) |
|
| 114 |
} else {
|
|
| 115 | ! |
stop("Subset is NULL and necessary fields are missing.")
|
| 116 |
} |
|
| 117 |
} else {
|
|
| 118 | ! |
choices$subset |
| 119 |
} |
|
| 120 |
} else {
|
|
| 121 | ! |
choices |
| 122 |
} |
|
| 123 |
} |
|
| 124 | ||
| 125 |
#' @keywords internal |
|
| 126 |
#' @noRd |
|
| 127 |
left_bordered_div <- function(...) {
|
|
| 128 | ! |
tags$div( |
| 129 | ! |
style = " |
| 130 | ! |
border-left: 3px solid #e3e3e3; |
| 131 | ! |
padding-left: 0.6em; |
| 132 | ! |
border-radius: 5px; |
| 133 | ! |
margin-left: -0.6em; |
| 134 | ! |
margin-bottom: 0.5em; |
| 135 |
", |
|
| 136 |
... |
|
| 137 |
) |
|
| 138 |
} |
|
| 139 | ||
| 140 |
#' Set the attributes of the last chunk outputs |
|
| 141 |
#' |
|
| 142 |
#' This function modifies the attributes of the last `n` elements of a `teal_card` |
|
| 143 |
#' that are `chunk_output` objects. It can be used to set attributes like `dev.width` |
|
| 144 |
#' and `dev.height` for plot outputs. |
|
| 145 |
#' |
|
| 146 |
#' @param teal_card (`teal_card`) the teal_card object to modify |
|
| 147 |
#' @param attributes (`list`) named list of attributes to set |
|
| 148 |
#' @param n (`integer(1)`) number of the last element of `teal_card` to modify. |
|
| 149 |
#' it will only change `chunk_output` objects. |
|
| 150 |
#' @param inner_classes (`character`) classes within `chunk_output` that should be modified. |
|
| 151 |
#' This can be used to only change `recordedplot`, `ggplot2` or other type of objects. |
|
| 152 |
#' @param quiet (`logical`) whether to suppress warnings |
|
| 153 |
#' @keywords internal |
|
| 154 |
set_chunk_attrs <- function(teal_card, |
|
| 155 |
attributes, |
|
| 156 |
n = 1, |
|
| 157 |
inner_classes = NULL, |
|
| 158 |
quiet = FALSE) {
|
|
| 159 | ! |
checkmate::assert_class(teal_card, "teal_card") |
| 160 | ! |
checkmate::assert_list(attributes, names = "unique") |
| 161 | ! |
checkmate::assert_int(n, lower = 1) |
| 162 | ! |
checkmate::assert_character(inner_classes, null.ok = TRUE) |
| 163 | ! |
checkmate::assert_flag(quiet) |
| 164 | ||
| 165 | ! |
if (!inherits(teal_card[[length(teal_card)]], "chunk_output")) {
|
| 166 | ! |
if (!quiet) {
|
| 167 | ! |
warning("The last element of the `teal_card` is not a `chunk_output` object. No attributes were modified.")
|
| 168 |
} |
|
| 169 | ! |
return(teal_card) |
| 170 |
} |
|
| 171 | ||
| 172 | ! |
for (ix in seq_len(length(teal_card))) {
|
| 173 | ! |
if (ix > n) {
|
| 174 | ! |
break |
| 175 |
} |
|
| 176 | ! |
current_ix <- length(teal_card) + 1 - ix |
| 177 | ! |
if (!inherits(teal_card[[current_ix]], "chunk_output")) {
|
| 178 | ! |
if (!quiet) {
|
| 179 | ! |
warning( |
| 180 | ! |
"The ", ix, |
| 181 | ! |
" to last element of the `teal_card` is not a `chunk_output` object. Skipping any further modifications." |
| 182 |
) |
|
| 183 |
} |
|
| 184 | ! |
return(teal_card) |
| 185 |
} |
|
| 186 | ||
| 187 |
if ( |
|
| 188 | ! |
length(inner_classes) > 0 && |
| 189 | ! |
length(teal_card[[current_ix]]) >= 1 && |
| 190 | ! |
!checkmate::test_multi_class(teal_card[[current_ix]][[1]], inner_classes) |
| 191 |
) {
|
|
| 192 | ! |
next |
| 193 |
} |
|
| 194 | ||
| 195 | ! |
attributes(teal_card[[current_ix]]) <- utils::modifyList( |
| 196 | ! |
attributes(teal_card[[current_ix]]), |
| 197 | ! |
attributes |
| 198 |
) |
|
| 199 |
} |
|
| 200 | ||
| 201 | ! |
teal_card |
| 202 |
} |
|
| 203 | ||
| 204 |
#' Create a reactive that sets plot dimensions on a `teal_card` |
|
| 205 |
#' |
|
| 206 |
#' This is a convenience function that creates a reactive expression that |
|
| 207 |
#' automatically sets the `dev.width` and `dev.height` attributes on the last |
|
| 208 |
#' chunk outputs of a `teal_card` based on plot dimensions from a plot widget. |
|
| 209 |
#' |
|
| 210 |
#' @param pws (`plot_widget`) plot widget that provides dimensions via `dim()` method |
|
| 211 |
#' @param q_r (`reactive`) reactive expression that returns a `teal_reporter` |
|
| 212 |
#' @param inner_classes (`character`) classes within `chunk_output` that should be modified. |
|
| 213 |
#' This can be used to only change `recordedplot`, `ggplot2` or other type of objects. |
|
| 214 |
#' |
|
| 215 |
#' @return A reactive expression that returns the `teal_card` with updated dimensions |
|
| 216 |
#' |
|
| 217 |
#' @keywords internal |
|
| 218 |
set_chunk_dims <- function(pws, q_r, inner_classes = NULL) {
|
|
| 219 | ! |
checkmate::assert_list(pws) |
| 220 | ! |
checkmate::assert_names(names(pws), must.include = "dim") |
| 221 | ! |
checkmate::assert_class(pws$dim, "reactive") |
| 222 | ! |
checkmate::assert_class(q_r, "reactive") |
| 223 | ! |
checkmate::assert_character(inner_classes, null.ok = TRUE) |
| 224 | ||
| 225 | ! |
reactive({
|
| 226 | ! |
pws_dim <- stats::setNames(as.list(req(pws$dim())), c("width", "height"))
|
| 227 | ! |
if (identical(pws_dim$width, "auto")) { # ignore non-numeric values (such as "auto")
|
| 228 | ! |
pws_dim$width <- NULL |
| 229 |
} |
|
| 230 | ! |
if (identical(pws_dim$height, "auto")) { # ignore non-numeric values (such as "auto")
|
| 231 | ! |
pws_dim$height <- NULL |
| 232 |
} |
|
| 233 | ! |
q <- req(q_r()) |
| 234 | ! |
teal.reporter::teal_card(q) <- set_chunk_attrs( |
| 235 | ! |
teal.reporter::teal_card(q), |
| 236 | ! |
list(dev.width = pws_dim$width, dev.height = pws_dim$height), |
| 237 | ! |
inner_classes = inner_classes |
| 238 |
) |
|
| 239 | ! |
q |
| 240 |
}) |
|
| 241 |
} |
| 1 |
#' Teal module for the heatmap by grade |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' Display the heatmap by grade as a shiny module |
|
| 6 |
#' |
|
| 7 |
#' @inheritParams teal.widgets::standard_layout |
|
| 8 |
#' @inheritParams teal::module |
|
| 9 |
#' @inheritParams argument_convention |
|
| 10 |
#' @param sl_dataname (`character`) subject level dataset name, |
|
| 11 |
#' needs to be available in the list passed to the `data` |
|
| 12 |
#' argument of [teal::init()] |
|
| 13 |
#' @param ex_dataname (`character`) exposures dataset name, |
|
| 14 |
#' needs to be available in the list passed to the `data` |
|
| 15 |
#' argument of [teal::init()] \cr |
|
| 16 |
#' @param ae_dataname (`character`) adverse events dataset name, |
|
| 17 |
#' needs to be available in the list passed to the `data` |
|
| 18 |
#' argument of [teal::init()] \cr |
|
| 19 |
#' @param cm_dataname (`character`) concomitant medications dataset name, |
|
| 20 |
#' needs to be available in the list passed to the `data` |
|
| 21 |
#' argument of [teal::init()] \cr |
|
| 22 |
#' specify to `NA` if no concomitant medications data is available |
|
| 23 |
#' @param id_var (`choices_seleced`) unique subject ID variable |
|
| 24 |
#' @param visit_var (`choices_seleced`) analysis visit variable |
|
| 25 |
#' @param ongo_var (`choices_seleced`) study ongoing status variable. |
|
| 26 |
#' This variable is a derived logical variable. Usually it can be derived from `EOSSTT`. |
|
| 27 |
#' @param anno_var (`choices_seleced`) annotation variable |
|
| 28 |
#' @param heat_var (`choices_seleced`) heatmap variable |
|
| 29 |
#' @param conmed_var (`choices_seleced`) concomitant medications variable, |
|
| 30 |
#' specify to `NA` if no concomitant medications data is available |
|
| 31 |
#' |
|
| 32 |
#' @inherit argument_convention return |
|
| 33 |
#' @inheritSection teal::example_module Reporting |
|
| 34 |
#' |
|
| 35 |
#' @export |
|
| 36 |
#' |
|
| 37 |
#' @examples |
|
| 38 |
#' data <- teal_data() |> |
|
| 39 |
#' within({
|
|
| 40 |
#' library(dplyr) |
|
| 41 |
#' library(nestcolor) |
|
| 42 |
#' ADSL <- rADSL %>% slice(1:30) |
|
| 43 |
#' ADEX <- rADEX %>% filter(USUBJID %in% ADSL$USUBJID) |
|
| 44 |
#' ADAE <- rADAE %>% filter(USUBJID %in% ADSL$USUBJID) |
|
| 45 |
#' ADCM <- rADCM %>% filter(USUBJID %in% ADSL$USUBJID) |
|
| 46 |
#' # This preprocess is only to force legacy standard on ADCM |
|
| 47 |
#' ADCM <- ADCM %>% |
|
| 48 |
#' select(-starts_with("ATC")) %>%
|
|
| 49 |
#' unique() |
|
| 50 |
#' # function to derive AVISIT from ADEX |
|
| 51 |
#' .add_visit <- function(data_need_visit) {
|
|
| 52 |
#' visit_dates <- ADEX %>% |
|
| 53 |
#' filter(PARAMCD == "DOSE") %>% |
|
| 54 |
#' distinct(USUBJID, AVISIT, ASTDTM) %>% |
|
| 55 |
#' group_by(USUBJID) %>% |
|
| 56 |
#' arrange(ASTDTM) %>% |
|
| 57 |
#' mutate(next_vis = lead(ASTDTM), is_last = ifelse(is.na(next_vis), TRUE, FALSE)) %>% |
|
| 58 |
#' rename(this_vis = ASTDTM) |
|
| 59 |
#' data_visit <- data_need_visit %>% |
|
| 60 |
#' select(USUBJID, ASTDTM) %>% |
|
| 61 |
#' left_join(visit_dates, by = "USUBJID") %>% |
|
| 62 |
#' filter(ASTDTM > this_vis & (ASTDTM < next_vis | is_last == TRUE)) %>% |
|
| 63 |
#' left_join(data_need_visit) %>% |
|
| 64 |
#' distinct() |
|
| 65 |
#' return(data_visit) |
|
| 66 |
#' } |
|
| 67 |
#' # derive AVISIT for ADAE and ADCM |
|
| 68 |
#' ADAE <- .add_visit(ADAE) |
|
| 69 |
#' ADCM <- .add_visit(ADCM) |
|
| 70 |
#' # derive ongoing status variable for ADEX |
|
| 71 |
#' ADEX <- ADEX %>% |
|
| 72 |
#' filter(PARCAT1 == "INDIVIDUAL") %>% |
|
| 73 |
#' mutate(ongo_status = (EOSSTT == "ONGOING")) |
|
| 74 |
#' }) |
|
| 75 |
#' |
|
| 76 |
#' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 77 |
#' |
|
| 78 |
#' ADCM <- data[["ADCM"]] |
|
| 79 |
#' |
|
| 80 |
#' app <- init( |
|
| 81 |
#' data = data, |
|
| 82 |
#' modules = modules( |
|
| 83 |
#' tm_g_heat_bygrade( |
|
| 84 |
#' label = "Heatmap by grade", |
|
| 85 |
#' sl_dataname = "ADSL", |
|
| 86 |
#' ex_dataname = "ADEX", |
|
| 87 |
#' ae_dataname = "ADAE", |
|
| 88 |
#' cm_dataname = "ADCM", |
|
| 89 |
#' id_var = choices_selected( |
|
| 90 |
#' selected = "USUBJID", |
|
| 91 |
#' choices = c("USUBJID", "SUBJID")
|
|
| 92 |
#' ), |
|
| 93 |
#' visit_var = choices_selected( |
|
| 94 |
#' selected = "AVISIT", |
|
| 95 |
#' choices = c("AVISIT")
|
|
| 96 |
#' ), |
|
| 97 |
#' ongo_var = choices_selected( |
|
| 98 |
#' selected = "ongo_status", |
|
| 99 |
#' choices = c("ongo_status")
|
|
| 100 |
#' ), |
|
| 101 |
#' anno_var = choices_selected( |
|
| 102 |
#' selected = c("SEX", "COUNTRY"),
|
|
| 103 |
#' choices = c("SEX", "COUNTRY", "USUBJID")
|
|
| 104 |
#' ), |
|
| 105 |
#' heat_var = choices_selected( |
|
| 106 |
#' selected = "AETOXGR", |
|
| 107 |
#' choices = c("AETOXGR")
|
|
| 108 |
#' ), |
|
| 109 |
#' conmed_var = choices_selected( |
|
| 110 |
#' selected = "CMDECOD", |
|
| 111 |
#' choices = c("CMDECOD")
|
|
| 112 |
#' ), |
|
| 113 |
#' plot_height = c(600, 200, 2000) |
|
| 114 |
#' ) |
|
| 115 |
#' ) |
|
| 116 |
#' ) |
|
| 117 |
#' if (interactive()) {
|
|
| 118 |
#' shinyApp(app$ui, app$server) |
|
| 119 |
#' } |
|
| 120 |
#' |
|
| 121 |
tm_g_heat_bygrade <- function(label, |
|
| 122 |
sl_dataname, |
|
| 123 |
ex_dataname, |
|
| 124 |
ae_dataname, |
|
| 125 |
cm_dataname = NA, |
|
| 126 |
id_var, |
|
| 127 |
visit_var, |
|
| 128 |
ongo_var, |
|
| 129 |
anno_var, |
|
| 130 |
heat_var, |
|
| 131 |
conmed_var = NULL, |
|
| 132 |
fontsize = c(5, 3, 7), |
|
| 133 |
plot_height = c(600L, 200L, 2000L), |
|
| 134 |
plot_width = NULL, |
|
| 135 |
transformators = list()) {
|
|
| 136 | ! |
message("Initializing tm_g_heat_bygrade")
|
| 137 | ! |
args <- as.list(environment()) |
| 138 | ||
| 139 | ! |
checkmate::assert_string(label) |
| 140 | ! |
checkmate::assert_string(sl_dataname) |
| 141 | ! |
checkmate::assert_string(ex_dataname) |
| 142 | ! |
checkmate::assert_string(ae_dataname) |
| 143 | ! |
checkmate::assert_string(cm_dataname, na.ok = TRUE) |
| 144 | ! |
checkmate::assert_class(id_var, classes = "choices_selected") |
| 145 | ! |
checkmate::assert_class(visit_var, classes = "choices_selected") |
| 146 | ! |
checkmate::assert_class(ongo_var, classes = "choices_selected") |
| 147 | ! |
checkmate::assert_class(anno_var, classes = "choices_selected") |
| 148 | ! |
checkmate::assert_class(heat_var, classes = "choices_selected") |
| 149 | ! |
checkmate::assert_class(conmed_var, classes = "choices_selected", null.ok = TRUE) |
| 150 | ! |
checkmate::assert( |
| 151 | ! |
checkmate::check_number(fontsize, finite = TRUE), |
| 152 | ! |
checkmate::assert( |
| 153 | ! |
combine = "and", |
| 154 | ! |
.var.name = "fontsize", |
| 155 | ! |
checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE), |
| 156 | ! |
checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
| 157 |
) |
|
| 158 |
) |
|
| 159 | ! |
checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 160 | ! |
checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 161 | ! |
checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 162 | ! |
checkmate::assert_numeric( |
| 163 | ! |
plot_width[1], |
| 164 | ! |
lower = plot_width[2], |
| 165 | ! |
upper = plot_width[3], |
| 166 | ! |
null.ok = TRUE, |
| 167 | ! |
.var.name = "plot_width" |
| 168 |
) |
|
| 169 | ||
| 170 | ! |
module( |
| 171 | ! |
label = label, |
| 172 | ! |
server = srv_g_heatmap_bygrade, |
| 173 | ! |
server_args = list( |
| 174 | ! |
label = label, |
| 175 | ! |
sl_dataname = sl_dataname, |
| 176 | ! |
ex_dataname = ex_dataname, |
| 177 | ! |
ae_dataname = ae_dataname, |
| 178 | ! |
cm_dataname = cm_dataname, |
| 179 | ! |
plot_height = plot_height, |
| 180 | ! |
plot_width = plot_width |
| 181 |
), |
|
| 182 | ! |
ui = ui_g_heatmap_bygrade, |
| 183 | ! |
ui_args = args, |
| 184 | ! |
transformators = transformators, |
| 185 | ! |
datanames = "all" |
| 186 |
) |
|
| 187 |
} |
|
| 188 | ||
| 189 |
ui_g_heatmap_bygrade <- function(id, ...) {
|
|
| 190 | ! |
ns <- NS(id) |
| 191 | ! |
args <- list(...) |
| 192 | ||
| 193 | ! |
shiny::tagList( |
| 194 | ! |
teal.widgets::standard_layout( |
| 195 | ! |
output = teal.widgets::white_small_well( |
| 196 | ! |
plot_decorate_output(id = ns(NULL)) |
| 197 |
), |
|
| 198 | ! |
encoding = tags$div( |
| 199 | ! |
teal.widgets::optionalSelectInput( |
| 200 | ! |
ns("id_var"),
|
| 201 | ! |
"ID Variable", |
| 202 | ! |
choices = get_choices(args$id_var$choices), |
| 203 | ! |
selected = args$id_var$selected, |
| 204 | ! |
multiple = FALSE |
| 205 |
), |
|
| 206 | ! |
teal.widgets::optionalSelectInput( |
| 207 | ! |
ns("visit_var"),
|
| 208 | ! |
"Visit Variable", |
| 209 | ! |
choices = get_choices(args$visit_var$choices), |
| 210 | ! |
selected = args$visit_var$selected, |
| 211 | ! |
multiple = FALSE |
| 212 |
), |
|
| 213 | ! |
teal.widgets::optionalSelectInput( |
| 214 | ! |
ns("ongo_var"),
|
| 215 | ! |
"Study Ongoing Status Variable", |
| 216 | ! |
choices = get_choices(args$ongo_var$choices), |
| 217 | ! |
selected = args$ongo_var$selected, |
| 218 | ! |
multiple = FALSE |
| 219 |
), |
|
| 220 | ! |
teal.widgets::optionalSelectInput( |
| 221 | ! |
ns("anno_var"),
|
| 222 | ! |
"Annotation Variables", |
| 223 | ! |
choices = get_choices(args$anno_var$choices), |
| 224 | ! |
selected = args$anno_var$selected, |
| 225 | ! |
multiple = TRUE |
| 226 |
), |
|
| 227 | ! |
teal.widgets::optionalSelectInput( |
| 228 | ! |
ns("heat_var"),
|
| 229 | ! |
"Heat Variable", |
| 230 | ! |
choices = get_choices(args$heat_var$choices), |
| 231 | ! |
selected = args$heat_var$selected, |
| 232 | ! |
multiple = FALSE |
| 233 |
), |
|
| 234 | ! |
helpText("Plot conmed"),
|
| 235 | ! |
left_bordered_div( |
| 236 | ! |
if (!is.na(args$cm_dataname)) {
|
| 237 | ! |
checkboxInput( |
| 238 | ! |
ns("plot_cm"),
|
| 239 | ! |
"Yes", |
| 240 | ! |
value = !is.na(args$cm_dataname) |
| 241 |
) |
|
| 242 |
} |
|
| 243 |
), |
|
| 244 | ! |
conditionalPanel( |
| 245 | ! |
paste0("input['", ns("plot_cm"), "']"),
|
| 246 | ! |
teal.widgets::optionalSelectInput( |
| 247 | ! |
ns("conmed_var"),
|
| 248 | ! |
"Conmed Variable", |
| 249 | ! |
choices = get_choices(args$conmed_var$choices), |
| 250 | ! |
selected = args$conmed_var$selected, |
| 251 | ! |
multiple = FALSE |
| 252 |
), |
|
| 253 | ! |
selectInput( |
| 254 | ! |
ns("conmed_level"),
|
| 255 | ! |
"Conmed Levels", |
| 256 | ! |
choices = get_choices(args$conmed_var$choices), |
| 257 | ! |
selected = args$conmed_var$selected, |
| 258 | ! |
multiple = TRUE |
| 259 |
) |
|
| 260 |
), |
|
| 261 | ! |
ui_g_decorate( |
| 262 | ! |
ns(NULL), |
| 263 | ! |
fontsize = args$fontsize, |
| 264 | ! |
titles = "Heatmap by Grade", |
| 265 | ! |
footnotes = "" |
| 266 |
) |
|
| 267 |
) |
|
| 268 |
) |
|
| 269 |
) |
|
| 270 |
} |
|
| 271 | ||
| 272 |
srv_g_heatmap_bygrade <- function(id, |
|
| 273 |
data, |
|
| 274 |
sl_dataname, |
|
| 275 |
ex_dataname, |
|
| 276 |
ae_dataname, |
|
| 277 |
cm_dataname, |
|
| 278 |
label, |
|
| 279 |
plot_height, |
|
| 280 |
plot_width) {
|
|
| 281 | ! |
checkmate::assert_class(data, "reactive") |
| 282 | ! |
checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 283 | ! |
if (!is.na(sl_dataname)) checkmate::assert_names(sl_dataname, subset.of = names(data)) |
| 284 | ! |
if (!is.na(ex_dataname)) checkmate::assert_names(ex_dataname, subset.of = names(data)) |
| 285 | ! |
if (!is.na(ae_dataname)) checkmate::assert_names(ae_dataname, subset.of = names(data)) |
| 286 | ! |
if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data)) |
| 287 | ||
| 288 | ! |
moduleServer(id, function(input, output, session) {
|
| 289 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 290 | ! |
iv <- reactive({
|
| 291 | ! |
ADSL <- data()[[sl_dataname]] |
| 292 | ! |
ADEX <- data()[[ex_dataname]] |
| 293 | ! |
ADAE <- data()[[ae_dataname]] |
| 294 | ! |
if (isTRUE(input$plot_cm)) {
|
| 295 | ! |
ADCM <- data()[[cm_dataname]] |
| 296 |
} |
|
| 297 | ||
| 298 | ! |
iv <- shinyvalidate::InputValidator$new() |
| 299 | ! |
iv$add_rule("id_var", shinyvalidate::sv_required(
|
| 300 | ! |
message = "ID Variable is required" |
| 301 |
)) |
|
| 302 | ! |
iv$add_rule("visit_var", shinyvalidate::sv_required(
|
| 303 | ! |
message = "Visit Variable is required" |
| 304 |
)) |
|
| 305 | ! |
iv$add_rule("ongo_var", shinyvalidate::sv_required(
|
| 306 | ! |
message = "Study Ongoing Status Variable is required" |
| 307 |
)) |
|
| 308 | ! |
iv$add_rule("ongo_var", shinyvalidate::sv_in_set(
|
| 309 | ! |
set = names(ADEX), |
| 310 | ! |
message_fmt = sprintf("Study Ongoing Status must be a variable in %s", ex_dataname)
|
| 311 |
)) |
|
| 312 | ! |
iv$add_rule("ongo_var", ~ if (!is.logical(ADEX[[req(.)]])) {
|
| 313 | ! |
"Study Ongoing Status must be a logical variable" |
| 314 |
}) |
|
| 315 | ! |
iv$add_rule("anno_var", shinyvalidate::sv_required(
|
| 316 | ! |
message = "Annotation Variables is required" |
| 317 |
)) |
|
| 318 | ! |
iv$add_rule("anno_var", ~ if (length(.) > 2L) {
|
| 319 | ! |
"No more than two Annotation Variables are allowed" |
| 320 |
}) |
|
| 321 | ! |
iv$add_rule("anno_var", shinyvalidate::sv_in_set(
|
| 322 | ! |
set = names(ADSL), |
| 323 | ! |
message_fmt = sprintf("Study Ongoing Status must be a variable in %s", sl_dataname)
|
| 324 |
)) |
|
| 325 | ! |
iv$add_rule("anno_var", ~ if (isTRUE(input$id_var %in% .)) {
|
| 326 | ! |
sprintf("Deselect %s in Annotation Variables", input$id_var)
|
| 327 |
}) |
|
| 328 | ! |
iv$add_rule("heat_var", shinyvalidate::sv_required(
|
| 329 | ! |
message = "Heat Variable is required" |
| 330 |
)) |
|
| 331 | ! |
iv$enable() |
| 332 | ! |
iv |
| 333 |
}) |
|
| 334 | ! |
iv_cm <- reactive({
|
| 335 | ! |
ADSL <- data()[[sl_dataname]] |
| 336 | ! |
ADEX <- data()[[ex_dataname]] |
| 337 | ! |
ADAE <- data()[[ae_dataname]] |
| 338 | ! |
if (isTRUE(input$plot_cm)) {
|
| 339 | ! |
ADCM <- data()[[cm_dataname]] |
| 340 |
} |
|
| 341 | ||
| 342 | ! |
iv_cm <- shinyvalidate::InputValidator$new() |
| 343 | ! |
iv_cm$condition(~ isTRUE(input$plot_cm)) |
| 344 | ! |
iv_cm$add_rule("conmed_var", shinyvalidate::sv_required(
|
| 345 | ! |
message = "Conmed Variable is required" |
| 346 |
)) |
|
| 347 | ! |
iv_cm$add_rule("conmed_var", shinyvalidate::sv_in_set(
|
| 348 | ! |
set = names(ADCM), |
| 349 | ! |
message_fmt = sprintf("Conmed Variable must be a variable in %s", cm_dataname)
|
| 350 |
)) |
|
| 351 | ! |
iv_cm$add_rule("conmed_var", ~ if (!is.factor(ADCM[[.]])) {
|
| 352 | ! |
"Study Ongoing Status must be a factor variable" |
| 353 |
}) |
|
| 354 | ! |
iv_cm$add_rule("conmed_level", shinyvalidate::sv_required(
|
| 355 | ! |
"Select Conmed Levels" |
| 356 |
)) |
|
| 357 | ! |
iv_cm$add_rule("conmed_level", ~ if (length(.) > 3L) {
|
| 358 | ! |
"No more than three Conmed Levels are allowed" |
| 359 |
}) |
|
| 360 | ! |
iv_cm$enable() |
| 361 | ! |
iv_cm |
| 362 |
}) |
|
| 363 | ||
| 364 | ! |
decorate_output <- srv_g_decorate( |
| 365 | ! |
id = NULL, |
| 366 | ! |
plt = plot_r, |
| 367 | ! |
plot_height = plot_height, |
| 368 | ! |
plot_width = plot_width |
| 369 |
) |
|
| 370 | ! |
font_size <- decorate_output$font_size |
| 371 | ! |
pws <- decorate_output$pws |
| 372 | ||
| 373 | ! |
if (!is.na(cm_dataname)) {
|
| 374 | ! |
observeEvent(input$conmed_var, {
|
| 375 | ! |
ADCM <- data()[[cm_dataname]] |
| 376 | ! |
choices <- levels(ADCM[[input$conmed_var]]) |
| 377 | ||
| 378 | ! |
updateSelectInput( |
| 379 | ! |
session, |
| 380 | ! |
"conmed_level", |
| 381 | ! |
selected = choices[1:3], |
| 382 | ! |
choices = choices |
| 383 |
) |
|
| 384 |
}) |
|
| 385 |
} |
|
| 386 | ||
| 387 | ! |
output_q <- shiny::debounce( |
| 388 | ! |
millis = 200, |
| 389 | ! |
r = reactive({
|
| 390 | ! |
obj <- data() |
| 391 | ! |
teal.reporter::teal_card(obj) <- |
| 392 | ! |
c( |
| 393 | ! |
teal.reporter::teal_card(obj), |
| 394 | ! |
teal.reporter::teal_card("## Module's output(s)")
|
| 395 |
) |
|
| 396 | ! |
obj <- teal.code::eval_code(obj, "library(dplyr)") |
| 397 | ||
| 398 | ! |
ADSL <- obj[[sl_dataname]] |
| 399 | ! |
ADEX <- obj[[ex_dataname]] |
| 400 | ! |
ADAE <- obj[[ae_dataname]] |
| 401 | ! |
ADCM <- obj[[cm_dataname]] |
| 402 | ||
| 403 | ! |
teal::validate_has_data(ADSL, min_nrow = 1, msg = sprintf("%s contains no data", sl_dataname))
|
| 404 | ! |
teal::validate_inputs(iv(), iv_cm()) |
| 405 | ! |
if (isTRUE(input$plot_cm)) {
|
| 406 | ! |
shiny::validate(shiny::need(all(input$conmed_level %in% ADCM[[input$conmed_var]]), "Updating Conmed Levels")) |
| 407 |
} |
|
| 408 | ||
| 409 | ! |
qenv <- obj |
| 410 | ||
| 411 | ! |
if (isTRUE(input$plot_cm)) {
|
| 412 | ! |
ADCM <- qenv[[cm_dataname]] |
| 413 | ! |
qenv <- teal.code::eval_code( |
| 414 | ! |
qenv, |
| 415 | ! |
code = substitute( |
| 416 | ! |
expr = {
|
| 417 | ! |
conmed_data <- ADCM %>% |
| 418 | ! |
filter(conmed_var_name %in% conmed_level) |
| 419 | ! |
conmed_data[[conmed_var]] <- |
| 420 | ! |
factor(conmed_data[[conmed_var]], levels = unique(conmed_data[[conmed_var]])) |
| 421 | ! |
formatters::var_labels(conmed_data)[conmed_var] <- |
| 422 | ! |
formatters::var_labels(ADCM, fill = FALSE)[conmed_var] |
| 423 |
}, |
|
| 424 | ! |
env = list( |
| 425 | ! |
ADCM = as.name(cm_dataname), |
| 426 | ! |
conmed_var = input$conmed_var, |
| 427 | ! |
conmed_var_name = as.name(input$conmed_var), |
| 428 | ! |
conmed_level = input$conmed_level |
| 429 |
) |
|
| 430 |
) |
|
| 431 |
) |
|
| 432 |
} |
|
| 433 | ||
| 434 | ! |
teal.reporter::teal_card(qenv) <- c(teal.reporter::teal_card(qenv), "### Plot") |
| 435 | ||
| 436 | ! |
teal.code::eval_code( |
| 437 | ! |
qenv, |
| 438 | ! |
code = bquote( |
| 439 | ! |
plot <- osprey::g_heat_bygrade( |
| 440 | ! |
id_var = .(input$id_var), |
| 441 | ! |
exp_data = .(as.name(ex_dataname)) %>% filter(PARCAT1 == "INDIVIDUAL"), |
| 442 | ! |
visit_var = .(input$visit_var), |
| 443 | ! |
ongo_var = .(input$ongo_var), |
| 444 | ! |
anno_data = .(as.name(sl_dataname))[c(.(input$anno_var), .(input$id_var))], |
| 445 | ! |
anno_var = .(input$anno_var), |
| 446 | ! |
heat_data = .(as.name(ae_dataname)) %>% |
| 447 | ! |
select(.(as.name(input$id_var)), .(as.name(input$visit_var)), .(as.name(input$heat_var))), |
| 448 | ! |
heat_color_var = .(input$heat_var), |
| 449 | ! |
conmed_data = .(if (isTRUE(input$plot_cm)) as.name("conmed_data")),
|
| 450 | ! |
conmed_var = .(if (isTRUE(input$plot_cm)) input$conmed_var), |
| 451 |
) |
|
| 452 |
) |
|
| 453 |
) |
|
| 454 |
}) |
|
| 455 |
) |
|
| 456 | ||
| 457 | ! |
plot_r <- reactive(output_q()[["plot"]]) |
| 458 | ! |
set_chunk_dims(pws, output_q) |
| 459 |
}) |
|
| 460 |
} |
| 1 |
#' Helper UI function to decorate plot output UI |
|
| 2 |
#' |
|
| 3 |
#' @description |
|
| 4 |
#' |
|
| 5 |
#' This is used in [tm_g_ae_oview()] and [tm_g_events_term_id()]. |
|
| 6 |
#' |
|
| 7 |
#' @param id (`character`) id of this module. set to `NULL` if you want to make it identical |
|
| 8 |
#' to the module who called it. |
|
| 9 |
#' @param titles (`character`) default titles |
|
| 10 |
#' @param footnotes (`character`) default footnotes |
|
| 11 |
#' @inheritParams argument_convention |
|
| 12 |
#' @export |
|
| 13 |
ui_g_decorate <- function(id, |
|
| 14 |
titles = "Titles", |
|
| 15 |
footnotes = "footnotes", |
|
| 16 |
fontsize = c(5, 4, 11)) {
|
|
| 17 | ! |
ns <- NS(id) |
| 18 | ! |
tagList( |
| 19 | ! |
teal.widgets::optionalSliderInputValMinMax( |
| 20 | ! |
ns("fontsize"),
|
| 21 | ! |
"Font Size", |
| 22 | ! |
value_min_max = fontsize, |
| 23 | ! |
step = 0.1 |
| 24 |
), |
|
| 25 | ! |
textInput(ns("title"), "Title", value = titles),
|
| 26 | ! |
textAreaInput(ns("foot"), "Footnote", value = footnotes, resize = "none")
|
| 27 |
) |
|
| 28 |
} |
|
| 29 | ||
| 30 |
#' Helper server function to decorate plot output |
|
| 31 |
#' |
|
| 32 |
#' @description |
|
| 33 |
#' |
|
| 34 |
#' This is used in [tm_g_ae_oview()] and [tm_g_events_term_id()]. |
|
| 35 |
#' |
|
| 36 |
#' @inheritParams shared_params |
|
| 37 |
#' @param id (`character`) id of the module |
|
| 38 |
#' @param plot_id (`character`) id for plot output |
|
| 39 |
#' @param plt (`reactive`) a reactive object of graph object |
|
| 40 |
#' |
|
| 41 |
#' @export |
|
| 42 |
srv_g_decorate <- function(id, |
|
| 43 |
plot_id = "out", |
|
| 44 |
plt = reactive(NULL), |
|
| 45 |
plot_height, |
|
| 46 |
plot_width) {
|
|
| 47 | ! |
moduleServer(id, function(input, output, session) {
|
| 48 | ! |
teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 49 | ! |
plot_g <- reactive({
|
| 50 | ! |
g <- tern::decorate_grob( |
| 51 | ! |
plt(), |
| 52 | ! |
titles = input$title, |
| 53 | ! |
footnotes = input$foot, |
| 54 | ! |
gp_titles = grid::gpar( |
| 55 | ! |
fontsize = input$fontsize * ggplot2::.pt, |
| 56 | ! |
col = "black", |
| 57 | ! |
fontface = "bold" |
| 58 |
), |
|
| 59 | ! |
gp_footnotes = grid::gpar(fontsize = input$fontsize * ggplot2::.pt, col = "black") |
| 60 |
) |
|
| 61 |
}) |
|
| 62 | ||
| 63 | ! |
plot_r <- function() {
|
| 64 | ! |
grid::grid.newpage() |
| 65 | ! |
grid::grid.draw(plot_g()) |
| 66 | ! |
plot_g() |
| 67 |
} |
|
| 68 | ||
| 69 | ! |
class(plot_r) <- c(class(plot_r), "reactive") |
| 70 | ||
| 71 | ! |
pws <- teal.widgets::plot_with_settings_srv( |
| 72 | ! |
id = plot_id, |
| 73 | ! |
plot_r = plot_r, |
| 74 | ! |
height = plot_height, |
| 75 | ! |
width = plot_width |
| 76 |
) |
|
| 77 | ||
| 78 | ! |
list(font_size = reactive(input$fontsize), pws = pws) |
| 79 |
}) |
|
| 80 |
} |
|
| 81 | ||
| 82 |
#' Helper function to plot decorated output UI |
|
| 83 |
#' |
|
| 84 |
#' @description |
|
| 85 |
#' |
|
| 86 |
#' @param id (`character`) id of this element |
|
| 87 |
#' |
|
| 88 |
#' @export |
|
| 89 |
plot_decorate_output <- function(id) {
|
|
| 90 | ! |
ns <- NS(id) |
| 91 | ! |
teal.widgets::plot_with_settings_ui(id = ns("out"))
|
| 92 |
} |