| 1 |
- #' Teal module for the heatmap by grade+ #' Patient Profile plot teal module |
||
| 6 |
- #' Display the heatmap by grade as a shiny module+ #' Display patient profile plot as a shiny module |
||
| 10 |
- #' @param sl_dataname (`character`) subject level dataset name,+ #' @param patient_id (`choices_seleced`) unique subject ID variable |
||
| 11 |
- #' needs to be available in the list passed to the `data`+ #' @param sl_dataname (`character`) subject level dataset name, |
||
| 12 |
- #' argument of [teal::init()]+ #' needs to be available in the list passed to the `data` |
||
| 13 |
- #' @param ex_dataname (`character`) exposures dataset name,+ #' argument of [teal::init()] |
||
| 14 |
- #' needs to be available in the list passed to the `data`+ #' @param ex_dataname,ae_dataname,rs_dataname,cm_dataname,lb_dataname |
||
| 15 |
- #' argument of [teal::init()] \cr+ #' (`character(1)`) names of exposure, adverse events, response, |
||
| 16 |
- #' @param ae_dataname (`character`) adverse events dataset name,+ #' concomitant medications, and labs datasets, respectively; |
||
| 17 |
- #' needs to be available in the list passed to the `data`+ #' must be available in the list passed to the `data` |
||
| 18 |
- #' argument of [teal::init()] \cr+ #' argument of [teal::init()]\cr |
||
| 19 |
- #' @param cm_dataname (`character`) concomitant medications dataset name,+ #' set to NA (default) to omit from analysis |
||
| 20 |
- #' needs to be available in the list passed to the `data`+ #' @param sl_start_date `choices_selected` study start date variable, usually set to |
||
| 21 |
- #' argument of [teal::init()] \cr+ #' treatment start date or randomization date |
||
| 22 |
- #' specify to `NA` if no concomitant medications data is available+ #' @param ex_var `choices_selected` exposure variable to plot as each line \cr |
||
| 23 |
- #' @param id_var (`choices_seleced`) unique subject ID variable+ #' leave unspecified or set to `NULL` if exposure data is not available |
||
| 24 |
- #' @param visit_var (`choices_seleced`) analysis visit variable+ #' @param ae_var `choices_selected` adverse event variable to plot as each line \cr |
||
| 25 |
- #' @param ongo_var (`choices_seleced`) study ongoing status variable.+ #' leave unspecified or set to `NULL` if adverse events data is not available |
||
| 26 |
- #' This variable is a derived logical variable. Usually it can be derived from `EOSSTT`.+ #' @param ae_line_col_var `choices_selected` variable for coloring `AE` lines \cr |
||
| 27 |
- #' @param anno_var (`choices_seleced`) annotation variable+ #' leave unspecified or set to `NULL` if adverse events data is not available |
||
| 28 |
- #' @param heat_var (`choices_seleced`) heatmap variable+ #' @param ae_line_col_opt aesthetic values to map color values |
||
| 29 |
- #' @param conmed_var (`choices_seleced`) concomitant medications variable,+ #' (named vector to map color values to each name). |
||
| 30 |
- #' specify to `NA` if no concomitant medications data is available+ #' If not `NULL`, please make sure this contains all possible |
||
| 31 |
- #'+ #' values for `ae_line_col_var` values. \cr |
||
| 32 |
- #' @inherit argument_convention return+ #' 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 |
- #' @export+ #' leave unspecified or set to `NULL` if response data is not available |
||
| 35 |
- #'+ #' @param cm_var `choices_selected` concomitant medication variable |
||
| 36 |
- #' @examples+ #' to plot as each line \cr |
||
| 37 |
- #' data <- teal_data() |>+ #' leave unspecified or set to `NULL` if concomitant medications data is not available |
||
| 38 |
- #' within({
+ #' @param lb_var `choices_selected` lab variable to plot as each line \cr |
||
| 39 |
- #' library(dplyr)+ #' leave unspecified or set to `NULL` if labs data is not available |
||
| 40 |
- #' ADSL <- rADSL %>% slice(1:30)+ #' @param x_limit a single `character` string with two numbers |
||
| 41 |
- #' ADEX <- rADEX %>% filter(USUBJID %in% ADSL$USUBJID)+ #' separated by a comma indicating the x-axis limit, |
||
| 42 |
- #' ADAE <- rADAE %>% filter(USUBJID %in% ADSL$USUBJID)+ #' default is "-28, 365" |
||
| 43 |
- #' ADCM <- rADCM %>% filter(USUBJID %in% ADSL$USUBJID)+ #' |
||
| 44 |
- #' # This preprocess is only to force legacy standard on ADCM+ #' @author Xuefeng Hou (houx14) \email{houx14@gene.com}
|
||
| 45 |
- #' ADCM <- ADCM %>%+ #' @author Tina Cho (chot) \email{tina.cho@roche.com}
|
||
| 46 |
- #' select(-starts_with("ATC")) %>%
+ #' @author Molly He (hey59) \email{hey59@gene.com}
|
||
| 47 |
- #' unique()+ #' @template author_qit3 |
||
| 48 |
- #' # function to derive AVISIT from ADEX+ #' |
||
| 49 |
- #' add_visit <- function(data_need_visit) {
+ #' @inherit argument_convention return |
||
| 50 |
- #' visit_dates <- ADEX %>%+ #' |
||
| 51 |
- #' filter(PARAMCD == "DOSE") %>%+ #' @details |
||
| 52 |
- #' distinct(USUBJID, AVISIT, ASTDTM) %>%+ #' As the patient profile module plots different domains in one plot, the study day (x-axis) |
||
| 53 |
- #' group_by(USUBJID) %>%+ #' is derived for consistency based the start date of user's choice in the app (for example, |
||
| 54 |
- #' arrange(ASTDTM) %>%+ #' `ADSL.RANDDT` or `ADSL.TRTSDT`): |
||
| 55 |
- #' mutate(next_vis = lead(ASTDTM), is_last = ifelse(is.na(next_vis), TRUE, FALSE)) %>%+ #' - In `ADAE`, `ADEX`, and `ADCM`, it would be study day based on `ASTDT` and/or |
||
| 56 |
- #' rename(this_vis = ASTDTM)+ #' `AENDT` in reference to the start date |
||
| 57 |
- #' data_visit <- data_need_visit %>%+ #' - In `ADRS` and `ADLB`, it would be study day based on `ADT` in reference to |
||
| 58 |
- #' select(USUBJID, ASTDTM) %>%+ #' the start date |
||
| 59 |
- #' left_join(visit_dates, by = "USUBJID") %>%+ #' |
||
| 60 |
- #' filter(ASTDTM > this_vis & (ASTDTM < next_vis | is_last == TRUE)) %>%+ #' @export |
||
| 61 |
- #' left_join(data_need_visit) %>%+ #' |
||
| 62 |
- #' distinct()+ #' @examples |
||
| 63 |
- #' return(data_visit)+ #' data <- teal_data() |> |
||
| 64 |
- #' }+ #' within({
|
||
| 65 |
- #' # derive AVISIT for ADAE and ADCM+ #' ADSL <- rADSL |
||
| 66 |
- #' ADAE <- add_visit(ADAE)+ #' ADAE <- rADAE %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM)) |
||
| 67 |
- #' ADCM <- add_visit(ADCM)+ #' ADCM <- rADCM %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM)) |
||
| 68 |
- #' # derive ongoing status variable for ADEX+ #' # The step below is to pre-process ADCM to legacy standard |
||
| 69 |
- #' ADEX <- ADEX %>%+ #' ADCM <- ADCM %>% |
||
| 70 |
- #' filter(PARCAT1 == "INDIVIDUAL") %>%+ #' select(-starts_with("ATC")) %>%
|
||
| 71 |
- #' mutate(ongo_status = (EOSSTT == "ONGOING"))+ #' unique() |
||
| 72 |
- #' })+ #' ADRS <- rADRS %>% mutate(ADT = as.Date(ADTM)) |
||
| 73 |
- #'+ #' ADEX <- rADEX %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM)) |
||
| 74 |
- #' datanames(data) <- c("ADSL", "ADEX", "ADAE", "ADCM")
+ #' ADLB <- rADLB %>% mutate(ADT = as.Date(ADTM), LBSTRESN = as.numeric(LBSTRESC)) |
||
| 75 |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ #' }) |
||
| 77 |
- #' ADCM <- data[["ADCM"]]+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
||
| 79 |
- #' app <- init(+ #' ADSL <- data[["ADSL"]] |
||
| 80 |
- #' data = data,+ #' |
||
| 81 |
- #' modules = modules(+ #' app <- init( |
||
| 82 |
- #' tm_g_heat_bygrade(+ #' data = data, |
||
| 83 |
- #' label = "Heatmap by grade",+ #' modules = modules( |
||
| 84 |
- #' sl_dataname = "ADSL",+ #' tm_g_patient_profile( |
||
| 85 |
- #' ex_dataname = "ADEX",+ #' label = "Patient Profile Plot", |
||
| 86 |
- #' ae_dataname = "ADAE",+ #' patient_id = choices_selected( |
||
| 87 |
- #' cm_dataname = "ADCM",+ #' choices = unique(ADSL$USUBJID), |
||
| 88 |
- #' id_var = choices_selected(+ #' selected = unique(ADSL$USUBJID)[1] |
||
| 89 |
- #' selected = "USUBJID",+ #' ), |
||
| 90 |
- #' choices = c("USUBJID", "SUBJID")
+ #' sl_dataname = "ADSL", |
||
| 91 |
- #' ),+ #' ex_dataname = "ADEX", |
||
| 92 |
- #' visit_var = choices_selected(+ #' ae_dataname = "ADAE", |
||
| 93 |
- #' selected = "AVISIT",+ #' rs_dataname = "ADRS", |
||
| 94 |
- #' choices = c("AVISIT")
+ #' cm_dataname = "ADCM", |
||
| 95 |
- #' ),+ #' lb_dataname = "ADLB", |
||
| 96 |
- #' ongo_var = choices_selected(+ #' sl_start_date = choices_selected( |
||
| 97 |
- #' selected = "ongo_status",+ #' selected = "TRTSDTM", |
||
| 98 |
- #' choices = c("ongo_status")
+ #' choices = c("TRTSDTM", "RANDDT")
|
||
| 100 |
- #' anno_var = choices_selected(+ #' ex_var = choices_selected( |
||
| 101 |
- #' selected = c("SEX", "COUNTRY"),
+ #' selected = "PARCAT2", |
||
| 102 |
- #' choices = c("SEX", "COUNTRY", "USUBJID")
+ #' choices = "PARCAT2" |
||
| 104 |
- #' heat_var = choices_selected(+ #' ae_var = choices_selected( |
||
| 105 |
- #' selected = "AETOXGR",+ #' selected = "AEDECOD", |
||
| 106 |
- #' choices = c("AETOXGR")
+ #' choices = c("AEDECOD", "AESOC")
|
||
| 108 |
- #' conmed_var = choices_selected(+ #' ae_line_col_var = choices_selected( |
||
| 109 |
- #' selected = "CMDECOD",+ #' selected = "AESER", |
||
| 110 |
- #' choices = c("CMDECOD")
+ #' choices = c("AESER", "AEREL")
|
||
| 112 |
- #' plot_height = c(600, 200, 2000)+ #' ae_line_col_opt = c("Y" = "red", "N" = "blue"),
|
||
| 113 |
- #' )+ #' rs_var = choices_selected( |
||
| 114 |
- #' )+ #' selected = "PARAMCD", |
||
| 115 |
- #' )+ #' choices = "PARAMCD" |
||
| 116 |
- #' if (interactive()) {
+ #' ), |
||
| 117 |
- #' shinyApp(app$ui, app$server)+ #' cm_var = choices_selected( |
||
| 118 |
- #' }+ #' selected = "CMDECOD", |
||
| 119 |
- #'+ #' choices = c("CMDECOD", "CMCAT")
|
||
| 120 |
- tm_g_heat_bygrade <- function(label,+ #' ), |
||
| 121 |
- sl_dataname,+ #' lb_var = choices_selected( |
||
| 122 |
- ex_dataname,+ #' selected = "LBTESTCD", |
||
| 123 |
- ae_dataname,+ #' choices = c("LBTESTCD", "LBCAT")
|
||
| 124 |
- cm_dataname = NA,+ #' ), |
||
| 125 |
- id_var,+ #' x_limit = "-28, 750", |
||
| 126 |
- visit_var,+ #' plot_height = c(1200, 400, 5000) |
||
| 127 |
- ongo_var,+ #' ) |
||
| 128 |
- anno_var,+ #' ) |
||
| 129 |
- heat_var,+ #' ) |
||
| 130 |
- conmed_var = NULL,+ #' if (interactive()) {
|
||
| 131 |
- fontsize = c(5, 3, 7),+ #' shinyApp(app$ui, app$server) |
||
| 132 |
- plot_height = c(600L, 200L, 2000L),+ #' } |
||
| 133 |
- plot_width = NULL) {
+ #' |
||
| 134 | -! | +
- message("Initializing tm_g_heat_bygrade")
+ tm_g_patient_profile <- function(label = "Patient Profile Plot", |
|
| 135 | -! | +
- args <- as.list(environment())+ patient_id, |
|
| 136 |
-
+ sl_dataname, |
||
| 137 | -! | +
- checkmate::assert_string(label)+ ex_dataname = NA, |
|
| 138 | -! | +
- checkmate::assert_string(sl_dataname)+ ae_dataname = NA, |
|
| 139 | -! | +
- checkmate::assert_string(ex_dataname)+ rs_dataname = NA, |
|
| 140 | -! | +
- checkmate::assert_string(ae_dataname)+ cm_dataname = NA, |
|
| 141 | -! | +
- checkmate::assert_string(cm_dataname, na.ok = TRUE)+ lb_dataname = NA, |
|
| 142 | -! | +
- checkmate::assert_class(id_var, classes = "choices_selected")+ sl_start_date, |
|
| 143 | -! | +
- checkmate::assert_class(visit_var, classes = "choices_selected")+ ex_var = NULL, |
|
| 144 | -! | +
- checkmate::assert_class(ongo_var, classes = "choices_selected")+ ae_var = NULL, |
|
| 145 | -! | +
- checkmate::assert_class(anno_var, classes = "choices_selected")+ ae_line_col_var = NULL, |
|
| 146 | -! | +
- checkmate::assert_class(heat_var, classes = "choices_selected")+ ae_line_col_opt = NULL, |
|
| 147 | -! | +
- checkmate::assert_class(conmed_var, classes = "choices_selected", null.ok = TRUE)+ rs_var = NULL, |
|
| 148 | -! | +
- checkmate::assert(+ cm_var = NULL, |
|
| 149 | -! | +
- checkmate::check_number(fontsize, finite = TRUE),+ lb_var = NULL, |
|
| 150 | -! | +
- checkmate::assert(+ x_limit = "-28, 365", |
|
| 151 | -! | +
- combine = "and",+ plot_height = c(1200L, 400L, 5000L), |
|
| 152 | -! | +
- .var.name = "fontsize",+ plot_width = NULL, |
|
| 153 | -! | +
- checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE),+ pre_output = NULL, |
|
| 154 | -! | +
- checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3])+ post_output = NULL) {
|
|
| 155 | -+ | ! |
- )+ args <- as.list(environment()) |
| 156 | -+ | ! |
- )+ checkmate::assert_string(label) |
| 157 | ! |
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ checkmate::assert_string(sl_dataname) |
|
| 158 | ! |
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ checkmate::assert_string(ex_dataname, na.ok = TRUE) |
|
| 159 | ! |
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ checkmate::assert_string(ae_dataname, na.ok = TRUE) |
|
| 160 | ! |
- checkmate::assert_numeric(+ checkmate::assert_string(rs_dataname, na.ok = TRUE) |
|
| 161 | ! |
- plot_width[1],+ checkmate::assert_string(cm_dataname, na.ok = TRUE) |
|
| 162 | ! |
- lower = plot_width[2],+ checkmate::assert_string(lb_dataname, na.ok = TRUE) |
|
| 163 | ! |
- upper = plot_width[3],+ checkmate::assert_character( |
|
| 164 | ! |
- null.ok = TRUE,+ c(sl_dataname, ex_dataname, rs_dataname, cm_dataname, lb_dataname), |
|
| 165 | ! |
- .var.name = "plot_width"+ any.missing = TRUE, all.missing = FALSE |
|
| 167 | -+ | ! |
-
+ checkmate::assert_class(sl_start_date, classes = "choices_selected") |
| 168 | ! |
- module(+ checkmate::assert_class(ex_var, classes = "choices_selected", null.ok = TRUE) |
|
| 169 | ! |
- label = label,+ checkmate::assert_class(ae_var, classes = "choices_selected", null.ok = TRUE) |
|
| 170 | ! |
- server = srv_g_heatmap_bygrade,+ checkmate::assert_class(ae_line_col_var, classes = "choices_selected", null.ok = TRUE) |
|
| 171 | ! |
- server_args = list(+ checkmate::assert_class(rs_var, classes = "choices_selected", null.ok = TRUE) |
|
| 172 | ! |
- label = label,+ checkmate::assert_class(cm_var, classes = "choices_selected", null.ok = TRUE) |
|
| 173 | ! |
- sl_dataname = sl_dataname,+ checkmate::assert_class(lb_var, classes = "choices_selected", null.ok = TRUE) |
|
| 174 | ! |
- ex_dataname = ex_dataname,+ checkmate::assert_string(x_limit) |
|
| 175 | ! |
- ae_dataname = ae_dataname,+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
|
| 176 | ! |
- cm_dataname = cm_dataname,+ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
|
| 177 | ! |
- plot_height = plot_height,+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
|
| 178 | ! |
- plot_width = plot_width+ checkmate::assert_numeric( |
|
| 179 | -+ | ! |
- ),+ plot_width[1], |
| 180 | ! |
- ui = ui_g_heatmap_bygrade,+ lower = plot_width[2], |
|
| 181 | ! |
- ui_args = args,+ upper = plot_width[3], |
|
| 182 | ! |
- datanames = "all"+ null.ok = TRUE, |
|
| 183 | -+ | ! |
- )+ .var.name = "plot_width" |
| 184 |
- }+ ) |
||
| 186 | -+ | ! |
- ui_g_heatmap_bygrade <- function(id, ...) {
+ module( |
| 187 | ! |
- ns <- NS(id)+ label = label, |
|
| 188 | ! |
- args <- list(...)+ ui = ui_g_patient_profile, |
|
| 189 | -+ | ! |
-
+ ui_args = args, |
| 190 | ! |
- shiny::tagList(+ server = srv_g_patient_profile, |
|
| 191 | ! |
- include_css_files("custom"),
+ server_args = list( |
|
| 192 | ! |
- teal.widgets::standard_layout(+ patient_id = patient_id, |
|
| 193 | ! |
- output = teal.widgets::white_small_well(+ sl_dataname = sl_dataname, |
|
| 194 | ! |
- plot_decorate_output(id = ns(NULL))+ ex_dataname = ex_dataname, |
|
| 195 | -+ | ! |
- ),+ ae_dataname = ae_dataname, |
| 196 | ! |
- encoding = tags$div(+ rs_dataname = rs_dataname, |
|
| 197 | -+ | ! |
- ### Reporter+ cm_dataname = cm_dataname, |
| 198 | ! |
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ lb_dataname = lb_dataname, |
|
| 199 | -+ | ! |
- ###+ ae_line_col_opt = ae_line_col_opt, |
| 200 | ! |
- teal.widgets::optionalSelectInput(+ label = label, |
|
| 201 | ! |
- ns("id_var"),
+ plot_height = plot_height, |
|
| 202 | ! |
- "ID Variable",+ plot_width = plot_width |
|
| 203 | -! | +
- choices = get_choices(args$id_var$choices),+ ), |
|
| 204 | ! |
- selected = args$id_var$selected,+ datanames = "all" |
|
| 205 | -! | +
- multiple = FALSE+ ) |
|
| 206 |
- ),+ } |
||
| 207 | -! | +
- teal.widgets::optionalSelectInput(+ |
|
| 208 | -! | +
- ns("visit_var"),
+ ui_g_patient_profile <- function(id, ...) {
|
|
| 209 | ! |
- "Visit Variable",+ a <- list(...) |
|
| 210 | ! |
- choices = get_choices(args$visit_var$choices),+ ns <- NS(id) |
|
| 211 | ! |
- selected = args$visit_var$selected,+ checkboxes <- c(a$ex_dataname, a$ae_dataname, a$rs_dataname, a$lb_dataname, a$cm_dataname) |
|
| 212 | -! | +
- multiple = FALSE+ |
|
| 213 | -+ | ! |
- ),+ shiny::tagList( |
| 214 | ! |
- teal.widgets::optionalSelectInput(+ include_css_files("custom"),
|
|
| 215 | ! |
- ns("ongo_var"),
+ teal.widgets::standard_layout( |
|
| 216 | ! |
- "Study Ongoing Status Variable",+ output = teal.widgets::white_small_well( |
|
| 217 | ! |
- choices = get_choices(args$ongo_var$choices),+ teal.widgets::plot_with_settings_ui(id = ns("patientprofileplot"))
|
|
| 218 | -! | +
- selected = args$ongo_var$selected,+ ), |
|
| 219 | ! |
- multiple = FALSE+ encoding = tags$div( |
|
| 220 |
- ),+ ### Reporter |
||
| 221 | ! |
- teal.widgets::optionalSelectInput(+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
|
|
| 222 | -! | +
- ns("anno_var"),
+ ### |
|
| 223 | ! |
- "Annotation Variables",+ tags$label("Encodings", class = "text-primary"),
|
|
| 224 | ! |
- choices = get_choices(args$anno_var$choices),+ selectizeInput( |
|
| 225 | ! |
- selected = args$anno_var$selected,+ inputId = ns("patient_id"),
|
|
| 226 | ! |
- multiple = TRUE+ label = "Patient ID", |
|
| 227 | -+ | ! |
- ),+ choices = NULL |
| 228 | -! | +
- teal.widgets::optionalSelectInput(+ ), |
|
| 229 | ! |
- ns("heat_var"),
+ tags$div( |
|
| 230 | ! |
- "Heat Variable",+ tagList( |
|
| 231 | ! |
- choices = get_choices(args$heat_var$choices),+ helpText("Select", tags$code("ADaM"), "Domains"),
|
|
| 232 | ! |
- selected = args$heat_var$selected,+ checkboxGroupInput( |
|
| 233 | ! |
- multiple = FALSE+ inputId = ns("select_ADaM"),
|
|
| 234 | -+ | ! |
- ),+ label = NULL, |
| 235 | ! |
- helpText("Plot conmed"),
+ choices = checkboxes[!is.na(checkboxes)], |
|
| 236 | ! |
- tags$div(+ selected = checkboxes[!is.na(checkboxes)] |
|
| 237 | -! | +
- class = "pretty-left-border",+ ) |
|
| 238 | -! | +
- if (!is.na(args$cm_dataname)) {
+ ) |
|
| 239 | -! | +
- checkboxInput(+ ), |
|
| 240 | ! |
- ns("plot_cm"),
+ teal.widgets::optionalSelectInput( |
|
| 241 | ! |
- "Yes",+ ns("sl_start_date"),
|
|
| 242 | ! |
- value = !is.na(args$cm_dataname)+ "Start date variable", |
|
| 243 | -+ | ! |
- )+ choices = get_choices(a$sl_start_date$choices), |
| 244 | -+ | ! |
- }+ selected = a$sl_start_date$selected, |
| 245 | -+ | ! |
- ),+ multiple = FALSE, |
| 246 | ! |
- conditionalPanel(+ label_help = helpText( |
|
| 247 | ! |
- paste0("input['", ns("plot_cm"), "']"),
+ "from ", tags$code("ADSL")
|
|
| 248 | -! | +
- teal.widgets::optionalSelectInput(+ ) |
|
| 249 | -! | +
- ns("conmed_var"),
+ ), |
|
| 250 | ! |
- "Conmed Variable",+ conditionalPanel( |
|
| 251 | ! |
- choices = get_choices(args$conmed_var$choices),+ condition = sprintf("input['select_ADaM'].includes('%s')", a$ex_dataname),
|
|
| 252 | ! |
- selected = args$conmed_var$selected,+ ns = ns, |
|
| 253 | ! |
- multiple = FALSE+ selectInput( |
|
| 254 | -+ | ! |
- ),+ ns("ex_var"),
|
| 255 | ! |
- selectInput(+ "Exposure variable", |
|
| 256 | ! |
- ns("conmed_level"),
+ choices = get_choices(a$ex_var$choices), |
|
| 257 | ! |
- "Conmed Levels",+ selected = a$ex_var$selected, |
|
| 258 | ! |
- choices = get_choices(args$conmed_var$choices),+ multiple = FALSE |
|
| 259 | -! | +
- selected = args$conmed_var$selected,+ ) |
|
| 260 | -! | +
- multiple = TRUE+ ), |
|
| 261 | -+ | ! |
- )+ conditionalPanel( |
| 262 | -+ | ! |
- ),+ condition = sprintf("input['select_ADaM'].includes('%s')", a$ae_dataname),
|
| 263 | ! |
- ui_g_decorate(+ ns = ns, |
|
| 264 | ! |
- ns(NULL),+ teal.widgets::optionalSelectInput( |
|
| 265 | ! |
- fontsize = args$fontsize,+ ns("ae_var"),
|
|
| 266 | ! |
- titles = "Heatmap by Grade",+ "Adverse Event variable", |
|
| 267 | ! |
- footnotes = ""+ choices = get_choices(a$ae_var$choices), |
|
| 268 | -+ | ! |
- )+ selected = a$ae_var$selected, |
| 269 | -+ | ! |
- ),+ multiple = FALSE |
| 270 | -! | +
- forms = tagList(+ ), |
|
| 271 | ! |
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ teal.widgets::optionalSelectInput( |
|
| 272 | -+ | ! |
- )+ ns("ae_line_var"),
|
| 273 | -+ | ! |
- )+ "Adverse Event line color variable", |
| 274 | -+ | ! |
- )+ choices = get_choices(a$ae_line_col_var$choices), |
| 275 | -+ | ! |
- }+ selected = a$ae_line_col_var$selected, |
| 276 | -+ | ! |
-
+ multiple = FALSE |
| 277 |
- srv_g_heatmap_bygrade <- function(id,+ ) |
||
| 278 |
- data,+ ), |
||
| 279 | -+ | ! |
- filter_panel_api,+ conditionalPanel( |
| 280 | -+ | ! |
- reporter,+ condition = sprintf("input['select_ADaM'].includes('%s')", a$rs_dataname),
|
| 281 | -+ | ! |
- sl_dataname,+ ns = ns, |
| 282 | -+ | ! |
- ex_dataname,+ teal.widgets::optionalSelectInput( |
| 283 | -+ | ! |
- ae_dataname,+ ns("rs_var"),
|
| 284 | -+ | ! |
- cm_dataname,+ "Tumor response variable", |
| 285 | -+ | ! |
- label,+ choices = get_choices(a$rs_var$choices), |
| 286 | -+ | ! |
- plot_height,+ selected = a$rs_var$selected, |
| 287 | -+ | ! |
- plot_width) {
+ multiple = FALSE |
| 288 | -! | +
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ ) |
|
| 289 | -! | +
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ ), |
|
| 290 | ! |
- checkmate::assert_class(data, "reactive")+ conditionalPanel( |
|
| 291 | ! |
- checkmate::assert_class(shiny::isolate(data()), "teal_data")+ condition = sprintf("input['select_ADaM'].includes('%s')", a$cm_dataname),
|
|
| 292 | ! |
- if (!is.na(sl_dataname)) checkmate::assert_names(sl_dataname, subset.of = names(data))+ ns = ns, |
|
| 293 | ! |
- if (!is.na(ex_dataname)) checkmate::assert_names(ex_dataname, subset.of = names(data))+ teal.widgets::optionalSelectInput( |
|
| 294 | ! |
- if (!is.na(ae_dataname)) checkmate::assert_names(ae_dataname, subset.of = names(data))+ ns("cm_var"),
|
|
| 295 | ! |
- if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data))+ "Concomitant medicine variable", |
|
| 296 | -+ | ! |
-
+ choices = get_choices(a$cm_var$choices), |
| 297 | ! |
- moduleServer(id, function(input, output, session) {
+ selected = a$cm_var$selected, |
|
| 298 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ multiple = FALSE |
|
| 299 | -! | +
- iv <- reactive({
+ ) |
|
| 300 | -! | +
- ADSL <- data()[[sl_dataname]]+ ), |
|
| 301 | ! |
- ADEX <- data()[[ex_dataname]]+ conditionalPanel( |
|
| 302 | ! |
- ADAE <- data()[[ae_dataname]]+ condition = sprintf("input['select_ADaM'].includes('%s')", a$lb_dataname),
|
|
| 303 | ! |
- if (isTRUE(input$plot_cm)) {
+ ns = ns, |
|
| 304 | ! |
- ADCM <- data()[[cm_dataname]]+ teal.widgets::optionalSelectInput( |
|
| 305 | -+ | ! |
- }+ ns("lb_var"),
|
| 306 | -+ | ! |
-
+ "Lab variable", |
| 307 | ! |
- iv <- shinyvalidate::InputValidator$new()+ choices = get_choices(a$lb_var$choices), |
|
| 308 | ! |
- iv$add_rule("id_var", shinyvalidate::sv_required(
+ selected = a$lb_var$selected, |
|
| 309 | ! |
- message = "ID Variable is required"+ multiple = FALSE |
|
| 310 |
- ))+ ), |
||
| 311 | ! |
- iv$add_rule("visit_var", shinyvalidate::sv_required(
+ selectInput( |
|
| 312 | ! |
- message = "Visit Variable is required"+ ns("lb_var_show"),
|
|
| 313 | -+ | ! |
- ))+ "Lab values", |
| 314 | ! |
- iv$add_rule("ongo_var", shinyvalidate::sv_required(
+ choices = get_choices(a$lb_var$choices), |
|
| 315 | ! |
- message = "Study Ongoing Status Variable is required"+ selected = a$lb_var$selected, |
|
| 316 | -+ | ! |
- ))+ multiple = TRUE |
| 317 | -! | +
- iv$add_rule("ongo_var", shinyvalidate::sv_in_set(
+ ) |
|
| 318 | -! | +
- set = names(ADEX),+ ), |
|
| 319 | ! |
- message_fmt = sprintf("Study Ongoing Status must be a variable in %s", ex_dataname)
+ textInput( |
|
| 320 | -+ | ! |
- ))+ ns("x_limit"),
|
| 321 | ! |
- iv$add_rule("ongo_var", ~ if (!is.logical(ADEX[[req(.)]])) {
+ label = tags$div( |
|
| 322 | ! |
- "Study Ongoing Status must be a logical variable"+ "Study Days Range", |
|
| 323 | -+ | ! |
- })+ tags$br(), |
| 324 | ! |
- iv$add_rule("anno_var", shinyvalidate::sv_required(
+ helpText("Enter TWO numeric values of study days range, separated by comma (eg. -28, 750)")
|
|
| 325 | -! | +
- message = "Annotation Variables is required"+ ), |
|
| 326 | -+ | ! |
- ))+ value = a$x_limit |
| 327 | -! | +
- iv$add_rule("anno_var", ~ if (length(.) > 2L) {
+ ) |
|
| 328 | -! | +
- "No more than two Annotation Variables are allowed"+ ), |
|
| 329 | -+ | ! |
- })+ forms = tagList( |
| 330 | ! |
- iv$add_rule("anno_var", shinyvalidate::sv_in_set(
+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
|
| 331 | -! | +
- set = names(ADSL),+ ), |
|
| 332 | ! |
- message_fmt = sprintf("Study Ongoing Status must be a variable in %s", sl_dataname)
+ pre_output = a$pre_output, |
|
| 333 | -+ | ! |
- ))+ post_output = a$post_output |
| 334 | -! | +
- iv$add_rule("anno_var", ~ if (isTRUE(input$id_var %in% .)) {
+ ) |
|
| 335 | -! | +
- sprintf("Deselect %s in Annotation Variables", input$id_var)
+ ) |
|
| 336 |
- })+ } |
||
| 337 | -! | +
- iv$add_rule("heat_var", shinyvalidate::sv_required(
+
|
|
| 338 | -! | +
- message = "Heat Variable is required"+ srv_g_patient_profile <- function(id, |
|
| 339 |
- ))+ data, |
||
| 340 | -! | +
- iv$enable()+ filter_panel_api, |
|
| 341 | -! | +
- iv+ reporter, |
|
| 342 |
- })+ patient_id, |
||
| 343 | -! | +
- iv_cm <- reactive({
+ sl_dataname, |
|
| 344 | -! | +
- ADSL <- data()[[sl_dataname]]+ ex_dataname, |
|
| 345 | -! | +
- ADEX <- data()[[ex_dataname]]+ ae_dataname, |
|
| 346 | -! | +
- ADAE <- data()[[ae_dataname]]+ rs_dataname, |
|
| 347 | -! | +
- if (isTRUE(input$plot_cm)) {
+ lb_dataname, |
|
| 348 | -! | +
- ADCM <- data()[[cm_dataname]]+ cm_dataname, |
|
| 349 |
- }+ label, |
||
| 350 |
-
+ ae_line_col_opt, |
||
| 351 | -! | +
- iv_cm <- shinyvalidate::InputValidator$new()+ plot_height, |
|
| 352 | -! | +
- iv_cm$condition(~ isTRUE(input$plot_cm))+ plot_width) {
|
|
| 353 | ! |
- iv_cm$add_rule("conmed_var", shinyvalidate::sv_required(
+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
|
| 354 | ! |
- message = "Conmed Variable is required"+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelApi") |
|
| 355 | -+ | ! |
- ))+ checkmate::assert_class(data, "reactive") |
| 356 | ! |
- iv_cm$add_rule("conmed_var", shinyvalidate::sv_in_set(
+ checkmate::assert_class(shiny::isolate(data()), "teal_data") |
|
| 357 | ! |
- set = names(ADCM),+ if (!is.na(ex_dataname)) checkmate::assert_names(ex_dataname, subset.of = names(data)) |
|
| 358 | ! |
- message_fmt = sprintf("Conmed Variable must be a variable in %s", cm_dataname)
+ if (!is.na(ae_dataname)) checkmate::assert_names(ae_dataname, subset.of = names(data)) |
|
| 359 | -+ | ! |
- ))+ if (!is.na(rs_dataname)) checkmate::assert_names(rs_dataname, subset.of = names(data)) |
| 360 | ! |
- iv_cm$add_rule("conmed_var", ~ if (!is.factor(ADCM[[.]])) {
+ if (!is.na(lb_dataname)) checkmate::assert_names(lb_dataname, subset.of = names(data)) |
|
| 361 | ! |
- "Study Ongoing Status must be a factor variable"+ if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data)) |
|
| 362 | -+ | ! |
- })+ checkboxes <- c(ex_dataname, ae_dataname, rs_dataname, lb_dataname, cm_dataname) |
| 363 | ! |
- iv_cm$add_rule("conmed_level", shinyvalidate::sv_required(
+ moduleServer(id, function(input, output, session) {
|
|
| 364 | ! |
- "Select Conmed Levels"+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
|
| 365 | -+ | ! |
- ))+ select_plot <- reactive( |
| 366 | ! |
- iv_cm$add_rule("conmed_level", ~ if (length(.) > 3L) {
+ vapply(checkboxes, function(x) x %in% input$select_ADaM, logical(1L)) |
|
| 367 | -! | +
- "No more than three Conmed Levels are allowed"+ ) |
|
| 368 |
- })+ |
||
| 369 | ! |
- iv_cm$enable()+ resolved <- teal.transform::resolve_delayed(patient_id, as.list(isolate(data()))) |
|
| 370 | -! | +
- iv_cm+ |
|
| 371 | -+ | ! |
- })+ updateSelectizeInput( |
| 372 | -+ | ! |
-
+ session = session, |
| 373 | ! |
- decorate_output <- srv_g_decorate(+ inputId = "patient_id", |
|
| 374 | ! |
- id = NULL,+ choices = resolved$choices, |
|
| 375 | ! |
- plt = plot_r,+ selected = resolved$selected |
|
| 376 | -! | +
- plot_height = plot_height,+ ) |
|
| 377 | -! | +
- plot_width = plot_width+ |
|
| 378 | -+ | ! |
- )+ if (!is.na(lb_dataname)) {
|
| 379 | ! |
- font_size <- decorate_output$font_size+ observeEvent(input$lb_var, ignoreNULL = TRUE, {
|
|
| 380 | ! |
- pws <- decorate_output$pws+ ADLB <- data()[[lb_dataname]] |
|
| 381 | -+ | ! |
-
+ choices <- unique(ADLB[[input$lb_var]]) |
| 382 | ! |
- if (!is.na(cm_dataname)) {
+ choices_selected <- if (length(choices) > 5) choices[1:5] else choices |
|
| 383 | -! | +
- observeEvent(input$conmed_var, {
+
|
|
| 384 | ! |
- ADCM <- data()[[cm_dataname]]+ updateSelectInput( |
|
| 385 | ! |
- choices <- levels(ADCM[[input$conmed_var]])+ session, |
|
| 386 | -+ | ! |
-
+ "lb_var_show", |
| 387 | ! |
- updateSelectInput(+ selected = choices_selected, |
|
| 388 | ! |
- session,+ choices = choices |
|
| 389 | -! | +
- "conmed_level",+ ) |
|
| 390 | -! | +
- selected = choices[1:3],+ }) |
|
| 391 | -! | +
- choices = choices+ } |
|
| 392 |
- )+ |
||
| 393 | -+ | ! |
- })+ iv <- reactive({
|
| 394 | -+ | ! |
- }+ iv <- shinyvalidate::InputValidator$new() |
| 395 | -+ | ! |
-
+ iv$add_rule("select_ADaM", shinyvalidate::sv_required(
|
| 396 | ! |
- output_q <- shiny::debounce(+ message = "At least one ADaM data set is required" |
|
| 397 | -! | +
- millis = 200,+ )) |
|
| 398 | ! |
- r = reactive({
+ iv$add_rule("sl_start_date", shinyvalidate::sv_required(
|
|
| 399 | ! |
- ADSL <- data()[[sl_dataname]]+ message = "Date variable is required" |
|
| 400 | -! | +
- ADEX <- data()[[ex_dataname]]+ )) |
|
| 401 | ! |
- ADAE <- data()[[ae_dataname]]+ if (isTRUE(select_plot()[ex_dataname])) {
|
|
| 402 | ! |
- ADCM <- data()[[cm_dataname]]+ iv$add_rule("ex_var", shinyvalidate::sv_required(
|
|
| 403 | -+ | ! |
-
+ message = "Exposure variable is required" |
| 404 | -! | +
- teal::validate_has_data(ADSL, min_nrow = 1, msg = sprintf("%s contains no data", sl_dataname))
+ )) |
|
| 405 | -! | +
- teal::validate_inputs(iv(), iv_cm())+ } |
|
| 406 | ! |
- if (isTRUE(input$plot_cm)) {
+ if (isTRUE(select_plot()[ae_dataname])) {
|
|
| 407 | ! |
- shiny::validate(shiny::need(all(input$conmed_level %in% ADCM[[input$conmed_var]]), "Updating Conmed Levels"))+ iv$add_rule("ae_var", shinyvalidate::sv_required(
|
|
| 408 | -+ | ! |
- }+ message = "Adverse Event variable is required" |
| 409 |
-
+ )) |
||
| 410 | ! |
- qenv <- data()+ iv$add_rule("ae_line_var", shinyvalidate::sv_optional())
|
|
| 411 | -+ | ! |
-
+ iv$add_rule("ae_line_var", ~ if (length(levels(data()[[ae_dataname]][[.]])) > length(ae_line_col_opt)) {
|
| 412 | ! |
- if (isTRUE(input$plot_cm)) {
+ "Not enough colors provided for Adverse Event line color, unselect" |
|
| 413 | -! | +
- ADCM <- qenv[[cm_dataname]]+ }) |
|
| 414 | -! | +
- qenv <- teal.code::eval_code(+ } |
|
| 415 | ! |
- qenv,+ if (isTRUE(select_plot()[rs_dataname])) {
|
|
| 416 | ! |
- code = substitute(+ iv$add_rule("rs_var", shinyvalidate::sv_required(
|
|
| 417 | ! |
- expr = {
+ message = "Tumor response variable is required" |
|
| 418 | -! | +
- conmed_data <- ADCM %>%+ )) |
|
| 419 | -! | +
- filter(conmed_var_name %in% conmed_level)+ } |
|
| 420 | ! |
- conmed_data[[conmed_var]] <-+ if (isTRUE(select_plot()[cm_dataname])) {
|
|
| 421 | ! |
- factor(conmed_data[[conmed_var]], levels = unique(conmed_data[[conmed_var]]))+ iv$add_rule("cm_var", shinyvalidate::sv_required(
|
|
| 422 | ! |
- formatters::var_labels(conmed_data)[conmed_var] <-+ message = "Concomitant medicine variable is required" |
|
| 423 | -! | +
- formatters::var_labels(ADCM, fill = FALSE)[conmed_var]+ )) |
|
| 424 |
- },+ } |
||
| 425 | ! |
- env = list(+ if (isTRUE(select_plot()[lb_dataname])) {
|
|
| 426 | ! |
- ADCM = as.name(cm_dataname),+ iv$add_rule("lb_var", shinyvalidate::sv_required(
|
|
| 427 | ! |
- conmed_var = input$conmed_var,+ message = "Lab variable is required" |
|
| 428 | -! | +
- conmed_var_name = as.name(input$conmed_var),+ )) |
|
| 429 | ! |
- conmed_level = input$conmed_level+ iv$add_rule("lb_var_show", shinyvalidate::sv_required(
|
|
| 430 | -+ | ! |
- )+ message = "At least one Lab value is required" |
| 431 |
- )+ )) |
||
| 432 | -+ | ! |
- )+ rule_diff <- function(value, other) {
|
| 433 | -+ | ! |
- }+ if (isTRUE(any(value == other))) {
|
| 434 | -+ | ! |
-
+ "Lab variable and Lab value must be different" |
| 435 | -! | +
- qenv <- teal.code::eval_code(+ } |
|
| 436 | -! | +
- qenv,+ } |
|
| 437 | ! |
- code = bquote(+ iv$add_rule("lb_var", rule_diff, other = input$lb_var_show)
|
|
| 438 | ! |
- plot <- osprey::g_heat_bygrade(+ iv$add_rule("lb_var_show", rule_diff, other = input$lb_var)
|
|
| 439 | -! | +
- id_var = .(input$id_var),+ } |
|
| 440 | ! |
- exp_data = .(as.name(ex_dataname)) %>% filter(PARCAT1 == "INDIVIDUAL"),+ iv$add_rule("x_limit", shinyvalidate::sv_required(
|
|
| 441 | ! |
- visit_var = .(input$visit_var),+ message = "Study Days Range is required" |
|
| 442 | -! | +
- ongo_var = .(input$ongo_var),+ )) |
|
| 443 | ! |
- anno_data = .(as.name(sl_dataname))[c(.(input$anno_var), .(input$id_var))],+ iv$add_rule("x_limit", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
|
| 444 | ! |
- anno_var = .(input$anno_var),+ "Study Days Range is invalid" |
|
| 445 | -! | +
- heat_data = .(as.name(ae_dataname)) %>%+ }) |
|
| 446 | ! |
- select(.(as.name(input$id_var)), .(as.name(input$visit_var)), .(as.name(input$heat_var))),+ iv$add_rule("x_limit", ~ if (length(suppressWarnings(as_numeric_from_comma_sep_str(.))) != 2L) {
|
|
| 447 | ! |
- heat_color_var = .(input$heat_var),+ "Study Days Range must be two values" |
|
| 448 | -! | +
- conmed_data = .(if (isTRUE(input$plot_cm)) as.name("conmed_data")),
+ }) |
|
| 449 | ! |
- conmed_var = .(if (isTRUE(input$plot_cm)) input$conmed_var),+ iv$add_rule("x_limit", ~ if (!identical(order(suppressWarnings(as_numeric_from_comma_sep_str(.))), 1:2)) {
|
|
| 450 | -+ | ! |
- )+ "Study Days Range mut be: first lower, then upper limit" |
| 451 |
- )+ }) |
||
| 452 | -+ | ! |
- )+ iv$enable() |
| 453 | ! |
- teal.code::eval_code(qenv, quote(plot))+ iv |
|
| 454 |
- })+ }) |
||
| 455 |
- )+ |
||
| 456 |
-
+ # render plot |
||
| 457 | ! |
- plot_r <- reactive(output_q()[["plot"]])+ output_q <- shiny::debounce( |
|
| 458 | -+ | ! |
-
+ millis = 200, |
| 459 | ! |
- teal.widgets::verbatim_popup_srv(+ r = reactive({
|
|
| 460 | ! |
- id = "rcode",+ teal::validate_inputs(iv()) |
|
| 461 | -! | +
- title = paste("R code for", label),
+
|
|
| 462 | -! | +
- verbatim_content = reactive(teal.code::get_code(output_q()))+ # get inputs --- |
|
| 463 | -+ | ! |
- )+ patient_id <- input$patient_id |
| 464 | -+ | ! |
-
+ sl_start_date <- input$sl_start_date |
| 465 | -+ | ! |
- ### REPORTER+ ae_var <- input$ae_var |
| 466 | ! |
- if (with_reporter) {
+ ae_line_col_var <- input$ae_line_var |
|
| 467 | ! |
- card_fun <- function(comment, label) {
+ rs_var <- input$rs_var |
|
| 468 | ! |
- card <- teal::report_card_template(+ cm_var <- input$cm_var |
|
| 469 | ! |
- title = "Heatmap by Grade",+ ex_var <- input$ex_var |
|
| 470 | ! |
- label = label,+ lb_var <- input$lb_var |
|
| 471 | ! |
- with_filter = with_filter,+ x_limit <- input$x_limit |
|
| 472 | ! |
- filter_panel_api = filter_panel_api+ lb_var_show <- input$lb_var_show |
|
| 473 |
- )+ |
||
| 474 | ! |
- card$append_text("Plot", "header3")
+ adrs_vars <- unique(c( |
|
| 475 | ! |
- card$append_plot(plot_r(), dim = pws$dim())+ "USUBJID", "STUDYID", "PARAMCD", |
|
| 476 | ! |
- if (!comment == "") {
+ "PARAM", "AVALC", "AVAL", "ADY", |
|
| 477 | ! |
- card$append_text("Comment", "header3")
+ "ADT", rs_var |
|
| 478 | -! | +
- card$append_text(comment)+ )) |
|
| 479 | -+ | ! |
- }+ adae_vars <- unique(c( |
| 480 | ! |
- card$append_src(teal.code::get_code(output_q()))+ "USUBJID", "STUDYID", "ASTDT", |
|
| 481 | ! |
- card+ "AENDT", "AESOC", "AEDECOD", |
|
| 482 | -+ | ! |
- }+ "AESER", "AETOXGR", "AEREL", |
| 483 | ! |
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
+ "ASTDY", "AENDY", |
|
| 484 | -+ | ! |
- }+ ae_var, ae_line_col_var |
| 485 |
- })+ )) |
||
| 486 | -- |
- }- |
-
| 1 | -- |
- #' teal module for the `AE` by subgroups- |
- |
| 2 | -- |
- #'- |
- |
| 3 | -- |
- #' @description- |
- |
| 4 | -+ | ! |
- #' `r lifecycle::badge("stable")`
+ adcm_vars <- unique(c( |
| 5 | -+ | ||
| 487 | +! |
- #'+ "USUBJID", "STUDYID", "ASTDT", |
|
| 6 | -+ | ||
| 488 | +! |
- #' Display the `AE` by subgroups plot as a teal module+ "AENDT", "ASTDT", "CMDECOD", |
|
| 7 | -+ | ||
| 489 | +! |
- #'+ "ASTDY", "AENDY", "CMCAT", |
|
| 8 | -+ | ||
| 490 | +! |
- #' @inheritParams teal.widgets::standard_layout+ cm_var |
|
| 9 | +491 |
- #' @inheritParams argument_convention+ )) |
|
| 10 | -+ | ||
| 492 | +! |
- #' @param group_var (`choices_selected`) subgroups variables. See [teal.transform::choices_selected()] for details.+ adex_vars <- unique(c( |
|
| 11 | -+ | ||
| 493 | +! |
- #'+ "USUBJID", "STUDYID", "ASTDT", |
|
| 12 | -+ | ||
| 494 | +! |
- #' @author Liming Li (Lil128) \email{liming.li@roche.com}
+ "AENDT", "PARCAT2", "AVAL", |
|
| 13 | -+ | ||
| 495 | +! |
- #' @author Molly He (hey59) \email{hey59@gene.com}
+ "AVALU", "PARAMCD", "PARCAT1", |
|
| 14 | -+ | ||
| 496 | +! |
- #'+ "PARCAT2", ex_var |
|
| 15 | +497 |
- #' @inherit argument_convention return+ )) |
|
| 16 | -+ | ||
| 498 | +! |
- #'+ adlb_vars <- unique(c( |
|
| 17 | -+ | ||
| 499 | +! |
- #' @export+ "USUBJID", "STUDYID", "ANRIND", "LBSEQ", |
|
| 18 | -+ | ||
| 500 | +! |
- #'+ "PARAMCD", "BASETYPE", "ADT", "AVISITN", |
|
| 19 | -+ | ||
| 501 | +! |
- #' @examples+ "LBSTRESN", "LBCAT", "LBTESTCD", |
|
| 20 | -+ | ||
| 502 | +! |
- #' # Example using stream (ADaM) dataset+ lb_var |
|
| 21 | +503 |
- #' data <- teal_data() |>+ )) |
|
| 22 | +504 |
- #' within({
+
|
|
| 23 | +505 |
- #' ADSL <- rADSL+ # get ADSL dataset --- |
|
| 24 | -+ | ||
| 506 | +! |
- #' ADAE <- rADAE+ ADSL <- data()[[sl_dataname]] |
|
| 25 | +507 |
- #' })+ |
|
| 26 | -+ | ||
| 508 | +! |
- #'+ ADEX <- NULL |
|
| 27 | -+ | ||
| 509 | +! |
- #' datanames(data) <- c("ADSL", "ADAE")
+ if (isTRUE(select_plot()[ex_dataname])) {
|
|
| 28 | -+ | ||
| 510 | +! |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ ADEX <- data()[[ex_dataname]] |
|
| 29 | -+ | ||
| 511 | +! |
- #'+ teal::validate_has_variable(ADEX, adex_vars) |
|
| 30 | +512 |
- #' app <- init(+ } |
|
| 31 | -+ | ||
| 513 | +! |
- #' data = data,+ ADAE <- NULL |
|
| 32 | -+ | ||
| 514 | +! |
- #' modules = modules(+ if (isTRUE(select_plot()[ae_dataname])) {
|
|
| 33 | -+ | ||
| 515 | +! |
- #' tm_g_ae_sub(+ ADAE <- data()[[ae_dataname]] |
|
| 34 | -+ | ||
| 516 | +! |
- #' label = "AE by Subgroup",+ teal::validate_has_variable(ADAE, adae_vars) |
|
| 35 | +517 |
- #' dataname = "ADAE",+ } |
|
| 36 | -+ | ||
| 518 | +! |
- #' arm_var = choices_selected(+ ADRS <- NULL |
|
| 37 | -+ | ||
| 519 | +! |
- #' selected = "ACTARMCD",+ if (isTRUE(select_plot()[rs_dataname])) {
|
|
| 38 | -+ | ||
| 520 | +! |
- #' choices = c("ACTARM", "ACTARMCD")
+ ADRS <- data()[[rs_dataname]] |
|
| 39 | -+ | ||
| 521 | +! |
- #' ),+ teal::validate_has_variable(ADRS, adrs_vars) |
|
| 40 | +522 |
- #' group_var = choices_selected(+ } |
|
| 41 | -+ | ||
| 523 | +! |
- #' selected = c("SEX", "REGION1", "RACE"),
+ ADCM <- NULL |
|
| 42 | -+ | ||
| 524 | +! |
- #' choices = c("SEX", "REGION1", "RACE")
+ if (isTRUE(select_plot()[cm_dataname])) {
|
|
| 43 | -+ | ||
| 525 | +! |
- #' ),+ ADCM <- data()[[cm_dataname]] |
|
| 44 | -+ | ||
| 526 | +! |
- #' plot_height = c(600, 200, 2000)+ teal::validate_has_variable(ADCM, adcm_vars) |
|
| 45 | +527 |
- #' )+ } |
|
| 46 | -+ | ||
| 528 | +! |
- #' )+ ADLB <- NULL |
|
| 47 | -+ | ||
| 529 | +! |
- #' )+ if (isTRUE(select_plot()[lb_dataname])) {
|
|
| 48 | -+ | ||
| 530 | +! |
- #' if (interactive()) {
+ ADLB <- data()[[lb_dataname]] |
|
| 49 | -+ | ||
| 531 | +! |
- #' shinyApp(app$ui, app$server)+ teal::validate_has_variable(ADLB, adlb_vars) |
|
| 50 | +532 |
- #' }+ } |
|
| 51 | +533 |
- #'+ |
|
| 52 | -+ | ||
| 534 | +! |
- tm_g_ae_sub <- function(label,+ empty_rs <- FALSE |
|
| 53 | -+ | ||
| 535 | +! |
- dataname,+ empty_ae <- FALSE |
|
| 54 | -+ | ||
| 536 | +! |
- arm_var,+ empty_cm <- FALSE |
|
| 55 | -+ | ||
| 537 | +! |
- group_var,+ empty_ex <- FALSE |
|
| 56 | -+ | ||
| 538 | +! |
- plot_height = c(600L, 200L, 2000L),+ empty_lb <- FALSE |
|
| 57 | +539 |
- plot_width = NULL,+ |
|
| 58 | -+ | ||
| 540 | +! |
- fontsize = c(5, 3, 7)) {
+ q1 <- teal.code::eval_code( |
|
| 59 | +541 | ! |
- message("Initializing tm_g_ae_sub")
+ data(), |
| 60 | +542 | ! |
- checkmate::assert_class(arm_var, classes = "choices_selected")+ code = substitute( |
| 61 | +543 | ! |
- checkmate::assert_class(group_var, classes = "choices_selected")+ expr = {
|
| 62 | +544 | ! |
- checkmate::assert(+ ADSL <- ADSL %>% |
| 63 | +545 | ! |
- checkmate::check_number(fontsize, finite = TRUE),+ filter(USUBJID == patient_id) %>% |
| 64 | +546 | ! |
- checkmate::assert(+ group_by(USUBJID) %>% |
| 65 | +547 | ! |
- combine = "and",+ mutate( |
| 66 | +548 | ! |
- .var.name = "fontsize",+ max_date = pmax(as.Date(LSTALVDT), as.Date(DTHDT), na.rm = TRUE), |
| 67 | +549 | ! |
- checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE),+ max_day = as.numeric(difftime(as.Date(max_date), as.Date(sl_start_date), units = "days")) + |
| 68 | +550 | ! |
- checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3])+ (as.Date(max_date) >= as.Date(sl_start_date)) |
| 69 | +551 |
- )+ ) |
|
| 70 | +552 |
- )+ }, |
|
| 71 | +553 | ! |
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ env = list( |
| 72 | +554 | ! |
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ ADSL = as.name(sl_dataname), |
| 73 | +555 | ! |
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ sl_start_date = as.name(sl_start_date), |
| 74 | +556 | ! |
- checkmate::assert_numeric(+ patient_id = patient_id |
| 75 | -! | +||
| 557 | +
- plot_width[1],+ ) |
||
| 76 | -! | +||
| 558 | +
- lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"+ ) |
||
| 77 | +559 |
- )+ ) |
|
| 78 | +560 | ||
| 79 | -! | +||
| 561 | +
- module(+ # ADSL with single subject |
||
| 80 | +562 | ! |
- label = label,+ validate( |
| 81 | +563 | ! |
- server = srv_g_ae_sub,+ need( |
| 82 | +564 | ! |
- server_args = list(+ nrow(q1[["ADSL"]]) >= 1, |
| 83 | +565 | ! |
- label = label,+ paste( |
| 84 | +566 | ! |
- dataname = dataname,+ "Subject", |
| 85 | +567 | ! |
- plot_height = plot_height,+ patient_id, |
| 86 | +568 | ! |
- plot_width = plot_width+ "not found in the dataset. Perhaps they have been filtered out by the filter panel?" |
| 87 | +569 |
- ),- |
- |
| 88 | -! | -
- ui = ui_g_ae_sub,- |
- |
| 89 | -! | -
- ui_args = list(- |
- |
| 90 | -! | -
- arm_var = arm_var,- |
- |
| 91 | -! | -
- group_var = group_var,- |
- |
| 92 | -! | -
- fontsize = fontsize+ ) |
|
| 93 | +570 |
- ),- |
- |
| 94 | -! | -
- datanames = c("ADSL", dataname)
+ ) |
|
| 95 | +571 |
- )+ ) |
|
| 96 | +572 |
- }+ |
|
| 97 | +573 |
-
+ # name for ae_line_col |
|
| 98 | -+ | ||
| 574 | +! |
- ui_g_ae_sub <- function(id, ...) {
+ q1 <- if (!is.null(ae_line_col_var) && is.data.frame(ADAE)) {
|
|
| 99 | +575 | ! |
- ns <- NS(id)+ teal.code::eval_code( |
| 100 | +576 | ! |
- args <- list(...)+ q1, |
| 101 | +577 | ! |
- teal.widgets::standard_layout(+ code = substitute( |
| 102 | +578 | ! |
- output = teal.widgets::white_small_well(+ expr = ae_line_col_name <- formatters::var_labels(ADAE, fill = FALSE)[ae_line_col_var], |
| 103 | +579 | ! |
- plot_decorate_output(id = ns(NULL))+ env = list(ADAE = as.name(ae_dataname), ae_line_col_var = ae_line_col_var) |
| 104 | +580 |
- ),+ ) |
|
| 105 | -! | +||
| 581 | +
- encoding = tags$div(+ ) |
||
| 106 | +582 |
- ### Reporter+ } else {
|
|
| 107 | +583 | ! |
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ teal.code::eval_code(q1, code = quote(ae_line_col_name <- NULL)) |
| 108 | +584 |
- ###+ } |
|
| 109 | -! | +||
| 585 | +
- tags$label("Encodings", class = "text-primary"),
+
|
||
| 110 | +586 | ! |
- helpText("Analysis data:", tags$code("ADAE")),
+ q1 <- if (isTRUE(select_plot()[ae_dataname])) {
|
| 111 | +587 | ! |
- teal.widgets::optionalSelectInput(+ if (all(ADAE$USUBJID %in% ADSL$USUBJID)) {
|
| 112 | +588 | ! |
- ns("arm_var"),
+ qq <- teal.code::eval_code( |
| 113 | +589 | ! |
- "Arm Variable",+ q1, |
| 114 | +590 | ! |
- choices = get_choices(args$arm_var$choices),+ code = substitute( |
| 115 | +591 | ! |
- selected = args$arm_var$selected+ expr = {
|
| 116 | +592 |
- ),+ # ADAE |
|
| 117 | +593 | ! |
- selectInput(+ ADAE <- ADAE[, adae_vars] |
| 118 | -! | +||
| 594 | +
- ns("arm_trt"),
+
|
||
| 119 | +595 | ! |
- "Treatment",+ ADAE <- ADSL %>% |
| 120 | +596 | ! |
- choices = get_choices(args$arm_var$choices),+ left_join(ADAE, by = c("STUDYID", "USUBJID")) %>%
|
| 121 | +597 | ! |
- selected = args$arm_var$selected+ as.data.frame() %>% |
| 122 | -+ | ||
| 598 | +! |
- ),+ filter(!is.na(ASTDT), !is.na(AENDT)) %>% |
|
| 123 | +599 | ! |
- selectInput(+ mutate( |
| 124 | +600 | ! |
- ns("arm_ref"),
+ ASTDY = as.numeric(difftime(ASTDT, as.Date(sl_start_date), units = "days")) + |
| 125 | +601 | ! |
- "Control",+ (ASTDT >= as.Date(sl_start_date)), |
| 126 | +602 | ! |
- choices = get_choices(args$arm_var$choices),+ AENDY = as.numeric(difftime(AENDT, as.Date(sl_start_date), units = "days")) + |
| 127 | +603 | ! |
- selected = args$arm_var$selected+ (AENDT >= as.Date(sl_start_date)) |
| 128 | +604 |
- ),- |
- |
| 129 | -! | -
- checkboxInput(+ ) %>% |
|
| 130 | +605 | ! |
- ns("arm_n"),
+ select(c(adae_vars, ASTDY, AENDY)) |
| 131 | +606 | ! |
- "Show N in each arm",+ formatters::var_labels(ADAE)[ae_line_col_var] <- |
| 132 | +607 | ! |
- value = args$arm_n+ formatters::var_labels(ADAE, fill = FALSE)[ae_line_col_var] |
| 133 | +608 |
- ),+ }, |
|
| 134 | +609 | ! |
- teal.widgets::optionalSelectInput(+ env = list( |
| 135 | +610 | ! |
- ns("groups"),
+ ADSL = as.name(sl_dataname), |
| 136 | +611 | ! |
- "Group Variable",+ ADAE = as.name(ae_dataname), |
| 137 | +612 | ! |
- choices = get_choices(args$group_var$choices),+ sl_start_date = as.name(sl_start_date), |
| 138 | +613 | ! |
- selected = args$group_var$selected,+ ae_line_col_var = ae_line_col_var, |
| 139 | +614 | ! |
- multiple = TRUE+ adae_vars = adae_vars |
| 140 | +615 |
- ),+ ) |
|
| 141 | -! | +||
| 616 | +
- teal.widgets::panel_item(+ ) |
||
| 142 | -! | +||
| 617 | +
- "Change group labels",+ ) %>% |
||
| 143 | +618 | ! |
- uiOutput(ns("grouplabel_output"))
- |
-
| 144 | -- |
- ),+ teal.code::eval_code( |
|
| 145 | +619 | ! |
- teal.widgets::panel_item(+ code = substitute( |
| 146 | +620 | ! |
- "Additional plot settings",+ expr = ae <- list( |
| 147 | +621 | ! |
- teal.widgets::optionalSelectInput(+ data = data.frame(ADAE), |
| 148 | +622 | ! |
- ns("ci"),
+ var = as.vector(ADAE[, ae_var]), |
| 149 | +623 | ! |
- "CI method",+ line_col = line_col, |
| 150 | +624 | ! |
- choices = ci_choices,+ line_col_legend = line_col_legend, |
| 151 | +625 | ! |
- selected = ci_choices[1]+ line_col_opt = line_col_opt |
| 152 | +626 |
- ),+ ), |
|
| 153 | +627 | ! |
- teal.widgets::optionalSliderInput(+ env = list( |
| 154 | +628 | ! |
- ns("conf_level"),
+ ADAE = as.name(ae_dataname), |
| 155 | +629 | ! |
- "Significant Level",+ ae_var = ae_var, |
| 156 | +630 | ! |
- min = 0.5,+ line_col = if (!is.null(ae_line_col_var)) bquote(as.vector(ADAE[, .(ae_line_col_var)])) else NULL, |
| 157 | +631 | ! |
- max = 1,+ line_col_legend = ae_line_col_var, |
| 158 | +632 | ! |
- value = 0.95+ line_col_opt = ae_line_col_opt |
| 159 | +633 |
- ),+ ) |
|
| 160 | -! | +||
| 634 | +
- ui_g_decorate(+ ) |
||
| 161 | -! | +||
| 635 | +
- ns(NULL),+ ) |
||
| 162 | +636 | ! |
- fontsize = args$fontsize,+ ADAE <- qq[[ae_dataname]] |
| 163 | +637 | ! |
- titles = "AE Table with Subgroups",+ if (is.null(ADAE) | nrow(ADAE) == 0) {
|
| 164 | +638 | ! |
- footnotes = ""+ empty_ae <- TRUE |
| 165 | +639 |
- )+ } |
|
| 166 | -+ | ||
| 640 | +! |
- )+ |
|
| 167 | +641 |
- ),+ } else {
|
|
| 168 | +642 | ! |
- forms = tagList(+ empty_ae <- TRUE |
| 169 | +643 | ! |
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ teal.code::eval_code(q1, code = quote(ae <- NULL)) |
| 170 | +644 |
- )+ } |
|
| 171 | +645 |
- )+ } else {
|
|
| 172 | -+ | ||
| 646 | +! |
- }+ teal.code::eval_code(q1, code = quote(ae <- NULL)) |
|
| 173 | +647 |
-
+ } |
|
| 174 | +648 |
- srv_g_ae_sub <- function(id,+ |
|
| 175 | -+ | ||
| 649 | +! |
- data,+ q1 <- if (isTRUE(select_plot()[rs_dataname])) {
|
|
| 176 | -+ | ||
| 650 | +! |
- filter_panel_api,+ if (all(ADRS$USUBJID %in% ADSL$USUBJID)) {
|
|
| 177 | -+ | ||
| 651 | +! |
- reporter,- |
- |
| 178 | -- |
- dataname,- |
- |
| 179 | -- |
- label,- |
- |
| 180 | -- |
- plot_height,- |
- |
| 181 | -- |
- plot_width) {
+ qq <- teal.code::eval_code( |
|
| 182 | +652 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ q1, |
| 183 | +653 | ! |
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ code = substitute( |
| 184 | +654 | ! |
- checkmate::assert_class(data, "reactive")+ expr = {
|
| 185 | +655 | ! |
- checkmate::assert_class(shiny::isolate(data()), "teal_data")+ ADRS <- ADRS[, adrs_vars] |
| 186 | -+ | ||
| 656 | +! |
-
+ ADRS <- ADSL %>% |
|
| 187 | +657 | ! |
- moduleServer(id, function(input, output, session) {
+ left_join(ADRS, by = c("STUDYID", "USUBJID")) %>%
|
| 188 | +658 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ as.data.frame() %>% |
| 189 | +659 | ! |
- iv <- reactive({
+ mutate( |
| 190 | +660 | ! |
- ANL <- data()[[dataname]]+ ADY = as.numeric(difftime(ADT, as.Date(sl_start_date), units = "days")) + |
| 191 | +661 | ! |
- ADSL <- data()[["ADSL"]]+ (ADT >= as.Date(sl_start_date)) |
| 192 | +662 |
-
+ ) %>% |
|
| 193 | +663 | ! |
- iv <- shinyvalidate::InputValidator$new()+ select(USUBJID, PARAMCD, PARAM, AVALC, AVAL, ADY, ADT) %>% |
| 194 | +664 | ! |
- iv$add_rule("arm_var", shinyvalidate::sv_required(
+ filter(is.na(ADY) == FALSE) |
| 195 | +665 | ! |
- message = "Arm Variable is required"+ rs <- list(data = data.frame(ADRS), var = as.vector(ADRS[, rs_var])) |
| 196 | +666 |
- ))+ }, |
|
| 197 | +667 | ! |
- iv$add_rule("arm_var", ~ if (!is.factor(ANL[[.]])) {
+ env = list( |
| 198 | +668 | ! |
- "Arm Var must be a factor variable, contact developer"+ ADRS = as.name(rs_dataname), |
| 199 | -+ | ||
| 669 | +! |
- })+ adrs_vars = adrs_vars, |
|
| 200 | +670 | ! |
- rule_diff <- function(value, other) {
+ sl_start_date = as.name(sl_start_date), |
| 201 | +671 | ! |
- if (isTRUE(value == other)) "Control and Treatment must be different"+ rs_var = rs_var |
| 202 | +672 |
- }+ ) |
|
| 203 | -! | +||
| 673 | +
- iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
+ ) |
||
| 204 | -! | +||
| 674 | +
- iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
+ ) |
||
| 205 | +675 | ! |
- iv$add_rule("groups", shinyvalidate::sv_in_set(
+ ADRS <- qq[[rs_dataname]] |
| 206 | +676 | ! |
- names(ANL),+ if (is.null(ADRS) || nrow(ADRS) == 0) {
|
| 207 | +677 | ! |
- message_fmt = sprintf("Groups must be a variable in %s", dataname)
+ empty_rs <- TRUE |
| 208 | +678 |
- ))+ } |
|
| 209 | +679 | ! |
- iv$add_rule("groups", shinyvalidate::sv_in_set(
+ |
+
| 680 | ++ |
+ } else {
|
|
| 210 | +681 | ! |
- names(ADSL),+ empty_rs <- TRUE |
| 211 | +682 | ! |
- message_fmt = "Groups must be a variable in ADSL"+ teal.code::eval_code(q1, expression = quote(rs <- NULL)) |
| 212 | +683 |
- ))+ } |
|
| 213 | -! | +||
| 684 | +
- iv$enable()+ } else {
|
||
| 214 | +685 | ! |
- iv+ teal.code::eval_code(q1, code = quote(rs <- NULL)) |
| 215 | +686 |
- })+ } |
|
| 216 | +687 | ||
| 217 | -! | -
- decorate_output <- srv_g_decorate(- |
- |
| 218 | +688 | ! |
- id = NULL,+ q1 <- if (isTRUE(select_plot()[cm_dataname])) {
|
| 219 | +689 | ! |
- plt = plot_r,+ if (all(ADCM$USUBJID %in% ADSL$USUBJID)) {
|
| 220 | +690 | ! |
- plot_height = plot_height,+ qq <- teal.code::eval_code( |
| 221 | +691 | ! |
- plot_width = plot_width- |
-
| 222 | -- |
- )+ q1, |
|
| 223 | +692 | ! |
- font_size <- decorate_output$font_size+ code = substitute( |
| 224 | +693 | ! |
- pws <- decorate_output$pws+ expr = {
|
| 225 | +694 |
-
+ # ADCM |
|
| 226 | +695 | ! |
- observeEvent(input$arm_var, ignoreNULL = TRUE, {
+ ADCM <- ADCM[, adcm_vars] |
| 227 | +696 | ! |
- arm_var <- input$arm_var+ ADCM <- ADSL %>% |
| 228 | +697 | ! |
- ANL <- data()[[dataname]]- |
-
| 229 | -- |
-
+ left_join(ADCM, by = c("STUDYID", "USUBJID")) %>%
|
|
| 230 | +698 | ! |
- anl_val <- ANL[[arm_var]]+ as.data.frame() %>% |
| 231 | +699 | ! |
- choices <- levels(anl_val)- |
-
| 232 | -- |
-
+ filter(!is.na(ASTDT), !is.na(AENDT)) %>% |
|
| 233 | +700 | ! |
- if (length(choices) == 1) {
+ mutate( |
| 234 | +701 | ! |
- ref_index <- 1+ ASTDY = as.numeric(difftime(ASTDT, as.Date(sl_start_date), units = "days")) + |
| 235 | -+ | ||
| 702 | +! |
- } else {
+ (ASTDT >= as.Date(sl_start_date)), |
|
| 236 | +703 | ! |
- ref_index <- 2+ AENDY = as.numeric(difftime(AENDT, as.Date(sl_start_date), units = "days")) + |
| 237 | -+ | ||
| 704 | +! |
- }+ (AENDT >= as.Date(sl_start_date)) |
|
| 238 | +705 |
-
+ ) %>% |
|
| 239 | +706 | ! |
- updateSelectInput(+ select(USUBJID, ASTDT, AENDT, ASTDY, AENDY, !!quo(cm_var)) |
| 240 | +707 | ! |
- session,+ if (length(unique(ADCM$USUBJID)) > 0) {
|
| 241 | +708 | ! |
- "arm_trt",+ ADCM <- ADCM[which(ADCM$AENDY >= -28 | is.na(ADCM$AENDY) == TRUE & is.na(ADCM$ASTDY) == FALSE), ] |
| 242 | -! | +||
| 709 | +
- selected = choices[1],+ } |
||
| 243 | +710 | ! |
- choices = choices+ cm <- list(data = data.frame(ADCM), var = as.vector(ADCM[, cm_var])) |
| 244 | +711 |
- )+ }, |
|
| 245 | +712 | ! |
- updateSelectInput(+ env = list( |
| 246 | +713 | ! |
- session,+ ADSL = as.name(sl_dataname), |
| 247 | +714 | ! |
- "arm_ref",+ ADCM = as.name(cm_dataname), |
| 248 | +715 | ! |
- selected = choices[ref_index],+ sl_start_date = as.name(sl_start_date), |
| 249 | +716 | ! |
- choices = choices+ adcm_vars = adcm_vars, |
| 250 | -+ | ||
| 717 | +! |
- )+ cm_var = cm_var |
|
| 251 | +718 |
- })+ ) |
|
| 252 | +719 | - - | -|
| 253 | -! | -
- observeEvent(list(input$ci, input$conf_level, input$arm_trt, input$arm_ref), {
- |
- |
| 254 | -! | -
- diff_ci_method <- input$ci- |
- |
| 255 | -! | -
- conf_level <- input$conf_level+ ) |
|
| 256 | -! | +||
| 720 | +
- trt <- input$arm_trt+ ) |
||
| 257 | -! | +||
| 721 | +
- ref <- input$arm_ref+ |
||
| 258 | +722 | ! |
- updateTextAreaInput(+ ADCM <- qq[[cm_dataname]] |
| 259 | +723 | ! |
- session,+ if (is.null(ADCM) | nrow(ADCM) == 0) {
|
| 260 | +724 | ! |
- "foot",+ empty_cm <- TRUE |
| 261 | -! | +||
| 725 | +
- value = sprintf(+ } |
||
| 262 | +726 | ! |
- "Note: %d%% CI is calculated using %s\nTRT: %s; CONT: %s",+ |
| 263 | -! | +||
| 727 | +
- round(conf_level * 100),+ } else {
|
||
| 264 | +728 | ! |
- name_ci(diff_ci_method),+ empty_cm <- TRUE |
| 265 | +729 | ! |
- trt,+ teal.code::eval_code(q1, code = quote(cm <- NULL)) |
| 266 | -! | +||
| 730 | +
- ref+ } |
||
| 267 | +731 |
- )+ } else {
|
|
| 268 | -+ | ||
| 732 | +! |
- )+ teal.code::eval_code(q1, code = quote(cm <- NULL)) |
|
| 269 | +733 |
- })+ } |
|
| 270 | +734 | ||
| 271 | +735 | ! |
- observeEvent(input$groups, {
+ q1 <- if (isTRUE(select_plot()[ex_dataname])) {
|
| 272 | +736 | ! |
- ANL <- data()[[dataname]]+ if (all(ADEX$USUBJID %in% ADSL$USUBJID)) {
|
| 273 | +737 | ! |
- output$grouplabel_output <- renderUI({
+ qq <- teal.code::eval_code( |
| 274 | +738 | ! |
- grps <- input$groups+ q1, |
| 275 | +739 | ! |
- lo <- lapply(seq_along(grps), function(index) {
+ code = substitute( |
| 276 | +740 | ! |
- grp <- grps[index]+ expr = {
|
| 277 | -! | +||
| 741 | +
- choices <- levels(ANL[[grp]])+ # ADEX |
||
| 278 | +742 | ! |
- sel <- teal.widgets::optionalSelectInput(+ ADEX <- ADEX[, adex_vars] |
| 279 | +743 | ! |
- session$ns(sprintf("groups__%s", index)),
+ ADEX <- ADSL %>% |
| 280 | +744 | ! |
- grp,+ left_join(ADEX, by = c("STUDYID", "USUBJID")) %>%
|
| 281 | +745 | ! |
- choices,+ as.data.frame() %>% |
| 282 | +746 | ! |
- multiple = TRUE,+ filter(PARCAT1 == "INDIVIDUAL" & PARAMCD == "DOSE" & !is.na(AVAL) & !is.na(ASTDT)) %>% |
| 283 | +747 | ! |
- selected = choices+ select(USUBJID, ASTDT, PARCAT2, AVAL, AVALU, PARAMCD, sl_start_date) |
| 284 | +748 |
- )- |
- |
| 285 | -! | -
- textname <- sprintf("text_%s_out", index)
+
|
|
| 286 | +749 | ! |
- txt <- uiOutput(session$ns(textname))+ ADEX <- split(ADEX, ADEX$USUBJID) %>% |
| 287 | +750 | ! |
- observeEvent(+ lapply(function(pinfo) {
|
| 288 | +751 | ! |
- eventExpr = input[[sprintf("groups__%s", index)]],
+ pinfo %>% |
| 289 | +752 | ! |
- handlerExpr = {
+ arrange(PARCAT2, PARAMCD, ASTDT) %>% |
| 290 | +753 | ! |
- output[[textname]] <- renderUI({
+ ungroup() %>% |
| 291 | +754 | ! |
- if (!is.null(input[[sprintf("groups__%s", index)]])) {
+ mutate( |
| 292 | +755 | ! |
- l <- input[[sprintf("groups__%s", index)]]
+ diff = c(0, diff(AVAL, lag = 1)), |
| 293 | +756 | ! |
- l2 <- lapply(seq_along(l), function(i) {
+ Modification = case_when( |
| 294 | +757 | ! |
- nm <- sprintf("groups__%s__level__%s", index, i)
+ diff < 0 ~ "Decrease", |
| 295 | +758 | ! |
- label <- sprintf("Label for %s, Level %s", grp, l[i])
+ diff > 0 ~ "Increase", |
| 296 | +759 | ! |
- textInput(session$ns(nm), label, l[i])+ diff == 0 ~ "None" |
| 297 | +760 |
- })+ ), |
|
| 298 | +761 | ! |
- tagList(textInput(+ ASTDT_dur = as.numeric(difftime(as.Date(ASTDT), as.Date(sl_start_date), units = "days")) + |
| 299 | +762 | ! |
- session$ns(+ (as.Date(ASTDT) >= as.Date(sl_start_date)) |
| 300 | -! | +||
| 763 | +
- sprintf("groups__%s__level__%s", index, "all")
+ ) |
||
| 301 | +764 |
- ),+ }) %>% |
|
| 302 | +765 | ! |
- sprintf("Label for %s", grp), grp
+ Reduce(rbind, .) %>% |
| 303 | +766 | ! |
- ), l2)+ as.data.frame() %>% |
| 304 | -+ | ||
| 767 | +! |
- }+ select(-diff) |
|
| 305 | -+ | ||
| 768 | +! |
- })+ ex <- list(data = data.frame(ADEX), var = as.vector(ADEX[, ex_var])) |
|
| 306 | +769 |
- }+ }, |
|
| 307 | -+ | ||
| 770 | +! |
- )+ env = list( |
|
| 308 | +771 | ! |
- tagList(sel, txt)+ ADSL = as.name(sl_dataname), |
| 309 | -+ | ||
| 772 | +! |
- })+ ADEX = as.name(ex_dataname), |
|
| 310 | +773 | ! |
- ret <- tagList(lo)+ adex_vars = adex_vars, |
| 311 | +774 | ! |
- ret+ sl_start_date = as.name(sl_start_date),+ |
+
| 775 | +! | +
+ ex_var = ex_var |
|
| 312 | +776 |
- })+ ) |
|
| 313 | +777 |
- })+ ) |
|
| 314 | +778 |
-
+ ) |
|
| 315 | +779 | ! |
- output_q <- shiny::debounce(+ ADEX <- qq[[ex_dataname]] |
| 316 | +780 | ! |
- millis = 200,+ if (is.null(ADEX) | nrow(ADEX) == 0) {
|
| 317 | +781 | ! |
- r = reactive({
+ empty_ex <- TRUE |
| 318 | -! | +||
| 782 | +
- ANL <- data()[[dataname]]+ } |
||
| 319 | +783 | ! |
- ADSL <- data()[["ADSL"]]+ |
| 320 | +784 |
-
+ } else {
|
|
| 321 | +785 | ! |
- teal::validate_has_data(ANL, min_nrow = 10, msg = sprintf("%s has not enough data", dataname))
- |
-
| 322 | -- |
-
+ empty_ex <- TRUE |
|
| 323 | +786 | ! |
- teal::validate_inputs(iv())+ teal.code::eval_code(q1, code = quote(ex <- NULL)) |
| 324 | +787 | - - | -|
| 325 | -! | -
- validate(need(+ } |
|
| 326 | -! | +||
| 788 | +
- input$arm_trt %in% ANL[[input$arm_var]] && input$arm_ref %in% ANL[[input$arm_var]],+ } else {
|
||
| 327 | +789 | ! |
- "Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?"+ teal.code::eval_code(q1, code = quote(ex <- NULL)) |
| 328 | +790 |
- ))+ } |
|
| 329 | +791 | ||
| 330 | +792 | ! |
- group_labels <- lapply(seq_along(input$groups), function(x) {
+ q1 <- if (isTRUE(select_plot()[lb_dataname])) {
|
| 331 | +793 | ! |
- items <- input[[sprintf("groups__%s", x)]]
+ if (all(ADLB$USUBJID %in% ADSL$USUBJID)) {
|
| 332 | +794 | ! |
- if (length(items) > 0) {
+ qq <- teal.code::eval_code( |
| 333 | +795 | ! |
- l <- lapply(seq_along(items), function(y) {
+ q1, |
| 334 | +796 | ! |
- input[[sprintf("groups__%s__level__%s", x, y)]]
- |
-
| 335 | -- |
- })+ code = substitute( |
|
| 336 | +797 | ! |
- names(l) <- items+ expr = {
|
| 337 | +798 | ! |
- l[["Total"]] <- input[[sprintf("groups__%s__level__%s", x, "all")]]
+ ADLB <- ADLB[, adlb_vars] |
| 338 | +799 | ! |
- l- |
-
| 339 | -- |
- }- |
- |
| 340 | -- |
- })- |
- |
| 341 | -- |
-
+ ADLB <- ADSL %>% |
|
| 342 | +800 | ! |
- group_labels_call <- if (length(unlist(group_labels)) == 0) {
+ left_join(ADLB, by = c("STUDYID", "USUBJID")) %>%
|
| 343 | +801 | ! |
- quote(group_labels <- NULL)- |
-
| 344 | -- |
- } else {
+ as.data.frame() %>% |
|
| 345 | +802 | ! |
- bquote(group_labels <- setNames(.(group_labels), .(input$groups)))+ mutate( |
| 346 | -+ | ||
| 803 | +! |
- }+ ANRIND = factor(ANRIND, levels = c("HIGH", "LOW", "NORMAL"))
|
|
| 347 | +804 | - - | -|
| 348 | -! | -
- teal.code::eval_code(data(), code = group_labels_call) %>%+ ) %>% |
|
| 349 | +805 | ! |
- teal.code::eval_code(code = "") %>%+ filter(!is.na(LBSTRESN) & !is.na(ANRIND) & .data[[lb_var]] %in% lb_var_show) %>% |
| 350 | +806 | ! |
- teal.code::eval_code(+ as.data.frame() %>% |
| 351 | +807 | ! |
- code = as.expression(c(+ select( |
| 352 | +808 | ! |
- bquote(+ USUBJID, STUDYID, LBSEQ, PARAMCD, BASETYPE, ADT, AVISITN, sl_start_date, LBTESTCD, ANRIND, lb_var |
| 353 | -! | +||
| 809 | +
- plot <- osprey::g_ae_sub(+ ) %>% |
||
| 354 | +810 | ! |
- id = .(as.name(dataname))$USUBJID,+ mutate( |
| 355 | +811 | ! |
- arm = as.factor(.(as.name(dataname))[[.(input$arm_var)]]),+ ADY = as.numeric(difftime(ADT, as.Date(sl_start_date), units = "days")) + |
| 356 | +812 | ! |
- arm_sl = as.character(ADSL[[.(input$arm_var)]]),+ (ADT >= as.Date(sl_start_date)) |
| 357 | -! | +||
| 813 | +
- trt = .(input$arm_trt),+ ) |
||
| 358 | +814 | ! |
- ref = .(input$arm_ref),+ lb <- list(data = data.frame(ADLB), var = as.vector(ADLB[, lb_var])) |
| 359 | -! | +||
| 815 | +
- subgroups = .(as.name(dataname))[.(input$groups)],+ }, |
||
| 360 | +816 | ! |
- subgroups_sl = ADSL[.(input$groups)],+ env = list( |
| 361 | +817 | ! |
- subgroups_levels = group_labels,+ ADLB = as.name(lb_dataname), |
| 362 | +818 | ! |
- conf_level = .(input$conf_level),+ ADSL = as.name(sl_dataname), |
| 363 | +819 | ! |
- diff_ci_method = .(input$ci),+ adlb_vars = adlb_vars, |
| 364 | +820 | ! |
- fontsize = .(font_size()),+ sl_start_date = as.name(sl_start_date), |
| 365 | +821 | ! |
- arm_n = .(input$arm_n),+ lb_var = lb_var, |
| 366 | +822 | ! |
- draw = TRUE+ lb_var_show = lb_var_show |
| 367 | +823 |
) |
|
| 368 | +824 |
- ),+ ) |
|
| 369 | -! | +||
| 825 | +
- quote(plot)+ ) |
||
| 370 | +826 |
- ))+ |
|
| 371 | -+ | ||
| 827 | +! |
- )+ ADLB <- qq[[lb_dataname]] |
|
| 372 | -+ | ||
| 828 | +! |
- })+ if (is.null(ADLB) | nrow(ADLB) == 0) {
|
|
| 373 | -+ | ||
| 829 | +! |
- )+ empty_lb <- TRUE |
|
| 374 | +830 |
-
+ } |
|
| 375 | +831 | ! |
- plot_r <- reactive(output_q()[["plot"]])+ |
| 376 | +832 |
-
+ } else {
|
|
| 377 | +833 | ! |
- teal.widgets::verbatim_popup_srv(+ empty_lb <- TRUE |
| 378 | +834 | ! |
- id = "rcode",+ teal.code::eval_code(q1, code = quote(lb <- NULL)) |
| 379 | -! | +||
| 835 | +
- verbatim_content = reactive(teal.code::get_code(output_q())),+ }+ |
+ ||
| 836 | ++ |
+ } else {
|
|
| 380 | +837 | ! |
- title = paste("R code for", label),
+ teal.code::eval_code(q1, code = quote(lb <- NULL)) |
| 381 | +838 |
- )+ } |
|
| 382 | +839 | ||
| 383 | +840 |
- ### REPORTER+ # Check the subject has information in at least one selected domain |
|
| 384 | +841 | ! |
- if (with_reporter) {
+ empty_data_check <- structure( |
| 385 | +842 | ! |
- card_fun <- function(comment, label) {
+ c(empty_ex, empty_ae, empty_rs, empty_lb, empty_cm), |
| 386 | +843 | ! |
- card <- teal::report_card_template(+ names = checkboxes |
| 387 | -! | +||
| 844 | +
- title = "AE Subgroups",+ )+ |
+ ||
| 845 | ++ | + | |
| 388 | +846 | ! |
- label = label,+ validate(need( |
| 389 | +847 | ! |
- with_filter = with_filter,+ any(!empty_data_check & select_plot()), |
| 390 | +848 | ! |
- filter_panel_api = filter_panel_api+ "The subject does not have information in any selected domain." |
| 391 | +849 |
- )+ )) |
|
| 392 | -! | +||
| 850 | +
- card$append_text("Plot", "header3")
+
|
||
| 393 | -! | +||
| 851 | +
- card$append_plot(plot_r(), dim = pws$dim())+ # Check the subject has information in all the selected domains |
||
| 394 | +852 | ! |
- if (!comment == "") {
+ if (any(empty_data_check & select_plot())) {
|
| 395 | +853 | ! |
- card$append_text("Comment", "header3")
+ showNotification( |
| 396 | +854 | ! |
- card$append_text(comment)+ paste0( |
| 397 | -+ | ||
| 855 | +! |
- }+ "This subject does not have information in the ", |
|
| 398 | +856 | ! |
- card$append_src(teal.code::get_code(output_q()))+ paste(checkboxes[empty_data_check & select_plot()], collapse = ", "), |
| 399 | +857 | ! |
- card+ " domain." |
| 400 | +858 |
- }+ ), |
|
| 401 | +859 | ! |
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
+ duration = 8, |
| 402 | -+ | ||
| 860 | +! |
- }+ type = "warning" |
|
| 403 | +861 |
- })+ ) |
|
| 404 | +862 |
- }+ } |
| 1 | +863 |
- #' Patient Profile plot teal module+ |
|
| 2 | +864 |
- #'+ # Convert x_limit to numeric vector |
|
| 3 | -+ | ||
| 865 | +! |
- #' @description+ if (!is.null(x_limit) || x_limit != "") {
|
|
| 4 | -+ | ||
| 866 | +! |
- #' `r lifecycle::badge("stable")`
+ q1 <- teal.code::eval_code( |
|
| 5 | -+ | ||
| 867 | +! |
- #'+ q1, |
|
| 6 | -+ | ||
| 868 | +! |
- #' Display patient profile plot as a shiny module+ code = bquote(x_limit <- as.numeric(unlist(strsplit(.(x_limit), ",")))) |
|
| 7 | +869 |
- #'+ ) |
|
| 8 | -+ | ||
| 870 | +! |
- #' @inheritParams teal.widgets::standard_layout+ x_limit <- q1[["x_limit"]] |
|
| 9 | +871 |
- #' @inheritParams argument_convention+ } |
|
| 10 | +872 |
- #' @param patient_id (`choices_seleced`) unique subject ID variable+ |
|
| 11 | -+ | ||
| 873 | +! |
- #' @param sl_dataname (`character`) subject level dataset name,+ q1 <- teal.code::eval_code( |
|
| 12 | -+ | ||
| 874 | +! |
- #' needs to be available in the list passed to the `data`+ q1, |
|
| 13 | -+ | ||
| 875 | +! |
- #' argument of [teal::init()]+ code = substitute( |
|
| 14 | -+ | ||
| 876 | +! |
- #' @param ex_dataname,ae_dataname,rs_dataname,cm_dataname,lb_dataname+ expr = {
|
|
| 15 | -+ | ||
| 877 | +! |
- #' (`character(1)`) names of exposure, adverse events, response,+ plot <- osprey::g_patient_profile( |
|
| 16 | -+ | ||
| 878 | +! |
- #' concomitant medications, and labs datasets, respectively;+ ex = ex, |
|
| 17 | -+ | ||
| 879 | +! |
- #' must be available in the list passed to the `data`+ ae = ae, |
|
| 18 | -+ | ||
| 880 | +! |
- #' argument of [teal::init()]\cr+ rs = rs, |
|
| 19 | -+ | ||
| 881 | +! |
- #' set to NA (default) to omit from analysis+ cm = cm, |
|
| 20 | -+ | ||
| 882 | +! |
- #' @param sl_start_date `choices_selected` study start date variable, usually set to+ lb = lb, |
|
| 21 | -+ | ||
| 883 | +! |
- #' treatment start date or randomization date+ arrow_end_day = ADSL[["max_day"]], |
|
| 22 | -+ | ||
| 884 | +! |
- #' @param ex_var `choices_selected` exposure variable to plot as each line \cr+ xlim = x_limit, |
|
| 23 | -+ | ||
| 885 | +! |
- #' leave unspecified or set to `NULL` if exposure data is not available+ xlab = "Study Day", |
|
| 24 | -+ | ||
| 886 | +! |
- #' @param ae_var `choices_selected` adverse event variable to plot as each line \cr+ title = paste("Patient Profile: ", patient_id)
|
|
| 25 | +887 |
- #' leave unspecified or set to `NULL` if adverse events data is not available+ ) |
|
| 26 | -+ | ||
| 888 | +! |
- #' @param ae_line_col_var `choices_selected` variable for coloring `AE` lines \cr+ plot |
|
| 27 | +889 |
- #' leave unspecified or set to `NULL` if adverse events data is not available+ }, |
|
| 28 | -+ | ||
| 890 | +! |
- #' @param ae_line_col_opt aesthetic values to map color values+ env = list( |
|
| 29 | -+ | ||
| 891 | +! |
- #' (named vector to map color values to each name).+ patient_id = patient_id, |
|
| 30 | -+ | ||
| 892 | +! |
- #' If not `NULL`, please make sure this contains all possible+ ADSL = as.name(sl_dataname) |
|
| 31 | +893 |
- #' values for `ae_line_col_var` values. \cr+ ) |
|
| 32 | +894 |
- #' leave unspecified or set to `NULL` if adverse events data is not available+ ) |
|
| 33 | +895 |
- #' @param rs_var `choices_selected` response variable to plot as each line \cr+ ) |
|
| 34 | +896 |
- #' leave unspecified or set to `NULL` if response data is not available+ }) |
|
| 35 | +897 |
- #' @param cm_var `choices_selected` concomitant medication variable+ ) |
|
| 36 | +898 |
- #' to plot as each line \cr+ |
|
| 37 | -+ | ||
| 899 | +! |
- #' leave unspecified or set to `NULL` if concomitant medications data is not available+ plot_r <- reactive(output_q()[["plot"]]) |
|
| 38 | +900 |
- #' @param lb_var `choices_selected` lab variable to plot as each line \cr+ |
|
| 39 | -+ | ||
| 901 | +! |
- #' leave unspecified or set to `NULL` if labs data is not available+ pws <- teal.widgets::plot_with_settings_srv( |
|
| 40 | -+ | ||
| 902 | +! |
- #' @param x_limit a single `character` string with two numbers+ id = "patientprofileplot", |
|
| 41 | -+ | ||
| 903 | +! |
- #' separated by a comma indicating the x-axis limit,+ plot_r = plot_r, |
|
| 42 | -+ | ||
| 904 | +! |
- #' default is "-28, 365"+ height = plot_height, |
|
| 43 | -+ | ||
| 905 | +! |
- #'+ width = plot_width |
|
| 44 | +906 |
- #' @author Xuefeng Hou (houx14) \email{houx14@gene.com}
+ ) |
|
| 45 | +907 |
- #' @author Tina Cho (chot) \email{tina.cho@roche.com}
+
|
|
| 46 | -+ | ||
| 908 | +! |
- #' @author Molly He (hey59) \email{hey59@gene.com}
+ teal.widgets::verbatim_popup_srv( |
|
| 47 | -+ | ||
| 909 | +! |
- #' @template author_qit3+ id = "rcode", |
|
| 48 | -+ | ||
| 910 | +! |
- #'+ title = paste("R code for", label),
|
|
| 49 | -+ | ||
| 911 | +! |
- #' @inherit argument_convention return+ verbatim_content = reactive(teal.code::get_code(output_q())) |
|
| 50 | +912 |
- #'+ ) |
|
| 51 | +913 |
- #' @details+ |
|
| 52 | +914 |
- #' As the patient profile module plots different domains in one plot, the study day (x-axis)+ ### REPORTER |
|
| 53 | -+ | ||
| 915 | +! |
- #' is derived for consistency based the start date of user's choice in the app (for example,+ if (with_reporter) {
|
|
| 54 | -+ | ||
| 916 | +! |
- #' `ADSL.RANDDT` or `ADSL.TRTSDT`):+ card_fun <- function(comment, label) {
|
|
| 55 | -+ | ||
| 917 | +! |
- #' - In `ADAE`, `ADEX`, and `ADCM`, it would be study day based on `ASTDT` and/or+ card <- teal::report_card_template( |
|
| 56 | -+ | ||
| 918 | +! |
- #' `AENDT` in reference to the start date+ title = "Patient Profile", |
|
| 57 | -+ | ||
| 919 | +! |
- #' - In `ADRS` and `ADLB`, it would be study day based on `ADT` in reference to+ label = label, |
|
| 58 | -+ | ||
| 920 | +! |
- #' the start date+ with_filter = with_filter, |
|
| 59 | -+ | ||
| 921 | +! |
- #'+ filter_panel_api = filter_panel_api |
|
| 60 | -- |
- #' @export- |
- |
| 61 | +922 |
- #'+ ) |
|
| 62 | -+ | ||
| 923 | +! |
- #' @examples+ card$append_text("Plot", "header3")
|
|
| 63 | -+ | ||
| 924 | +! |
- #' data <- teal_data() |>+ card$append_plot(plot_r(), dim = pws$dim()) |
|
| 64 | -+ | ||
| 925 | +! |
- #' within({
+ if (!comment == "") {
|
|
| 65 | -+ | ||
| 926 | +! |
- #' ADSL <- rADSL+ card$append_text("Comment", "header3")
|
|
| 66 | -+ | ||
| 927 | +! |
- #' ADAE <- rADAE %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM))+ card$append_text(comment) |
|
| 67 | +928 |
- #' ADCM <- rADCM %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM))+ } |
|
| 68 | -+ | ||
| 929 | +! |
- #' # The step below is to pre-process ADCM to legacy standard+ card$append_src(teal.code::get_code(output_q())) |
|
| 69 | -+ | ||
| 930 | +! |
- #' ADCM <- ADCM %>%+ card |
|
| 70 | +931 |
- #' select(-starts_with("ATC")) %>%
+ } |
|
| 71 | -+ | ||
| 932 | +! |
- #' unique()+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
|
| 72 | +933 |
- #' ADRS <- rADRS %>% mutate(ADT = as.Date(ADTM))+ } |
|
| 73 | +934 |
- #' ADEX <- rADEX %>% mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM))+ }) |
|
| 74 | +935 |
- #' ADLB <- rADLB %>% mutate(ADT = as.Date(ADTM), LBSTRESN = as.numeric(LBSTRESC))+ } |
| 75 | +1 |
- #' })+ #' Events by Term Plot Teal Module |
|
| 76 | +2 |
#' |
|
| 77 | +3 |
- #' datanames(data) <- c("ADSL", "ADAE", "ADCM", "ADRS", "ADEX", "ADLB")
+ #' @description |
|
| 78 | +4 |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ #' `r lifecycle::badge("stable")`
|
|
| 79 | +5 |
#' |
|
| 80 | +6 |
- #' ADSL <- data[["ADSL"]]+ #' Display Events by Term plot as a shiny module |
|
| 81 | +7 |
#' |
|
| 82 | -- |
- #' app <- init(- |
- |
| 83 | -- |
- #' data = data,- |
- |
| 84 | -- |
- #' modules = modules(- |
- |
| 85 | -- |
- #' tm_g_patient_profile(- |
- |
| 86 | -- |
- #' label = "Patient Profile Plot",- |
- |
| 87 | -- |
- #' patient_id = choices_selected(- |
- |
| 88 | +8 |
- #' choices = unique(ADSL$USUBJID),+ #' @inheritParams teal.widgets::standard_layout |
|
| 89 | +9 |
- #' selected = unique(ADSL$USUBJID)[1]+ #' @inheritParams argument_convention |
|
| 90 | +10 |
- #' ),+ #' @param term_var [teal.transform::choices_selected] object with all available choices |
|
| 91 | +11 |
- #' sl_dataname = "ADSL",+ #' and pre-selected option names that can be used to specify the term for events |
|
| 92 | +12 |
- #' ex_dataname = "ADEX",+ #' |
|
| 93 | +13 |
- #' ae_dataname = "ADAE",+ #' @inherit argument_convention return |
|
| 94 | +14 |
- #' rs_dataname = "ADRS",+ #' |
|
| 95 | +15 |
- #' cm_dataname = "ADCM",+ #' @export |
|
| 96 | +16 |
- #' lb_dataname = "ADLB",+ #' |
|
| 97 | +17 |
- #' sl_start_date = choices_selected(+ #' @author Liming Li (lil128) \email{liming.li@roche.com}
|
|
| 98 | +18 |
- #' selected = "TRTSDTM",+ #' @author Molly He (hey59) \email{hey59@gene.com}
|
|
| 99 | +19 |
- #' choices = c("TRTSDTM", "RANDDT")
+ #' |
|
| 100 | +20 |
- #' ),+ #' @examples |
|
| 101 | +21 |
- #' ex_var = choices_selected(+ #' data <- teal_data() |> |
|
| 102 | +22 |
- #' selected = "PARCAT2",+ #' within({
|
|
| 103 | +23 |
- #' choices = "PARCAT2"+ #' ADSL <- rADSL |
|
| 104 | +24 |
- #' ),+ #' ADAE <- rADAE |
|
| 105 | +25 |
- #' ae_var = choices_selected(+ #' }) |
|
| 106 | +26 |
- #' selected = "AEDECOD",+ #' |
|
| 107 | +27 |
- #' choices = c("AEDECOD", "AESOC")
+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 108 | +28 |
- #' ),+ #' |
|
| 109 | +29 |
- #' ae_line_col_var = choices_selected(+ #' app <- init( |
|
| 110 | +30 |
- #' selected = "AESER",+ #' data = data, |
|
| 111 | +31 |
- #' choices = c("AESER", "AEREL")
+ #' modules = modules( |
|
| 112 | +32 |
- #' ),+ #' tm_g_events_term_id( |
|
| 113 | +33 |
- #' ae_line_col_opt = c("Y" = "red", "N" = "blue"),
+ #' label = "Common AE", |
|
| 114 | +34 |
- #' rs_var = choices_selected(+ #' dataname = "ADAE", |
|
| 115 | +35 |
- #' selected = "PARAMCD",+ #' term_var = choices_selected( |
|
| 116 | +36 |
- #' choices = "PARAMCD"+ #' selected = "AEDECOD", |
|
| 117 | +37 |
- #' ),+ #' choices = c( |
|
| 118 | +38 |
- #' cm_var = choices_selected(+ #' "AEDECOD", "AETERM", |
|
| 119 | +39 |
- #' selected = "CMDECOD",+ #' "AEHLT", "AELLT", "AEBODSYS" |
|
| 120 | +40 |
- #' choices = c("CMDECOD", "CMCAT")
+ #' ) |
|
| 121 | +41 |
#' ), |
|
| 122 | +42 |
- #' lb_var = choices_selected(+ #' arm_var = choices_selected( |
|
| 123 | +43 |
- #' selected = "LBTESTCD",+ #' selected = "ACTARMCD", |
|
| 124 | +44 |
- #' choices = c("LBTESTCD", "LBCAT")
+ #' choices = c("ACTARM", "ACTARMCD")
|
|
| 125 | +45 |
#' ), |
|
| 126 | -- |
- #' x_limit = "-28, 750",- |
- |
| 127 | +46 |
- #' plot_height = c(1200, 400, 5000)+ #' plot_height = c(600, 200, 2000) |
|
| 128 | +47 |
#' ) |
|
| 129 | +48 |
#' ) |
|
| 130 | +49 |
#' ) |
|
| 131 | +50 |
#' if (interactive()) {
|
|
| 132 | +51 |
#' shinyApp(app$ui, app$server) |
|
| 133 | +52 |
#' } |
|
| 134 | +53 |
#' |
|
| 135 | -- |
- tm_g_patient_profile <- function(label = "Patient Profile Plot",- |
- |
| 136 | +54 |
- patient_id,+ tm_g_events_term_id <- function(label, |
|
| 137 | +55 |
- sl_dataname,+ dataname, |
|
| 138 | +56 |
- ex_dataname = NA,+ term_var, |
|
| 139 | +57 |
- ae_dataname = NA,+ arm_var, |
|
| 140 | +58 |
- rs_dataname = NA,+ fontsize = c(5, 3, 7), |
|
| 141 | +59 |
- cm_dataname = NA,+ plot_height = c(600L, 200L, 2000L), |
|
| 142 | +60 |
- lb_dataname = NA,+ plot_width = NULL) {
|
|
| 143 | -+ | ||
| 61 | +! |
- sl_start_date,+ message("Initializing tm_g_events_term_id")
|
|
| 144 | -+ | ||
| 62 | +! |
- ex_var = NULL,+ checkmate::assert_string(label) |
|
| 145 | -+ | ||
| 63 | +! |
- ae_var = NULL,+ checkmate::assert_class(term_var, classes = "choices_selected") |
|
| 146 | -+ | ||
| 64 | +! |
- ae_line_col_var = NULL,+ checkmate::assert_class(arm_var, classes = "choices_selected") |
|
| 147 | -+ | ||
| 65 | +! |
- ae_line_col_opt = NULL,+ checkmate::assert( |
|
| 148 | -+ | ||
| 66 | +! |
- rs_var = NULL,+ checkmate::check_number(fontsize, finite = TRUE), |
|
| 149 | -+ | ||
| 67 | +! |
- cm_var = NULL,+ checkmate::assert( |
|
| 150 | -+ | ||
| 68 | +! |
- lb_var = NULL,+ combine = "and", |
|
| 151 | -+ | ||
| 69 | +! |
- x_limit = "-28, 365",+ .var.name = "fontsize", |
|
| 152 | -+ | ||
| 70 | +! |
- plot_height = c(1200L, 400L, 5000L),+ checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE), |
|
| 153 | -+ | ||
| 71 | +! |
- plot_width = NULL,+ checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
|
| 154 | +72 |
- pre_output = NULL,+ ) |
|
| 155 | +73 |
- post_output = NULL) {
+ ) |
|
| 156 | +74 | ! |
- args <- as.list(environment())+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 157 | +75 | ! |
- checkmate::assert_string(label)+ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 158 | +76 | ! |
- checkmate::assert_string(sl_dataname)+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 159 | +77 | ! |
- checkmate::assert_string(ex_dataname, na.ok = TRUE)+ checkmate::assert_numeric( |
| 160 | +78 | ! |
- checkmate::assert_string(ae_dataname, na.ok = TRUE)+ plot_width[1], |
| 161 | +79 | ! |
- checkmate::assert_string(rs_dataname, na.ok = TRUE)+ lower = plot_width[2], |
| 162 | +80 | ! |
- checkmate::assert_string(cm_dataname, na.ok = TRUE)+ upper = plot_width[3], |
| 163 | +81 | ! |
- checkmate::assert_string(lb_dataname, na.ok = TRUE)+ null.ok = TRUE, |
| 164 | +82 | ! |
- checkmate::assert_character(+ .var.name = "plot_width" |
| 165 | -! | +||
| 83 | +
- c(sl_dataname, ex_dataname, rs_dataname, cm_dataname, lb_dataname),- |
- ||
| 166 | -! | -
- any.missing = TRUE, all.missing = FALSE+ ) |
|
| 167 | +84 |
- )+ |
|
| 168 | +85 | ! |
- checkmate::assert_class(sl_start_date, classes = "choices_selected")+ args <- as.list(environment()) |
| 169 | -! | +||
| 86 | +
- checkmate::assert_class(ex_var, classes = "choices_selected", null.ok = TRUE)+ |
||
| 170 | +87 | ! |
- checkmate::assert_class(ae_var, classes = "choices_selected", null.ok = TRUE)+ module( |
| 171 | +88 | ! |
- checkmate::assert_class(ae_line_col_var, classes = "choices_selected", null.ok = TRUE)+ label = label, |
| 172 | +89 | ! |
- checkmate::assert_class(rs_var, classes = "choices_selected", null.ok = TRUE)+ server = srv_g_events_term_id, |
| 173 | +90 | ! |
- checkmate::assert_class(cm_var, classes = "choices_selected", null.ok = TRUE)+ server_args = list(label = label, dataname = dataname, plot_height = plot_height, plot_width = plot_width), |
| 174 | +91 | ! |
- checkmate::assert_class(lb_var, classes = "choices_selected", null.ok = TRUE)+ ui = ui_g_events_term_id, |
| 175 | +92 | ! |
- checkmate::assert_string(x_limit)+ ui_args = args, |
| 176 | +93 | ! |
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ datanames = c("ADSL", dataname)
|
| 177 | -! | +||
| 94 | +
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ ) |
||
| 178 | -! | +||
| 95 | +
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ } |
||
| 179 | -! | +||
| 96 | +
- checkmate::assert_numeric(+ + |
+ ||
| 97 | ++ |
+ ui_g_events_term_id <- function(id, ...) {
|
|
| 180 | +98 | ! |
- plot_width[1],+ ns <- NS(id) |
| 181 | +99 | ! |
- lower = plot_width[2],+ args <- list(...) |
| 182 | +100 | ! |
- upper = plot_width[3],+ teal.widgets::standard_layout( |
| 183 | +101 | ! |
- null.ok = TRUE,+ output = teal.widgets::white_small_well( |
| 184 | +102 | ! |
- .var.name = "plot_width"+ plot_decorate_output(id = ns(NULL)) |
| 185 | +103 |
- )+ ),+ |
+ |
| 104 | +! | +
+ encoding = tags$div( |
|
| 186 | +105 |
-
+ ### Reporter |
|
| 187 | +106 | ! |
- module(+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
|
| 188 | -! | +||
| 107 | +
- label = label,+ ### |
||
| 189 | +108 | ! |
- ui = ui_g_patient_profile,+ teal.widgets::optionalSelectInput( |
| 190 | +109 | ! |
- ui_args = args,+ ns("term"),
|
| 191 | +110 | ! |
- server = srv_g_patient_profile,+ "Term Variable", |
| 192 | +111 | ! |
- server_args = list(+ choices = get_choices(args$term_var$choices), |
| 193 | +112 | ! |
- patient_id = patient_id,+ selected = args$term_var$selected |
| 194 | -! | +||
| 113 | +
- sl_dataname = sl_dataname,+ ), |
||
| 195 | +114 | ! |
- ex_dataname = ex_dataname,+ teal.widgets::optionalSelectInput( |
| 196 | +115 | ! |
- ae_dataname = ae_dataname,+ ns("arm_var"),
|
| 197 | +116 | ! |
- rs_dataname = rs_dataname,+ "Arm Variable", |
| 198 | +117 | ! |
- cm_dataname = cm_dataname,+ choices = get_choices(args$arm_var$choices), |
| 199 | +118 | ! |
- lb_dataname = lb_dataname,+ selected = args$arm_var$selected |
| 200 | -! | +||
| 119 | +
- ae_line_col_opt = ae_line_col_opt,+ ), |
||
| 201 | +120 | ! |
- label = label,+ selectInput( |
| 202 | +121 | ! |
- plot_height = plot_height,+ ns("arm_ref"),
|
| 203 | +122 | ! |
- plot_width = plot_width- |
-
| 204 | -- |
- ),+ "Control", |
|
| 205 | +123 | ! |
- datanames = "all"+ choices = get_choices(args$arm_var$choices), |
| 206 | -+ | ||
| 124 | +! |
- )+ selected = args$arm_var$selected |
|
| 207 | +125 |
- }+ ), |
|
| 208 | -+ | ||
| 126 | +! |
-
+ selectInput( |
|
| 209 | -+ | ||
| 127 | +! |
- ui_g_patient_profile <- function(id, ...) {
+ ns("arm_trt"),
|
|
| 210 | +128 | ! |
- a <- list(...)+ "Treatment", |
| 211 | +129 | ! |
- ns <- NS(id)+ choices = get_choices(args$arm_var$choices), |
| 212 | +130 | ! |
- checkboxes <- c(a$ex_dataname, a$ae_dataname, a$rs_dataname, a$lb_dataname, a$cm_dataname)+ selected = args$arm_var$selected |
| 213 | +131 |
-
+ ), |
|
| 214 | +132 | ! |
- shiny::tagList(+ teal.widgets::optionalSelectInput( |
| 215 | +133 | ! |
- include_css_files("custom"),
+ ns("sort"),
|
| 216 | +134 | ! |
- teal.widgets::standard_layout(+ "Sort By", |
| 217 | +135 | ! |
- output = teal.widgets::white_small_well(+ choices = c( |
| 218 | +136 | ! |
- teal.widgets::plot_with_settings_ui(id = ns("patientprofileplot"))
+ "Term" = "term", |
| 219 | -+ | ||
| 137 | +! |
- ),+ "Risk Difference" = "riskdiff", |
|
| 220 | +138 | ! |
- encoding = tags$div(+ "Mean Risk" = "meanrisk" |
| 221 | +139 |
- ### Reporter+ ), |
|
| 222 | +140 | ! |
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ selected = NULL |
| 223 | +141 |
- ###+ ), |
|
| 224 | +142 | ! |
- tags$label("Encodings", class = "text-primary"),
+ teal.widgets::panel_item( |
| 225 | +143 | ! |
- selectizeInput(+ "Confidence interval settings", |
| 226 | +144 | ! |
- inputId = ns("patient_id"),
+ teal.widgets::optionalSelectInput( |
| 227 | +145 | ! |
- label = "Patient ID",+ ns("diff_ci_method"),
|
| 228 | +146 | ! |
- choices = NULL- |
-
| 229 | -- |
- ),+ "Method for Difference of Proportions CI", |
|
| 230 | +147 | ! |
- tags$div(+ choices = ci_choices, |
| 231 | +148 | ! |
- tagList(+ selected = ci_choices[1] |
| 232 | -! | +||
| 149 | +
- helpText("Select", tags$code("ADaM"), "Domains"),
+ ), |
||
| 233 | +150 | ! |
- checkboxGroupInput(+ teal.widgets::optionalSliderInput( |
| 234 | +151 | ! |
- inputId = ns("select_ADaM"),
+ ns("conf_level"),
|
| 235 | +152 | ! |
- label = NULL,+ "Confidence Level", |
| 236 | +153 | ! |
- choices = checkboxes[!is.na(checkboxes)],+ min = 0.5, |
| 237 | +154 | ! |
- selected = checkboxes[!is.na(checkboxes)]+ max = 1, |
| 238 | -+ | ||
| 155 | +! |
- )+ value = 0.95 |
|
| 239 | +156 |
- )+ ) |
|
| 240 | +157 |
- ),- |
- |
| 241 | -! | -
- teal.widgets::optionalSelectInput(+ ), |
|
| 242 | +158 | ! |
- ns("sl_start_date"),
+ teal.widgets::panel_item( |
| 243 | +159 | ! |
- "Start date variable",+ "Additional plot settings", |
| 244 | +160 | ! |
- choices = get_choices(a$sl_start_date$choices),+ teal.widgets::optionalSelectInput( |
| 245 | +161 | ! |
- selected = a$sl_start_date$selected,+ ns("axis"),
|
| 246 | +162 | ! |
- multiple = FALSE,+ "Axis Side", |
| 247 | +163 | ! |
- label_help = helpText(+ choices = c("Left" = "left", "Right" = "right"),
|
| 248 | +164 | ! |
- "from ", tags$code("ADSL")
- |
-
| 249 | -- |
- )+ selected = "left" |
|
| 250 | +165 |
), |
|
| 251 | +166 | ! |
- conditionalPanel(+ sliderInput( |
| 252 | +167 | ! |
- condition = sprintf("input['select_ADaM'].includes('%s')", a$ex_dataname),
+ ns("raterange"),
|
| 253 | +168 | ! |
- ns = ns,+ "Overall Rate Range", |
| 254 | +169 | ! |
- selectInput(+ min = 0, |
| 255 | +170 | ! |
- ns("ex_var"),
+ max = 1, |
| 256 | +171 | ! |
- "Exposure variable",+ value = c(0.1, 1), |
| 257 | +172 | ! |
- choices = get_choices(a$ex_var$choices),+ step = 0.01 |
| 258 | -! | +||
| 173 | +
- selected = a$ex_var$selected,+ ), |
||
| 259 | +174 | ! |
- multiple = FALSE- |
-
| 260 | -- |
- )+ sliderInput( |
|
| 261 | -+ | ||
| 175 | +! |
- ),+ ns("diffrange"),
|
|
| 262 | +176 | ! |
- conditionalPanel(+ "Rate Difference Range", |
| 263 | +177 | ! |
- condition = sprintf("input['select_ADaM'].includes('%s')", a$ae_dataname),
+ min = -1, |
| 264 | +178 | ! |
- ns = ns,+ max = 1, |
| 265 | +179 | ! |
- teal.widgets::optionalSelectInput(+ value = c(-0.5, 0.5), |
| 266 | +180 | ! |
- ns("ae_var"),
+ step = 0.01 |
| 267 | -! | +||
| 181 | +
- "Adverse Event variable",+ ), |
||
| 268 | +182 | ! |
- choices = get_choices(a$ae_var$choices),+ checkboxInput(ns("reverse"),
|
| 269 | +183 | ! |
- selected = a$ae_var$selected,+ "Reverse Order", |
| 270 | +184 | ! |
- multiple = FALSE+ value = FALSE |
| 271 | +185 |
- ),+ ) |
|
| 272 | -! | +||
| 186 | +
- teal.widgets::optionalSelectInput(+ ), |
||
| 273 | +187 | ! |
- ns("ae_line_var"),
+ ui_g_decorate( |
| 274 | +188 | ! |
- "Adverse Event line color variable",+ ns(NULL), |
| 275 | +189 | ! |
- choices = get_choices(a$ae_line_col_var$choices),+ fontsize = args$fontsize, |
| 276 | +190 | ! |
- selected = a$ae_line_col_var$selected,+ titles = "Common AE Table", |
| 277 | +191 | ! |
- multiple = FALSE+ footnotes = "" |
| 278 | +192 |
- )+ ) |
|
| 279 | +193 |
- ),+ ), |
|
| 280 | +194 | ! |
- conditionalPanel(+ forms = tagList( |
| 281 | +195 | ! |
- condition = sprintf("input['select_ADaM'].includes('%s')", a$rs_dataname),
+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
| 282 | -! | +||
| 196 | +
- ns = ns,+ ) |
||
| 283 | -! | +||
| 197 | +
- teal.widgets::optionalSelectInput(+ ) |
||
| 284 | -! | +||
| 198 | +
- ns("rs_var"),
+ } |
||
| 285 | -! | +||
| 199 | +
- "Tumor response variable",+ |
||
| 286 | -! | +||
| 200 | +
- choices = get_choices(a$rs_var$choices),+ srv_g_events_term_id <- function(id, |
||
| 287 | -! | +||
| 201 | +
- selected = a$rs_var$selected,+ data, |
||
| 288 | -! | +||
| 202 | +
- multiple = FALSE+ filter_panel_api, |
||
| 289 | +203 |
- )+ reporter, |
|
| 290 | +204 |
- ),+ dataname,+ |
+ |
| 205 | ++ |
+ label,+ |
+ |
| 206 | ++ |
+ plot_height,+ |
+ |
| 207 | ++ |
+ plot_width) {
|
|
| 291 | +208 | ! |
- conditionalPanel(+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
| 292 | +209 | ! |
- condition = sprintf("input['select_ADaM'].includes('%s')", a$cm_dataname),
+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
| 293 | +210 | ! |
- ns = ns,+ checkmate::assert_class(data, "reactive") |
| 294 | +211 | ! |
- teal.widgets::optionalSelectInput(+ checkmate::assert_class(shiny::isolate(data()), "teal_data")+ |
+
| 212 | ++ | + | |
| 295 | +213 | ! |
- ns("cm_var"),
+ moduleServer(id, function(input, output, session) {
|
| 296 | +214 | ! |
- "Concomitant medicine variable",+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 297 | +215 | ! |
- choices = get_choices(a$cm_var$choices),+ iv <- reactive({
|
| 298 | +216 | ! |
- selected = a$cm_var$selected,+ iv <- shinyvalidate::InputValidator$new() |
| 299 | +217 | ! |
- multiple = FALSE+ iv$add_rule("term", shinyvalidate::sv_required(
|
| 300 | -+ | ||
| 218 | +! |
- )+ message = "Term Variable is required" |
|
| 301 | +219 |
- ),+ )) |
|
| 302 | +220 | ! |
- conditionalPanel(+ iv$add_rule("arm_var", shinyvalidate::sv_required(
|
| 303 | +221 | ! |
- condition = sprintf("input['select_ADaM'].includes('%s')", a$lb_dataname),
+ message = "Arm Variable is required" |
| 304 | -! | +||
| 222 | +
- ns = ns,+ )) |
||
| 305 | +223 | ! |
- teal.widgets::optionalSelectInput(+ rule_diff <- function(value, other) {
|
| 306 | +224 | ! |
- ns("lb_var"),
+ if (isTRUE(value == other)) "Control and Treatment must be different"+ |
+
| 225 | ++ |
+ } |
|
| 307 | +226 | ! |
- "Lab variable",+ iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
|
| 308 | +227 | ! |
- choices = get_choices(a$lb_var$choices),+ iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
|
| 309 | +228 | ! |
- selected = a$lb_var$selected,+ iv$enable() |
| 310 | +229 | ! |
- multiple = FALSE+ iv |
| 311 | +230 |
- ),+ })+ |
+ |
| 231 | ++ | + | |
| 312 | +232 | ! |
- selectInput(+ decorate_output <- srv_g_decorate( |
| 313 | +233 | ! |
- ns("lb_var_show"),
+ id = NULL, plt = plot_r, plot_height = plot_height, plot_width = plot_width+ |
+
| 234 | ++ |
+ ) |
|
| 314 | +235 | ! |
- "Lab values",+ font_size <- decorate_output$font_size |
| 315 | +236 | ! |
- choices = get_choices(a$lb_var$choices),+ pws <- decorate_output$pws+ |
+
| 237 | ++ | + | |
| 316 | +238 | ! |
- selected = a$lb_var$selected,+ observeEvent(list(input$diff_ci_method, input$conf_level), {
|
| 317 | +239 | ! |
- multiple = TRUE+ req(!is.null(input$diff_ci_method) && !is.null(input$conf_level)) |
| 318 | -+ | ||
| 240 | +! |
- )+ diff_ci_method <- input$diff_ci_method |
|
| 319 | -+ | ||
| 241 | +! |
- ),+ conf_level <- input$conf_level |
|
| 320 | +242 | ! |
- textInput(+ updateTextAreaInput( |
| 321 | +243 | ! |
- ns("x_limit"),
+ session, |
| 322 | +244 | ! |
- label = tags$div(+ "foot", |
| 323 | +245 | ! |
- "Study Days Range",+ value = sprintf( |
| 324 | +246 | ! |
- tags$br(),+ "Note: %d%% CI is calculated using %s", |
| 325 | +247 | ! |
- helpText("Enter TWO numeric values of study days range, separated by comma (eg. -28, 750)")
+ round(conf_level * 100),+ |
+
| 248 | +! | +
+ name_ci(diff_ci_method) |
|
| 326 | +249 |
- ),+ ) |
|
| 327 | -! | +||
| 250 | +
- value = a$x_limit+ ) |
||
| 328 | +251 |
- )+ }) |
|
| 329 | +252 |
- ),+ |
|
| 330 | -! | +||
| 253 | +
- forms = tagList(+ |
||
| 331 | +254 | ! |
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ observeEvent(input$sort, |
| 332 | +255 |
- ),+ {
|
|
| 333 | +256 | ! |
- pre_output = a$pre_output,+ sort <- if (is.null(input$sort)) " " else input$sort |
| 334 | +257 | ! |
- post_output = a$post_output+ updateTextInput( |
| 335 | -+ | ||
| 258 | +! |
- )+ session, |
|
| 336 | -+ | ||
| 259 | +! |
- )+ "title", |
|
| 337 | -+ | ||
| 260 | +! |
- }+ value = sprintf( |
|
| 338 | -+ | ||
| 261 | +! |
-
+ "Common AE Table %s", |
|
| 339 | -+ | ||
| 262 | +! |
- srv_g_patient_profile <- function(id,+ c( |
|
| 340 | -+ | ||
| 263 | +! |
- data,+ "term" = "Sorted by Term", |
|
| 341 | -+ | ||
| 264 | +! |
- filter_panel_api,+ "riskdiff" = "Sorted by Risk Difference", |
|
| 342 | -+ | ||
| 265 | +! |
- reporter,+ "meanrisk" = "Sorted by Mean Risk", |
|
| 343 | +266 |
- patient_id,+ " " = "" |
|
| 344 | -+ | ||
| 267 | +! |
- sl_dataname,+ )[sort] |
|
| 345 | +268 |
- ex_dataname,+ ) |
|
| 346 | +269 |
- ae_dataname,+ ) |
|
| 347 | +270 |
- rs_dataname,+ }, |
|
| 348 | -+ | ||
| 271 | +! |
- lb_dataname,+ ignoreNULL = FALSE |
|
| 349 | +272 |
- cm_dataname,+ ) |
|
| 350 | +273 |
- label,+ |
|
| 351 | -+ | ||
| 274 | +! |
- ae_line_col_opt,+ observeEvent(input$arm_var, |
|
| 352 | +275 |
- plot_height,+ {
|
|
| 353 | -+ | ||
| 276 | +! |
- plot_width) {
+ arm_var <- input$arm_var |
|
| 354 | +277 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ ANL <- data()[[dataname]] |
| 355 | -! | +||
| 278 | +
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelApi")+ |
||
| 356 | +279 | ! |
- checkmate::assert_class(data, "reactive")+ choices <- levels(ANL[[arm_var]]) |
| 357 | -! | +||
| 280 | +
- checkmate::assert_class(shiny::isolate(data()), "teal_data")+ |
||
| 358 | +281 | ! |
- if (!is.na(ex_dataname)) checkmate::assert_names(ex_dataname, subset.of = names(data))+ if (length(choices) == 1) {
|
| 359 | +282 | ! |
- if (!is.na(ae_dataname)) checkmate::assert_names(ae_dataname, subset.of = names(data))+ trt_index <- 1 |
| 360 | -! | +||
| 283 | +
- if (!is.na(rs_dataname)) checkmate::assert_names(rs_dataname, subset.of = names(data))+ } else {
|
||
| 361 | +284 | ! |
- if (!is.na(lb_dataname)) checkmate::assert_names(lb_dataname, subset.of = names(data))+ trt_index <- 2 |
| 362 | -! | +||
| 285 | +
- if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data))+ } |
||
| 363 | -! | +||
| 286 | +
- checkboxes <- c(ex_dataname, ae_dataname, rs_dataname, lb_dataname, cm_dataname)+ |
||
| 364 | +287 | ! |
- moduleServer(id, function(input, output, session) {
+ updateSelectInput( |
| 365 | +288 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ session, |
| 366 | +289 | ! |
- select_plot <- reactive(+ "arm_ref", |
| 367 | +290 | ! |
- vapply(checkboxes, function(x) x %in% input$select_ADaM, logical(1L))+ selected = choices[1], |
| 368 | -+ | ||
| 291 | +! |
- )+ choices = choices |
|
| 369 | +292 |
-
+ ) |
|
| 370 | +293 | ! |
- resolved <- teal.transform::resolve_delayed(patient_id, as.list(isolate(data())@env))+ updateSelectInput( |
| 371 | -+ | ||
| 294 | +! |
-
+ session, |
|
| 372 | +295 | ! |
- updateSelectizeInput(+ "arm_trt", |
| 373 | +296 | ! |
- session = session,+ selected = choices[trt_index], |
| 374 | +297 | ! |
- inputId = "patient_id",+ choices = choices |
| 375 | -! | +||
| 298 | +
- choices = resolved$choices,+ )+ |
+ ||
| 299 | ++ |
+ }, |
|
| 376 | +300 | ! |
- selected = resolved$selected+ ignoreNULL = TRUE |
| 377 | +301 |
) |
|
| 378 | +302 | ||
| 379 | -! | -
- if (!is.na(lb_dataname)) {
- |
- |
| 380 | +303 | ! |
- observeEvent(input$lb_var, ignoreNULL = TRUE, {
+ output_q <- reactive({
|
| 381 | +304 | ! |
- ADLB <- data()[[lb_dataname]]+ ANL <- data()[[dataname]] |
| 382 | -! | +||
| 305 | +
- choices <- unique(ADLB[[input$lb_var]])+ |
||
| 383 | +306 | ! |
- choices_selected <- if (length(choices) > 5) choices[1:5] else choices+ teal::validate_inputs(iv()) |
| 384 | +307 | ||
| 385 | +308 | ! |
- updateSelectInput(+ shiny::validate( |
| 386 | +309 | ! |
- session,+ shiny::need(is.factor(ANL[[input$arm_var]]), "Arm Var must be a factor variable. Contact developer."), |
| 387 | +310 | ! |
- "lb_var_show",+ shiny::need( |
| 388 | +311 | ! |
- selected = choices_selected,+ input$arm_trt %in% ANL[[req(input$arm_var)]] && input$arm_ref %in% ANL[[req(input$arm_var)]], |
| 389 | +312 | ! |
- choices = choices+ "Cannot generate plot. The dataset does not contain subjects from both the control and treatment arms." |
| 390 | +313 |
) |
|
| 391 | -- |
- })- |
- |
| 392 | +314 |
- }+ ) |
|
| 393 | +315 | ||
| 394 | -! | -
- iv <- reactive({
- |
- |
| 395 | -! | -
- iv <- shinyvalidate::InputValidator$new()- |
- |
| 396 | +316 | ! |
- iv$add_rule("select_ADaM", shinyvalidate::sv_required(
+ adsl_vars <- unique(c("USUBJID", "STUDYID", input$arm_var))
|
| 397 | +317 | ! |
- message = "At least one ADaM data set is required"+ anl_vars <- c("USUBJID", "STUDYID", input$term)
|
| 398 | +318 |
- ))+ |
|
| 399 | +319 | ! |
- iv$add_rule("sl_start_date", shinyvalidate::sv_required(
+ q1 <- teal.code::eval_code( |
| 400 | +320 | ! |
- message = "Date variable is required"- |
-
| 401 | -- |
- ))+ data(), |
|
| 402 | +321 | ! |
- if (isTRUE(select_plot()[ex_dataname])) {
+ code = bquote( |
| 403 | +322 | ! |
- iv$add_rule("ex_var", shinyvalidate::sv_required(
+ ANL <- merge( |
| 404 | +323 | ! |
- message = "Exposure variable is required"- |
-
| 405 | -- |
- ))- |
- |
| 406 | -- |
- }+ x = ADSL[, .(adsl_vars), drop = FALSE], |
|
| 407 | +324 | ! |
- if (isTRUE(select_plot()[ae_dataname])) {
+ y = .(as.name(dataname))[, .(anl_vars), drop = FALSE], |
| 408 | +325 | ! |
- iv$add_rule("ae_var", shinyvalidate::sv_required(
+ all.x = FALSE, |
| 409 | +326 | ! |
- message = "Adverse Event variable is required"- |
-
| 410 | -- |
- ))+ all.y = FALSE, |
|
| 411 | +327 | ! |
- iv$add_rule("ae_line_var", shinyvalidate::sv_optional())
+ by = c("USUBJID", "STUDYID")
|
| 412 | -! | +||
| 328 | +
- iv$add_rule("ae_line_var", ~ if (length(levels(data()[[ae_dataname]][[.]])) > length(ae_line_col_opt)) {
+ ) |
||
| 413 | -! | +||
| 329 | +
- "Not enough colors provided for Adverse Event line color, unselect"+ ) |
||
| 414 | +330 |
- })+ ) |
|
| 415 | +331 |
- }+ |
|
| 416 | +332 | ! |
- if (isTRUE(select_plot()[rs_dataname])) {
+ teal::validate_has_data(q1[["ANL"]], |
| 417 | +333 | ! |
- iv$add_rule("rs_var", shinyvalidate::sv_required(
+ min_nrow = 10, |
| 418 | +334 | ! |
- message = "Tumor response variable is required"+ msg = "Analysis data set must have at least 10 data points" |
| 419 | +335 |
- ))+ ) |
|
| 420 | +336 |
- }+ |
|
| 421 | +337 | ! |
- if (isTRUE(select_plot()[cm_dataname])) {
+ q2 <- teal.code::eval_code( |
| 422 | +338 | ! |
- iv$add_rule("cm_var", shinyvalidate::sv_required(
+ q1, |
| 423 | +339 | ! |
- message = "Concomitant medicine variable is required"+ code = bquote( |
| 424 | -+ | ||
| 340 | +! |
- ))+ plot <- osprey::g_events_term_id( |
|
| 425 | -+ | ||
| 341 | +! |
- }+ term = ANL[[.(input$term)]], |
|
| 426 | +342 | ! |
- if (isTRUE(select_plot()[lb_dataname])) {
+ id = ANL$USUBJID, |
| 427 | +343 | ! |
- iv$add_rule("lb_var", shinyvalidate::sv_required(
+ arm = ANL[[.(input$arm_var)]], |
| 428 | +344 | ! |
- message = "Lab variable is required"+ arm_N = table(ADSL[[.(input$arm_var)]]), |
| 429 | -+ | ||
| 345 | +! |
- ))+ ref = .(input$arm_ref), |
|
| 430 | +346 | ! |
- iv$add_rule("lb_var_show", shinyvalidate::sv_required(
+ trt = .(input$arm_trt), |
| 431 | +347 | ! |
- message = "At least one Lab value is required"+ sort_by = .(input$sort), |
| 432 | -+ | ||
| 348 | +! |
- ))+ rate_range = .(input$raterange), |
|
| 433 | +349 | ! |
- rule_diff <- function(value, other) {
+ diff_range = .(input$diffrange), |
| 434 | +350 | ! |
- if (isTRUE(any(value == other))) {
+ reversed = .(input$reverse), |
| 435 | +351 | ! |
- "Lab variable and Lab value must be different"+ conf_level = .(input$conf_level), |
| 436 | -+ | ||
| 352 | +! |
- }+ diff_ci_method = .(input$diff_ci_method), |
|
| 437 | -+ | ||
| 353 | +! |
- }+ axis_side = .(input$axis), |
|
| 438 | +354 | ! |
- iv$add_rule("lb_var", rule_diff, other = input$lb_var_show)
+ fontsize = .(font_size()), |
| 439 | +355 | ! |
- iv$add_rule("lb_var_show", rule_diff, other = input$lb_var)
+ draw = TRUE |
| 440 | +356 |
- }- |
- |
| 441 | -! | -
- iv$add_rule("x_limit", shinyvalidate::sv_required(
+ ) |
|
| 442 | -! | +||
| 357 | +
- message = "Study Days Range is required"+ ) |
||
| 443 | +358 |
- ))+ ) |
|
| 444 | -! | +||
| 359 | +
- iv$add_rule("x_limit", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
+
|
||
| 445 | +360 | ! |
- "Study Days Range is invalid"+ teal.code::eval_code(q2, quote(plot)) |
| 446 | +361 |
- })+ }) |
|
| 447 | -! | +||
| 362 | +
- iv$add_rule("x_limit", ~ if (length(suppressWarnings(as_numeric_from_comma_sep_str(.))) != 2L) {
+
|
||
| 448 | +363 | ! |
- "Study Days Range must be two values"+ plot_r <- reactive(output_q()[["plot"]]) |
| 449 | +364 |
- })+ |
|
| 450 | +365 | ! |
- iv$add_rule("x_limit", ~ if (!identical(order(suppressWarnings(as_numeric_from_comma_sep_str(.))), 1:2)) {
+ teal.widgets::verbatim_popup_srv( |
| 451 | +366 | ! |
- "Study Days Range mut be: first lower, then upper limit"- |
-
| 452 | -- |
- })+ id = "rcode", |
|
| 453 | +367 | ! |
- iv$enable()+ title = paste("R code for", label),
|
| 454 | +368 | ! |
- iv+ verbatim_content = reactive(teal.code::get_code(output_q())) |
| 455 | +369 |
- })+ ) |
|
| 456 | +370 | ||
| 457 | +371 |
- # render plot+ ### REPORTER |
|
| 458 | +372 | ! |
- output_q <- shiny::debounce(+ if (with_reporter) {
|
| 459 | +373 | ! |
- millis = 200,+ card_fun <- function(comment, label) {
|
| 460 | +374 | ! |
- r = reactive({
+ card <- teal::report_card_template( |
| 461 | +375 | ! |
- teal::validate_inputs(iv())+ title = "Events by Term", |
| 462 | -+ | ||
| 376 | +! |
-
+ label = label, |
|
| 463 | -+ | ||
| 377 | +! |
- # get inputs ---+ with_filter = with_filter, |
|
| 464 | +378 | ! |
- patient_id <- input$patient_id+ filter_panel_api = filter_panel_api |
| 465 | -! | +||
| 379 | +
- sl_start_date <- input$sl_start_date+ ) |
||
| 466 | +380 | ! |
- ae_var <- input$ae_var+ card$append_text("Plot", "header3")
|
| 467 | +381 | ! |
- ae_line_col_var <- input$ae_line_var+ card$append_plot(plot_r(), dim = pws$dim()) |
| 468 | +382 | ! |
- rs_var <- input$rs_var+ if (!comment == "") {
|
| 469 | +383 | ! |
- cm_var <- input$cm_var+ card$append_text("Comment", "header3")
|
| 470 | +384 | ! |
- ex_var <- input$ex_var+ card$append_text(comment) |
| 471 | -! | +||
| 385 | +
- lb_var <- input$lb_var+ } |
||
| 472 | +386 | ! |
- x_limit <- input$x_limit+ card$append_src(teal.code::get_code(output_q())) |
| 473 | +387 | ! |
- lb_var_show <- input$lb_var_show+ card |
| 474 | +388 |
-
+ } |
|
| 475 | +389 | ! |
- adrs_vars <- unique(c(+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
| 476 | -! | +||
| 390 | +
- "USUBJID", "STUDYID", "PARAMCD",+ } |
||
| 477 | -! | +||
| 391 | +
- "PARAM", "AVALC", "AVAL", "ADY",+ }) |
||
| 478 | -! | +||
| 392 | +
- "ADT", rs_var+ } |
| 479 | +1 |
- ))+ #' Teal Module for Waterfall Plot |
|
| 480 | -! | +||
| 2 | +
- adae_vars <- unique(c(+ #' |
||
| 481 | -! | +||
| 3 | +
- "USUBJID", "STUDYID", "ASTDT",+ #' @description |
||
| 482 | -! | +||
| 4 | +
- "AENDT", "AESOC", "AEDECOD",+ #' `r lifecycle::badge("stable")`
|
||
| 483 | -! | +||
| 5 | +
- "AESER", "AETOXGR", "AEREL",+ #' |
||
| 484 | -! | +||
| 6 | +
- "ASTDY", "AENDY",+ #' This is teal module that generates a waterfall plot for `ADaM` data |
||
| 485 | -! | +||
| 7 | +
- ae_var, ae_line_col_var+ #' |
||
| 486 | +8 |
- ))+ #' @inheritParams teal.widgets::standard_layout |
|
| 487 | -! | +||
| 9 | +
- adcm_vars <- unique(c(+ #' @inheritParams argument_convention |
||
| 488 | -! | +||
| 10 | +
- "USUBJID", "STUDYID", "ASTDT",+ #' @param dataname_tr tumor burden analysis data used in teal module to plot as bar height, needs to |
||
| 489 | -! | +||
| 11 | +
- "AENDT", "ASTDT", "CMDECOD",+ #' be available in the list passed to the `data` argument of [teal::init()] |
||
| 490 | -! | +||
| 12 | +
- "ASTDY", "AENDY", "CMCAT",+ #' @param dataname_rs response analysis data used in teal module to label response parameters, needs to |
||
| 491 | -! | +||
| 13 | +
- cm_var+ #' be available in the list passed to the `data` argument of [teal::init()] |
||
| 492 | +14 |
- ))+ #' @param bar_paramcd `choices_selected` parameter in tumor burden data that will be plotted as |
|
| 493 | -! | +||
| 15 | +
- adex_vars <- unique(c(+ #' bar height |
||
| 494 | -! | +||
| 16 | +
- "USUBJID", "STUDYID", "ASTDT",+ #' @param bar_var `choices_selected` numeric variable from dataset to plot the bar height, e.g., `PCHG` |
||
| 495 | -! | +||
| 17 | +
- "AENDT", "PARCAT2", "AVAL",+ #' @param bar_color_var `choices_selected` color by variable (subject level), `None` corresponds |
||
| 496 | -! | +||
| 18 | +
- "AVALU", "PARAMCD", "PARCAT1",+ #' to `NULL` |
||
| 497 | -! | +||
| 19 | +
- "PARCAT2", ex_var+ #' @param bar_color_opt aesthetic values to map color values (named vector to map color values to each name). |
||
| 498 | +20 |
- ))+ #' If not `NULL`, please make sure this contains all possible values for `bar_color_var` values, |
|
| 499 | -! | +||
| 21 | +
- adlb_vars <- unique(c(+ #' otherwise color will be assigned by `ggplot` default, please note that `NULL` needs to be specified |
||
| 500 | -! | +||
| 22 | +
- "USUBJID", "STUDYID", "ANRIND", "LBSEQ",+ #' in this case |
||
| 501 | -! | +||
| 23 | +
- "PARAMCD", "BASETYPE", "ADT", "AVISITN",+ #' @param sort_var `choices_selected` sort by variable (subject level), `None` corresponds |
||
| 502 | -! | +||
| 24 | +
- "LBSTRESN", "LBCAT", "LBTESTCD",+ #' to `NULL` |
||
| 503 | -! | +||
| 25 | +
- lb_var+ #' @param add_label_var_sl `choices_selected` add label to bars (subject level), `None` |
||
| 504 | +26 |
- ))+ #' corresponds to `NULL` |
|
| 505 | +27 |
-
+ #' @param add_label_paramcd_rs `choices_selected` add label to bars (response dataset), `None` |
|
| 506 | +28 |
- # get ADSL dataset ---+ #' corresponds to `NULL`. At least one of `add_label_var_sl` and `add_label_paramcd_rs` needs |
|
| 507 | -! | +||
| 29 | +
- ADSL <- data()[[sl_dataname]]+ #' to be `NULL` |
||
| 508 | +30 |
-
+ #' @param anno_txt_var_sl `choices_selected` subject level variables to be displayed in the annotation |
|
| 509 | -! | +||
| 31 | +
- ADEX <- NULL+ #' table, default is `NULL` |
||
| 510 | -! | +||
| 32 | +
- if (isTRUE(select_plot()[ex_dataname])) {
+ #' @param anno_txt_paramcd_rs `choices_selected` analysis dataset variables to be displayed in the |
||
| 511 | -! | +||
| 33 | +
- ADEX <- data()[[ex_dataname]]+ #' annotation table, default is `NULL` |
||
| 512 | -! | +||
| 34 | +
- teal::validate_has_variable(ADEX, adex_vars)+ #' @param facet_var `choices_selected` facet by variable (subject level), `None` corresponds to |
||
| 513 | +35 |
- }+ #' `NULL` |
|
| 514 | -! | +||
| 36 | +
- ADAE <- NULL+ #' @param ytick_at bar height axis interval, default is 20 |
||
| 515 | -! | +||
| 37 | +
- if (isTRUE(select_plot()[ae_dataname])) {
+ #' @param href_line numeric vector to plot horizontal reference lines, default is `NULL` |
||
| 516 | -! | +||
| 38 | +
- ADAE <- data()[[ae_dataname]]+ #' @param gap_point_val singular numeric value for adding bar break when some bars are significantly higher |
||
| 517 | -! | +||
| 39 | +
- teal::validate_has_variable(ADAE, adae_vars)+ #' than others, default is `NULL` |
||
| 518 | +40 |
- }+ #' @param show_value boolean of whether value of bar height is shown, default is `TRUE` |
|
| 519 | -! | +||
| 41 | +
- ADRS <- NULL+ #' |
||
| 520 | -! | +||
| 42 | +
- if (isTRUE(select_plot()[rs_dataname])) {
+ #' @inherit argument_convention return |
||
| 521 | -! | +||
| 43 | +
- ADRS <- data()[[rs_dataname]]+ #' |
||
| 522 | -! | +||
| 44 | +
- teal::validate_has_variable(ADRS, adrs_vars)+ #' @export |
||
| 523 | +45 |
- }+ #' |
|
| 524 | -! | +||
| 46 | +
- ADCM <- NULL+ #' @template author_qit3 |
||
| 525 | -! | +||
| 47 | +
- if (isTRUE(select_plot()[cm_dataname])) {
+ #' @author houx14 \email{houx14@gene.com}
|
||
| 526 | -! | +||
| 48 | +
- ADCM <- data()[[cm_dataname]]+ #' |
||
| 527 | -! | +||
| 49 | +
- teal::validate_has_variable(ADCM, adcm_vars)+ #' @examples |
||
| 528 | +50 |
- }+ #' data <- teal_data() |> |
|
| 529 | -! | +||
| 51 | +
- ADLB <- NULL+ #' within({
|
||
| 530 | -! | +||
| 52 | +
- if (isTRUE(select_plot()[lb_dataname])) {
+ #' ADSL <- rADSL |
||
| 531 | -! | +||
| 53 | +
- ADLB <- data()[[lb_dataname]]+ #' ADRS <- rADRS |
||
| 532 | -! | +||
| 54 | +
- teal::validate_has_variable(ADLB, adlb_vars)+ #' ADTR <- rADTR |
||
| 533 | +55 |
- }+ #' ADSL$SEX <- factor(ADSL$SEX, levels = unique(ADSL$SEX)) |
|
| 534 | +56 |
-
+ #' }) |
|
| 535 | -! | +||
| 57 | +
- empty_rs <- FALSE+ #' |
||
| 536 | -! | -
- empty_ae <- FALSE- |
- |
| 537 | -! | -
- empty_cm <- FALSE- |
- |
| 538 | -! | -
- empty_ex <- FALSE- |
- |
| 539 | -! | +||
| 58 | +
- empty_lb <- FALSE+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
||
| 540 | +59 |
-
+ #' |
|
| 541 | -! | +||
| 60 | +
- q1 <- teal.code::eval_code(+ #' app <- init( |
||
| 542 | -! | +||
| 61 | +
- data(),+ #' data = data, |
||
| 543 | -! | +||
| 62 | +
- code = substitute(+ #' modules = modules( |
||
| 544 | -! | +||
| 63 | +
- expr = {
+ #' tm_g_waterfall( |
||
| 545 | -! | +||
| 64 | +
- ADSL <- ADSL %>%+ #' label = "Waterfall", |
||
| 546 | -! | +||
| 65 | +
- filter(USUBJID == patient_id) %>%+ #' dataname_tr = "ADTR", |
||
| 547 | -! | +||
| 66 | +
- group_by(USUBJID) %>%+ #' dataname_rs = "ADRS", |
||
| 548 | -! | +||
| 67 | +
- mutate(+ #' bar_paramcd = choices_selected(c("SLDINV"), "SLDINV"),
|
||
| 549 | -! | +||
| 68 | +
- max_date = pmax(as.Date(LSTALVDT), as.Date(DTHDT), na.rm = TRUE),+ #' bar_var = choices_selected(c("PCHG", "AVAL"), "PCHG"),
|
||
| 550 | -! | +||
| 69 | +
- max_day = as.numeric(difftime(as.Date(max_date), as.Date(sl_start_date), units = "days")) ++ #' bar_color_var = choices_selected(c("ARMCD", "SEX"), "ARMCD"),
|
||
| 551 | -! | +||
| 70 | +
- (as.Date(max_date) >= as.Date(sl_start_date))+ #' bar_color_opt = NULL, |
||
| 552 | +71 |
- )+ #' sort_var = choices_selected(c("ARMCD", "SEX"), NULL),
|
|
| 553 | +72 |
- },+ #' add_label_var_sl = choices_selected(c("SEX", "EOSDY"), NULL),
|
|
| 554 | -! | +||
| 73 | +
- env = list(+ #' add_label_paramcd_rs = choices_selected(c("BESRSPI", "OBJRSPI"), NULL),
|
||
| 555 | -! | +||
| 74 | +
- ADSL = as.name(sl_dataname),+ #' anno_txt_var_sl = choices_selected(c("SEX", "ARMCD", "BMK1", "BMK2"), NULL),
|
||
| 556 | -! | +||
| 75 | +
- sl_start_date = as.name(sl_start_date),+ #' anno_txt_paramcd_rs = choices_selected(c("BESRSPI", "OBJRSPI"), NULL),
|
||
| 557 | -! | +||
| 76 | +
- patient_id = patient_id+ #' facet_var = choices_selected(c("SEX", "ARMCD", "STRATA1", "STRATA2"), NULL),
|
||
| 558 | +77 |
- )+ #' href_line = "-30, 20" |
|
| 559 | +78 |
- )+ #' ) |
|
| 560 | +79 |
- )+ #' ) |
|
| 561 | +80 |
-
+ #' ) |
|
| 562 | +81 |
- # ADSL with single subject+ #' if (interactive()) {
|
|
| 563 | -! | +||
| 82 | +
- validate(+ #' shinyApp(app$ui, app$server) |
||
| 564 | -! | +||
| 83 | +
- need(+ #' } |
||
| 565 | -! | +||
| 84 | +
- nrow(q1[["ADSL"]]) >= 1,+ #' |
||
| 566 | -! | +||
| 85 | +
- paste(+ tm_g_waterfall <- function(label, |
||
| 567 | -! | +||
| 86 | +
- "Subject",+ dataname_tr = "ADTR", |
||
| 568 | -! | +||
| 87 | +
- patient_id,+ dataname_rs = "ADRS", |
||
| 569 | -! | +||
| 88 | +
- "not found in the dataset. Perhaps they have been filtered out by the filter panel?"+ bar_paramcd, |
||
| 570 | +89 |
- )+ bar_var, |
|
| 571 | +90 |
- )+ bar_color_var, |
|
| 572 | +91 |
- )+ bar_color_opt = NULL, |
|
| 573 | +92 |
-
+ sort_var, |
|
| 574 | +93 |
- # name for ae_line_col+ add_label_var_sl, |
|
| 575 | -! | +||
| 94 | +
- q1 <- if (!is.null(ae_line_col_var) && is.data.frame(ADAE)) {
+ add_label_paramcd_rs, |
||
| 576 | -! | +||
| 95 | +
- teal.code::eval_code(+ anno_txt_var_sl, |
||
| 577 | -! | +||
| 96 | +
- q1,+ anno_txt_paramcd_rs, |
||
| 578 | -! | +||
| 97 | +
- code = substitute(+ facet_var, |
||
| 579 | -! | +||
| 98 | +
- expr = ae_line_col_name <- formatters::var_labels(ADAE, fill = FALSE)[ae_line_col_var],+ ytick_at = 20, |
||
| 580 | -! | +||
| 99 | +
- env = list(ADAE = as.name(ae_dataname), ae_line_col_var = ae_line_col_var)+ href_line = NULL, |
||
| 581 | +100 |
- )+ gap_point_val = NULL, |
|
| 582 | +101 |
- )+ show_value = TRUE, |
|
| 583 | +102 |
- } else {
+ plot_height = c(1200L, 400L, 5000L), |
|
| 584 | -! | +||
| 103 | +
- teal.code::eval_code(q1, code = quote(ae_line_col_name <- NULL))+ plot_width = NULL, |
||
| 585 | +104 |
- }+ pre_output = NULL, |
|
| 586 | +105 |
-
+ post_output = NULL) {
|
|
| 587 | +106 | ! |
- q1 <- if (isTRUE(select_plot()[ae_dataname])) {
+ message("Initializing tm_g_waterfall")
|
| 588 | +107 | ! |
- if (all(ADAE$USUBJID %in% ADSL$USUBJID)) {
+ checkmate::assert_string(label) |
| 589 | +108 | ! |
- qq <- teal.code::eval_code(+ checkmate::assert_string(dataname_tr) |
| 590 | +109 | ! |
- q1,+ checkmate::assert_string(dataname_rs) |
| 591 | +110 | ! |
- code = substitute(+ checkmate::assert_class(bar_paramcd, classes = "choices_selected") |
| 592 | +111 | ! |
- expr = {
+ checkmate::assert_class(bar_var, classes = "choices_selected") |
| 593 | -+ | ||
| 112 | +! |
- # ADAE+ checkmate::assert_class(bar_color_var, classes = "choices_selected") |
|
| 594 | +113 | ! |
- ADAE <- ADAE[, adae_vars]+ checkmate::assert_class(sort_var, classes = "choices_selected") |
| 595 | -+ | ||
| 114 | +! |
-
+ checkmate::assert_class(anno_txt_var_sl, classes = "choices_selected") |
|
| 596 | +115 | ! |
- ADAE <- ADSL %>%+ checkmate::assert_class(anno_txt_paramcd_rs, classes = "choices_selected") |
| 597 | +116 | ! |
- left_join(ADAE, by = c("STUDYID", "USUBJID")) %>%
+ checkmate::assert_class(facet_var, classes = "choices_selected") |
| 598 | +117 | ! |
- as.data.frame() %>%+ checkmate::assert_class(add_label_var_sl, classes = "choices_selected") |
| 599 | +118 | ! |
- filter(!is.na(ASTDT), !is.na(AENDT)) %>%+ checkmate::assert_class(add_label_paramcd_rs, classes = "choices_selected") |
| 600 | +119 | ! |
- mutate(+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 601 | +120 | ! |
- ASTDY = as.numeric(difftime(ASTDT, as.Date(sl_start_date), units = "days")) ++ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 602 | +121 | ! |
- (ASTDT >= as.Date(sl_start_date)),+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 603 | +122 | ! |
- AENDY = as.numeric(difftime(AENDT, as.Date(sl_start_date), units = "days")) ++ checkmate::assert_numeric( |
| 604 | +123 | ! |
- (AENDT >= as.Date(sl_start_date))+ plot_width[1], |
| 605 | -+ | ||
| 124 | +! |
- ) %>%+ lower = plot_width[2], |
|
| 606 | +125 | ! |
- select(c(adae_vars, ASTDY, AENDY))+ upper = plot_width[3], |
| 607 | +126 | ! |
- formatters::var_labels(ADAE)[ae_line_col_var] <-+ null.ok = TRUE, |
| 608 | +127 | ! |
- formatters::var_labels(ADAE, fill = FALSE)[ae_line_col_var]+ .var.name = "plot_width" |
| 609 | +128 |
- },+ ) |
|
| 610 | -! | +||
| 129 | +
- env = list(+ |
||
| 611 | +130 | ! |
- ADSL = as.name(sl_dataname),+ args <- as.list(environment()) |
| 612 | -! | +||
| 131 | +
- ADAE = as.name(ae_dataname),+ |
||
| 613 | +132 | ! |
- sl_start_date = as.name(sl_start_date),+ module( |
| 614 | +133 | ! |
- ae_line_col_var = ae_line_col_var,+ label = label, |
| 615 | +134 | ! |
- adae_vars = adae_vars+ ui = ui_g_waterfall, |
| 616 | -+ | ||
| 135 | +! |
- )+ ui_args = args, |
|
| 617 | -+ | ||
| 136 | +! |
- )+ server = srv_g_waterfall, |
|
| 618 | -+ | ||
| 137 | +! |
- ) %>%+ server_args = list( |
|
| 619 | +138 | ! |
- teal.code::eval_code(+ dataname_tr = dataname_tr, |
| 620 | +139 | ! |
- code = substitute(+ dataname_rs = dataname_rs, |
| 621 | +140 | ! |
- expr = ae <- list(+ bar_paramcd = bar_paramcd, |
| 622 | +141 | ! |
- data = data.frame(ADAE),+ add_label_paramcd_rs = add_label_paramcd_rs, |
| 623 | +142 | ! |
- var = as.vector(ADAE[, ae_var]),+ anno_txt_paramcd_rs = anno_txt_paramcd_rs, |
| 624 | -! | -
- line_col = line_col,- |
- |
| 625 | -! | -
- line_col_legend = line_col_legend,- |
- |
| 626 | +143 | ! |
- line_col_opt = line_col_opt- |
-
| 627 | -- |
- ),+ label = label, |
|
| 628 | +144 | ! |
- env = list(+ bar_color_opt = bar_color_opt, |
| 629 | +145 | ! |
- ADAE = as.name(ae_dataname),+ plot_height = plot_height, |
| 630 | +146 | ! |
- ae_var = ae_var,+ plot_width = plot_width |
| 631 | -! | +||
| 147 | +
- line_col = if (!is.null(ae_line_col_var)) bquote(as.vector(ADAE[, .(ae_line_col_var)])) else NULL,+ ), |
||
| 632 | +148 | ! |
- line_col_legend = ae_line_col_var,+ datanames = "all" |
| 633 | -! | +||
| 149 | +
- line_col_opt = ae_line_col_opt+ ) |
||
| 634 | +150 |
- )+ } |
|
| 635 | +151 |
- )+ |
|
| 636 | +152 |
- )+ ui_g_waterfall <- function(id, ...) {
|
|
| 637 | +153 | ! |
- ADAE <- qq[[ae_dataname]]+ a <- list(...) |
| 638 | +154 | ! |
- if (is.null(ADAE) | nrow(ADAE) == 0) {
+ ns <- NS(id) |
| 639 | +155 | ! |
- empty_ae <- TRUE+ teal.widgets::standard_layout( |
| 640 | -+ | ||
| 156 | +! |
- }+ output = teal.widgets::white_small_well( |
|
| 641 | +157 | ! |
- teal.widgets::plot_with_settings_ui(id = ns("waterfallplot"))
|
| 642 | +158 |
- } else {
+ ), |
|
| 643 | +159 | ! |
- empty_ae <- TRUE+ encoding = tags$div( |
| 644 | -! | +||
| 160 | +
- teal.code::eval_code(q1, code = quote(ae <- NULL))+ ### Reporter |
||
| 645 | -+ | ||
| 161 | +! |
- }+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
|
|
| 646 | +162 |
- } else {
+ ### |
|
| 647 | +163 | ! |
- teal.code::eval_code(q1, code = quote(ae <- NULL))+ tags$label("Encodings", class = "text-primary"),
|
| 648 | -+ | ||
| 164 | +! |
- }+ helpText("Analysis Data: ", tags$code(a$dataname_tr), tags$code(a$dataname_rs)),
|
|
| 649 | -+ | ||
| 165 | +! |
-
+ teal.widgets::optionalSelectInput( |
|
| 650 | +166 | ! |
- q1 <- if (isTRUE(select_plot()[rs_dataname])) {
+ ns("bar_paramcd"),
|
| 651 | +167 | ! |
- if (all(ADRS$USUBJID %in% ADSL$USUBJID)) {
+ "Tumor Burden Parameter", |
| 652 | +168 | ! |
- qq <- teal.code::eval_code(+ multiple = FALSE |
| 653 | -! | +||
| 169 | +
- q1,+ ), |
||
| 654 | +170 | ! |
- code = substitute(+ teal.widgets::optionalSelectInput( |
| 655 | +171 | ! |
- expr = {
+ ns("bar_var"),
|
| 656 | +172 | ! |
- ADRS <- ADRS[, adrs_vars]+ "Bar Height", |
| 657 | +173 | ! |
- ADRS <- ADSL %>%+ choices = get_choices(a$bar_var$choices), |
| 658 | +174 | ! |
- left_join(ADRS, by = c("STUDYID", "USUBJID")) %>%
+ selected = a$bar_var$selected, |
| 659 | +175 | ! |
- as.data.frame() %>%+ multiple = FALSE, |
| 660 | +176 | ! |
- mutate(+ label_help = helpText("Tumor change variable from ", tags$code("ADTR"))
+ |
+
| 177 | ++ |
+ ), |
|
| 661 | +178 | ! |
- ADY = as.numeric(difftime(ADT, as.Date(sl_start_date), units = "days")) ++ teal.widgets::optionalSelectInput( |
| 662 | +179 | ! |
- (ADT >= as.Date(sl_start_date))+ ns("bar_color_var"),
|
| 663 | -+ | ||
| 180 | +! |
- ) %>%+ "Bar Color", |
|
| 664 | +181 | ! |
- select(USUBJID, PARAMCD, PARAM, AVALC, AVAL, ADY, ADT) %>%+ choices = get_choices(a$bar_color_var$choices), |
| 665 | +182 | ! |
- filter(is.na(ADY) == FALSE)+ selected = a$bar_color_var$selected, |
| 666 | +183 | ! |
- rs <- list(data = data.frame(ADRS), var = as.vector(ADRS[, rs_var]))+ multiple = FALSE |
| 667 | +184 |
- },+ ), |
|
| 668 | +185 | ! |
- env = list(+ teal.widgets::optionalSelectInput( |
| 669 | +186 | ! |
- ADRS = as.name(rs_dataname),+ ns("sort_var"),
|
| 670 | +187 | ! |
- adrs_vars = adrs_vars,+ "Sort by", |
| 671 | +188 | ! |
- sl_start_date = as.name(sl_start_date),+ choices = get_choices(a$sort_var$choices), |
| 672 | +189 | ! |
- rs_var = rs_var+ selected = a$sort_var$selected, |
| 673 | -+ | ||
| 190 | +! |
- )+ multiple = FALSE, |
|
| 674 | -+ | ||
| 191 | +! |
- )+ label_help = helpText("from ", tags$code("ADSL"))
|
|
| 675 | +192 |
- )+ ), |
|
| 676 | +193 | ! |
- ADRS <- qq[[rs_dataname]]+ teal.widgets::optionalSelectInput( |
| 677 | +194 | ! |
- if (is.null(ADRS) || nrow(ADRS) == 0) {
+ ns("add_label_var_sl"),
|
| 678 | +195 | ! |
- empty_rs <- TRUE+ "Add ADSL Label to Bars", |
| 679 | -+ | ||
| 196 | +! |
- }+ choices = get_choices(a$add_label_var_sl$choices), |
|
| 680 | +197 | ! |
- selected = a$add_label_var_sl$selected,+ |
+
| 198 | +! | +
+ multiple = FALSE |
|
| 681 | +199 |
- } else {
+ ), |
|
| 682 | +200 | ! |
- empty_rs <- TRUE+ teal.widgets::optionalSelectInput( |
| 683 | +201 | ! |
- teal.code::eval_code(q1, expression = quote(rs <- NULL))- |
-
| 684 | -- |
- }+ ns("add_label_paramcd_rs"),
|
|
| 685 | -+ | ||
| 202 | +! |
- } else {
+ "Add ADRS Label to Bars", |
|
| 686 | +203 | ! |
- teal.code::eval_code(q1, code = quote(rs <- NULL))+ multiple = FALSE |
| 687 | +204 |
- }+ ), |
|
| 688 | -+ | ||
| 205 | +! |
-
+ teal.widgets::optionalSelectInput( |
|
| 689 | +206 | ! |
- q1 <- if (isTRUE(select_plot()[cm_dataname])) {
+ ns("anno_txt_var_sl"),
|
| 690 | +207 | ! |
- if (all(ADCM$USUBJID %in% ADSL$USUBJID)) {
+ "Annotation Variables", |
| 691 | +208 | ! |
- qq <- teal.code::eval_code(+ choices = get_choices(a$anno_txt_var_sl$choices), |
| 692 | +209 | ! |
- q1,+ selected = a$anno_txt_var_sl$selected, |
| 693 | +210 | ! |
- code = substitute(+ multiple = TRUE, |
| 694 | +211 | ! |
- expr = {
+ label_help = helpText("from ", tags$code("ADSL"))
|
| 695 | +212 |
- # ADCM+ ), |
|
| 696 | +213 | ! |
- ADCM <- ADCM[, adcm_vars]+ teal.widgets::optionalSelectInput( |
| 697 | +214 | ! |
- ADCM <- ADSL %>%+ ns("anno_txt_paramcd_rs"),
|
| 698 | +215 | ! |
- left_join(ADCM, by = c("STUDYID", "USUBJID")) %>%
+ "Annotation Parameters", |
| 699 | +216 | ! |
- as.data.frame() %>%+ multiple = TRUE, |
| 700 | +217 | ! |
- filter(!is.na(ASTDT), !is.na(AENDT)) %>%+ label_help = helpText("from ", tags$code("ADRS"))
+ |
+
| 218 | ++ |
+ ), |
|
| 701 | +219 | ! |
- mutate(+ teal.widgets::optionalSelectInput( |
| 702 | +220 | ! |
- ASTDY = as.numeric(difftime(ASTDT, as.Date(sl_start_date), units = "days")) ++ ns("facet_var"),
|
| 703 | +221 | ! |
- (ASTDT >= as.Date(sl_start_date)),+ "Facet by", |
| 704 | +222 | ! |
- AENDY = as.numeric(difftime(AENDT, as.Date(sl_start_date), units = "days")) ++ choices = get_choices(a$facet_var$choices), |
| 705 | +223 | ! |
- (AENDT >= as.Date(sl_start_date))+ selected = NULL, |
| 706 | -+ | ||
| 224 | +! |
- ) %>%+ multiple = FALSE, |
|
| 707 | +225 | ! |
- select(USUBJID, ASTDT, AENDT, ASTDY, AENDY, !!quo(cm_var))+ label_help = helpText("from ", tags$code("ADSL"))
+ |
+
| 226 | ++ |
+ ), |
|
| 708 | +227 | ! |
- if (length(unique(ADCM$USUBJID)) > 0) {
+ checkboxInput( |
| 709 | +228 | ! |
- ADCM <- ADCM[which(ADCM$AENDY >= -28 | is.na(ADCM$AENDY) == TRUE & is.na(ADCM$ASTDY) == FALSE), ]+ ns("show_value"),
|
| 710 | -+ | ||
| 229 | +! |
- }+ "Add Bar Height Value", |
|
| 711 | +230 | ! |
- cm <- list(data = data.frame(ADCM), var = as.vector(ADCM[, cm_var]))+ value = a$show_value |
| 712 | +231 |
- },+ ), |
|
| 713 | +232 | ! |
- env = list(+ textInput( |
| 714 | +233 | ! |
- ADSL = as.name(sl_dataname),+ ns("href_line"),
|
| 715 | +234 | ! |
- ADCM = as.name(cm_dataname),+ label = tags$div( |
| 716 | +235 | ! |
- sl_start_date = as.name(sl_start_date),+ "Horizontal Reference Line(s)", |
| 717 | +236 | ! |
- adcm_vars = adcm_vars,+ tags$br(), |
| 718 | +237 | ! |
- cm_var = cm_var+ helpText("Enter numeric value(s) of reference lines, separated by comma (eg. -10, 20)")
|
| 719 | +238 |
- )+ ), |
|
| 720 | -+ | ||
| 239 | +! |
- )+ value = a$href_line |
|
| 721 | +240 |
- )+ ), |
|
| 722 | -+ | ||
| 241 | +! |
-
+ textInput( |
|
| 723 | +242 | ! |
- ADCM <- qq[[cm_dataname]]+ ns("ytick_at"),
|
| 724 | +243 | ! |
- if (is.null(ADCM) | nrow(ADCM) == 0) {
+ label = tags$div( |
| 725 | +244 | ! |
- empty_cm <- TRUE+ "Y-axis Interval",+ |
+
| 245 | +! | +
+ tags$br(),+ |
+ |
| 246 | +! | +
+ helpText("Enter a numeric value of Y axis interval")
|
|
| 726 | +247 |
- }+ ), |
|
| 727 | +248 | ! |
- value = a$ytick_at |
| 728 | +249 |
- } else {
+ ), |
|
| 729 | +250 | ! |
- empty_cm <- TRUE+ textInput( |
| 730 | +251 | ! |
- teal.code::eval_code(q1, code = quote(cm <- NULL))+ ns("gap_point_val"),
|
| 731 | -+ | ||
| 252 | +! |
- }+ label = tags$div(+ |
+ |
| 253 | +! | +
+ "Break High Bars",+ |
+ |
| 254 | +! | +
+ tags$br(),+ |
+ |
| 255 | +! | +
+ helpText("Enter a numeric value to break very high bars")
|
|
| 732 | +256 |
- } else {
+ ), |
|
| 733 | +257 | ! |
- teal.code::eval_code(q1, code = quote(cm <- NULL))+ value = a$gap_point_val |
| 734 | +258 |
- }+ ) |
|
| 735 | +259 |
-
+ ), |
|
| 736 | +260 | ! |
- q1 <- if (isTRUE(select_plot()[ex_dataname])) {
+ forms = tagList( |
| 737 | +261 | ! |
- if (all(ADEX$USUBJID %in% ADSL$USUBJID)) {
+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
| 738 | -! | +||
| 262 | +
- qq <- teal.code::eval_code(+ ), |
||
| 739 | +263 | ! |
- q1,+ pre_output = a$pre_output, |
| 740 | +264 | ! |
- code = substitute(+ post_output = a$post_output |
| 741 | -! | +||
| 265 | +
- expr = {
+ ) |
||
| 742 | +266 |
- # ADEX+ } |
|
| 743 | -! | +||
| 267 | +
- ADEX <- ADEX[, adex_vars]+ |
||
| 744 | -! | +||
| 268 | +
- ADEX <- ADSL %>%+ srv_g_waterfall <- function(id, |
||
| 745 | -! | +||
| 269 | +
- left_join(ADEX, by = c("STUDYID", "USUBJID")) %>%
+ data, |
||
| 746 | -! | +||
| 270 | +
- as.data.frame() %>%+ filter_panel_api, |
||
| 747 | -! | +||
| 271 | +
- filter(PARCAT1 == "INDIVIDUAL" & PARAMCD == "DOSE" & !is.na(AVAL) & !is.na(ASTDT)) %>%+ reporter, |
||
| 748 | -! | +||
| 272 | +
- select(USUBJID, ASTDT, PARCAT2, AVAL, AVALU, PARAMCD, sl_start_date)+ bar_paramcd, |
||
| 749 | +273 |
-
+ add_label_paramcd_rs, |
|
| 750 | -! | +||
| 274 | +
- ADEX <- split(ADEX, ADEX$USUBJID) %>%+ anno_txt_paramcd_rs, |
||
| 751 | -! | +||
| 275 | +
- lapply(function(pinfo) {
+ dataname_tr, |
||
| 752 | -! | +||
| 276 | +
- pinfo %>%+ dataname_rs, |
||
| 753 | -! | +||
| 277 | +
- arrange(PARCAT2, PARAMCD, ASTDT) %>%+ bar_color_opt, |
||
| 754 | -! | +||
| 278 | +
- ungroup() %>%+ label, |
||
| 755 | -! | +||
| 279 | +
- mutate(+ plot_height, |
||
| 756 | -! | +||
| 280 | +
- diff = c(0, diff(AVAL, lag = 1)),+ plot_width) {
|
||
| 757 | +281 | ! |
- Modification = case_when(+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
| 758 | +282 | ! |
- diff < 0 ~ "Decrease",+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
| 759 | +283 | ! |
- diff > 0 ~ "Increase",+ checkmate::assert_class(data, "reactive") |
| 760 | +284 | ! |
- diff == 0 ~ "None"+ checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 761 | +285 |
- ),+ |
|
| 762 | +286 | ! |
- ASTDT_dur = as.numeric(difftime(as.Date(ASTDT), as.Date(sl_start_date), units = "days")) ++ moduleServer(id, function(input, output, session) {
|
| 763 | +287 | ! |
- (as.Date(ASTDT) >= as.Date(sl_start_date))- |
-
| 764 | -- |
- )+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
|
| 765 | +288 |
- }) %>%+ |
|
| 766 | +289 | ! |
- Reduce(rbind, .) %>%+ env <- as.list(isolate(data())) |
| 767 | +290 | ! |
- as.data.frame() %>%+ resolved_bar_paramcd <- teal.transform::resolve_delayed(bar_paramcd, env) |
| 768 | +291 | ! |
- select(-diff)+ resolved_add_label_paramcd_rs <- teal.transform::resolve_delayed(add_label_paramcd_rs, env) |
| 769 | +292 | ! |
- ex <- list(data = data.frame(ADEX), var = as.vector(ADEX[, ex_var]))+ resolved_anno_txt_paramcd_rs <- teal.transform::resolve_delayed(anno_txt_paramcd_rs, env) |
| 770 | +293 |
- },- |
- |
| 771 | -! | -
- env = list(+ |
|
| 772 | +294 | ! |
- ADSL = as.name(sl_dataname),+ teal.widgets::updateOptionalSelectInput( |
| 773 | +295 | ! |
- ADEX = as.name(ex_dataname),+ session = session, |
| 774 | +296 | ! |
- adex_vars = adex_vars,+ inputId = "bar_paramcd", |
| 775 | +297 | ! |
- sl_start_date = as.name(sl_start_date),+ choices = resolved_bar_paramcd$choices, |
| 776 | +298 | ! |
- ex_var = ex_var- |
-
| 777 | -- |
- )- |
- |
| 778 | -- |
- )+ selected = resolved_bar_paramcd$selected |
|
| 779 | +299 |
- )+ ) |
|
| 780 | +300 | ! |
- ADEX <- qq[[ex_dataname]]+ teal.widgets::updateOptionalSelectInput( |
| 781 | +301 | ! |
- if (is.null(ADEX) | nrow(ADEX) == 0) {
+ session = session, |
| 782 | +302 | ! |
- empty_ex <- TRUE+ inputId = "add_label_paramcd_rs", |
| 783 | -+ | ||
| 303 | +! |
- }+ choices = resolved_add_label_paramcd_rs$choices, |
|
| 784 | +304 | ! |
- selected = resolved_add_label_paramcd_rs$selected |
| 785 | +305 |
- } else {
+ ) |
|
| 786 | +306 | ! |
- empty_ex <- TRUE+ teal.widgets::updateOptionalSelectInput( |
| 787 | +307 | ! |
- teal.code::eval_code(q1, code = quote(ex <- NULL))+ session = session, |
| 788 | -+ | ||
| 308 | +! |
- }+ inputId = "anno_txt_paramcd_rs", |
|
| 789 | -+ | ||
| 309 | +! |
- } else {
+ choices = resolved_anno_txt_paramcd_rs$choices, |
|
| 790 | +310 | ! |
- teal.code::eval_code(q1, code = quote(ex <- NULL))+ selected = resolved_anno_txt_paramcd_rs$selected |
| 791 | +311 |
- }+ ) |
|
| 792 | +312 | ||
| 793 | +313 | ! |
- q1 <- if (isTRUE(select_plot()[lb_dataname])) {
+ iv <- reactive({
|
| 794 | +314 | ! |
- if (all(ADLB$USUBJID %in% ADSL$USUBJID)) {
+ adsl <- data()[["ADSL"]] |
| 795 | +315 | ! |
- qq <- teal.code::eval_code(+ adtr <- data()[[dataname_tr]] |
| 796 | +316 | ! |
- q1,+ adrs <- data()[[dataname_rs]]+ |
+
| 317 | ++ | + | |
| 797 | +318 | ! |
- code = substitute(+ iv <- shinyvalidate::InputValidator$new() |
| 798 | +319 | ! |
- expr = {
+ iv$add_rule("bar_var", shinyvalidate::sv_required(
|
| 799 | +320 | ! |
- ADLB <- ADLB[, adlb_vars]+ message = "Bar Height is required"+ |
+
| 321 | ++ |
+ )) |
|
| 800 | +322 | ! |
- ADLB <- ADSL %>%+ iv$add_rule("bar_paramcd", shinyvalidate::sv_required(
|
| 801 | +323 | ! |
- left_join(ADLB, by = c("STUDYID", "USUBJID")) %>%
+ message = "Tumor Burden Parameter is required"+ |
+
| 324 | ++ |
+ )) |
|
| 802 | +325 | ! |
- as.data.frame() %>%+ iv$add_rule("bar_paramcd", shinyvalidate::sv_in_set(
|
| 803 | +326 | ! |
- mutate(+ set = adtr$PARAMCD, |
| 804 | +327 | ! |
- ANRIND = factor(ANRIND, levels = c("HIGH", "LOW", "NORMAL"))
+ message_fmt = "All values of Tumor Burden Parameter must be elements of ADTR PARAMCD" |
| 805 | +328 |
- ) %>%+ )) |
|
| 806 | +329 | ! |
- filter(!is.na(LBSTRESN) & !is.na(ANRIND) & .data[[lb_var]] %in% lb_var_show) %>%+ iv$add_rule("add_label_paramcd_rs", shinyvalidate::sv_optional())
|
| 807 | +330 | ! |
- as.data.frame() %>%+ iv$add_rule("add_label_paramcd_rs", shinyvalidate::sv_in_set(
|
| 808 | +331 | ! |
- select(+ set = adrs$PARAMCD, |
| 809 | +332 | ! |
- USUBJID, STUDYID, LBSEQ, PARAMCD, BASETYPE, ADT, AVISITN, sl_start_date, LBTESTCD, ANRIND, lb_var+ message_fmt = "ADRS Label must be an element of ADRS PARAMCD" |
| 810 | +333 |
- ) %>%+ )) |
|
| 811 | +334 | ! |
- mutate(+ rule_excl <- function(value, other) {
|
| 812 | +335 | ! |
- ADY = as.numeric(difftime(ADT, as.Date(sl_start_date), units = "days")) ++ if (length(value) > 0L && length(other) > 0L) {
|
| 813 | +336 | ! |
- (ADT >= as.Date(sl_start_date))+ "Only one \"Label to Bars\" is allowed" |
| 814 | +337 |
- )- |
- |
| 815 | -! | -
- lb <- list(data = data.frame(ADLB), var = as.vector(ADLB[, lb_var]))+ } |
|
| 816 | +338 |
- },+ } |
|
| 817 | +339 | ! |
- env = list(+ iv$add_rule("add_label_paramcd_rs", rule_excl, other = input$add_label_var_sl)
|
| 818 | +340 | ! |
- ADLB = as.name(lb_dataname),+ iv$add_rule("add_label_var_sl", rule_excl, other = input$add_label_paramcd_rs)
|
| 819 | +341 | ! |
- ADSL = as.name(sl_dataname),+ iv$add_rule("anno_txt_paramcd_rs", shinyvalidate::sv_optional())
|
| 820 | +342 | ! |
- adlb_vars = adlb_vars,+ iv$add_rule("anno_txt_paramcd_rs", shinyvalidate::sv_in_set(
|
| 821 | +343 | ! |
- sl_start_date = as.name(sl_start_date),+ set = adrs$PARAMCD, |
| 822 | +344 | ! |
- lb_var = lb_var,+ message_fmt = "Annotation Parameters must be elements of ADRS PARAMCD"+ |
+
| 345 | ++ |
+ )) |
|
| 823 | +346 | ! |
- lb_var_show = lb_var_show+ iv$add_rule("href_line", shinyvalidate::sv_optional())
|
| 824 | -+ | ||
| 347 | +! |
- )+ iv$add_rule("href_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
|
| 825 | -+ | ||
| 348 | +! |
- )+ "Horizontal Reference Line(s) are invalid" |
|
| 826 | +349 |
- )+ }) |
|
| 827 | -+ | ||
| 350 | +! |
-
+ iv$add_rule("ytick_at", shinyvalidate::sv_required(
|
|
| 828 | +351 | ! |
- ADLB <- qq[[lb_dataname]]+ message = "Y-axis Interval is required"+ |
+
| 352 | ++ |
+ )) |
|
| 829 | +353 | ! |
- if (is.null(ADLB) | nrow(ADLB) == 0) {
+ iv$add_rule("ytick_at", ~ if (!checkmate::test_number(suppressWarnings(as.numeric(.)), lower = 1)) {
|
| 830 | +354 | ! |
- empty_lb <- TRUE+ "Y-axis Interval must be a single positive number" |
| 831 | +355 |
- }+ }) |
|
| 832 | +356 | ! |
- |
-
| 833 | -- |
- } else {
+ iv$add_rule("gap_point_val", shinyvalidate::sv_optional())
|
|
| 834 | +357 | ! |
- empty_lb <- TRUE+ iv$add_rule("gap_point_val", ~ if (!checkmate::test_number(suppressWarnings(as.numeric(.)), lower = 1)) {
|
| 835 | +358 | ! |
- teal.code::eval_code(q1, code = quote(lb <- NULL))+ "Break High Bars must be a single positive number" |
| 836 | +359 |
- }+ }) |
|
| 837 | -+ | ||
| 360 | +! |
- } else {
+ iv$enable() |
|
| 838 | +361 | ! |
- teal.code::eval_code(q1, code = quote(lb <- NULL))+ iv |
| 839 | +362 |
- }+ }) |
|
| 840 | +363 | ||
| 841 | -+ | ||
| 364 | +! |
- # Check the subject has information in at least one selected domain+ output_q <- reactive({
|
|
| 842 | +365 | ! |
- empty_data_check <- structure(+ adsl <- data()[["ADSL"]] |
| 843 | +366 | ! |
- c(empty_ex, empty_ae, empty_rs, empty_lb, empty_cm),+ adtr <- data()[[dataname_tr]] |
| 844 | +367 | ! |
- names = checkboxes+ adrs <- data()[[dataname_rs]] |
| 845 | +368 |
- )+ |
|
| 846 | +369 |
-
+ # validate data rows |
|
| 847 | +370 | ! |
- validate(need(+ teal::validate_has_data(adsl, min_nrow = 2) |
| 848 | +371 | ! |
- any(!empty_data_check & select_plot()),+ teal::validate_has_data(adtr, min_nrow = 2) |
| 849 | +372 | ! |
- "The subject does not have information in any selected domain."- |
-
| 850 | -- |
- ))+ teal::validate_has_data(adrs, min_nrow = 2) |
|
| 851 | +373 | ||
| 852 | -- |
- # Check the subject has information in all the selected domains- |
- |
| 853 | -! | -
- if (any(empty_data_check & select_plot())) {
- |
- |
| 854 | +374 | ! |
- showNotification(+ adsl_vars <- unique( |
| 855 | +375 | ! |
- paste0(+ c( |
| 856 | +376 | ! |
- "This subject does not have information in the ",+ "USUBJID", "STUDYID", |
| 857 | +377 | ! |
- paste(checkboxes[empty_data_check & select_plot()], collapse = ", "),+ input$bar_color_var, input$sort_var, input$add_label_var_sl, input$anno_txt_var_sl, input$facet_var |
| 858 | -! | +||
| 378 | +
- " domain."+ ) |
||
| 859 | +379 |
- ),+ ) |
|
| 860 | +380 | ! |
- duration = 8,+ adtr_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", input$bar_var))
|
| 861 | +381 | ! |
- type = "warning"- |
-
| 862 | -- |
- )+ adrs_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", "AVALC"))
|
|
| 863 | -+ | ||
| 382 | +! |
- }+ adrs_paramcd <- unique(c(input$add_label_paramcd_rs, input$anno_txt_paramcd_rs)) |
|
| 864 | +383 | ||
| 865 | +384 |
- # Convert x_limit to numeric vector- |
- |
| 866 | -! | -
- if (!is.null(x_limit) || x_limit != "") {
+ # validate data input |
|
| 867 | +385 | ! |
- q1 <- teal.code::eval_code(+ teal::validate_has_variable(adsl, adsl_vars) |
| 868 | +386 | ! |
- q1,+ teal::validate_has_variable(adrs, adrs_vars) |
| 869 | +387 | ! |
- code = bquote(x_limit <- as.numeric(unlist(strsplit(.(x_limit), ","))))+ teal::validate_has_variable(adtr, adtr_vars) |
| 870 | +388 |
- )+ |
|
| 871 | +389 | ! |
- x_limit <- q1[["x_limit"]]+ teal::validate_inputs(iv()) |
| 872 | +390 |
- }+ |
|
| 873 | +391 |
-
+ # get variables |
|
| 874 | +392 | ! |
- q1 <- teal.code::eval_code(+ bar_var <- input$bar_var |
| 875 | +393 | ! |
- q1,+ bar_paramcd <- input$bar_paramcd |
| 876 | +394 | ! |
- code = substitute(+ add_label_var_sl <- input$add_label_var_sl |
| 877 | +395 | ! |
- expr = {
+ add_label_paramcd_rs <- input$add_label_paramcd_rs |
| 878 | +396 | ! |
- plot <- osprey::g_patient_profile(+ anno_txt_var_sl <- input$anno_txt_var_sl |
| 879 | +397 | ! |
- ex = ex,+ anno_txt_paramcd_rs <- input$anno_txt_paramcd_rs |
| 880 | +398 | ! |
- ae = ae,+ ytick_at <- input$ytick_at |
| 881 | +399 | ! |
- rs = rs,+ href_line <- input$href_line |
| 882 | +400 | ! |
- cm = cm,+ gap_point_val <- input$gap_point_val |
| 883 | +401 | ! |
- lb = lb,+ show_value <- input$show_value |
| 884 | +402 | ! |
- arrow_end_day = ADSL[["max_day"]],+ href_line <- suppressWarnings(as_numeric_from_comma_sep_str(href_line)) |
| 885 | -! | +||
| 403 | +
- xlim = x_limit,+ |
||
| 886 | +404 | ! |
- xlab = "Study Day",+ if (gap_point_val == "") {
|
| 887 | +405 | ! |
- title = paste("Patient Profile: ", patient_id)
+ gap_point_val <- NULL |
| 888 | +406 |
- )+ } else {
|
|
| 889 | +407 | ! |
- plot+ gap_point_val <- as.numeric(gap_point_val) |
| 890 | +408 |
- },+ } |
|
| 891 | +409 | ! |
- env = list(+ ytick_at <- as.numeric(ytick_at) |
| 892 | -! | +||
| 410 | +
- patient_id = patient_id,+ |
||
| 893 | +411 | ! |
- ADSL = as.name(sl_dataname)+ bar_color_var <- if ( |
| 894 | -+ | ||
| 412 | +! |
- )+ !is.null(input$bar_color_var) && |
|
| 895 | -+ | ||
| 413 | +! |
- )+ input$bar_color_var != "None" && |
|
| 896 | -+ | ||
| 414 | +! |
- )+ input$bar_color_var != "" |
|
| 897 | +415 |
- })+ ) {
|
|
| 898 | -+ | ||
| 416 | +! |
- )+ input$bar_color_var |
|
| 899 | +417 |
-
+ } else {
|
|
| 900 | +418 | ! |
- plot_r <- reactive(output_q()[["plot"]])+ NULL |
| 901 | +419 | - - | -|
| 902 | -! | -
- pws <- teal.widgets::plot_with_settings_srv(+ } |
|
| 903 | +420 | ! |
- id = "patientprofileplot",+ sort_var <- if (!is.null(input$sort_var) && input$sort_var != "None" && input$sort_var != "") {
|
| 904 | +421 | ! |
- plot_r = plot_r,+ input$sort_var |
| 905 | -! | +||
| 422 | +
- height = plot_height,+ } else {
|
||
| 906 | +423 | ! |
- width = plot_width- |
-
| 907 | -- |
- )+ NULL |
|
| 908 | +424 |
-
+ } |
|
| 909 | +425 | ! |
- teal.widgets::verbatim_popup_srv(+ facet_var <- if (!is.null(input$facet_var) && input$facet_var != "None" && input$facet_var != "") {
|
| 910 | +426 | ! |
- id = "rcode",+ input$facet_var |
| 911 | -! | +||
| 427 | +
- title = paste("R code for", label),
+ } else {
|
||
| 912 | +428 | ! |
- verbatim_content = reactive(teal.code::get_code(output_q()))+ NULL |
| 913 | +429 |
- )+ } |
|
| 914 | +430 | ||
| 915 | +431 |
- ### REPORTER+ # write variables to qenv |
|
| 916 | +432 | ! |
- if (with_reporter) {
+ q1 <- teal.code::eval_code( |
| 917 | +433 | ! |
- card_fun <- function(comment, label) {
+ data(), |
| 918 | +434 | ! |
- card <- teal::report_card_template(+ code = bquote({
|
| 919 | +435 | ! |
- title = "Patient Profile",+ bar_var <- .(bar_var) |
| 920 | +436 | ! |
- label = label,+ bar_color_var <- .(bar_color_var) |
| 921 | +437 | ! |
- with_filter = with_filter,+ sort_var <- .(sort_var) |
| 922 | +438 | ! |
- filter_panel_api = filter_panel_api- |
-
| 923 | -- |
- )+ add_label_var_sl <- .(add_label_var_sl) |
|
| 924 | +439 | ! |
- card$append_text("Plot", "header3")
+ add_label_paramcd_rs <- .(add_label_paramcd_rs) |
| 925 | +440 | ! |
- card$append_plot(plot_r(), dim = pws$dim())+ anno_txt_var_sl <- .(anno_txt_var_sl) |
| 926 | +441 | ! |
- if (!comment == "") {
+ anno_txt_paramcd_rs <- .(anno_txt_paramcd_rs) |
| 927 | +442 | ! |
- card$append_text("Comment", "header3")
+ facet_var <- .(facet_var) |
| 928 | +443 | ! |
- card$append_text(comment)- |
-
| 929 | -- |
- }+ href_line <- .(href_line) |
|
| 930 | +444 | ! |
- card$append_src(teal.code::get_code(output_q()))+ gap_point_val <- .(gap_point_val) |
| 931 | +445 | ! |
- card+ show_value <- .(show_value) |
| 932 | +446 |
- }+ }) |
|
| 933 | -! | +||
| 447 | +
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
+ ) |
||
| 934 | +448 |
- }+ |
|
| 935 | +449 |
- })+ # data processing |
|
| 936 | -+ | ||
| 450 | +! |
- }+ q1 <- teal.code::eval_code( |
| 1 | -+ | ||
| 451 | +! |
- #' Teal Module for Waterfall Plot+ q1, |
|
| 2 | -+ | ||
| 452 | +! |
- #'+ code = bquote({
|
|
| 3 | -+ | ||
| 453 | +! |
- #' @description+ adsl <- ADSL[, .(adsl_vars)] |
|
| 4 | -+ | ||
| 454 | +! |
- #' `r lifecycle::badge("stable")`
+ adtr <- .(as.name(dataname_tr))[, .(adtr_vars)] |
|
| 5 | -+ | ||
| 455 | +! |
- #'+ adrs <- .(as.name(dataname_rs))[, .(adrs_vars)] |
|
| 6 | +456 |
- #' This is teal module that generates a waterfall plot for `ADaM` data+ |
|
| 7 | -+ | ||
| 457 | +! |
- #'+ bar_tr <- .(as.name(dataname_tr)) %>% |
|
| 8 | -+ | ||
| 458 | +! |
- #' @inheritParams teal.widgets::standard_layout+ dplyr::filter(PARAMCD == .(bar_paramcd)) %>% |
|
| 9 | -+ | ||
| 459 | +! |
- #' @inheritParams argument_convention+ dplyr::select(USUBJID, .(as.name(bar_var))) %>% |
|
| 10 | -+ | ||
| 460 | +! |
- #' @param dataname_tr tumor burden analysis data used in teal module to plot as bar height, needs to+ dplyr::group_by(USUBJID) %>% |
|
| 11 | -+ | ||
| 461 | +! |
- #' be available in the list passed to the `data` argument of [teal::init()]+ dplyr::slice(which.min(.(as.name(bar_var)))) |
|
| 12 | -+ | ||
| 462 | +! |
- #' @param dataname_rs response analysis data used in teal module to label response parameters, needs to+ bar_data <- adsl %>% dplyr::inner_join(bar_tr, "USUBJID") |
|
| 13 | +463 |
- #' be available in the list passed to the `data` argument of [teal::init()]+ }) |
|
| 14 | +464 |
- #' @param bar_paramcd `choices_selected` parameter in tumor burden data that will be plotted as+ ) |
|
| 15 | +465 |
- #' bar height+ |
|
| 16 | -+ | ||
| 466 | +! |
- #' @param bar_var `choices_selected` numeric variable from dataset to plot the bar height, e.g., `PCHG`+ q1 <- if (is.null(adrs_paramcd)) {
|
|
| 17 | -+ | ||
| 467 | +! |
- #' @param bar_color_var `choices_selected` color by variable (subject level), `None` corresponds+ teal.code::eval_code( |
|
| 18 | -+ | ||
| 468 | +! |
- #' to `NULL`+ q1, |
|
| 19 | -+ | ||
| 469 | +! |
- #' @param bar_color_opt aesthetic values to map color values (named vector to map color values to each name).+ code = bquote({
|
|
| 20 | -+ | ||
| 470 | +! |
- #' If not `NULL`, please make sure this contains all possible values for `bar_color_var` values,+ anl <- bar_data |
|
| 21 | -+ | ||
| 471 | +! |
- #' otherwise color will be assigned by `ggplot` default, please note that `NULL` needs to be specified+ anl$USUBJID <- unlist(lapply(strsplit(anl$USUBJID, "-", fixed = TRUE), tail, 1)) |
|
| 22 | +472 |
- #' in this case+ }) |
|
| 23 | +473 |
- #' @param sort_var `choices_selected` sort by variable (subject level), `None` corresponds+ ) |
|
| 24 | +474 |
- #' to `NULL`+ } else {
|
|
| 25 | -+ | ||
| 475 | +! |
- #' @param add_label_var_sl `choices_selected` add label to bars (subject level), `None`+ qq1 <- teal.code::eval_code( |
|
| 26 | -+ | ||
| 476 | +! |
- #' corresponds to `NULL`+ q1, |
|
| 27 | -+ | ||
| 477 | +! |
- #' @param add_label_paramcd_rs `choices_selected` add label to bars (response dataset), `None`+ code = bquote( |
|
| 28 | -+ | ||
| 478 | +! |
- #' corresponds to `NULL`. At least one of `add_label_var_sl` and `add_label_paramcd_rs` needs+ rs_sub <- .(as.name(dataname_rs)) %>% |
|
| 29 | -+ | ||
| 479 | +! |
- #' to be `NULL`+ dplyr::filter(PARAMCD %in% .(adrs_paramcd)) |
|
| 30 | +480 |
- #' @param anno_txt_var_sl `choices_selected` subject level variables to be displayed in the annotation+ ) |
|
| 31 | +481 |
- #' table, default is `NULL`+ ) |
|
| 32 | +482 |
- #' @param anno_txt_paramcd_rs `choices_selected` analysis dataset variables to be displayed in the+ |
|
| 33 | -+ | ||
| 483 | +! |
- #' annotation table, default is `NULL`+ teal::validate_one_row_per_id(qq1[["rs_sub"]], key = c("STUDYID", "USUBJID", "PARAMCD"))
|
|
| 34 | +484 |
- #' @param facet_var `choices_selected` facet by variable (subject level), `None` corresponds to+ |
|
| 35 | -+ | ||
| 485 | +! |
- #' `NULL`+ teal.code::eval_code( |
|
| 36 | -+ | ||
| 486 | +! |
- #' @param ytick_at bar height axis interval, default is 20+ qq1, |
|
| 37 | -+ | ||
| 487 | +! |
- #' @param href_line numeric vector to plot horizontal reference lines, default is `NULL`+ code = bquote({
|
|
| 38 | -+ | ||
| 488 | +! |
- #' @param gap_point_val singular numeric value for adding bar break when some bars are significantly higher+ rs_label <- rs_sub %>% |
|
| 39 | -+ | ||
| 489 | +! |
- #' than others, default is `NULL`+ dplyr::select(USUBJID, PARAMCD, AVALC) %>% |
|
| 40 | -+ | ||
| 490 | +! |
- #' @param show_value boolean of whether value of bar height is shown, default is `TRUE`+ tidyr::pivot_wider(names_from = PARAMCD, values_from = AVALC) |
|
| 41 | -+ | ||
| 491 | +! |
- #'+ anl <- bar_data %>% dplyr::left_join(rs_label, by = c("USUBJID"))
|
|
| 42 | -+ | ||
| 492 | +! |
- #' @inherit argument_convention return+ anl$USUBJID <- unlist(lapply(strsplit(anl$USUBJID, "-", fixed = TRUE), tail, 1)) |
|
| 43 | +493 |
- #'+ }) |
|
| 44 | +494 |
- #' @export+ ) |
|
| 45 | +495 |
- #'+ } |
|
| 46 | +496 |
- #' @template author_qit3+ |
|
| 47 | +497 |
- #' @author houx14 \email{houx14@gene.com}
+ # write plotting code to qenv |
|
| 48 | -+ | ||
| 498 | +! |
- #'+ anl <- q1[["anl"]] |
|
| 49 | +499 |
- #' @examples+ |
|
| 50 | -+ | ||
| 500 | +! |
- #' data <- teal_data() |>+ q1 <- teal.code::eval_code( |
|
| 51 | -+ | ||
| 501 | +! |
- #' within({
+ q1, |
|
| 52 | -+ | ||
| 502 | +! |
- #' ADSL <- rADSL+ code = bquote({
|
|
| 53 | -+ | ||
| 503 | +! |
- #' ADRS <- rADRS+ plot <- osprey::g_waterfall( |
|
| 54 | -+ | ||
| 504 | +! |
- #' ADTR <- rADTR+ bar_id = anl[["USUBJID"]], |
|
| 55 | -+ | ||
| 505 | +! |
- #' ADSL$SEX <- factor(ADSL$SEX, levels = unique(ADSL$SEX))+ bar_height = anl[[bar_var]], |
|
| 56 | -+ | ||
| 506 | +! |
- #' })+ sort_by = .(if (length(sort_var) > 0) {
|
|
| 57 | -+ | ||
| 507 | +! |
- #'+ quote(anl[[sort_var]]) |
|
| 58 | +508 |
- #' datanames(data) <- c("ADSL", "ADTR", "ADRS")
+ } else {
|
|
| 59 | -+ | ||
| 509 | +! |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ NULL |
|
| 60 | +510 |
- #'+ }), |
|
| 61 | -+ | ||
| 511 | +! |
- #' app <- init(+ col_by = .(if (length(bar_color_var) > 0) {
|
|
| 62 | -+ | ||
| 512 | +! |
- #' data = data,+ quote(anl[[bar_color_var]]) |
|
| 63 | +513 |
- #' modules = modules(+ } else {
|
|
| 64 | -+ | ||
| 514 | +! |
- #' tm_g_waterfall(+ NULL |
|
| 65 | +515 |
- #' label = "Waterfall",+ }), |
|
| 66 | -+ | ||
| 516 | +! |
- #' dataname_tr = "ADTR",+ bar_color_opt = .(if (length(bar_color_var) == 0) {
|
|
| 67 | -+ | ||
| 517 | +! |
- #' dataname_rs = "ADRS",+ NULL |
|
| 68 | -+ | ||
| 518 | +! |
- #' bar_paramcd = choices_selected(c("SLDINV"), "SLDINV"),
+ } else if (length(bar_color_var) > 0 & all(unique(anl[[bar_color_var]]) %in% names(bar_color_opt))) {
|
|
| 69 | -+ | ||
| 519 | +! |
- #' bar_var = choices_selected(c("PCHG", "AVAL"), "PCHG"),
+ bar_color_opt |
|
| 70 | +520 |
- #' bar_color_var = choices_selected(c("ARMCD", "SEX"), "ARMCD"),
+ } else {
|
|
| 71 | -+ | ||
| 521 | +! |
- #' bar_color_opt = NULL,+ NULL |
|
| 72 | +522 |
- #' sort_var = choices_selected(c("ARMCD", "SEX"), NULL),
+ }), |
|
| 73 | -+ | ||
| 523 | +! |
- #' add_label_var_sl = choices_selected(c("SEX", "EOSDY"), NULL),
+ anno_txt = .(if (length(anno_txt_var_sl) == 0 & length(anno_txt_paramcd_rs) == 0) {
|
|
| 74 | -+ | ||
| 524 | +! |
- #' add_label_paramcd_rs = choices_selected(c("BESRSPI", "OBJRSPI"), NULL),
+ NULL |
|
| 75 | -+ | ||
| 525 | +! |
- #' anno_txt_var_sl = choices_selected(c("SEX", "ARMCD", "BMK1", "BMK2"), NULL),
+ } else if (length(anno_txt_var_sl) >= 1 & length(anno_txt_paramcd_rs) == 0) {
|
|
| 76 | -+ | ||
| 526 | +! |
- #' anno_txt_paramcd_rs = choices_selected(c("BESRSPI", "OBJRSPI"), NULL),
+ quote(data.frame(anl[anno_txt_var_sl])) |
|
| 77 | -+ | ||
| 527 | +! |
- #' facet_var = choices_selected(c("SEX", "ARMCD", "STRATA1", "STRATA2"), NULL),
+ } else if (length(anno_txt_paramcd_rs) >= 1 & length(anno_txt_var_sl) == 0) {
|
|
| 78 | -+ | ||
| 528 | +! |
- #' href_line = "-30, 20"+ quote(data.frame(anl[anno_txt_paramcd_rs])) |
|
| 79 | +529 |
- #' )+ } else {
|
|
| 80 | -+ | ||
| 530 | +! |
- #' )+ quote(cbind(anl[anno_txt_var_sl], anl[anno_txt_paramcd_rs])) |
|
| 81 | +531 |
- #' )+ }), |
|
| 82 | -+ | ||
| 532 | +! |
- #' if (interactive()) {
+ href_line = .(href_line), |
|
| 83 | -+ | ||
| 533 | +! |
- #' shinyApp(app$ui, app$server)+ facet_by = .(if (length(facet_var) > 0) {
|
|
| 84 | -+ | ||
| 534 | +! |
- #' }+ quote(as.factor(anl[[facet_var]])) |
|
| 85 | +535 |
- #'+ } else {
|
|
| 86 | -+ | ||
| 536 | +! |
- tm_g_waterfall <- function(label,+ NULL |
|
| 87 | +537 |
- dataname_tr = "ADTR",+ }), |
|
| 88 | -+ | ||
| 538 | +! |
- dataname_rs = "ADRS",+ show_datavalue = .(show_value), |
|
| 89 | -+ | ||
| 539 | +! |
- bar_paramcd,+ add_label = .(if (length(add_label_var_sl) > 0 & length(add_label_paramcd_rs) == 0) {
|
|
| 90 | -+ | ||
| 540 | +! |
- bar_var,+ quote(anl[[add_label_var_sl]]) |
|
| 91 | -+ | ||
| 541 | +! |
- bar_color_var,+ } else if (length(add_label_paramcd_rs) > 0 & length(add_label_var_sl) == 0) {
|
|
| 92 | -+ | ||
| 542 | +! |
- bar_color_opt = NULL,+ quote(anl[[add_label_paramcd_rs]]) |
|
| 93 | +543 |
- sort_var,+ } else {
|
|
| 94 | -+ | ||
| 544 | +! |
- add_label_var_sl,+ NULL |
|
| 95 | +545 |
- add_label_paramcd_rs,+ }), |
|
| 96 | -+ | ||
| 546 | +! |
- anno_txt_var_sl,+ gap_point = .(gap_point_val), |
|
| 97 | -+ | ||
| 547 | +! |
- anno_txt_paramcd_rs,+ ytick_at = .(ytick_at), |
|
| 98 | -+ | ||
| 548 | +! |
- facet_var,+ y_label = "Tumor Burden Change from Baseline", |
|
| 99 | -+ | ||
| 549 | +! |
- ytick_at = 20,+ title = "Waterfall Plot" |
|
| 100 | +550 |
- href_line = NULL,+ )+ |
+ |
| 551 | +! | +
+ plot |
|
| 101 | +552 |
- gap_point_val = NULL,+ }) |
|
| 102 | +553 |
- show_value = TRUE,+ ) |
|
| 103 | +554 |
- plot_height = c(1200L, 400L, 5000L),+ }) |
|
| 104 | +555 |
- plot_width = NULL,+ + |
+ |
| 556 | +! | +
+ plot_r <- reactive(output_q()[["plot"]]) |
|
| 105 | +557 |
- pre_output = NULL,+ |
|
| 106 | +558 |
- post_output = NULL) {
+ # Insert the plot into a plot_with_settings module from teal.widgets |
|
| 107 | +559 | ! |
- message("Initializing tm_g_waterfall")
+ pws <- teal.widgets::plot_with_settings_srv( |
| 108 | +560 | ! |
- checkmate::assert_string(label)+ id = "waterfallplot", |
| 109 | +561 | ! |
- checkmate::assert_string(dataname_tr)+ plot_r = plot_r, |
| 110 | +562 | ! |
- checkmate::assert_string(dataname_rs)+ height = plot_height, |
| 111 | +563 | ! |
- checkmate::assert_class(bar_paramcd, classes = "choices_selected")+ width = plot_width |
| 112 | -! | +||
| 564 | +
- checkmate::assert_class(bar_var, classes = "choices_selected")+ ) |
||
| 113 | -! | +||
| 565 | +
- checkmate::assert_class(bar_color_var, classes = "choices_selected")+ |
||
| 114 | -! | +||
| 566 | +
- checkmate::assert_class(sort_var, classes = "choices_selected")+ # Show R Code |
||
| 115 | +567 | ! |
- checkmate::assert_class(anno_txt_var_sl, classes = "choices_selected")+ teal.widgets::verbatim_popup_srv( |
| 116 | +568 | ! |
- checkmate::assert_class(anno_txt_paramcd_rs, classes = "choices_selected")+ id = "rcode", |
| 117 | +569 | ! |
- checkmate::assert_class(facet_var, classes = "choices_selected")+ title = paste("R code for", label),
|
| 118 | +570 | ! |
- checkmate::assert_class(add_label_var_sl, classes = "choices_selected")+ verbatim_content = reactive(teal.code::get_code(output_q())) |
| 119 | -! | +||
| 571 | +
- checkmate::assert_class(add_label_paramcd_rs, classes = "choices_selected")+ ) |
||
| 120 | -! | +||
| 572 | +
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ |
||
| 121 | -! | +||
| 573 | +
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ ### REPORTER |
||
| 122 | +574 | ! |
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ if (with_reporter) {
|
| 123 | +575 | ! |
- checkmate::assert_numeric(+ card_fun <- function(comment, label) {
|
| 124 | +576 | ! |
- plot_width[1],+ card <- teal::report_card_template( |
| 125 | +577 | ! |
- lower = plot_width[2],+ title = "Waterfall Plot", |
| 126 | +578 | ! |
- upper = plot_width[3],+ label = label, |
| 127 | +579 | ! |
- null.ok = TRUE,+ with_filter = with_filter, |
| 128 | +580 | ! |
- .var.name = "plot_width"- |
-
| 129 | -- |
- )+ filter_panel_api = filter_panel_api |
|
| 130 | +581 |
-
+ ) |
|
| 131 | +582 | ! |
- args <- as.list(environment())- |
-
| 132 | -- |
-
+ card$append_text("Selected Options", "header3")
|
|
| 133 | +583 | ! |
- module(+ card$append_text(paste0("Tumor Burden Parameter: ", input$bar_paramcd, "."))
|
| 134 | +584 | ! |
- label = label,+ if (!is.null(input$sort_var)) {
|
| 135 | +585 | ! |
- ui = ui_g_waterfall,+ card$append_text(paste0("Sorted by: ", input$sort_var, "."))
|
| 136 | -! | +||
| 586 | +
- ui_args = args,+ } |
||
| 137 | +587 | ! |
- server = srv_g_waterfall,+ if (!is.null(input$facet_var)) {
|
| 138 | +588 | ! |
- server_args = list(+ card$append_text(paste0("Faceted by: ", paste(input$facet_var, collapse = ", "), "."))
|
| 139 | -! | +||
| 589 | +
- dataname_tr = dataname_tr,+ } |
||
| 140 | +590 | ! |
- dataname_rs = dataname_rs,+ card$append_text("Plot", "header3")
|
| 141 | +591 | ! |
- bar_paramcd = bar_paramcd,+ card$append_plot(plot_r(), dim = pws$dim()) |
| 142 | +592 | ! |
- add_label_paramcd_rs = add_label_paramcd_rs,+ if (!comment == "") {
|
| 143 | +593 | ! |
- anno_txt_paramcd_rs = anno_txt_paramcd_rs,+ card$append_text("Comment", "header3")
|
| 144 | +594 | ! |
- label = label,+ card$append_text(comment) |
| 145 | -! | +||
| 595 | +
- bar_color_opt = bar_color_opt,+ } |
||
| 146 | +596 | ! |
- plot_height = plot_height,+ card$append_src(teal.code::get_code(output_q())) |
| 147 | +597 | ! |
- plot_width = plot_width+ card |
| 148 | +598 |
- ),+ } |
|
| 149 | +599 | ! |
- datanames = "all"+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
| 150 | +600 |
- )+ } |
|
| 151 | +601 |
- }+ }) |
|
| 152 | +602 |
-
+ } |
|
| 153 | +
| 1 |
- ui_g_waterfall <- function(id, ...) {
+ #' Butterfly plot Teal Module |
||
| 154 | -! | +||
| 2 | +
- a <- list(...)+ #' |
||
| 155 | -! | +||
| 3 | +
- ns <- NS(id)+ #' @description |
||
| 156 | -! | +||
| 4 | +
- teal.widgets::standard_layout(+ #' `r lifecycle::badge("stable")`
|
||
| 157 | -! | +||
| 5 | +
- output = teal.widgets::white_small_well(+ #' |
||
| 158 | -! | +||
| 6 | +
- teal.widgets::plot_with_settings_ui(id = ns("waterfallplot"))
+ #' Display butterfly plot as a shiny module |
||
| 159 | +7 |
- ),+ #' |
|
| 160 | -! | +||
| 8 | +
- encoding = tags$div(+ #' @inheritParams teal.widgets::standard_layout |
||
| 161 | +9 |
- ### Reporter+ #' @inheritParams argument_convention |
|
| 162 | -! | +||
| 10 | +
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ #' @param filter_var (`choices_selected`) variable name of data filter, please see details regarding |
||
| 163 | +11 |
- ###+ #' expected values, default is`NULL`.`choices` |
|
| 164 | -! | +||
| 12 | +
- tags$label("Encodings", class = "text-primary"),
+ #' vector with `filter_var` choices, default is |
||
| 165 | -! | +||
| 13 | +
- helpText("Analysis Data: ", tags$code(a$dataname_tr), tags$code(a$dataname_rs)),
+ #' `NULL` |
||
| 166 | -! | +||
| 14 | +
- teal.widgets::optionalSelectInput(+ #' @param right_var (`choices_selected`) dichotomization variable for right side |
||
| 167 | -! | +||
| 15 | +
- ns("bar_paramcd"),
+ #' @param left_var (`choices_selected`) dichotomization variable for left side |
||
| 168 | -! | +||
| 16 | +
- "Tumor Burden Parameter",+ #' @param category_var (`choices_selected`) category (y axis) variable |
||
| 169 | -! | +||
| 17 | +
- multiple = FALSE+ #' @param color_by_var (`choices_selected`) variable defines color blocks within each bar |
||
| 170 | +18 |
- ),+ #' @param count_by_var (`choices_selected`) variable defines how x axis is calculated |
|
| 171 | -! | +||
| 19 | +
- teal.widgets::optionalSelectInput(+ #' @param facet_var (`choices_selected`) variable for row facets |
||
| 172 | -! | +||
| 20 | +
- ns("bar_var"),
+ #' @param sort_by_var (`choices_selected`) argument for order of class and term elements in table, |
||
| 173 | -! | +||
| 21 | +
- "Bar Height",+ #' default here is "count" |
||
| 174 | -! | +||
| 22 | +
- choices = get_choices(a$bar_var$choices),+ #' @param legend_on (`boolean`) value for whether legend is displayed |
||
| 175 | -! | +||
| 23 | +
- selected = a$bar_var$selected,+ #' |
||
| 176 | -! | +||
| 24 | +
- multiple = FALSE,+ #' @details `filter_var` option is designed to work in conjunction with |
||
| 177 | -! | +||
| 25 | +
- label_help = helpText("Tumor change variable from ", tags$code("ADTR"))
+ #' filtering function provided by `teal` (encoding panel on the right |
||
| 178 | +26 |
- ),+ #' hand side of the shiny app). It can be used as quick access to predefined |
|
| 179 | -! | +||
| 27 | +
- teal.widgets::optionalSelectInput(+ #' subsets of the domain datasets (not subject-level dataset) to be used for |
||
| 180 | -! | +||
| 28 | +
- ns("bar_color_var"),
+ #' analysis, denoted by an value of "Y". Each variable within the |
||
| 181 | -! | +||
| 29 | +
- "Bar Color",+ #' `filter_var_choices` is expected to contain values of either "Y" or |
||
| 182 | -! | +||
| 30 | +
- choices = get_choices(a$bar_color_var$choices),+ #' "N". If multiple variables are selected as `filter_var`, only |
||
| 183 | -! | +||
| 31 | +
- selected = a$bar_color_var$selected,+ #' observations with "Y" value in each and every selected variables will be |
||
| 184 | -! | +||
| 32 | +
- multiple = FALSE+ #' used for subsequent analysis. Flag variables (from `ADaM` datasets) can be |
||
| 185 | +33 |
- ),+ #' used directly as filter. |
|
| 186 | -! | +||
| 34 | +
- teal.widgets::optionalSelectInput(+ #' |
||
| 187 | -! | +||
| 35 | +
- ns("sort_var"),
+ #' @inherit argument_convention return |
||
| 188 | -! | +||
| 36 | +
- "Sort by",+ #' |
||
| 189 | -! | +||
| 37 | +
- choices = get_choices(a$sort_var$choices),+ #' @export |
||
| 190 | -! | +||
| 38 | +
- selected = a$sort_var$selected,+ #' |
||
| 191 | -! | +||
| 39 | +
- multiple = FALSE,+ #' @template author_zhanc107 |
||
| 192 | -! | +||
| 40 | +
- label_help = helpText("from ", tags$code("ADSL"))
+ #' @template author_liaoc10 |
||
| 193 | +41 |
- ),+ #' |
|
| 194 | -! | +||
| 42 | +
- teal.widgets::optionalSelectInput(+ #' @examples |
||
| 195 | -! | +||
| 43 | +
- ns("add_label_var_sl"),
+ #' # Example using stream (ADaM) dataset |
||
| 196 | -! | +||
| 44 | +
- "Add ADSL Label to Bars",+ #' data <- teal_data() |> |
||
| 197 | -! | +||
| 45 | +
- choices = get_choices(a$add_label_var_sl$choices),+ #' within({
|
||
| 198 | -! | +||
| 46 | +
- selected = a$add_label_var_sl$selected,+ #' library(dplyr) |
||
| 199 | -! | +||
| 47 | +
- multiple = FALSE+ #' set.seed(23) |
||
| 200 | +48 |
- ),+ #' ADSL <- rADSL |
|
| 201 | -! | +||
| 49 | +
- teal.widgets::optionalSelectInput(+ #' ADAE <- rADAE |
||
| 202 | -! | +||
| 50 | +
- ns("add_label_paramcd_rs"),
+ #' ADSL <- mutate(ADSL, DOSE = paste(sample(1:3, n(), replace = TRUE), "UG")) |
||
| 203 | -! | +||
| 51 | +
- "Add ADRS Label to Bars",+ #' ADAE <- mutate( |
||
| 204 | -! | +||
| 52 | ++ |
+ #' ADAE,+ |
+ |
| 53 | ++ |
+ #' flag1 = ifelse(AETOXGR == 1, 1, 0),+ |
+ |
| 54 | ++ |
+ #' flag2 = ifelse(AETOXGR == 2, 1, 0),+ |
+ |
| 55 | ++ |
+ #' flag3 = ifelse(AETOXGR == 3, 1, 0),+ |
+ |
| 56 | ++ |
+ #' flag1_filt = rep("Y", n())
+ |
+ |
| 57 | ++ |
+ #' )+ |
+ |
| 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_butterfly(+ |
+ |
| 66 | ++ |
+ #' label = "Butterfly Plot",+ |
+ |
| 67 | ++ |
+ #' dataname = "ADAE",+ |
+ |
| 68 | ++ |
+ #' right_var = choices_selected(+ |
+ |
| 69 | ++ |
+ #' selected = "SEX",+ |
+ |
| 70 | ++ |
+ #' choices = c("SEX", "ARM", "RACE")
+ |
+ |
| 71 | ++ |
+ #' ),+ |
+ |
| 72 | ++ |
+ #' left_var = choices_selected(+ |
+ |
| 73 | ++ |
+ #' selected = "RACE",+ |
+ |
| 74 | ++ |
+ #' choices = c("SEX", "ARM", "RACE")
+ |
+ |
| 75 | ++ |
+ #' ),+ |
+ |
| 76 | ++ |
+ #' category_var = choices_selected(+ |
+ |
| 77 | ++ |
+ #' selected = "AEBODSYS",+ |
+ |
| 78 | ++ |
+ #' choices = c("AEDECOD", "AEBODSYS")
+ |
+ |
| 79 | ++ |
+ #' ),+ |
+ |
| 80 | ++ |
+ #' color_by_var = choices_selected(+ |
+ |
| 81 | ++ |
+ #' selected = "AETOXGR",+ |
+ |
| 82 | ++ |
+ #' choices = c("AETOXGR", "None")
+ |
+ |
| 83 | ++ |
+ #' ),+ |
+ |
| 84 | +
- multiple = FALSE+ #' count_by_var = choices_selected( |
||
| 205 | +85 |
- ),+ #' selected = "# of patients", |
|
| 206 | -! | +||
| 86 | +
- teal.widgets::optionalSelectInput(+ #' choices = c("# of patients", "# of AEs")
|
||
| 207 | -! | +||
| 87 | +
- ns("anno_txt_var_sl"),
+ #' ), |
||
| 208 | -! | +||
| 88 | +
- "Annotation Variables",+ #' facet_var = choices_selected( |
||
| 209 | -! | +||
| 89 | +
- choices = get_choices(a$anno_txt_var_sl$choices),+ #' selected = NULL, |
||
| 210 | -! | +||
| 90 | +
- selected = a$anno_txt_var_sl$selected,+ #' choices = c("RACE", "SEX", "ARM")
|
||
| 211 | -! | +||
| 91 | +
- multiple = TRUE,+ #' ), |
||
| 212 | -! | +||
| 92 | +
- label_help = helpText("from ", tags$code("ADSL"))
+ #' sort_by_var = choices_selected( |
||
| 213 | +93 |
- ),+ #' selected = "count", |
|
| 214 | -! | +||
| 94 | +
- teal.widgets::optionalSelectInput(+ #' choices = c("count", "alphabetical")
|
||
| 215 | -! | +||
| 95 | +
- ns("anno_txt_paramcd_rs"),
+ #' ), |
||
| 216 | -! | +||
| 96 | +
- "Annotation Parameters",+ #' legend_on = TRUE, |
||
| 217 | -! | +||
| 97 | +
- multiple = TRUE,+ #' plot_height = c(600, 200, 2000) |
||
| 218 | -! | +||
| 98 | +
- label_help = helpText("from ", tags$code("ADRS"))
+ #' ) |
||
| 219 | +99 |
- ),+ #' ) |
|
| 220 | -! | +||
| 100 | +
- teal.widgets::optionalSelectInput(+ #' ) |
||
| 221 | -! | +||
| 101 | +
- ns("facet_var"),
+ #' if (interactive()) {
|
||
| 222 | -! | +||
| 102 | +
- "Facet by",+ #' shinyApp(app$ui, app$server) |
||
| 223 | -! | +||
| 103 | +
- choices = get_choices(a$facet_var$choices),+ #' } |
||
| 224 | -! | +||
| 104 | +
- selected = NULL,+ #' |
||
| 225 | -! | +||
| 105 | +
- multiple = FALSE,+ tm_g_butterfly <- function(label, |
||
| 226 | -! | +||
| 106 | +
- label_help = helpText("from ", tags$code("ADSL"))
+ dataname, |
||
| 227 | +107 |
- ),+ filter_var = NULL, |
|
| 228 | -! | +||
| 108 | +
- checkboxInput(+ right_var, |
||
| 229 | -! | +||
| 109 | +
- ns("show_value"),
+ left_var, |
||
| 230 | -! | +||
| 110 | +
- "Add Bar Height Value",+ category_var, |
||
| 231 | -! | +||
| 111 | +
- value = a$show_value+ color_by_var, |
||
| 232 | +112 |
- ),+ count_by_var, |
|
| 233 | -! | +||
| 113 | +
- textInput(+ facet_var = NULL, |
||
| 234 | -! | +||
| 114 | +
- ns("href_line"),
+ sort_by_var = teal.transform::choices_selected( |
||
| 235 | -! | +||
| 115 | +
- label = tags$div(+ selected = "count", choices = c("count", "alphabetical")
|
||
| 236 | -! | +||
| 116 | +
- "Horizontal Reference Line(s)",+ ), |
||
| 237 | -! | +||
| 117 | +
- tags$br(),+ legend_on = TRUE, |
||
| 238 | -! | +||
| 118 | +
- helpText("Enter numeric value(s) of reference lines, separated by comma (eg. -10, 20)")
+ plot_height = c(600L, 200L, 2000L), |
||
| 239 | +119 |
- ),+ plot_width = NULL, |
|
| 240 | -! | +||
| 120 | +
- value = a$href_line+ pre_output = NULL, |
||
| 241 | +121 |
- ),+ post_output = NULL) {
|
|
| 242 | +122 | ! |
- textInput(+ message("Initializing tm_g_butterfly")
|
| 243 | +123 | ! |
- ns("ytick_at"),
+ checkmate::assert_string(label) |
| 244 | +124 | ! |
- label = tags$div(+ checkmate::assert_string(dataname) |
| 245 | +125 | ! |
- "Y-axis Interval",+ checkmate::assert_class(filter_var, classes = "choices_selected", null.ok = TRUE) |
| 246 | +126 | ! |
- tags$br(),+ checkmate::assert_class(right_var, classes = "choices_selected") |
| 247 | +127 | ! |
- helpText("Enter a numeric value of Y axis interval")
- |
-
| 248 | -- |
- ),+ checkmate::assert_class(left_var, classes = "choices_selected") |
|
| 249 | +128 | ! |
- value = a$ytick_at- |
-
| 250 | -- |
- ),+ checkmate::assert_class(category_var, classes = "choices_selected") |
|
| 251 | +129 | ! |
- textInput(+ checkmate::assert_class(color_by_var, classes = "choices_selected") |
| 252 | +130 | ! |
- ns("gap_point_val"),
+ checkmate::assert_class(count_by_var, classes = "choices_selected") |
| 253 | +131 | ! |
- label = tags$div(+ checkmate::assert_class(facet_var, classes = "choices_selected", null.ok = TRUE) |
| 254 | +132 | ! |
- "Break High Bars",+ checkmate::assert_class(sort_by_var, classes = "choices_selected") |
| 255 | +133 | ! |
- tags$br(),+ checkmate::assert_flag(legend_on) |
| 256 | +134 | ! |
- helpText("Enter a numeric value to break very high bars")
- |
-
| 257 | -- |
- ),+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
|
| 258 | +135 | ! |
- value = a$gap_point_val+ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 259 | -+ | ||
| 136 | +! |
- )+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
|
| 260 | -+ | ||
| 137 | +! |
- ),+ checkmate::assert_numeric( |
|
| 261 | +138 | ! |
- forms = tagList(+ plot_width[1], |
| 262 | +139 | ! |
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ lower = plot_width[2], |
| 263 | -+ | ||
| 140 | +! |
- ),+ upper = plot_width[3], |
|
| 264 | +141 | ! |
- pre_output = a$pre_output,+ null.ok = TRUE, |
| 265 | +142 | ! |
- post_output = a$post_output+ .var.name = "plot_width" |
| 266 | +143 |
) |
|
| 267 | -- |
- }- |
- |
| 268 | +144 | ||
| 269 | -+ | ||
| 145 | +! |
- srv_g_waterfall <- function(id,+ args <- as.list(environment()) |
|
| 270 | +146 |
- data,+ |
|
| 271 | -+ | ||
| 147 | +! |
- filter_panel_api,+ module( |
|
| 272 | -+ | ||
| 148 | +! |
- reporter,+ label = label, |
|
| 273 | -+ | ||
| 149 | +! |
- bar_paramcd,+ datanames = c("ADSL", dataname),
|
|
| 274 | -+ | ||
| 150 | +! |
- add_label_paramcd_rs,+ server = srv_g_butterfly, |
|
| 275 | -+ | ||
| 151 | +! |
- anno_txt_paramcd_rs,+ server_args = list(dataname = dataname, label = label, plot_height = plot_height, plot_width = plot_width), |
|
| 276 | -+ | ||
| 152 | +! |
- dataname_tr,+ ui = ui_g_butterfly, |
|
| 277 | -+ | ||
| 153 | +! |
- dataname_rs,+ ui_args = args |
|
| 278 | +154 |
- bar_color_opt,+ ) |
|
| 279 | +155 |
- label,+ } |
|
| 280 | +156 |
- plot_height,+ |
|
| 281 | +157 |
- plot_width) {
+ ui_g_butterfly <- function(id, ...) {
|
|
| 282 | +158 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ ns <- NS(id) |
| 283 | +159 | ! |
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ a <- list(...) |
| 284 | -! | +||
| 160 | +
- checkmate::assert_class(data, "reactive")+ |
||
| 285 | +161 | ! |
- checkmate::assert_class(shiny::isolate(data()), "teal_data")- |
-
| 286 | -- |
-
+ teal.widgets::standard_layout( |
|
| 287 | +162 | ! |
- moduleServer(id, function(input, output, session) {
+ output = teal.widgets::white_small_well( |
| 288 | +163 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ teal.widgets::plot_with_settings_ui(id = ns("butterflyplot"))
|
| 289 | +164 | - - | -|
| 290 | -! | -
- env <- as.list(isolate(data())@env)+ ), |
|
| 291 | +165 | ! |
- resolved_bar_paramcd <- teal.transform::resolve_delayed(bar_paramcd, env)+ encoding = tags$div( |
| 292 | -! | +||
| 166 | +
- resolved_add_label_paramcd_rs <- teal.transform::resolve_delayed(add_label_paramcd_rs, env)+ ### Reporter |
||
| 293 | +167 | ! |
- resolved_anno_txt_paramcd_rs <- teal.transform::resolve_delayed(anno_txt_paramcd_rs, env)+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
|
| 294 | +168 |
-
+ ### |
|
| 295 | +169 | ! |
- teal.widgets::updateOptionalSelectInput(+ tags$label("Encodings", class = "text-primary"),
|
| 296 | +170 | ! |
- session = session,+ helpText("Dataset is:", tags$code(a$dataname)),
|
| 297 | +171 | ! |
- inputId = "bar_paramcd",+ if (!is.null(a$filter_var)) {
|
| 298 | +172 | ! |
- choices = resolved_bar_paramcd$choices,+ teal.widgets::optionalSelectInput( |
| 299 | +173 | ! |
- selected = resolved_bar_paramcd$selected+ ns("filter_var"),
|
| 300 | -+ | ||
| 174 | +! |
- )+ label = |
|
| 301 | +175 | ! |
- teal.widgets::updateOptionalSelectInput(+ "Preset Data Filters Observations with value of 'Y' for selected variable(s) will be used for analysis", |
| 302 | +176 | ! |
- session = session,+ choices = get_choices(a$filter_var$choices), |
| 303 | +177 | ! |
- inputId = "add_label_paramcd_rs",+ selected = a$filter_var$selected, |
| 304 | +178 | ! |
- choices = resolved_add_label_paramcd_rs$choices,+ multiple = TRUE |
| 305 | -! | +||
| 179 | +
- selected = resolved_add_label_paramcd_rs$selected+ ) |
||
| 306 | +180 |
- )+ }, |
|
| 307 | +181 | ! |
- teal.widgets::updateOptionalSelectInput(+ teal.widgets::optionalSelectInput( |
| 308 | +182 | ! |
- session = session,+ ns("right_var"),
|
| 309 | +183 | ! |
- inputId = "anno_txt_paramcd_rs",+ "Right Dichotomization Variable", |
| 310 | +184 | ! |
- choices = resolved_anno_txt_paramcd_rs$choices,+ get_choices(a$right_var$choices), |
| 311 | +185 | ! |
- selected = resolved_anno_txt_paramcd_rs$selected+ a$right_var$selected, |
| 312 | -+ | ||
| 186 | +! |
- )+ multiple = FALSE |
|
| 313 | +187 |
-
+ ), |
|
| 314 | +188 | ! |
- iv <- reactive({
+ teal.widgets::optionalSelectInput( |
| 315 | +189 | ! |
- adsl <- data()[["ADSL"]]+ ns("right_val"),
|
| 316 | +190 | ! |
- adtr <- data()[[dataname_tr]]+ "Choose Up To 2:", |
| 317 | +191 | ! |
- adrs <- data()[[dataname_rs]]+ multiple = TRUE, |
| 318 | -+ | ||
| 192 | +! |
-
+ options = list( |
|
| 319 | +193 | ! |
- iv <- shinyvalidate::InputValidator$new()+ `max-options` = 2L, |
| 320 | +194 | ! |
- iv$add_rule("bar_var", shinyvalidate::sv_required(
+ `max-options-text` = "no more than 2", |
| 321 | +195 | ! |
- message = "Bar Height is required"+ `actions-box` = FALSE |
| 322 | +196 |
- ))+ )+ |
+ |
| 197 | ++ |
+ ), |
|
| 323 | +198 | ! |
- iv$add_rule("bar_paramcd", shinyvalidate::sv_required(
+ teal.widgets::optionalSelectInput( |
| 324 | +199 | ! |
- message = "Tumor Burden Parameter is required"+ ns("left_var"),
|
| 325 | -+ | ||
| 200 | +! |
- ))+ "Left Dichotomization Variable", |
|
| 326 | +201 | ! |
- iv$add_rule("bar_paramcd", shinyvalidate::sv_in_set(
+ get_choices(a$left_var$choices), |
| 327 | +202 | ! |
- set = adtr$PARAMCD,+ a$left_var$selected, |
| 328 | +203 | ! |
- message_fmt = "All values of Tumor Burden Parameter must be elements of ADTR PARAMCD"+ multiple = FALSE |
| 329 | +204 |
- ))+ ), |
|
| 330 | +205 | ! |
- iv$add_rule("add_label_paramcd_rs", shinyvalidate::sv_optional())
+ teal.widgets::optionalSelectInput( |
| 331 | +206 | ! |
- iv$add_rule("add_label_paramcd_rs", shinyvalidate::sv_in_set(
+ ns("left_val"),
|
| 332 | +207 | ! |
- set = adrs$PARAMCD,+ "Choose Up To 2:", |
| 333 | +208 | ! |
- message_fmt = "ADRS Label must be an element of ADRS PARAMCD"+ multiple = TRUE, |
| 334 | -+ | ||
| 209 | +! |
- ))+ options = list( |
|
| 335 | +210 | ! |
- rule_excl <- function(value, other) {
+ `max-options` = 2L, |
| 336 | +211 | ! |
- if (length(value) > 0L && length(other) > 0L) {
+ `max-options-text` = "no more than 2", |
| 337 | +212 | ! |
- "Only one \"Label to Bars\" is allowed"+ `actions-box` = FALSE |
| 338 | +213 |
- }+ ) |
|
| 339 | +214 |
- }+ ), |
|
| 340 | +215 | ! |
- iv$add_rule("add_label_paramcd_rs", rule_excl, other = input$add_label_var_sl)
+ teal.widgets::optionalSelectInput( |
| 341 | +216 | ! |
- iv$add_rule("add_label_var_sl", rule_excl, other = input$add_label_paramcd_rs)
+ ns("category_var"),
|
| 342 | +217 | ! |
- iv$add_rule("anno_txt_paramcd_rs", shinyvalidate::sv_optional())
+ "Category Variable", |
| 343 | +218 | ! |
- iv$add_rule("anno_txt_paramcd_rs", shinyvalidate::sv_in_set(
+ get_choices(a$category_var$choices), |
| 344 | +219 | ! |
- set = adrs$PARAMCD,+ a$category_var$selected, |
| 345 | +220 | ! |
- message_fmt = "Annotation Parameters must be elements of ADRS PARAMCD"+ multiple = FALSE |
| 346 | +221 |
- ))+ ), |
|
| 347 | +222 | ! |
- iv$add_rule("href_line", shinyvalidate::sv_optional())
+ radioButtons( |
| 348 | +223 | ! |
- iv$add_rule("href_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
+ ns("color_by_var"),
|
| 349 | +224 | ! |
- "Horizontal Reference Line(s) are invalid"- |
-
| 350 | -- |
- })+ "Color Block By Variable", |
|
| 351 | +225 | ! |
- iv$add_rule("ytick_at", shinyvalidate::sv_required(
+ get_choices(a$color_by_var$choices), |
| 352 | +226 | ! |
- message = "Y-axis Interval is required"+ a$color_by_var$selected |
| 353 | +227 |
- ))+ ), |
|
| 354 | +228 | ! |
- iv$add_rule("ytick_at", ~ if (!checkmate::test_number(suppressWarnings(as.numeric(.)), lower = 1)) {
+ radioButtons( |
| 355 | +229 | ! |
- "Y-axis Interval must be a single positive number"- |
-
| 356 | -- |
- })+ ns("count_by_var"),
|
|
| 357 | +230 | ! |
- iv$add_rule("gap_point_val", shinyvalidate::sv_optional())
+ "Count By Variable", |
| 358 | +231 | ! |
- iv$add_rule("gap_point_val", ~ if (!checkmate::test_number(suppressWarnings(as.numeric(.)), lower = 1)) {
+ get_choices(a$count_by_var$choices), |
| 359 | +232 | ! |
- "Break High Bars must be a single positive number"+ a$count_by_var$selected |
| 360 | +233 |
- })+ ), |
|
| 361 | +234 | ! |
- iv$enable()+ if (!is.null(a$facet_var)) {
|
| 362 | +235 | ! |
- iv- |
-
| 363 | -- |
- })+ teal.widgets::optionalSelectInput( |
|
| 364 | -+ | ||
| 236 | +! |
-
+ ns("facet_var"),
|
|
| 365 | +237 | ! |
- output_q <- reactive({
+ "Facet By Variable", |
| 366 | +238 | ! |
- adsl <- data()[["ADSL"]]+ get_choices(a$facet_var$choices), |
| 367 | +239 | ! |
- adtr <- data()[[dataname_tr]]+ a$facet_var$selected, |
| 368 | +240 | ! |
- adrs <- data()[[dataname_rs]]+ multiple = TRUE |
| 369 | +241 |
-
+ ) |
|
| 370 | +242 |
- # validate data rows- |
- |
| 371 | -! | -
- teal::validate_has_data(adsl, min_nrow = 2)- |
- |
| 372 | -! | -
- teal::validate_has_data(adtr, min_nrow = 2)+ }, |
|
| 373 | +243 | ! |
- teal::validate_has_data(adrs, min_nrow = 2)- |
-
| 374 | -- |
-
+ radioButtons( |
|
| 375 | +244 | ! |
- adsl_vars <- unique(+ ns("sort_by_var"),
|
| 376 | +245 | ! |
- c(+ "Sort By Variable", |
| 377 | +246 | ! |
- "USUBJID", "STUDYID",+ get_choices(a$sort_by_var$choices), |
| 378 | +247 | ! |
- input$bar_color_var, input$sort_var, input$add_label_var_sl, input$anno_txt_var_sl, input$facet_var+ a$sort_by_var$selected |
| 379 | +248 |
- )+ ), |
|
| 380 | -+ | ||
| 249 | +! |
- )+ checkboxInput( |
|
| 381 | +250 | ! |
- adtr_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", input$bar_var))
+ ns("legend_on"),
|
| 382 | +251 | ! |
- adrs_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", "AVALC"))
+ "Add legend", |
| 383 | +252 | ! |
- adrs_paramcd <- unique(c(input$add_label_paramcd_rs, input$anno_txt_paramcd_rs))+ value = a$legend_on |
| 384 | +253 |
-
+ ) |
|
| 385 | +254 |
- # validate data input+ ), |
|
| 386 | +255 | ! |
- teal::validate_has_variable(adsl, adsl_vars)+ forms = tagList( |
| 387 | +256 | ! |
- teal::validate_has_variable(adrs, adrs_vars)+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
| 388 | -! | +||
| 257 | +
- teal::validate_has_variable(adtr, adtr_vars)+ ), |
||
| 389 | -+ | ||
| 258 | +! |
-
+ pre_output = a$pre_output, |
|
| 390 | +259 | ! |
- teal::validate_inputs(iv())+ post_output = a$post_output |
| 391 | +260 |
-
+ ) |
|
| 392 | +261 |
- # get variables+ } |
|
| 393 | -! | +||
| 262 | +
- bar_var <- input$bar_var+ |
||
| 394 | -! | +||
| 263 | +
- bar_paramcd <- input$bar_paramcd+ srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, label, plot_height, plot_width) {
|
||
| 395 | +264 | ! |
- add_label_var_sl <- input$add_label_var_sl+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
| 396 | +265 | ! |
- add_label_paramcd_rs <- input$add_label_paramcd_rs+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
| 397 | +266 | ! |
- anno_txt_var_sl <- input$anno_txt_var_sl+ checkmate::assert_class(data, "reactive") |
| 398 | +267 | ! |
- anno_txt_paramcd_rs <- input$anno_txt_paramcd_rs+ checkmate::assert_class(shiny::isolate(data()), "teal_data")+ |
+
| 268 | ++ | + | |
| 399 | +269 | ! |
- ytick_at <- input$ytick_at+ moduleServer(id, function(input, output, session) {
|
| 400 | +270 | ! |
- href_line <- input$href_line+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 401 | +271 | ! |
- gap_point_val <- input$gap_point_val+ iv <- reactive({
|
| 402 | +272 | ! |
- show_value <- input$show_value+ ADSL <- data()[["ADSL"]] |
| 403 | +273 | ! |
- href_line <- suppressWarnings(as_numeric_from_comma_sep_str(href_line))+ ANL <- data()[[dataname]] |
| 404 | +274 | ||
| 405 | +275 | ! |
- if (gap_point_val == "") {
+ iv <- shinyvalidate::InputValidator$new() |
| 406 | +276 | ! |
- gap_point_val <- NULL- |
-
| 407 | -- |
- } else {
+ iv$add_rule("category_var", shinyvalidate::sv_required(
|
|
| 408 | +277 | ! |
- gap_point_val <- as.numeric(gap_point_val)+ message = "Category Variable is required" |
| 409 | +278 |
- }+ )) |
|
| 410 | +279 | ! |
- ytick_at <- as.numeric(ytick_at)+ iv$add_rule("right_var", shinyvalidate::sv_required(
+ |
+
| 280 | +! | +
+ message = "Right Dichotomization Variable is required" |
|
| 411 | +281 |
-
+ )) |
|
| 412 | +282 | ! |
- bar_color_var <- if (+ iv$add_rule("left_var", shinyvalidate::sv_required(
|
| 413 | +283 | ! |
- !is.null(input$bar_color_var) &&+ message = "Left Dichotomization Variable is required"+ |
+
| 284 | ++ |
+ )) |
|
| 414 | +285 | ! |
- input$bar_color_var != "None" &&+ iv$add_rule("right_var", ~ if (!is.factor(ANL[[.]])) {
|
| 415 | +286 | ! |
- input$bar_color_var != ""+ "Right Dichotomization Variable must be a factor variable, contact developer" |
| 416 | +287 |
- ) {
+ }) |
|
| 417 | +288 | ! |
- input$bar_color_var- |
-
| 418 | -- |
- } else {
+ iv$add_rule("left_var", ~ if (!is.factor(ANL[[.]])) {
|
|
| 419 | +289 | ! |
- NULL+ "Left Dichotomization Variable must be a factor variable, contact developer" |
| 420 | +290 |
- }+ }) |
|
| 421 | +291 | ! |
- sort_var <- if (!is.null(input$sort_var) && input$sort_var != "None" && input$sort_var != "") {
+ iv$add_rule("right_val", shinyvalidate::sv_required(
|
| 422 | +292 | ! |
- input$sort_var+ message = "At least one value of Right Dichotomization Variable must be selected" |
| 423 | +293 |
- } else {
+ )) |
|
| 424 | +294 | ! |
- NULL+ iv$add_rule("left_val", shinyvalidate::sv_required(
+ |
+
| 295 | +! | +
+ message = "At least one value of Left Dichotomization Variable must be selected" |
|
| 425 | +296 |
- }+ )) |
|
| 426 | +297 | ! |
- facet_var <- if (!is.null(input$facet_var) && input$facet_var != "None" && input$facet_var != "") {
+ iv$enable() |
| 427 | +298 | ! |
- input$facet_var+ iv |
| 428 | +299 |
- } else {
+ })+ |
+ |
| 300 | ++ | + | |
| 429 | +301 | ! |
- NULL+ options <- reactiveValues(r = NULL, l = NULL) |
| 430 | -+ | ||
| 302 | +! |
- }+ vars <- reactiveValues(r = NULL, l = NULL) |
|
| 431 | +303 | ||
| 432 | +304 |
- # write variables to qenv+ # dynamic options for dichotomization variable |
|
| 433 | +305 | ! |
- q1 <- teal.code::eval_code(+ observeEvent(input$right_var, |
| 434 | +306 | ! |
- data(),+ handlerExpr = {
|
| 435 | +307 | ! |
- code = bquote({
+ right_var <- input$right_var |
| 436 | +308 | ! |
- bar_var <- .(bar_var)+ right_val <- isolate(input$right_val) |
| 437 | +309 | ! |
- bar_color_var <- .(bar_color_var)+ current_r_var <- isolate(vars$r) |
| 438 | +310 | ! |
- sort_var <- .(sort_var)+ if (is.null(right_var)) {
|
| 439 | +311 | ! |
- add_label_var_sl <- .(add_label_var_sl)+ teal.widgets::updateOptionalSelectInput( |
| 440 | +312 | ! |
- add_label_paramcd_rs <- .(add_label_paramcd_rs)+ session, |
| 441 | +313 | ! |
- anno_txt_var_sl <- .(anno_txt_var_sl)+ "right_val", |
| 442 | +314 | ! |
- anno_txt_paramcd_rs <- .(anno_txt_paramcd_rs)+ choices = character(0), |
| 443 | +315 | ! |
- facet_var <- .(facet_var)+ selected = character(0) |
| 444 | -! | +||
| 316 | +
- href_line <- .(href_line)+ )+ |
+ ||
| 317 | ++ |
+ } else {
|
|
| 445 | +318 | ! |
- gap_point_val <- .(gap_point_val)+ options$r <- if (right_var %in% names(data()[["ADSL"]])) {
|
| 446 | +319 | ! |
- show_value <- .(show_value)+ levels(data()[["ADSL"]][[right_var]]) |
| 447 | +320 |
- })+ } else {
|
|
| 448 | -+ | ||
| 321 | +! |
- )+ levels(data()[[dataname]][[right_var]]) |
|
| 449 | +322 |
-
+ } |
|
| 450 | +323 |
- # data processing+ |
|
| 451 | +324 | ! |
- q1 <- teal.code::eval_code(+ selected <- if (length(right_val) > 0) {
|
| 452 | +325 | ! |
- q1,+ left_over <- right_val[right_val %in% options$r] |
| 453 | +326 | ! |
- code = bquote({
+ if (length(left_over) > 0 && !is.null(current_r_var) && current_r_var == right_var) {
|
| 454 | +327 | ! |
- adsl <- ADSL[, .(adsl_vars)]+ left_over |
| 455 | -! | +||
| 328 | +
- adtr <- .(as.name(dataname_tr))[, .(adtr_vars)]+ } else {
|
||
| 456 | +329 | ! |
- adrs <- .(as.name(dataname_rs))[, .(adrs_vars)]+ options$r[1] |
| 457 | +330 |
-
+ } |
|
| 458 | -! | +||
| 331 | +
- bar_tr <- .(as.name(dataname_tr)) %>%+ } else {
|
||
| 459 | +332 | ! |
- dplyr::filter(PARAMCD == .(bar_paramcd)) %>%+ options$r[1] |
| 460 | -! | +||
| 333 | +
- dplyr::select(USUBJID, .(as.name(bar_var))) %>%+ } |
||
| 461 | +334 | ! |
- dplyr::group_by(USUBJID) %>%+ teal.widgets::updateOptionalSelectInput( |
| 462 | +335 | ! |
- dplyr::slice(which.min(.(as.name(bar_var))))+ session, "right_val", |
| 463 | +336 | ! |
- bar_data <- adsl %>% dplyr::inner_join(bar_tr, "USUBJID")+ choices = as.character(options$r), selected = selected, label = "Choose Up To 2:" |
| 464 | +337 |
- })+ ) |
|
| 465 | +338 |
- )+ }+ |
+ |
| 339 | +! | +
+ vars$r <- right_var |
|
| 466 | +340 |
-
+ }, |
|
| 467 | +341 | ! |
- q1 <- if (is.null(adrs_paramcd)) {
+ ignoreNULL = FALSE |
| 468 | -! | +||
| 342 | +
- teal.code::eval_code(+ ) |
||
| 469 | -! | +||
| 343 | +
- q1,+ |
||
| 470 | +344 | ! |
- code = bquote({
+ observeEvent(input$left_var, |
| 471 | +345 | ! |
- anl <- bar_data+ handlerExpr = {
|
| 472 | +346 | ! |
- anl$USUBJID <- unlist(lapply(strsplit(anl$USUBJID, "-", fixed = TRUE), tail, 1))- |
-
| 473 | -- |
- })- |
- |
| 474 | -- |
- )+ left_var <- input$left_var |
|
| 475 | -+ | ||
| 347 | +! |
- } else {
+ left_val <- isolate(input$left_val) |
|
| 476 | +348 | ! |
- qq1 <- teal.code::eval_code(+ current_l_var <- isolate(vars$l) |
| 477 | +349 | ! |
- q1,+ if (is.null(left_var)) {
|
| 478 | +350 | ! |
- code = bquote(+ teal.widgets::updateOptionalSelectInput( |
| 479 | +351 | ! |
- rs_sub <- .(as.name(dataname_rs)) %>%+ session, "left_val", |
| 480 | +352 | ! |
- dplyr::filter(PARAMCD %in% .(adrs_paramcd))+ choices = character(0), selected = character(0) |
| 481 | +353 |
) |
|
| 482 | +354 |
- )+ } else {
+ |
+ |
| 355 | +! | +
+ options$l <- if (left_var %in% names(data()[["ADSL"]])) {
+ |
+ |
| 356 | +! | +
+ levels(data()[["ADSL"]][[left_var]]) |
|
| 483 | +357 |
-
+ } else {
|
|
| 484 | +358 | ! |
- teal::validate_one_row_per_id(qq1[["rs_sub"]], key = c("STUDYID", "USUBJID", "PARAMCD"))
+ levels(data()[[dataname]][[left_var]]) |
| 485 | +359 | ++ |
+ }+ |
+
| 360 | |||
| 486 | +361 | ! |
- teal.code::eval_code(+ selected <- if (length(left_val) > 0) {
|
| 487 | +362 | ! |
- qq1,+ left_over <- left_val[left_val %in% options$l] |
| 488 | +363 | ! |
- code = bquote({
+ if (length(left_over) > 0 && !is.null(current_l_var) && current_l_var == left_var) {
|
| 489 | +364 | ! |
- rs_label <- rs_sub %>%+ left_over |
| 490 | -! | +||
| 365 | +
- dplyr::select(USUBJID, PARAMCD, AVALC) %>%+ } else {
|
||
| 491 | +366 | ! |
- tidyr::pivot_wider(names_from = PARAMCD, values_from = AVALC)+ options$l[1] |
| 492 | -! | +||
| 367 | +
- anl <- bar_data %>% dplyr::left_join(rs_label, by = c("USUBJID"))
+ }+ |
+ ||
| 368 | ++ |
+ } else {
|
|
| 493 | +369 | ! |
- anl$USUBJID <- unlist(lapply(strsplit(anl$USUBJID, "-", fixed = TRUE), tail, 1))+ options$l[1] |
| 494 | +370 |
- })+ } |
|
| 495 | +371 |
- )+ |
|
| 496 | -+ | ||
| 372 | +! |
- }+ teal.widgets::updateOptionalSelectInput(+ |
+ |
| 373 | +! | +
+ session, "left_val",+ |
+ |
| 374 | +! | +
+ choices = as.character(options$l), selected = selected, label = "Choose Up To 2:" |
|
| 497 | +375 |
-
+ ) |
|
| 498 | +376 |
- # write plotting code to qenv+ } |
|
| 499 | +377 | ! |
- anl <- q1[["anl"]]+ vars$l <- left_var |
| 500 | +378 |
-
+ }, |
|
| 501 | +379 | ! |
- q1 <- teal.code::eval_code(+ ignoreNULL = FALSE |
| 502 | -! | +||
| 380 | +
- q1,+ ) |
||
| 503 | -! | +||
| 381 | +
- code = bquote({
+
|
||
| 504 | +382 | ! |
- plot <- osprey::g_waterfall(+ output_q <- shiny::debounce( |
| 505 | +383 | ! |
- bar_id = anl[["USUBJID"]],+ millis = 200, |
| 506 | +384 | ! |
- bar_height = anl[[bar_var]],+ r = reactive({
|
| 507 | +385 | ! |
- sort_by = .(if (length(sort_var) > 0) {
+ ADSL <- data()[["ADSL"]] |
| 508 | +386 | ! |
- quote(anl[[sort_var]])+ ANL <- data()[[dataname]] |
| 509 | +387 |
- } else {
+
|
|
| 510 | +388 | ! |
- NULL+ teal::validate_has_data(ADSL, min_nrow = 0, msg = sprintf("%s Data is empty", "ADSL"))
|
| 511 | -+ | ||
| 389 | +! |
- }),+ teal::validate_has_data(ANL, min_nrow = 0, msg = sprintf("%s Data is empty", dataname))
|
|
| 512 | -! | +||
| 390 | +
- col_by = .(if (length(bar_color_var) > 0) {
+
|
||
| 513 | +391 | ! |
- quote(anl[[bar_color_var]])+ teal::validate_inputs(iv()) |
| 514 | +392 |
- } else {
+
|
|
| 515 | +393 | ! |
- NULL- |
-
| 516 | -- |
- }),+ validate( |
|
| 517 | +394 | ! |
- bar_color_opt = .(if (length(bar_color_var) == 0) {
+ need( |
| 518 | +395 | ! |
- NULL+ all(input$right_val %in% ADSL[[input$right_var]]) && |
| 519 | +396 | ! |
- } else if (length(bar_color_var) > 0 & all(unique(anl[[bar_color_var]]) %in% names(bar_color_opt))) {
+ all(input$left_val %in% ADSL[[input$left_var]]), |
| 520 | +397 | ! |
- bar_color_opt+ "No observations for selected dichotomization values (filtered out?)" |
| 521 | +398 |
- } else {
+ ) |
|
| 522 | -! | +||
| 399 | +
- NULL+ ) |
||
| 523 | +400 |
- }),+ |
|
| 524 | +401 | ! |
- anno_txt = .(if (length(anno_txt_var_sl) == 0 & length(anno_txt_paramcd_rs) == 0) {
+ right_var <- isolate(input$right_var) |
| 525 | +402 | ! |
- NULL+ left_var <- isolate(input$left_var) |
| 526 | +403 | ! |
- } else if (length(anno_txt_var_sl) >= 1 & length(anno_txt_paramcd_rs) == 0) {
+ right_val <- input$right_val |
| 527 | +404 | ! |
- quote(data.frame(anl[anno_txt_var_sl]))+ left_val <- input$left_val |
| 528 | +405 | ! |
- } else if (length(anno_txt_paramcd_rs) >= 1 & length(anno_txt_var_sl) == 0) {
+ category_var <- input$category_var |
| 529 | +406 | ! |
- quote(data.frame(anl[anno_txt_paramcd_rs]))- |
-
| 530 | -- |
- } else {
+ color_by_var <- input$color_by_var |
|
| 531 | +407 | ! |
- quote(cbind(anl[anno_txt_var_sl], anl[anno_txt_paramcd_rs]))+ count_by_var <- input$count_by_var |
| 532 | -+ | ||
| 408 | +! |
- }),+ legend_on <- input$legend_on |
|
| 533 | +409 | ! |
- href_line = .(href_line),+ facet_var <- input$facet_var |
| 534 | +410 | ! |
- facet_by = .(if (length(facet_var) > 0) {
+ sort_by_var <- input$sort_by_var |
| 535 | +411 | ! |
- quote(as.factor(anl[[facet_var]]))+ filter_var <- input$filter_var |
| 536 | +412 |
- } else {
- |
- |
| 537 | -! | -
- NULL+ |
|
| 538 | +413 |
- }),+ # if variable is not in ADSL, then take from domain VADs |
|
| 539 | +414 | ! |
- show_datavalue = .(show_value),+ varlist <- c(category_var, color_by_var, facet_var, filter_var, right_var, left_var) |
| 540 | +415 | ! |
- add_label = .(if (length(add_label_var_sl) > 0 & length(add_label_paramcd_rs) == 0) {
+ varlist_from_adsl <- intersect(varlist, names(ADSL)) |
| 541 | +416 | ! |
- quote(anl[[add_label_var_sl]])+ varlist_from_anl <- intersect(varlist, setdiff(names(ANL), names(ADSL))) |
| 542 | -! | +||
| 417 | +
- } else if (length(add_label_paramcd_rs) > 0 & length(add_label_var_sl) == 0) {
+
|
||
| 543 | +418 | ! |
- quote(anl[[add_label_paramcd_rs]])- |
-
| 544 | -- |
- } else {
+ adsl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_adsl))
|
|
| 545 | +419 | ! |
- NULL+ anl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_anl))
|
| 546 | +420 |
- }),+ |
|
| 547 | +421 | ! |
- gap_point = .(gap_point_val),+ q1 <- teal.code::eval_code( |
| 548 | +422 | ! |
- ytick_at = .(ytick_at),+ data(), |
| 549 | +423 | ! |
- y_label = "Tumor Burden Change from Baseline",+ code = bquote({
|
| 550 | +424 | ! |
- title = "Waterfall Plot"- |
-
| 551 | -- |
- )+ ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame() |
|
| 552 | +425 | ! |
- plot- |
-
| 553 | -- |
- })+ ANL <- .(as.name(dataname))[, .(anl_vars)] %>% as.data.frame() |
|
| 554 | +426 |
- )+ }) |
|
| 555 | +427 |
- })+ ) |
|
| 556 | +428 | ||
| 557 | +429 | ! |
- plot_r <- reactive(output_q()[["plot"]])+ if (!("NULL" %in% filter_var) && !is.null(filter_var)) {
|
| 558 | -+ | ||
| 430 | +! |
-
+ q1 <- teal.code::eval_code( |
|
| 559 | -+ | ||
| 431 | +! |
- # Insert the plot into a plot_with_settings module from teal.widgets+ q1, |
|
| 560 | +432 | ! |
- pws <- teal.widgets::plot_with_settings_srv(+ code = bquote( |
| 561 | +433 | ! |
- id = "waterfallplot",+ ANL <- quick_filter(.(filter_var), ANL) %>% |
| 562 | +434 | ! |
- plot_r = plot_r,+ droplevels() %>% |
| 563 | +435 | ! |
- height = plot_height,+ as.data.frame() |
| 564 | -! | +||
| 436 | +
- width = plot_width+ ) |
||
| 565 | +437 |
- )+ ) |
|
| 566 | +438 |
-
+ } |
|
| 567 | +439 |
- # Show R Code+ |
|
| 568 | +440 | ! |
- teal.widgets::verbatim_popup_srv(+ q1 <- teal.code::eval_code( |
| 569 | +441 | ! |
- id = "rcode",+ q1, |
| 570 | +442 | ! |
- title = paste("R code for", label),
+ code = bquote({
|
| 571 | +443 | ! |
- verbatim_content = reactive(teal.code::get_code(output_q()))+ ANL_f <- left_join(ADSL, ANL, by = c("USUBJID", "STUDYID")) %>% as.data.frame()
|
| 572 | -+ | ||
| 444 | +! |
- )+ ANL_f <- na.omit(ANL_f) |
|
| 573 | +445 |
-
+ }) |
|
| 574 | +446 |
- ### REPORTER- |
- |
| 575 | -! | -
- if (with_reporter) {
- |
- |
| 576 | -! | -
- card_fun <- function(comment, label) {
+ ) |
|
| 577 | -! | +||
| 447 | +
- card <- teal::report_card_template(+ |
||
| 578 | +448 | ! |
- title = "Waterfall Plot",+ if (!is.null(right_val) && !is.null(right_val)) {
|
| 579 | +449 | ! |
- label = label,+ q1 <- teal.code::eval_code( |
| 580 | +450 | ! |
- with_filter = with_filter,+ q1, |
| 581 | +451 | ! |
- filter_panel_api = filter_panel_api- |
-
| 582 | -- |
- )+ code = bquote({
|
|
| 583 | +452 | ! |
- card$append_text("Selected Options", "header3")
+ right <- ANL_f[, .(right_var)] %in% .(right_val) |
| 584 | +453 | ! |
- card$append_text(paste0("Tumor Burden Parameter: ", input$bar_paramcd, "."))
+ right_name <- paste(.(right_val), collapse = " - ") |
| 585 | +454 | ! |
- if (!is.null(input$sort_var)) {
+ left <- ANL_f[, .(left_var)] %in% .(left_val) |
| 586 | +455 | ! |
- card$append_text(paste0("Sorted by: ", input$sort_var, "."))
+ left_name <- paste(.(left_val), collapse = " - ") |
| 587 | +456 |
- }- |
- |
| 588 | -! | -
- if (!is.null(input$facet_var)) {
+ }) |
|
| 589 | -! | +||
| 457 | +
- card$append_text(paste0("Faceted by: ", paste(input$facet_var, collapse = ", "), "."))
+ ) |
||
| 590 | +458 |
} |
|
| 591 | -! | +||
| 459 | +
- card$append_text("Plot", "header3")
+
|
||
| 592 | +460 | ! |
- card$append_plot(plot_r(), dim = pws$dim())+ if (!is.null(right_val) && !is.null(left_val)) {
|
| 593 | +461 | ! |
- if (!comment == "") {
+ q1 <- teal.code::eval_code( |
| 594 | +462 | ! |
- card$append_text("Comment", "header3")
+ q1, |
| 595 | +463 | ! |
- card$append_text(comment)+ code = bquote( |
| 596 | -+ | ||
| 464 | +! |
- }+ plot <- osprey::g_butterfly( |
|
| 597 | +465 | ! |
- card$append_src(teal.code::get_code(output_q()))+ category = ANL_f[, .(category_var)], |
| 598 | +466 | ! |
- card+ right_flag = right, |
| 599 | -+ | ||
| 467 | +! |
- }+ left_flag = left, |
|
| 600 | +468 | ! |
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
+ group_names = c(right_name, left_name), |
| 601 | -+ | ||
| 469 | +! |
- }+ block_count = .(count_by_var), |
|
| 602 | -+ | ||
| 470 | +! |
- })+ block_color = .(if (color_by_var != "None") {
|
|
| 603 | -+ | ||
| 471 | +! |
- }+ bquote(ANL_f[, .(color_by_var)]) |
| 1 | +472 |
- #' Spider plot Teal Module+ } else {
|
|
| 2 | -+ | ||
| 473 | +! |
- #'+ NULL |
|
| 3 | +474 |
- #' @description+ }), |
|
| 4 | -+ | ||
| 475 | +! |
- #' `r lifecycle::badge("stable")`
+ id = ANL_f$USUBJID, |
|
| 5 | -+ | ||
| 476 | +! |
- #'+ facet_rows = .(if (!is.null(facet_var)) {
|
|
| 6 | -+ | ||
| 477 | +! |
- #' Display spider plot as a shiny module+ bquote(ANL_f[, .(facet_var)]) |
|
| 7 | +478 |
- #'+ } else {
|
|
| 8 | -+ | ||
| 479 | +! |
- #' @inheritParams teal.widgets::standard_layout+ NULL |
|
| 9 | +480 |
- #' @inheritParams argument_convention+ }), |
|
| 10 | -+ | ||
| 481 | +! |
- #' @param x_var x-axis variables+ x_label = .(count_by_var), |
|
| 11 | -+ | ||
| 482 | +! |
- #' @param y_var y-axis variables+ y_label = .(category_var), |
|
| 12 | -+ | ||
| 483 | +! |
- #' @param marker_var variable dictates marker symbol+ legend_label = .(color_by_var), |
|
| 13 | -+ | ||
| 484 | +! |
- #' @param line_colorby_var variable dictates line color+ sort_by = .(sort_by_var), |
|
| 14 | -+ | ||
| 485 | +! |
- #' @param vref_line vertical reference lines+ show_legend = .(legend_on) |
|
| 15 | +486 |
- #' @param href_line horizontal reference lines+ ) |
|
| 16 | +487 |
- #' @param anno_txt_var annotation text+ ) |
|
| 17 | +488 |
- #' @param legend_on boolean value for whether legend is displayed+ ) |
|
| 18 | +489 |
- #' @param xfacet_var variable for x facets+ } |
|
| 19 | +490 |
- #' @param yfacet_var variable for y facets+ |
|
| 20 | -+ | ||
| 491 | +! |
- #'+ teal.code::eval_code(q1, quote(plot)) |
|
| 21 | +492 |
- #' @inherit argument_convention return+ }) |
|
| 22 | +493 |
- #' @export+ ) |
|
| 23 | +494 |
- #'+ |
|
| 24 | -+ | ||
| 495 | +! |
- #' @template author_zhanc107+ plot_r <- reactive(output_q()[["plot"]]) |
|
| 25 | +496 |
- #' @template author_liaoc10+ |
|
| 26 | +497 |
- #'+ # Insert the plot into a plot_with_settings module from teal.widgets |
|
| 27 | -+ | ||
| 498 | +! |
- #' @examples+ pws <- teal.widgets::plot_with_settings_srv( |
|
| 28 | -+ | ||
| 499 | +! |
- #' # Example using stream (ADaM) dataset+ id = "butterflyplot", |
|
| 29 | -+ | ||
| 500 | +! |
- #' data <- teal_data() |>+ plot_r = plot_r, |
|
| 30 | -+ | ||
| 501 | +! |
- #' within({
+ height = plot_height, |
|
| 31 | -+ | ||
| 502 | +! |
- #' ADSL <- rADSL+ width = plot_width |
|
| 32 | +503 |
- #' ADTR <- rADTR+ ) |
|
| 33 | +504 |
- #' })+ |
|
| 34 | -+ | ||
| 505 | +! |
- #'+ teal.widgets::verbatim_popup_srv( |
|
| 35 | -+ | ||
| 506 | +! |
- #' datanames(data) <- c("ADSL", "ADTR")
+ id = "rcode", |
|
| 36 | -+ | ||
| 507 | +! |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ title = paste("R code for", label),
|
|
| 37 | -+ | ||
| 508 | +! |
- #'+ verbatim_content = reactive(teal.code::get_code(output_q())) |
|
| 38 | +509 |
- #' app <- init(+ ) |
|
| 39 | +510 |
- #' data = data,+ |
|
| 40 | +511 |
- #' modules = modules(+ ### REPORTER |
|
| 41 | -+ | ||
| 512 | +! |
- #' tm_g_spiderplot(+ if (with_reporter) {
|
|
| 42 | -+ | ||
| 513 | +! |
- #' label = "Spider plot",+ card_fun <- function(comment, label) {
|
|
| 43 | -+ | ||
| 514 | +! |
- #' dataname = "ADTR",+ card <- teal::report_card_template( |
|
| 44 | -+ | ||
| 515 | +! |
- #' paramcd = choices_selected(+ title = "Butterfly Plot", |
|
| 45 | -+ | ||
| 516 | +! |
- #' choices = "SLDINV",+ label = label, |
|
| 46 | -+ | ||
| 517 | +! |
- #' selected = "SLDINV"+ with_filter = with_filter, |
|
| 47 | -+ | ||
| 518 | +! |
- #' ),+ filter_panel_api = filter_panel_api |
|
| 48 | +519 |
- #' x_var = choices_selected(+ ) |
|
| 49 | -+ | ||
| 520 | +! |
- #' choices = "ADY",+ if (!is.null(input$filter_var) || !is.null(input$facet_var) || !is.null(input$sort_by_var)) {
|
|
| 50 | -+ | ||
| 521 | +! |
- #' selected = "ADY"+ card$append_text("Selected Options", "header3")
|
|
| 51 | +522 |
- #' ),+ } |
|
| 52 | -+ | ||
| 523 | +! |
- #' y_var = choices_selected(+ if (!is.null(input$filter_var)) {
|
|
| 53 | -+ | ||
| 524 | +! |
- #' choices = c("PCHG", "CHG", "AVAL"),
+ card$append_text(paste0("Preset Data Filters: ", paste(input$filter_var, collapse = ", "), "."))
|
|
| 54 | +525 |
- #' selected = "PCHG"+ } |
|
| 55 | -+ | ||
| 526 | +! |
- #' ),+ if (!is.null(input$facet_var)) {
|
|
| 56 | -+ | ||
| 527 | +! |
- #' marker_var = choices_selected(+ card$append_text(paste0("Faceted by: ", paste(input$facet_var, collapse = ", "), "."))
|
|
| 57 | +528 |
- #' choices = c("SEX", "RACE", "USUBJID"),
+ } |
|
| 58 | -+ | ||
| 529 | +! |
- #' selected = "SEX"+ if (!is.null(input$sort_by_var)) {
|
|
| 59 | -+ | ||
| 530 | +! |
- #' ),+ card$append_text(paste0("Sorted by: ", paste(input$sort_by_var, collapse = ", "), "."))
|
|
| 60 | +531 |
- #' line_colorby_var = choices_selected(+ } |
|
| 61 | -+ | ||
| 532 | +! |
- #' choices = c("SEX", "USUBJID", "RACE"),
+ card$append_text("Plot", "header3")
|
|
| 62 | -+ | ||
| 533 | +! |
- #' selected = "SEX"+ card$append_plot(plot_r(), dim = pws$dim()) |
|
| 63 | -+ | ||
| 534 | +! |
- #' ),+ if (!comment == "") {
|
|
| 64 | -+ | ||
| 535 | +! |
- #' xfacet_var = choices_selected(+ card$append_text("Comment", "header3")
|
|
| 65 | -+ | ||
| 536 | +! |
- #' choices = c("SEX", "ARM"),
+ card$append_text(comment) |
|
| 66 | +537 |
- #' selected = "SEX"+ } |
|
| 67 | -+ | ||
| 538 | +! |
- #' ),+ card$append_src(teal.code::get_code(output_q())) |
|
| 68 | -+ | ||
| 539 | +! |
- #' yfacet_var = choices_selected(+ card |
|
| 69 | +540 |
- #' choices = c("SEX", "ARM"),
+ } |
|
| 70 | -+ | ||
| 541 | +! |
- #' selected = "ARM"+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
|
| 71 | +542 |
- #' ),+ } |
|
| 72 | +543 |
- #' vref_line = "10, 37",+ }) |
|
| 73 | +544 |
- #' href_line = "-20, 0"+ } |
| 74 | +1 |
- #' )+ #' Teal Module for `Swimlane` Plot |
|
| 75 | +2 |
- #' )+ #' |
|
| 76 | +3 |
- #' )+ #' @description |
|
| 77 | +4 |
- #' if (interactive()) {
+ #' `r lifecycle::badge("stable")`
|
|
| 78 | +5 |
- #' shinyApp(app$ui, app$server)+ #' |
|
| 79 | +6 |
- #' }+ #' This is teal module that generates a `swimlane` plot (bar plot with markers) for `ADaM` data |
|
| 80 | +7 |
#' |
|
| 81 | +8 |
- tm_g_spiderplot <- function(label,+ #' @inheritParams teal.widgets::standard_layout |
|
| 82 | +9 |
- dataname,+ #' @inheritParams argument_convention |
|
| 83 | +10 |
- paramcd,+ #' @param dataname analysis data used for plotting, needs to be available in the list passed to the `data` |
|
| 84 | +11 |
- x_var,+ #' argument of [teal::init()]. If no markers are to be plotted in the module, `"ADSL"` should be |
|
| 85 | +12 |
- y_var,+ #' the input. If markers are to be plotted, data name for the marker data should be the input |
|
| 86 | +13 |
- marker_var,+ #' @param bar_var [teal.transform::choices_selected] subject-level numeric variable from dataset |
|
| 87 | +14 |
- line_colorby_var,+ #' to plot as the bar length |
|
| 88 | +15 |
- xfacet_var = NULL,+ #' @param bar_color_var [teal.transform::choices_selected] color by variable (subject-level) |
|
| 89 | +16 |
- yfacet_var = NULL,+ #' @param sort_var `choices_selected` sort by variable (subject-level) |
|
| 90 | +17 |
- vref_line = NULL,+ #' @param marker_pos_var [teal.transform::choices_selected] variable for marker position from marker data |
|
| 91 | +18 |
- href_line = NULL,+ #' (Note: make sure that marker position has the same relative start day as bar length variable `bar_var` |
|
| 92 | +19 |
- anno_txt_var = TRUE,+ #' @param marker_shape_var [teal.transform::choices_selected] marker shape variable from marker data |
|
| 93 | +20 |
- legend_on = FALSE,+ #' @param marker_shape_opt aesthetic values to map shape values (named vector to map shape values to each name). |
|
| 94 | +21 |
- plot_height = c(600L, 200L, 2000L),+ #' If not `NULL`, please make sure this contains all possible values for `marker_shape_var` values, |
|
| 95 | +22 |
- plot_width = NULL,+ #' otherwise shape will be assigned by `ggplot` default |
|
| 96 | +23 |
- pre_output = NULL,+ #' @param marker_color_var marker color variable from marker data |
|
| 97 | +24 |
- post_output = NULL) {
- |
- |
| 98 | -! | -
- message("Initializing tm_g_spiderplot")
- |
- |
| 99 | -! | -
- checkmate::assert_class(paramcd, classes = "choices_selected")- |
- |
| 100 | -! | -
- checkmate::assert_class(x_var, classes = "choices_selected")- |
- |
| 101 | -! | -
- checkmate::assert_class(y_var, classes = "choices_selected")- |
- |
| 102 | -! | -
- checkmate::assert_class(marker_var, classes = "choices_selected")- |
- |
| 103 | -! | -
- checkmate::assert_class(line_colorby_var, classes = "choices_selected")- |
- |
| 104 | -! | -
- checkmate::assert_class(xfacet_var, classes = "choices_selected")- |
- |
| 105 | -! | -
- checkmate::assert_class(yfacet_var, classes = "choices_selected")- |
- |
| 106 | -! | -
- checkmate::assert_string(vref_line)- |
- |
| 107 | -! | -
- checkmate::assert_string(href_line)- |
- |
| 108 | -! | -
- checkmate::assert_flag(anno_txt_var)- |
- |
| 109 | -! | -
- checkmate::assert_flag(legend_on)- |
- |
| 110 | -! | -
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ #' @param marker_color_opt aesthetic values to map color values (named vector to map color values to each name). |
|
| 111 | -! | +||
| 25 | +
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ #' If not `NULL`, please make sure this contains all possible values for `marker_color_var` values, |
||
| 112 | -! | +||
| 26 | +
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ #' otherwise color will be assigned by `ggplot` default |
||
| 113 | -! | +||
| 27 | +
- checkmate::assert_numeric(+ #' @param vref_line vertical reference lines |
||
| 114 | -! | +||
| 28 | +
- plot_width[1],+ #' @param anno_txt_var character vector with subject-level variable names that are selected as annotation |
||
| 115 | -! | +||
| 29 | +
- lower = plot_width[2],+ #' @param x_label the label of the x axis |
||
| 116 | -! | +||
| 30 | +
- upper = plot_width[3],+ #' |
||
| 117 | -! | +||
| 31 | +
- null.ok = TRUE,+ #' @inherit argument_convention return |
||
| 118 | -! | +||
| 32 | +
- .var.name = "plot_width"+ #' |
||
| 119 | +33 |
- )+ #' @export |
|
| 120 | +34 |
-
+ #' |
|
| 121 | -! | +||
| 35 | +
- args <- as.list(environment())+ #' @template author_qit3 |
||
| 122 | -! | +||
| 36 | +
- module(+ #' |
||
| 123 | -! | +||
| 37 | +
- label = label,+ #' @examples |
||
| 124 | -! | +||
| 38 | +
- datanames = c("ADSL", dataname),
+ #' # Example using stream (ADaM) dataset |
||
| 125 | -! | +||
| 39 | +
- server = srv_g_spider,+ #' data <- teal_data() |> |
||
| 126 | -! | +||
| 40 | +
- server_args = list(+ #' within({
|
||
| 127 | -! | +||
| 41 | +
- dataname = dataname,+ #' library(dplyr) |
||
| 128 | -! | +||
| 42 | +
- paramcd = paramcd,+ #' ADSL <- rADSL %>% |
||
| 129 | -! | +||
| 43 | +
- label = label,+ #' mutate(TRTDURD = as.integer(TRTEDTM - TRTSDTM) + 1) %>% |
||
| 130 | -! | +||
| 44 | +
- plot_height = plot_height,+ #' filter(STRATA1 == "A" & ARMCD == "ARM A") |
||
| 131 | -! | +||
| 45 | +
- plot_width = plot_width+ #' ADRS <- rADRS %>% |
||
| 132 | +46 |
- ),+ #' filter(PARAMCD == "LSTASDI" & DCSREAS == "Death") %>% |
|
| 133 | -! | +||
| 47 | +
- ui = ui_g_spider,+ #' mutate(AVALC = DCSREAS, ADY = EOSDY) %>% |
||
| 134 | -! | +||
| 48 | +
- ui_args = args+ #' rbind(rADRS %>% filter(PARAMCD == "OVRINV" & AVALC != "NE")) %>% |
||
| 135 | +49 |
- )+ #' arrange(USUBJID) |
|
| 136 | +50 |
- }+ #' }) |
|
| 137 | +51 |
-
+ #' |
|
| 138 | +52 |
- ui_g_spider <- function(id, ...) {
+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
|
| 139 | -! | +||
| 53 | +
- ns <- NS(id)+ #' |
||
| 140 | -! | +||
| 54 | +
- a <- list(...)+ #' ADSL <- data[["ADSL"]] |
||
| 141 | -! | +||
| 55 | +
- shiny::tagList(+ #' ADRS <- data[["ADRS"]] |
||
| 142 | -! | +||
| 56 | +
- include_css_files("custom"),
+ #' |
||
| 143 | -! | +||
| 57 | +
- teal.widgets::standard_layout(+ #' app <- init( |
||
| 144 | -! | +||
| 58 | +
- output = teal.widgets::white_small_well(+ #' data = data, |
||
| 145 | -! | +||
| 59 | +
- teal.widgets::plot_with_settings_ui(id = ns("spiderplot"))
+ #' modules = modules( |
||
| 146 | +60 |
- ),+ #' tm_g_swimlane( |
|
| 147 | -! | +||
| 61 | +
- encoding = tags$div(+ #' label = "Swimlane Plot", |
||
| 148 | +62 |
- ### Reporter+ #' dataname = "ADRS", |
|
| 149 | -! | +||
| 63 | +
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ #' bar_var = choices_selected( |
||
| 150 | +64 |
- ###+ #' selected = "TRTDURD", |
|
| 151 | -! | +||
| 65 | +
- tags$label("Encodings", class = "text-primary"),
+ #' choices = c("TRTDURD", "EOSDY")
|
||
| 152 | -! | +||
| 66 | +
- helpText("Analysis data:", tags$code(a$dataname)),
+ #' ), |
||
| 153 | -! | +||
| 67 | +
- tags$div(+ #' bar_color_var = choices_selected( |
||
| 154 | -! | +||
| 68 | +
- class = "pretty-left-border",+ #' selected = "EOSSTT", |
||
| 155 | -! | +||
| 69 | +
- teal.widgets::optionalSelectInput(+ #' choices = c("EOSSTT", "ARM", "ARMCD", "ACTARM", "ACTARMCD", "SEX")
|
||
| 156 | -! | +||
| 70 | +
- ns("paramcd"),
+ #' ), |
||
| 157 | -! | +||
| 71 | +
- paste("Parameter - from", a$dataname),
+ #' sort_var = choices_selected( |
||
| 158 | -! | +||
| 72 | +
- multiple = FALSE+ #' selected = "ACTARMCD", |
||
| 159 | +73 |
- ),+ #' choices = c("USUBJID", "SITEID", "ACTARMCD", "TRTDURD")
|
|
| 160 | -! | +||
| 74 | +
- teal.widgets::optionalSelectInput(+ #' ), |
||
| 161 | -! | +||
| 75 | +
- ns("x_var"),
+ #' marker_pos_var = choices_selected( |
||
| 162 | -! | +||
| 76 | +
- "X-axis Variable",+ #' selected = "ADY", |
||
| 163 | -! | +||
| 77 | +
- get_choices(a$x_var$choices),+ #' choices = c("ADY")
|
||
| 164 | -! | +||
| 78 | +
- a$x_var$selected,+ #' ), |
||
| 165 | -! | +||
| 79 | +
- multiple = FALSE+ #' marker_shape_var = choices_selected( |
||
| 166 | +80 |
- ),+ #' selected = "AVALC", |
|
| 167 | -! | +||
| 81 | +
- teal.widgets::optionalSelectInput(+ #' c("AVALC", "AVISIT")
|
||
| 168 | -! | +||
| 82 | +
- ns("y_var"),
+ #' ), |
||
| 169 | -! | +||
| 83 | +
- "Y-axis Variable",+ #' marker_shape_opt = c("CR" = 16, "PR" = 17, "SD" = 18, "PD" = 15, "Death" = 8),
|
||
| 170 | -! | +||
| 84 | +
- get_choices(a$y_var$choices),+ #' marker_color_var = choices_selected( |
||
| 171 | -! | +||
| 85 | +
- a$y_var$selected,+ #' selected = "AVALC", |
||
| 172 | -! | +||
| 86 | +
- multiple = FALSE+ #' choices = c("AVALC", "AVISIT")
|
||
| 173 | +87 |
- ),+ #' ), |
|
| 174 | -! | +||
| 88 | +
- teal.widgets::optionalSelectInput(+ #' marker_color_opt = c( |
||
| 175 | -! | +||
| 89 | +
- ns("line_colorby_var"),
+ #' "CR" = "green", "PR" = "blue", "SD" = "goldenrod", |
||
| 176 | -! | +||
| 90 | +
- "Color By Variable (Line)",+ #' "PD" = "red", "Death" = "black" |
||
| 177 | -! | +||
| 91 | +
- get_choices(a$line_colorby_var$choices),+ #' ), |
||
| 178 | -! | +||
| 92 | +
- a$line_colorby_var$selected,+ #' vref_line = c(30, 60), |
||
| 179 | -! | +||
| 93 | +
- multiple = FALSE+ #' anno_txt_var = choices_selected( |
||
| 180 | +94 |
- ),+ #' selected = c("ACTARM", "SEX"),
|
|
| 181 | -! | +||
| 95 | +
- teal.widgets::optionalSelectInput(+ #' choices = c( |
||
| 182 | -! | +||
| 96 | +
- ns("marker_var"),
+ #' "ARM", "ARMCD", "ACTARM", "ACTARMCD", "AGEGR1", |
||
| 183 | -! | +||
| 97 | +
- "Marker Symbol By Variable",+ #' "SEX", "RACE", "COUNTRY", "DCSREAS", "DCSREASP" |
||
| 184 | -! | +||
| 98 | +
- get_choices(a$marker_var$choices),+ #' ) |
||
| 185 | -! | +||
| 99 | +
- a$marker_var$selected,+ #' ) |
||
| 186 | -! | +||
| 100 | +
- multiple = FALSE+ #' ) |
||
| 187 | +101 |
- ),+ #' ) |
|
| 188 | -! | +||
| 102 | +
- teal.widgets::optionalSelectInput(+ #' ) |
||
| 189 | -! | +||
| 103 | +
- ns("xfacet_var"),
+ #' if (interactive()) {
|
||
| 190 | -! | +||
| 104 | +
- "X-facet By Variable",+ #' shinyApp(app$ui, app$server) |
||
| 191 | -! | +||
| 105 | +
- get_choices(a$xfacet_var$choices),+ #' } |
||
| 192 | -! | +||
| 106 | +
- a$xfacet_var$selected,+ #' |
||
| 193 | -! | +||
| 107 | +
- multiple = TRUE+ tm_g_swimlane <- function(label, |
||
| 194 | +108 |
- ),+ dataname, |
|
| 195 | -! | +||
| 109 | +
- teal.widgets::optionalSelectInput(+ bar_var, |
||
| 196 | -! | +||
| 110 | +
- ns("yfacet_var"),
+ bar_color_var = NULL, |
||
| 197 | -! | +||
| 111 | +
- "Y-facet By Variable",+ sort_var = NULL, |
||
| 198 | -! | +||
| 112 | +
- get_choices(a$yfacet_var$choices),+ marker_pos_var = NULL, |
||
| 199 | -! | +||
| 113 | +
- a$yfacet_var$selected,+ marker_shape_var = NULL, |
||
| 200 | -! | +||
| 114 | +
- multiple = TRUE+ marker_shape_opt = NULL, |
||
| 201 | +115 |
- )+ marker_color_var = NULL, |
|
| 202 | +116 |
- ),+ marker_color_opt = NULL, |
|
| 203 | -! | +||
| 117 | +
- checkboxInput(+ anno_txt_var = NULL, |
||
| 204 | -! | +||
| 118 | +
- ns("anno_txt_var"),
+ vref_line = NULL, |
||
| 205 | -! | +||
| 119 | +
- "Add subject ID label",+ plot_height = c(1200L, 400L, 5000L), |
||
| 206 | -! | +||
| 120 | +
- value = a$anno_txt_var+ plot_width = NULL, |
||
| 207 | +121 |
- ),+ pre_output = NULL, |
|
| 208 | -! | +||
| 122 | +
- checkboxInput(+ post_output = NULL, |
||
| 209 | -! | +||
| 123 | +
- ns("legend_on"),
+ x_label = "Time from First Treatment (Day)") {
|
||
| 210 | +124 | ! |
- "Add legend",+ message("Initializing tm_g_swimlane")
|
| 211 | +125 | ! |
- value = a$legend_on+ args <- as.list(environment()) |
| 212 | +126 |
- ),+ |
|
| 213 | +127 | ! |
- textInput(+ checkmate::assert_string(label) |
| 214 | +128 | ! |
- ns("vref_line"),
+ checkmate::assert_string(dataname) |
| 215 | +129 | ! |
- label = tags$div(+ checkmate::assert_class(bar_var, classes = "choices_selected") |
| 216 | +130 | ! |
- "Vertical Reference Line(s)",+ checkmate::assert_class(bar_color_var, classes = "choices_selected") |
| 217 | +131 | ! |
- tags$br(),+ checkmate::assert_class(marker_pos_var, classes = "choices_selected") |
| 218 | +132 | ! |
- helpText("Enter numeric value(s) of vertical reference lines, separated by comma (eg. -2, 1)")
- |
-
| 219 | -- |
- ),+ checkmate::assert_class(marker_shape_var, classes = "choices_selected") |
|
| 220 | +133 | ! |
- value = a$vref_line- |
-
| 221 | -- |
- ),+ checkmate::assert_numeric(marker_shape_opt, min.len = 1, any.missing = FALSE) |
|
| 222 | +134 | ! |
- textInput(+ checkmate::assert_class(marker_color_var, classes = "choices_selected") |
| 223 | +135 | ! |
- ns("href_line"),
+ checkmate::assert_character(marker_color_opt, min.len = 1, any.missing = FALSE, null.ok = TRUE) |
| 224 | +136 | ! |
- label = tags$div(+ checkmate::assert_class(anno_txt_var, classes = "choices_selected") |
| 225 | +137 | ! |
- "Hortizontal Reference Line(s)",+ checkmate::assert_numeric(vref_line, min.len = 1, null.ok = TRUE, any.missing = FALSE) |
| 226 | +138 | ! |
- tags$br(),+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 227 | +139 | ! |
- helpText("Enter numeric value(s) of horizontal reference lines, separated by comma (eg. -2, 1)")
- |
-
| 228 | -- |
- ),+ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
|
| 229 | +140 | ! |
- value = a$href_line- |
-
| 230 | -- |
- )- |
- |
| 231 | -- |
- ),+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
|
| 232 | +141 | ! |
- forms = tagList(+ checkmate::assert_numeric( |
| 233 | +142 | ! |
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ plot_width[1], |
| 234 | -+ | ||
| 143 | +! |
- ),+ lower = plot_width[2], |
|
| 235 | +144 | ! |
- pre_output = a$pre_output,+ upper = plot_width[3], |
| 236 | +145 | ! |
- post_output = a$post_output+ null.ok = TRUE, |
| 237 | -+ | ||
| 146 | +! |
- )+ .var.name = "plot_width" |
|
| 238 | +147 |
) |
|
| 239 | -+ | ||
| 148 | +! |
- }+ checkmate::assert_string(x_label) |
|
| 240 | +149 | ||
| 241 | +150 |
- srv_g_spider <- function(id, data, filter_panel_api, paramcd, reporter, dataname, label, plot_height, plot_width) {
+
|
|
| 242 | +151 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ module( |
| 243 | +152 | ! |
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ label = label, |
| 244 | +153 | ! |
- checkmate::assert_class(data, "reactive")+ ui = ui_g_swimlane, |
| 245 | +154 | ! |
- checkmate::assert_class(shiny::isolate(data()), "teal_data")+ ui_args = args, |
| 246 | -+ | ||
| 155 | +! |
-
+ server = srv_g_swimlane, |
|
| 247 | +156 | ! |
- moduleServer(id, function(input, output, session) {
+ server_args = list( |
| 248 | +157 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ dataname = dataname, |
| 249 | -+ | ||
| 158 | +! |
-
+ marker_pos_var = marker_pos_var, |
|
| 250 | +159 | ! |
- env <- as.list(isolate(data())@env)+ marker_shape_var = marker_shape_var, |
| 251 | +160 | ! |
- resolved_paramcd <- teal.transform::resolve_delayed(paramcd, env)+ marker_shape_opt = marker_shape_opt, |
| 252 | -+ | ||
| 161 | +! |
-
+ marker_color_var = marker_color_var, |
|
| 253 | +162 | ! |
- teal.widgets::updateOptionalSelectInput(+ marker_color_opt = marker_color_opt, |
| 254 | +163 | ! |
- session = session,+ label = label, |
| 255 | +164 | ! |
- inputId = "paramcd",+ plot_height = plot_height, |
| 256 | +165 | ! |
- choices = resolved_paramcd$choices,+ plot_width = plot_width, |
| 257 | +166 | ! |
- selected = resolved_paramcd$selected+ x_label = x_label |
| 258 | +167 |
- )+ ), |
|
| 259 | -+ | ||
| 168 | +! |
-
+ datanames = c("ADSL", dataname)
|
|
| 260 | -! | +||
| 169 | +
- iv <- reactive({
+ ) |
||
| 261 | -! | +||
| 170 | +
- ADSL <- data()[["ADSL"]]+ } |
||
| 262 | -! | +||
| 171 | +
- ADTR <- data()[[dataname]]+ |
||
| 263 | +172 | ||
| 264 | -! | +||
| 173 | +
- iv <- shinyvalidate::InputValidator$new()+ ui_g_swimlane <- function(id, ...) {
|
||
| 265 | +174 | ! |
- iv$add_rule("paramcd", shinyvalidate::sv_required(
+ a <- list(...) |
| 266 | +175 | ! |
- message = "Parameter is required"+ ns <- NS(id) |
| 267 | +176 |
- ))+ |
|
| 268 | +177 | ! |
- iv$add_rule("x_var", shinyvalidate::sv_required(
+ shiny::tagList( |
| 269 | +178 | ! |
- message = "X Axis Variable is required"+ include_css_files("custom"),
|
| 270 | -+ | ||
| 179 | +! |
- ))+ teal.widgets::standard_layout( |
|
| 271 | +180 | ! |
- iv$add_rule("y_var", shinyvalidate::sv_required(
+ output = teal.widgets::white_small_well( |
| 272 | +181 | ! |
- message = "Y Axis Variable is required"+ teal.widgets::plot_with_settings_ui(id = ns("swimlaneplot"))
|
| 273 | +182 |
- ))+ ), |
|
| 274 | +183 | ! |
- iv$add_rule("line_colorby_var", shinyvalidate::sv_required(
+ encoding = tags$div(+ |
+
| 184 | ++ |
+ ### Reporter |
|
| 275 | +185 | ! |
- message = "Color Variable is required"+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
|
| 276 | +186 |
- ))+ ### |
|
| 277 | +187 | ! |
- iv$add_rule("marker_var", shinyvalidate::sv_required(
+ tags$label("Encodings", class = "text-primary"),
|
| 278 | +188 | ! |
- message = "Marker Symbol Variable is required"- |
-
| 279 | -- |
- ))+ helpText("Analysis data:", tags$code(a$dataname)),
|
|
| 280 | +189 | ! |
- fac_dupl <- function(value, other) {
+ tags$div( |
| 281 | +190 | ! |
- if (length(value) * length(other) > 0L && anyDuplicated(c(value, other))) {
+ class = "pretty-left-border", |
| 282 | +191 | ! |
- "X- and Y-facet Variables must not overlap"+ teal.widgets::optionalSelectInput( |
| 283 | -+ | ||
| 192 | +! |
- }+ ns("bar_var"),
|
|
| 284 | -+ | ||
| 193 | +! |
- }+ "Bar Length", |
|
| 285 | +194 | ! |
- iv$add_rule("xfacet_var", fac_dupl, other = input$yfacet_var)
+ choices = get_choices(a$bar_var$choices), |
| 286 | +195 | ! |
- iv$add_rule("yfacet_var", fac_dupl, other = input$xfacet_var)
+ selected = a$bar_var$selected, |
| 287 | +196 | ! |
- iv$add_rule("vref_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
+ multiple = FALSE, |
| 288 | +197 | ! |
- "Vertical Reference Line(s) are invalid"+ label_help = helpText("from ", tags$code("ADSL"))
|
| 289 | +198 |
- })+ ), |
|
| 290 | +199 | ! |
- iv$add_rule("href_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
+ teal.widgets::optionalSelectInput( |
| 291 | +200 | ! |
- "Horizontal Reference Line(s) are invalid"+ ns("bar_color_var"),
|
| 292 | -+ | ||
| 201 | +! |
- })+ "Bar Color", |
|
| 293 | +202 | ! |
- iv$enable()+ choices = get_choices(a$bar_color_var$choices), |
| 294 | -+ | ||
| 203 | +! |
- })+ selected = a$bar_color_var$selected, |
|
| 295 | -+ | ||
| 204 | +! |
-
+ multiple = FALSE, |
|
| 296 | +205 | ! |
- vals <- reactiveValues(spiderplot = NULL)+ label_help = helpText("from ", tags$code("ADSL"))
|
| 297 | +206 |
-
+ ) |
|
| 298 | +207 |
- # render plot+ ), |
|
| 299 | +208 | ! |
- output_q <- reactive({
+ teal.widgets::optionalSelectInput( |
| 300 | -+ | ||
| 209 | +! |
- # get datasets ---+ ns("sort_var"),
|
|
| 301 | +210 | ! |
- ADSL <- data()[["ADSL"]]+ "Sort by", |
| 302 | +211 | ! |
- ADTR <- data()[[dataname]]+ choices = get_choices(a$sort_var$choices), |
| 303 | -+ | ||
| 212 | +! |
-
+ selected = a$sort_var$selected, |
|
| 304 | +213 | ! |
- teal::validate_inputs(iv())+ multiple = FALSE,+ |
+
| 214 | +! | +
+ label_help = helpText("from ", tags$code("ADSL"))
|
|
| 305 | +215 |
-
+ ), |
|
| 306 | +216 | ! |
- teal::validate_has_data(ADSL, min_nrow = 1, msg = sprintf("%s data has zero rows", "ADSL"))
+ tags$div( |
| 307 | +217 | ! |
- teal::validate_has_data(ADTR, min_nrow = 1, msg = sprintf("%s data has zero rows", dataname))
+ class = "pretty-left-border", |
| 308 | -+ | ||
| 218 | +! |
-
+ if (a$dataname == "ADSL") {
|
|
| 309 | +219 | ! |
- paramcd <- input$paramcd+ NULL |
| 310 | +220 | ! |
- x_var <- input$x_var+ } else if (is.null(a$marker_pos_var)) {
|
| 311 | +221 | ! |
- y_var <- input$y_var+ NULL |
| 312 | -! | +||
| 222 | +
- marker_var <- input$marker_var+ } else {
|
||
| 313 | +223 | ! |
- line_colorby_var <- input$line_colorby_var+ teal.widgets::optionalSelectInput( |
| 314 | +224 | ! |
- anno_txt_var <- input$anno_txt_var+ ns("marker_pos_var"),
|
| 315 | +225 | ! |
- legend_on <- input$legend_on+ "Marker Position", |
| 316 | +226 | ! |
- xfacet_var <- input$xfacet_var+ choices = get_choices(a$marker_pos_var$choices), |
| 317 | +227 | ! |
- yfacet_var <- input$yfacet_var+ selected = a$marker_pos_var$selected, |
| 318 | +228 | ! |
- vref_line <- input$vref_line+ multiple = FALSE, |
| 319 | +229 | ! |
- href_line <- input$href_line+ label_help = helpText("from ", tags$code(a$dataname))
|
| 320 | +230 |
-
+ ) |
|
| 321 | +231 |
- # reference lines preprocessing+ }, |
|
| 322 | +232 | ! |
- vref_line <- as_numeric_from_comma_sep_str(vref_line)+ uiOutput(ns("marker_shape_sel")),
|
| 323 | +233 | ! |
- href_line <- as_numeric_from_comma_sep_str(href_line)+ uiOutput(ns("marker_color_sel"))
|
| 324 | +234 |
-
+ ), |
|
| 325 | -+ | ||
| 235 | +! | +
+ teal.widgets::optionalSelectInput(+ |
+ |
| 236 | +! | +
+ ns("anno_txt_var"),
+ |
+ |
| 237 | +! | +
+ "Annotation Variables",+ |
+ |
| 238 | +! | +
+ choices = get_choices(a$anno_txt_var$choices),+ |
+ |
| 239 | +! | +
+ selected = a$anno_txt_var$selected,+ |
+ |
| 240 | +! | +
+ multiple = TRUE,+ |
+ |
| 241 | +! |
- # define variables ---+ label_help = helpText("from ", tags$code("ADSL"))
|
|
| 326 | +242 |
- # if variable is not in ADSL, then take from domain VADs+ ), |
|
| 327 | +243 | ! |
- varlist <- c(xfacet_var, yfacet_var, marker_var, line_colorby_var)+ textInput( |
| 328 | +244 | ! |
- varlist_from_adsl <- varlist[varlist %in% names(ADSL)]+ ns("vref_line"),
|
| 329 | +245 | ! |
- varlist_from_anl <- varlist[!varlist %in% names(ADSL)]+ label = tags$div( |
| 330 | -+ | ||
| 246 | +! |
-
+ "Vertical Reference Line(s)", |
|
| 331 | +247 | ! |
- adsl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_adsl))
+ tags$br(), |
| 332 | +248 | ! |
- adtr_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", x_var, y_var, varlist_from_anl))
+ helpText("Enter numeric value(s) of reference lines, separated by comma (eg. 100, 200)")
|
| 333 | +249 |
-
+ ), |
|
| 334 | -+ | ||
| 250 | +! |
- # preprocessing of datasets to qenv ---+ value = paste(a$vref_line, collapse = ", ") |
|
| 335 | +251 |
-
+ ) |
|
| 336 | +252 |
- # vars definition+ ), |
|
| 337 | +253 | ! |
- adtr_vars <- adtr_vars[adtr_vars != "None"]+ forms = tagList( |
| 338 | +254 | ! |
- adtr_vars <- adtr_vars[!is.null(adtr_vars)]- |
-
| 339 | -- |
-
+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
|
| 340 | +255 |
- # merge+ ), |
|
| 341 | +256 | ! |
- q1 <- teal.code::eval_code(+ pre_output = a$pre_output, |
| 342 | +257 | ! |
- data(),+ post_output = a$post_output |
| 343 | -! | +||
| 258 | +
- code = bquote({
+ ) |
||
| 344 | -! | +||
| 259 | +
- ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame()+ ) |
||
| 345 | -! | +||
| 260 | +
- ADTR <- .(as.name(dataname))[, .(adtr_vars)] %>% as.data.frame()+ } |
||
| 346 | +261 | ||
| 347 | -! | +||
| 262 | +
- ANL <- merge(ADSL, ADTR, by = c("USUBJID", "STUDYID"))
+ srv_g_swimlane <- function(id, |
||
| 348 | -! | +||
| 263 | +
- ANL <- ANL %>%+ data, |
||
| 349 | -! | +||
| 264 | +
- group_by(USUBJID, PARAMCD) %>%+ filter_panel_api, |
||
| 350 | -! | +||
| 265 | +
- arrange(ANL[, .(x_var)]) %>%+ reporter, |
||
| 351 | -! | +||
| 266 | +
- as.data.frame()+ dataname, |
||
| 352 | +267 |
- })+ marker_pos_var, |
|
| 353 | +268 |
- )+ marker_shape_var, |
|
| 354 | +269 |
-
+ marker_shape_opt, |
|
| 355 | +270 |
- # format and filter+ marker_color_var, |
|
| 356 | -! | +||
| 271 | +
- q1 <- teal.code::eval_code(+ marker_color_opt, |
||
| 357 | -! | +||
| 272 | +
- q1,+ label, |
||
| 358 | -! | +||
| 273 | +
- code = bquote({
+ plot_height, |
||
| 359 | -! | +||
| 274 | +
- ANL$USUBJID <- unlist(lapply(strsplit(ANL$USUBJID, "-", fixed = TRUE), tail, 1))+ plot_width,+ |
+ ||
| 275 | ++ |
+ x_label) {
|
|
| 360 | +276 | ! |
- ANL_f <- ANL %>%+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
| 361 | +277 | ! |
- filter(PARAMCD == .(paramcd)) %>%+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
| 362 | +278 | ! |
- as.data.frame()+ checkmate::assert_class(data, "reactive") |
| 363 | -+ | ||
| 279 | +! |
- })+ checkmate::assert_class(shiny::isolate(data()), "teal_data") |
|
| 364 | +280 |
- )+ |
|
| 365 | -+ | ||
| 281 | +! |
-
+ moduleServer(id, function(input, output, session) {
|
|
| 366 | -+ | ||
| 282 | +! |
- # label+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
|
| 367 | +283 | ! |
- q1 <- if (anno_txt_var) {
+ iv <- reactive({
|
| 368 | +284 | ! |
- teal.code::eval_code(+ iv <- shinyvalidate::InputValidator$new() |
| 369 | +285 | ! |
- q1,+ iv$add_rule("bar_var", shinyvalidate::sv_required(
|
| 370 | +286 | ! |
- code = quote(lbl <- list(txt_ann = as.factor(ANL_f$USUBJID)))+ message = "Bar Length is required" |
| 371 | +287 |
- )+ )) |
|
| 372 | +288 |
- } else {
+ # If reference lines are requested |
|
| 373 | +289 | ! |
- teal.code::eval_code(q1, code = quote(lbl <- NULL))+ iv$add_rule("vref_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
+ |
+
| 290 | +! | +
+ "Vertical Reference Line(s) are invalid" |
|
| 374 | +291 |
- }+ })+ |
+ |
| 292 | +! | +
+ iv$enable()+ |
+ |
| 293 | +! | +
+ iv |
|
| 375 | +294 |
-
+ }) |
|
| 376 | +295 |
- # plot code to qenv ---+ |
|
| 377 | +296 |
-
+ # if marker position is NULL, then hide options for marker shape and color |
|
| 378 | +297 | ! |
- q1 <- teal.code::eval_code(+ output$marker_shape_sel <- renderUI({
|
| 379 | +298 | ! |
- q1,+ if (dataname == "ADSL" || is.null(marker_shape_var) || is.null(input$marker_pos_var)) {
|
| 380 | +299 | ! |
- code = bquote({
+ NULL+ |
+
| 300 | ++ |
+ } else {
|
|
| 381 | +301 | ! |
- plot <- osprey::g_spiderplot(+ ns <- session$ns |
| 382 | +302 | ! |
- marker_x = ANL_f[, .(x_var)],+ teal.widgets::optionalSelectInput( |
| 383 | +303 | ! |
- marker_id = ANL_f$USUBJID,+ ns("marker_shape_var"), "Marker Shape",
|
| 384 | +304 | ! |
- marker_y = ANL_f[, .(y_var)],+ choices = get_choices(marker_shape_var$choices), |
| 385 | +305 | ! |
- line_colby = .(if (line_colorby_var != "None") {
+ selected = marker_shape_var$selected, multiple = FALSE, |
| 386 | +306 | ! |
- bquote(ANL_f[, .(line_colorby_var)])+ label_help = helpText("from ", tags$code(dataname))
|
| 387 | +307 |
- } else {
+ ) |
|
| 388 | -! | +||
| 308 | +
- NULL+ } |
||
| 389 | +309 |
- }),+ }) |
|
| 390 | +310 | ! |
- marker_shape = .(if (marker_var != "None") {
+ output$marker_color_sel <- renderUI({
|
| 391 | +311 | ! |
- bquote(ANL_f[, .(marker_var)])+ if (dataname == "ADSL" || is.null(marker_color_var) || is.null(input$marker_pos_var)) {
+ |
+
| 312 | +! | +
+ NULL |
|
| 392 | +313 |
- } else {
+ } else {
|
|
| 393 | +314 | ! |
- NULL+ ns <- session$ns |
| 394 | -+ | ||
| 315 | +! |
- }),+ teal.widgets::optionalSelectInput( |
|
| 395 | +316 | ! |
- marker_size = 4,+ ns("marker_color_var"), "Marker Color",
|
| 396 | +317 | ! |
- datalabel_txt = lbl,+ choices = get_choices(marker_color_var$choices), |
| 397 | +318 | ! |
- facet_rows = .(if (!is.null(yfacet_var)) {
+ selected = marker_color_var$selected, multiple = FALSE, |
| 398 | +319 | ! |
- bquote(data.frame(ANL_f[, .(yfacet_var)]))+ label_help = helpText("from ", tags$code(dataname))
|
| 399 | +320 |
- } else {
+ ) |
|
| 400 | -! | +||
| 321 | +
- NULL+ } |
||
| 401 | +322 |
- }),+ })+ |
+ |
| 323 | ++ | + + | +|
| 324 | ++ |
+ # create plot |
|
| 402 | +325 | ! |
- facet_columns = .(if (!is.null(xfacet_var)) {
+ output_q <- reactive({
|
| 403 | +326 | ! |
- bquote(data.frame(ANL_f[, .(xfacet_var)]))+ teal::validate_inputs(iv()) |
| 404 | +327 |
- } else {
+
|
|
| 405 | +328 | ! |
- NULL+ validate(need("ADSL" %in% names(data()), "'ADSL' not included in data"))
|
| 406 | -+ | ||
| 329 | +! |
- }),+ validate(need( |
|
| 407 | +330 | ! |
- vref_line = .(vref_line),+ (length(data()) == 1 && dataname == "ADSL") || |
| 408 | +331 | ! |
- href_line = .(href_line),+ (length(data()) >= 2 && dataname != "ADSL"), paste( |
| 409 | +332 | ! |
- x_label = if (is.null(formatters::var_labels(ADTR[.(x_var)], fill = FALSE))) {
+ "Please either add just 'ADSL' as dataname when just ADSL is available.", |
| 410 | +333 | ! |
- .(x_var)+ "In case 2 datasets are available ADSL is not supposed to be the dataname." |
| 411 | +334 |
- } else {
+ )+ |
+ |
| 335 | ++ |
+ ))+ |
+ |
| 336 | ++ | + | |
| 412 | +337 | ! |
- formatters::var_labels(ADTR[.(x_var)], fill = FALSE)+ ADSL <- data()[["ADSL"]] |
| 413 | +338 |
- },+ + |
+ |
| 339 | +! | +
+ anl_vars <- unique(c( |
|
| 414 | +340 | ! |
- y_label = if (is.null(formatters::var_labels(ADTR[.(y_var)], fill = FALSE))) {
+ "USUBJID", "STUDYID", |
| 415 | +341 | ! |
- .(y_var)+ input$marker_pos_var, input$marker_shape_var, input$marker_color_var |
| 416 | +342 |
- } else {
+ )) |
|
| 417 | +343 | ! |
- formatters::var_labels(ADTR[.(y_var)], fill = FALSE)+ adsl_vars <- unique(c( |
| 418 | -+ | ||
| 344 | +! |
- },+ "USUBJID", "STUDYID", |
|
| 419 | +345 | ! |
- show_legend = .(legend_on)+ input$bar_var, input$bar_color_var, input$sort_var, input$anno_txt_var |
| 420 | +346 |
- )+ )) |
|
| 421 | +347 | ||
| 422 | +348 | ! |
- plot+ if (dataname == "ADSL") {
|
| 423 | -+ | ||
| 349 | +! |
- })+ teal::validate_has_data(ADSL, min_nrow = 3) |
|
| 424 | -+ | ||
| 350 | +! |
- )+ teal::validate_has_variable(ADSL, adsl_vars) |
|
| 425 | +351 |
- })+ } else {
|
|
| 426 | -+ | ||
| 352 | +! |
-
+ anl <- data()[[dataname]] |
|
| 427 | +353 | ! |
- plot_r <- reactive(output_q()[["plot"]])+ teal::validate_has_data(anl, min_nrow = 3)+ |
+
| 354 | +! | +
+ teal::validate_has_variable(anl, anl_vars) |
|
| 428 | +355 | ||
| 429 | +356 | ! |
- pws <- teal.widgets::plot_with_settings_srv(+ validate(need( |
| 430 | +357 | ! |
- id = "spiderplot",+ !any(c(marker_pos_var, marker_shape_var, marker_color_var) %in% adsl_vars), |
| 431 | +358 | ! |
- plot_r = plot_r,+ "marker-related variables need to come from marker data" |
| 432 | -! | +||
| 359 | +
- height = plot_height,+ )) |
||
| 433 | -! | +||
| 360 | +
- width = plot_width+ } |
||
| 434 | +361 |
- )+ |
|
| 435 | +362 |
-
+ # VARIABLE GETTERS |
|
| 436 | -! | +||
| 363 | +
- teal.widgets::verbatim_popup_srv(+ # lookup bar variables |
||
| 437 | +364 | ! |
- id = "rcode",+ bar_var <- input$bar_var |
| 438 | +365 | ! |
- title = paste("R code for", label),
+ bar_color_var <- input$bar_color_var |
| 439 | +366 | ! |
- verbatim_content = reactive(teal.code::get_code(output_q()))+ sort_var <- input$sort_var |
| 440 | -+ | ||
| 367 | +! |
- )+ anno_txt_var <- input$anno_txt_var |
|
| 441 | +368 | ||
| 442 | +369 |
- ### REPORTER+ # Check if marker inputs can be used |
|
| 443 | +370 | ! |
- if (with_reporter) {
+ if (dataname == "ADSL") {
|
| 444 | +371 | ! |
- card_fun <- function(comment, label) {
+ marker_pos_var <- NULL |
| 445 | +372 | ! |
- card <- teal::report_card_template(+ marker_shape_var <- NULL |
| 446 | +373 | ! |
- title = "Spider Plot",+ marker_color_var <- NULL+ |
+
| 374 | ++ |
+ } else {
|
|
| 447 | +375 | ! |
- label = label,+ marker_pos_var <- input$marker_pos_var |
| 448 | +376 | ! |
- with_filter = with_filter,+ marker_shape_var <- input$marker_shape_var |
| 449 | +377 | ! |
- filter_panel_api = filter_panel_api+ marker_color_var <- input$marker_color_var |
| 450 | +378 |
- )- |
- |
| 451 | -! | -
- if (!is.null(input$paramcd) || !is.null(input$xfacet_var) || !is.null(input$yfacet_var)) {
+ } |
|
| 452 | +379 | ! |
- card$append_text("Selected Options", "header3")
+ vref_line <- suppressWarnings(as_numeric_from_comma_sep_str(debounce(reactive(input$vref_line), 1500)())) |
| 453 | +380 |
- }- |
- |
| 454 | -! | -
- if (!is.null(input$paramcd)) {
+
|
|
| 455 | +381 | ! |
- card$append_text(paste0("Parameter - (from ", dataname, "): ", input$paramcd, "."))
+ q1 <- data() |
| 456 | +382 |
- }+ |
|
| 457 | +383 | ! |
- if (!is.null(input$xfacet_var)) {
+ q2 <- teal.code::eval_code( |
| 458 | +384 | ! |
- card$append_text(paste0("Faceted horizontally by: ", paste(input$xfacet_var, collapse = ", "), "."))
- |
-
| 459 | -- |
- }+ q1, |
|
| 460 | +385 | ! |
- if (!is.null(input$yfacet_var)) {
+ code = bquote({
|
| 461 | +386 | ! |
- card$append_text(paste0("Faceted vertically by: ", paste(input$yfacet_var, collapse = ", "), "."))
+ bar_var <- .(bar_var) |
| 462 | -+ | ||
| 387 | +! |
- }+ bar_color_var <- .(bar_color_var) |
|
| 463 | +388 | ! |
- card$append_text("Plot", "header3")
+ sort_var <- .(sort_var) |
| 464 | +389 | ! |
- card$append_plot(plot_r(), dim = pws$dim())+ marker_pos_var <- .(marker_pos_var) |
| 465 | +390 | ! |
- if (!comment == "") {
+ marker_shape_var <- .(marker_shape_var) |
| 466 | +391 | ! |
- card$append_text("Comment", "header3")
+ marker_color_var <- .(marker_color_var) |
| 467 | +392 | ! |
- card$append_text(comment)+ anno_txt_var <- .(anno_txt_var) |
| 468 | +393 |
- }+ }) |
|
| 469 | -! | +||
| 394 | +
- card$append_src(teal.code::get_code(output_q()))+ ) |
||
| 470 | -! | +||
| 395 | +
- card+ |
||
| 471 | +396 |
- }+ # WRITE DATA SELECTION TO qenv |
|
| 472 | +397 | ! |
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
- |
-
| 473 | -- |
- }+ q3 <- if (dataname == "ADSL") {
|
|
| 474 | -+ | ||
| 398 | +! |
- })+ teal.code::eval_code( |
|
| 475 | -+ | ||
| 399 | +! |
- }+ q2, |
| 1 | -+ | ||
| 400 | +! |
- #' Teal module for the `AE` overview+ code = bquote({
|
|
| 2 | -+ | ||
| 401 | +! |
- #'+ ADSL_p <- ADSL |
|
| 3 | -+ | ||
| 402 | +! |
- #' @description+ ADSL <- ADSL_p[, .(adsl_vars)] |
|
| 4 | +403 |
- #' `r lifecycle::badge("stable")`
+ # only take last part of USUBJID |
|
| 5 | -+ | ||
| 404 | +! |
- #'+ ADSL$USUBJID <- unlist(lapply(strsplit(ADSL$USUBJID, "-", fixed = TRUE), tail, 1)) |
|
| 6 | +405 |
- #' Display the `AE` overview plot as a shiny module+ }) |
|
| 7 | +406 |
- #'+ ) |
|
| 8 | +407 |
- #' @inheritParams teal.widgets::standard_layout+ } else {
|
|
| 9 | -+ | ||
| 408 | +! |
- #' @inheritParams argument_convention+ teal.code::eval_code( |
|
| 10 | -+ | ||
| 409 | +! |
- #' @param flag_var_anl ([`teal.transform::choices_selected`])+ q2, |
|
| 11 | -+ | ||
| 410 | +! |
- #' `choices_selected` object with variables used to count adverse event+ code = bquote({
|
|
| 12 | -+ | ||
| 411 | +! |
- #' sub-groups (e.g. Serious events, Related events, etc.)+ ADSL_p <- ADSL |
|
| 13 | -+ | ||
| 412 | +! |
- #'+ ANL_p <- .(as.name(dataname)) |
|
| 14 | +413 |
- #' @inherit argument_convention return+ |
|
| 15 | -+ | ||
| 414 | +! |
- #'+ ADSL <- ADSL_p[, .(adsl_vars)] |
|
| 16 | -+ | ||
| 415 | +! |
- #' @export+ ANL <- merge( |
|
| 17 | -+ | ||
| 416 | +! |
- #'+ x = ADSL, |
|
| 18 | -+ | ||
| 417 | +! |
- #' @examples+ y = ANL_p[, .(anl_vars)], |
|
| 19 | -+ | ||
| 418 | +! |
- #' data <- teal_data() |>+ all.x = FALSE, all.y = FALSE, |
|
| 20 | -+ | ||
| 419 | +! |
- #' within({
+ by = c("USUBJID", "STUDYID")
|
|
| 21 | +420 |
- #' ADSL <- rADSL+ ) |
|
| 22 | +421 |
- #' ADAE <- rADAE+ # only take last part of USUBJID |
|
| 23 | -+ | ||
| 422 | +! |
- #' add_event_flags <- function(dat) {
+ ADSL$USUBJID <- unlist(lapply(strsplit(ADSL$USUBJID, "-", fixed = TRUE), tail, 1)) |
|
| 24 | -+ | ||
| 423 | +! |
- #' dat <- dat |>+ ANL$USUBJID <- unlist(lapply(strsplit(ANL$USUBJID, "-", fixed = TRUE), tail, 1)) |
|
| 25 | +424 |
- #' mutate(+ }) |
|
| 26 | +425 |
- #' TMPFL_SER = AESER == "Y",+ ) |
|
| 27 | +426 |
- #' TMPFL_REL = AEREL == "Y",+ } |
|
| 28 | +427 |
- #' TMPFL_GR5 = AETOXGR == "5",+ |
|
| 29 | -+ | ||
| 428 | +! |
- #' AEREL1 = (AEREL == "Y" & ACTARM == "A: Drug X"),+ plot_call <- if (dataname == "ADSL") {
|
|
| 30 | -+ | ||
| 429 | +! |
- #' AEREL2 = (AEREL == "Y" & ACTARM == "B: Placebo")+ bquote( |
|
| 31 | -+ | ||
| 430 | +! |
- #' )+ plot <- osprey::g_swimlane( |
|
| 32 | -+ | ||
| 431 | +! |
- #' labels <- c(+ bar_id = ADSL[["USUBJID"]], |
|
| 33 | -+ | ||
| 432 | +! |
- #' "Serious AE", "Related AE", "Grade 5 AE",+ bar_length = ADSL[[bar_var]], |
|
| 34 | -+ | ||
| 433 | +! |
- #' "AE related to A: Drug X", "AE related to B: Placebo"+ sort_by = .(if (length(sort_var) > 0) quote(ADSL[[sort_var]]) else NULL), |
|
| 35 | -+ | ||
| 434 | +! |
- #' )+ col_by = .(if (length(bar_color_var) > 0) quote(ADSL[[bar_color_var]]) else NULL), |
|
| 36 | -+ | ||
| 435 | +! |
- #' cols <- c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2")
+ marker_id = NULL, |
|
| 37 | -+ | ||
| 436 | +! |
- #' for (i in seq_along(labels)) {
+ marker_pos = NULL, |
|
| 38 | -+ | ||
| 437 | +! |
- #' attr(dat[[cols[i]]], "label") <- labels[i]+ marker_shape = NULL, |
|
| 39 | -+ | ||
| 438 | +! |
- #' }+ marker_shape_opt = NULL, |
|
| 40 | -+ | ||
| 439 | +! |
- #' dat+ marker_color = NULL, |
|
| 41 | -+ | ||
| 440 | +! |
- #' }+ marker_color_opt = NULL, |
|
| 42 | -+ | ||
| 441 | +! |
- #' ADAE <- add_event_flags(ADAE)+ anno_txt = .(if (length(anno_txt_var) > 0) quote(ADSL[, anno_txt_var]) else NULL), |
|
| 43 | -+ | ||
| 442 | +! |
- #' })+ xref_line = .(vref_line), |
|
| 44 | -+ | ||
| 443 | +! |
- #'+ xtick_at = waiver(), |
|
| 45 | -+ | ||
| 444 | +! |
- #' datanames(data) <- c("ADSL", "ADAE")
+ xlab = .(x_label), |
|
| 46 | -+ | ||
| 445 | +! |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ title = "Swimlane Plot" |
|
| 47 | +446 |
- #'+ ) |
|
| 48 | +447 |
- #' ADAE <- data[["ADAE"]]+ ) |
|
| 49 | +448 |
- #'+ } else {
|
|
| 50 | -+ | ||
| 449 | +! |
- #' app <- init(+ bquote( |
|
| 51 | -+ | ||
| 450 | +! |
- #' data = data,+ plot <- osprey::g_swimlane( |
|
| 52 | -+ | ||
| 451 | +! |
- #' modules = modules(+ bar_id = ADSL[["USUBJID"]], |
|
| 53 | -+ | ||
| 452 | +! |
- #' tm_g_ae_oview(+ bar_length = ADSL[[bar_var]], |
|
| 54 | -+ | ||
| 453 | +! |
- #' label = "AE Overview",+ sort_by = .(if (length(sort_var) > 0) {
|
|
| 55 | -+ | ||
| 454 | +! |
- #' dataname = "ADAE",+ quote(ADSL[[sort_var]]) |
|
| 56 | +455 |
- #' arm_var = choices_selected(+ } else {
|
|
| 57 | -+ | ||
| 456 | +! |
- #' selected = "ACTARM",+ NULL |
|
| 58 | +457 |
- #' choices = c("ACTARM", "ACTARMCD")
+ }), |
|
| 59 | -+ | ||
| 458 | +! |
- #' ),+ col_by = .(if (length(bar_color_var) > 0) {
|
|
| 60 | -+ | ||
| 459 | +! |
- #' flag_var_anl = choices_selected(+ quote(ADSL[[bar_color_var]]) |
|
| 61 | +460 |
- #' selected = "AEREL1",+ } else {
|
|
| 62 | -+ | ||
| 461 | +! |
- #' choices = variable_choices(+ NULL |
|
| 63 | +462 |
- #' ADAE,+ }), |
|
| 64 | -+ | ||
| 463 | +! |
- #' c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2")
+ marker_id = ANL[["USUBJID"]], |
|
| 65 | -+ | ||
| 464 | +! |
- #' ),+ marker_pos = .(if (length(marker_pos_var) > 0) {
|
|
| 66 | -+ | ||
| 465 | +! |
- #' ),+ quote(ANL[[marker_pos_var]]) |
|
| 67 | +466 |
- #' plot_height = c(600, 200, 2000)+ } else {
|
|
| 68 | -+ | ||
| 467 | +! |
- #' )+ NULL |
|
| 69 | +468 |
- #' )+ }), |
|
| 70 | -+ | ||
| 469 | +! |
- #' )+ marker_shape = .(if (length(marker_shape_var) > 0) {
|
|
| 71 | -+ | ||
| 470 | +! |
- #' if (interactive()) {
+ quote(ANL[[marker_shape_var]]) |
|
| 72 | +471 |
- #' shinyApp(app$ui, app$server)+ } else {
|
|
| 73 | -+ | ||
| 472 | +! |
- #' }+ NULL |
|
| 74 | +473 |
- #'+ }), |
|
| 75 | -+ | ||
| 474 | +! |
- tm_g_ae_oview <- function(label,+ marker_shape_opt = .(if (length(marker_shape_var) == 0) {
|
|
| 76 | -+ | ||
| 475 | +! |
- dataname,+ NULL |
|
| 77 | -+ | ||
| 476 | +! |
- arm_var,+ } else if (length(marker_shape_var) > 0 && all(unique(anl[[marker_shape_var]]) %in% names(marker_shape_opt))) { # nolint: line_length.
|
|
| 78 | -+ | ||
| 477 | +! |
- flag_var_anl,+ bquote(.(marker_shape_opt)) |
|
| 79 | +478 |
- fontsize = c(5, 3, 7),+ } else {
|
|
| 80 | -+ | ||
| 479 | +! |
- plot_height = c(600L, 200L, 2000L),+ NULL |
|
| 81 | +480 |
- plot_width = NULL) {
+ }), |
|
| 82 | +481 | ! |
- message("Initializing tm_g_ae_oview")
+ marker_color = .(if (length(marker_color_var) > 0) {
|
| 83 | +482 | ! |
- checkmate::assert_class(arm_var, classes = "choices_selected")+ quote(ANL[[marker_color_var]]) |
| 84 | -! | +||
| 483 | +
- checkmate::assert_class(flag_var_anl, classes = "choices_selected")+ } else {
|
||
| 85 | +484 | ! |
- checkmate::assert(+ NULL |
| 86 | -! | +||
| 485 | +
- checkmate::check_number(fontsize, finite = TRUE),+ }), |
||
| 87 | +486 | ! |
- checkmate::assert(+ marker_color_opt = .(if (length(marker_color_var) == 0) {
|
| 88 | +487 | ! |
- combine = "and",+ NULL |
| 89 | +488 | ! |
- .var.name = "fontsize",+ } else if (length(marker_color_var) > 0 && all(unique(anl[[marker_color_var]]) %in% names(marker_color_opt))) { # nolint: line_length.
|
| 90 | +489 | ! |
- checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE),+ bquote(.(marker_color_opt)) |
| 91 | -! | +||
| 490 | +
- checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3])+ } else {
|
||
| 92 | -+ | ||
| 491 | +! |
- )+ NULL |
|
| 93 | +492 |
- )+ }), |
|
| 94 | +493 | ! |
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ anno_txt = .(if (length(anno_txt_var) > 0) {
|
| 95 | +494 | ! |
- checkmate::assert_numeric(plot_height[1],+ quote(ADSL[, anno_txt_var]) |
| 96 | -! | +||
| 495 | +
- lower = plot_height[2], upper = plot_height[3],+ } else {
|
||
| 97 | +496 | ! |
- .var.name = "plot_height"+ NULL |
| 98 | +497 |
- )+ }), |
|
| 99 | +498 | ! |
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ xref_line = .(vref_line), |
| 100 | +499 | ! |
- checkmate::assert_numeric(+ xtick_at = waiver(), |
| 101 | +500 | ! |
- plot_width[1],+ xlab = .(x_label), |
| 102 | +501 | ! |
- lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"+ title = "Swimlane Plot" |
| 103 | +502 |
- )+ ) |
|
| 104 | +503 | ++ |
+ )+ |
+
| 504 | ++ |
+ }+ |
+ |
| 505 | |||
| 105 | +506 | ! |
- args <- as.list(environment())+ q4 <- teal.code::eval_code(q3, code = plot_call)+ |
+
| 507 | +! | +
+ teal.code::eval_code(q4, quote(plot)) |
|
| 106 | +508 | ++ |
+ })+ |
+
| 509 | |||
| 107 | +510 | ! |
- module(+ plot_r <- reactive(output_q()[["plot"]])+ |
+
| 511 | ++ | + | |
| 108 | -! | +||
| 512 | +
- label = label,+ # Insert the plot into a plot_with_settings module from teal.widgets |
||
| 109 | +513 | ! |
- server = srv_g_ae_oview,+ pws <- teal.widgets::plot_with_settings_srv( |
| 110 | +514 | ! |
- server_args = list(+ id = "swimlaneplot", |
| 111 | +515 | ! |
- label = label,+ plot_r = plot_r, |
| 112 | +516 | ! |
- dataname = dataname,+ height = plot_height, |
| 113 | +517 | ! |
- plot_height = plot_height,+ width = plot_width |
| 114 | -! | +||
| 518 | +
- plot_width = plot_width+ ) |
||
| 115 | +519 |
- ),+ |
|
| 116 | +520 | ! |
- ui = ui_g_ae_oview,+ teal.widgets::verbatim_popup_srv( |
| 117 | +521 | ! |
- ui_args = args,+ id = "rcode", |
| 118 | +522 | ! |
- datanames = c("ADSL", dataname)
+ title = paste("R code for", label),
|
| 119 | -+ | ||
| 523 | +! |
- )+ verbatim_content = reactive(teal.code::get_code(output_q())) |
|
| 120 | +524 |
- }+ ) |
|
| 121 | +525 | ||
| 122 | +526 |
- ui_g_ae_oview <- function(id, ...) {
+ ### REPORTER |
|
| 123 | +527 | ! |
- ns <- NS(id)+ if (with_reporter) {
|
| 124 | +528 | ! |
- args <- list(...)+ card_fun <- function(comment, label) {
|
| 125 | +529 | ! |
- teal.widgets::standard_layout(+ card <- teal::report_card_template( |
| 126 | +530 | ! |
- output = teal.widgets::white_small_well(+ title = "Swimlane Plot", |
| 127 | +531 | ! |
- plot_decorate_output(id = ns(NULL))+ label = label, |
| 128 | -+ | ||
| 532 | +! |
- ),+ with_filter = with_filter, |
|
| 129 | +533 | ! |
- encoding = tags$div(+ filter_panel_api = filter_panel_api |
| 130 | +534 |
- ### Reporter+ ) |
|
| 131 | +535 | ! |
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ if (!is.null(input$sort_var)) {
|
| 132 | -+ | ||
| 536 | +! |
- ###+ card$append_text("Selected Options", "header3")
|
|
| 133 | +537 | ! |
- teal.widgets::optionalSelectInput(+ card$append_text(paste("Sorted by:", input$sort_var))
+ |
+
| 538 | ++ |
+ } |
|
| 134 | +539 | ! |
- ns("arm_var"),
+ card$append_text("Plot", "header3")
|
| 135 | +540 | ! |
- "Arm Variable",+ card$append_plot(plot_r(), dim = pws$dim()) |
| 136 | +541 | ! |
- choices = get_choices(args$arm_var$choices),+ if (!comment == "") {
|
| 137 | +542 | ! |
- selected = args$arm_var$selected,+ card$append_text("Comment", "header3")
|
| 138 | +543 | ! |
- multiple = FALSE+ card$append_text(comment) |
| 139 | +544 |
- ),+ } |
|
| 140 | +545 | ! |
- selectInput(+ card$append_src(teal.code::get_code(output_q())) |
| 141 | +546 | ! |
- ns("arm_ref"),
+ card |
| 142 | -! | +||
| 547 | +
- "Control",+ } |
||
| 143 | +548 | ! |
- choices = get_choices(args$arm_var$choices),+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
| 144 | -! | +||
| 549 | +
- selected = args$arm_var$selected+ } |
||
| 145 | +550 |
- ),+ }) |
|
| 146 | -! | +||
| 551 | +
- selectInput(+ } |
||
| 147 | -! | +
| 1 | +
- ns("arm_trt"),
+ #' teal module for the `AE` by subgroups |
||
| 148 | -! | +||
| 2 | +
- "Treatment",+ #' |
||
| 149 | -! | +||
| 3 | +
- choices = get_choices(args$arm_var$choices),+ #' @description |
||
| 150 | -! | +||
| 4 | +
- selected = args$arm_var$selected+ #' `r lifecycle::badge("stable")`
|
||
| 151 | +5 |
- ),+ #' |
|
| 152 | -! | +||
| 6 | +
- selectInput(+ #' Display the `AE` by subgroups plot as a teal module |
||
| 153 | -! | +||
| 7 | +
- ns("flag_var_anl"),
+ #' |
||
| 154 | -! | +||
| 8 | +
- "Flags",+ #' @inheritParams teal.widgets::standard_layout |
||
| 155 | -! | +||
| 9 | +
- choices = get_choices(args$flag_var_anl$choices),+ #' @inheritParams argument_convention |
||
| 156 | -! | +||
| 10 | +
- selected = args$flag_var_anl$selected,+ #' @param group_var (`choices_selected`) subgroups variables. See [teal.transform::choices_selected()] for details. |
||
| 157 | -! | +||
| 11 | +
- multiple = TRUE+ #' |
||
| 158 | +12 |
- ),+ #' @author Liming Li (Lil128) \email{liming.li@roche.com}
|
|
| 159 | -! | +||
| 13 | +
- teal.widgets::panel_item(+ #' @author Molly He (hey59) \email{hey59@gene.com}
|
||
| 160 | -! | +||
| 14 | +
- "Confidence interval settings",+ #' |
||
| 161 | -! | +||
| 15 | +
- teal.widgets::optionalSelectInput(+ #' @inherit argument_convention return |
||
| 162 | -! | +||
| 16 | +
- ns("diff_ci_method"),
+ #' |
||
| 163 | -! | +||
| 17 | +
- "Method for Difference of Proportions CI",+ #' @export |
||
| 164 | -! | +||
| 18 | +
- choices = ci_choices,+ #' |
||
| 165 | -! | +||
| 19 | +
- selected = ci_choices[1],+ #' @examples |
||
| 166 | -! | +||
| 20 | +
- multiple = FALSE+ #' # Example using stream (ADaM) dataset |
||
| 167 | +21 |
- ),+ #' data <- teal_data() |> |
|
| 168 | -! | +||
| 22 | +
- teal.widgets::optionalSliderInput(+ #' within({
|
||
| 169 | -! | +||
| 23 | +
- ns("conf_level"),
+ #' ADSL <- rADSL |
||
| 170 | -! | +||
| 24 | +
- "Confidence Level",+ #' ADAE <- rADAE |
||
| 171 | -! | +||
| 25 | +
- min = 0.5,+ #' }) |
||
| 172 | -! | +||
| 26 | +
- max = 1,+ #' |
||
| 173 | -! | +||
| 27 | +
- value = 0.95+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
||
| 174 | +28 |
- )+ #' |
|
| 175 | +29 |
- ),+ #' app <- init( |
|
| 176 | -! | +||
| 30 | +
- teal.widgets::optionalSelectInput(+ #' data = data, |
||
| 177 | -! | +||
| 31 | +
- ns("axis"),
+ #' modules = modules( |
||
| 178 | -! | +||
| 32 | +
- "Axis Side",+ #' tm_g_ae_sub( |
||
| 179 | -! | +||
| 33 | +
- choices = c("Left" = "left", "Right" = "right"),
+ #' label = "AE by Subgroup", |
||
| 180 | -! | +||
| 34 | +
- selected = "left",+ #' dataname = "ADAE", |
||
| 181 | -! | +||
| 35 | +
- multiple = FALSE+ #' arm_var = choices_selected( |
||
| 182 | +36 |
- ),+ #' selected = "ACTARMCD", |
|
| 183 | -! | +||
| 37 | +
- ui_g_decorate(+ #' choices = c("ACTARM", "ACTARMCD")
|
||
| 184 | -! | +||
| 38 | +
- ns(NULL),+ #' ), |
||
| 185 | -! | +||
| 39 | +
- fontsize = args$fontsize,+ #' group_var = choices_selected( |
||
| 186 | -! | +||
| 40 | +
- titles = "AE Overview",+ #' selected = c("SEX", "REGION1", "RACE"),
|
||
| 187 | -! | +||
| 41 | +
- footnotes = ""+ #' choices = c("SEX", "REGION1", "RACE")
|
||
| 188 | +42 |
- )+ #' ), |
|
| 189 | +43 |
- ),+ #' plot_height = c(600, 200, 2000) |
|
| 190 | -! | +||
| 44 | +
- forms = tagList(+ #' ) |
||
| 191 | -! | +||
| 45 | +
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ #' ) |
||
| 192 | +46 |
- )+ #' ) |
|
| 193 | +47 |
- )+ #' if (interactive()) {
|
|
| 194 | +48 |
- }+ #' shinyApp(app$ui, app$server) |
|
| 195 | +49 |
-
+ #' } |
|
| 196 | +50 |
- srv_g_ae_oview <- function(id,+ #' |
|
| 197 | +51 |
- data,+ tm_g_ae_sub <- function(label, |
|
| 198 | +52 |
- filter_panel_api,+ dataname, |
|
| 199 | +53 |
- reporter,+ arm_var, |
|
| 200 | +54 |
- dataname,+ group_var, |
|
| 201 | +55 |
- label,+ plot_height = c(600L, 200L, 2000L), |
|
| 202 | +56 |
- plot_height,+ plot_width = NULL, |
|
| 203 | +57 |
- plot_width) {
+ fontsize = c(5, 3, 7)) {
|
|
| 204 | +58 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ message("Initializing tm_g_ae_sub")
|
| 205 | +59 | ! |
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ checkmate::assert_class(arm_var, classes = "choices_selected") |
| 206 | +60 | ! |
- checkmate::assert_class(data, "reactive")+ checkmate::assert_class(group_var, classes = "choices_selected") |
| 207 | +61 | ! |
- checkmate::assert_class(isolate(data()), "teal_data")+ checkmate::assert( |
| 208 | -+ | ||
| 62 | +! |
-
+ checkmate::check_number(fontsize, finite = TRUE), |
|
| 209 | +63 | ! |
- moduleServer(id, function(input, output, session) {
+ checkmate::assert( |
| 210 | +64 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ combine = "and", |
| 211 | +65 | ! |
- iv <- reactive({
+ .var.name = "fontsize", |
| 212 | +66 | ! |
- ANL <- data()[[dataname]]+ checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE),+ |
+
| 67 | +! | +
+ checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
|
| 213 | +68 |
-
+ )+ |
+ |
| 69 | ++ |
+ ) |
|
| 214 | +70 | ! |
- iv <- shinyvalidate::InputValidator$new()+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 215 | +71 | ! |
- iv$add_rule("arm_var", shinyvalidate::sv_required(
+ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 216 | +72 | ! |
- message = "Arm Variable is required"+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 217 | -+ | ||
| 73 | +! |
- ))+ checkmate::assert_numeric( |
|
| 218 | +74 | ! |
- iv$add_rule("arm_var", ~ if (!is.factor(ANL[[.]])) {
+ plot_width[1], |
| 219 | +75 | ! |
- "Arm Var must be a factor variable"+ lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" |
| 220 | +76 |
- })+ )+ |
+ |
| 77 | ++ | + | |
| 221 | +78 | ! |
- iv$add_rule("arm_var", ~ if (nlevels(ANL[[.]]) < 2L) {
+ module( |
| 222 | +79 | ! |
- "Selected Arm Var must have at least two levels"+ label = label, |
| 223 | -+ | ||
| 80 | +! |
- })+ server = srv_g_ae_sub, |
|
| 224 | +81 | ! |
- iv$add_rule("flag_var_anl", shinyvalidate::sv_required(
+ server_args = list( |
| 225 | +82 | ! |
- message = "At least one Flag is required"+ label = label, |
| 226 | -+ | ||
| 83 | +! |
- ))+ dataname = dataname, |
|
| 227 | +84 | ! |
- rule_diff <- function(value, other) {
+ plot_height = plot_height, |
| 228 | +85 | ! |
- if (isTRUE(value == other)) "Control and Treatment must be different"+ plot_width = plot_width |
| 229 | +86 |
- }+ ), |
|
| 230 | +87 | ! |
- iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
+ ui = ui_g_ae_sub, |
| 231 | +88 | ! |
- iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
+ ui_args = list( |
| 232 | +89 | ! |
- iv$enable()+ arm_var = arm_var, |
| 233 | +90 | ! |
- iv+ group_var = group_var,+ |
+
| 91 | +! | +
+ fontsize = fontsize |
|
| 234 | +92 |
- })+ ),+ |
+ |
| 93 | +! | +
+ datanames = c("ADSL", dataname)
|
|
| 235 | +94 | ++ |
+ )+ |
+
| 95 | ++ |
+ }+ |
+ |
| 96 | |||
| 97 | ++ |
+ ui_g_ae_sub <- function(id, ...) {
+ |
+ |
| 236 | +98 | ! |
- decorate_output <- srv_g_decorate(+ ns <- NS(id) |
| 237 | +99 | ! |
- id = NULL, plt = plot_r,+ args <- list(...) |
| 238 | +100 | ! |
- plot_height = plot_height, plot_width = plot_width+ teal.widgets::standard_layout( |
| 239 | -+ | ||
| 101 | +! |
- )+ output = teal.widgets::white_small_well( |
|
| 240 | +102 | ! |
- font_size <- decorate_output$font_size+ plot_decorate_output(id = ns(NULL))+ |
+
| 103 | ++ |
+ ), |
|
| 241 | +104 | ! |
- pws <- decorate_output$pws+ encoding = tags$div( |
| 242 | +105 |
-
+ ### Reporter |
|
| 243 | +106 | ! |
- observeEvent(list(input$diff_ci_method, input$conf_level), {
+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ |
+
| 107 | ++ |
+ ### |
|
| 244 | +108 | ! |
- req(!is.null(input$diff_ci_method) && !is.null(input$conf_level))+ tags$label("Encodings", class = "text-primary"),
|
| 245 | +109 | ! |
- diff_ci_method <- input$diff_ci_method+ helpText("Analysis data:", tags$code("ADAE")),
|
| 246 | +110 | ! |
- conf_level <- input$conf_level+ teal.widgets::optionalSelectInput( |
| 247 | +111 | ! |
- updateTextAreaInput(session,+ ns("arm_var"),
|
| 248 | +112 | ! |
- "foot",+ "Arm Variable", |
| 249 | +113 | ! |
- value = sprintf(+ choices = get_choices(args$arm_var$choices), |
| 250 | +114 | ! |
- "Note: %d%% CI is calculated using %s",+ selected = args$arm_var$selected+ |
+
| 115 | ++ |
+ ), |
|
| 251 | +116 | ! |
- round(conf_level * 100),+ selectInput( |
| 252 | +117 | ! |
- name_ci(diff_ci_method)+ ns("arm_trt"),
|
| 253 | -+ | ||
| 118 | +! |
- )+ "Treatment", |
|
| 254 | -+ | ||
| 119 | +! |
- )+ choices = get_choices(args$arm_var$choices), |
|
| 255 | -+ | ||
| 120 | +! |
- })+ selected = args$arm_var$selected |
|
| 256 | +121 |
-
+ ), |
|
| 257 | +122 | ! |
- observeEvent(input$arm_var, ignoreNULL = TRUE, {
+ selectInput( |
| 258 | +123 | ! |
- ANL <- data()[[dataname]]+ ns("arm_ref"),
|
| 259 | +124 | ! |
- arm_var <- input$arm_var+ "Control", |
| 260 | +125 | ! |
- arm_val <- ANL[[arm_var]]+ choices = get_choices(args$arm_var$choices), |
| 261 | +126 | ! |
- choices <- levels(arm_val)+ selected = args$arm_var$selected |
| 262 | +127 |
-
+ ), |
|
| 263 | +128 | ! |
- if (length(choices) == 1) {
+ checkboxInput( |
| 264 | +129 | ! |
- trt_index <- 1+ ns("arm_n"),
|
| 265 | -+ | ||
| 130 | +! |
- } else {
+ "Show N in each arm", |
|
| 266 | +131 | ! |
- trt_index <- 2+ value = args$arm_n |
| 267 | +132 |
- }+ ), |
|
| 268 | -+ | ||
| 133 | +! |
-
+ teal.widgets::optionalSelectInput( |
|
| 269 | +134 | ! |
- updateSelectInput(+ ns("groups"),
|
| 270 | +135 | ! |
- session,+ "Group Variable", |
| 271 | +136 | ! |
- "arm_ref",+ choices = get_choices(args$group_var$choices), |
| 272 | +137 | ! |
- selected = choices[1],+ selected = args$group_var$selected, |
| 273 | +138 | ! |
- choices = choices+ multiple = TRUE |
| 274 | +139 |
- )+ ), |
|
| 275 | +140 | ! |
- updateSelectInput(+ teal.widgets::panel_item( |
| 276 | +141 | ! |
- session,+ "Change group labels", |
| 277 | +142 | ! |
- "arm_trt",+ uiOutput(ns("grouplabel_output"))
+ |
+
| 143 | ++ |
+ ), |
|
| 278 | +144 | ! |
- selected = choices[trt_index],+ teal.widgets::panel_item( |
| 279 | +145 | +! | +
+ "Additional plot settings",+ |
+
| 146 | +! | +
+ teal.widgets::optionalSelectInput(+ |
+ |
| 147 | +! | +
+ ns("ci"),
+ |
+ |
| 148 | ! |
- choices = choices+ "CI method", |
|
| 280 | -+ | ||
| 149 | +! |
- )+ choices = ci_choices, |
|
| 281 | -+ | ||
| 150 | +! |
- })+ selected = ci_choices[1] |
|
| 282 | +151 |
-
+ ), |
|
| 283 | +152 | ! |
- output_q <- shiny::debounce(+ teal.widgets::optionalSliderInput( |
| 284 | +153 | ! |
- millis = 200,+ ns("conf_level"),
|
| 285 | +154 | ! |
- r = reactive({
+ "Significant Level", |
| 286 | +155 | ! |
- ANL <- data()[[dataname]]+ min = 0.5, |
| 287 | -+ | ||
| 156 | +! |
-
+ max = 1, |
|
| 288 | +157 | ! |
- teal::validate_has_data(ANL, min_nrow = 10, msg = sprintf("%s has not enough data", dataname))
+ value = 0.95 |
| 289 | +158 |
-
+ ), |
|
| 290 | +159 | ! |
- teal::validate_inputs(iv())+ ui_g_decorate( |
| 291 | -+ | ||
| 160 | +! |
-
+ ns(NULL), |
|
| 292 | +161 | ! |
- validate(need(+ fontsize = args$fontsize, |
| 293 | +162 | ! |
- input$arm_trt %in% ANL[[input$arm_var]] && input$arm_ref %in% ANL[[input$arm_var]],+ titles = "AE Table with Subgroups", |
| 294 | +163 | ! |
- "Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?"+ footnotes = "" |
| 295 | +164 |
- ))+ ) |
|
| 296 | +165 |
-
+ ) |
|
| 297 | -! | +||
| 166 | +
- q1 <- teal.code::eval_code(+ ), |
||
| 298 | +167 | ! |
- data(),+ forms = tagList( |
| 299 | +168 | ! |
- code = as.expression(c(+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
| 300 | -! | +||
| 169 | +
- bquote(anl_labels <- formatters::var_labels(.(as.name(dataname)), fill = FALSE)),+ ) |
||
| 301 | -! | +||
| 170 | +
- bquote(+ ) |
||
| 302 | -! | +||
| 171 | +
- flags <- .(as.name(dataname)) %>%+ } |
||
| 303 | -! | +||
| 172 | +
- select(all_of(.(input$flag_var_anl))) %>%+ |
||
| 304 | -! | +||
| 173 | +
- rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x]))+ srv_g_ae_sub <- function(id, |
||
| 305 | +174 |
- )+ data, |
|
| 306 | +175 |
- ))+ filter_panel_api, |
|
| 307 | +176 |
- )+ reporter, |
|
| 308 | +177 |
-
+ dataname, |
|
| 309 | -! | +||
| 178 | +
- teal.code::eval_code(+ label, |
||
| 310 | -! | +||
| 179 | +
- q1,+ plot_height, |
||
| 311 | -! | +||
| 180 | +
- code = as.expression(c(+ plot_width) {
|
||
| 312 | +181 | ! |
- bquote(+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
| 313 | +182 | ! |
- plot <- osprey::g_events_term_id(+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
| 314 | +183 | ! |
- term = flags,+ checkmate::assert_class(data, "reactive") |
| 315 | +184 | ! |
- id = .(as.name(dataname))[["USUBJID"]],+ checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 316 | -! | +||
| 185 | +
- arm = .(as.name(dataname))[[.(input$arm_var)]],+ |
||
| 317 | +186 | ! |
- arm_N = table(ADSL[[.(input$arm_var)]]),+ moduleServer(id, function(input, output, session) {
|
| 318 | +187 | ! |
- ref = .(input$arm_ref),+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 319 | +188 | ! |
- trt = .(input$arm_trt),+ iv <- reactive({
|
| 320 | +189 | ! |
- diff_ci_method = .(input$diff_ci_method),+ ANL <- data()[[dataname]] |
| 321 | +190 | ! |
- conf_level = .(input$conf_level),+ ADSL <- data()[["ADSL"]] |
| 322 | -! | +||
| 191 | +
- axis_side = .(input$axis),+ |
||
| 323 | +192 | ! |
- fontsize = .(font_size()),+ iv <- shinyvalidate::InputValidator$new() |
| 324 | +193 | ! |
- draw = TRUE+ iv$add_rule("arm_var", shinyvalidate::sv_required(
|
| 325 | -+ | ||
| 194 | +! |
- )+ message = "Arm Variable is required" |
|
| 326 | +195 |
- ),+ )) |
|
| 327 | +196 | ! |
- quote(plot)- |
-
| 328 | -- |
- ))+ iv$add_rule("arm_var", ~ if (!is.factor(ANL[[.]])) {
|
|
| 329 | -+ | ||
| 197 | +! |
- )+ "Arm Var must be a factor variable, contact developer" |
|
| 330 | +198 |
}) |
|
| 331 | -- |
- )- |
- |
| 332 | -+ | ||
| 199 | +! |
-
+ rule_diff <- function(value, other) {
|
|
| 333 | +200 | ! |
- plot_r <- reactive(output_q()[["plot"]])+ if (isTRUE(value == other)) "Control and Treatment must be different" |
| 334 | +201 |
-
+ } |
|
| 335 | +202 | ! |
- teal.widgets::verbatim_popup_srv(+ iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
|
| 336 | +203 | ! |
- id = "rcode",+ iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
|
| 337 | +204 | ! |
- verbatim_content = reactive(teal.code::get_code(output_q())),+ iv$add_rule("groups", shinyvalidate::sv_in_set(
|
| 338 | +205 | ! |
- title = paste("R code for", label)
+ names(ANL), |
| 339 | -+ | ||
| 206 | +! |
- )+ message_fmt = sprintf("Groups must be a variable in %s", dataname)
|
|
| 340 | +207 |
- ### REPORTER+ )) |
|
| 341 | +208 | ! |
- if (with_reporter) {
+ iv$add_rule("groups", shinyvalidate::sv_in_set(
|
| 342 | +209 | ! |
- card_fun <- function(comment, label) {
+ names(ADSL), |
| 343 | +210 | ! |
- card <- teal::report_card_template(+ message_fmt = "Groups must be a variable in ADSL" |
| 344 | -! | +||
| 211 | +
- title = "AE Overview",+ )) |
||
| 345 | +212 | ! |
- label = label,+ iv$enable() |
| 346 | +213 | ! |
- with_filter = with_filter,+ iv |
| 347 | -! | +||
| 214 | +
- filter_panel_api = filter_panel_api+ }) |
||
| 348 | +215 |
- )+ |
|
| 349 | +216 | ! |
- card$append_text("Plot", "header3")
+ decorate_output <- srv_g_decorate( |
| 350 | +217 | ! |
- card$append_plot(plot_r(), dim = pws$dim())+ id = NULL, |
| 351 | +218 | ! |
- if (!comment == "") {
+ plt = plot_r, |
| 352 | +219 | ! |
- card$append_text("Comment", "header3")
+ plot_height = plot_height, |
| 353 | +220 | ! |
- card$append_text(comment)+ plot_width = plot_width |
| 354 | +221 |
- }+ ) |
|
| 355 | +222 | ! |
- card$append_src(teal.code::get_code(output_q()))+ font_size <- decorate_output$font_size |
| 356 | +223 | ! |
- card+ pws <- decorate_output$pws |
| 357 | +224 |
- }+ |
|
| 358 | +225 | ! |
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
- |
-
| 359 | -- |
- }- |
- |
| 360 | -- |
- })- |
- |
| 361 | -- |
- }- |
-
| 1 | -- |
- #' Butterfly plot Teal Module- |
- |
| 2 | -- |
- #'+ observeEvent(input$arm_var, ignoreNULL = TRUE, {
|
|
| 3 | -+ | ||
| 226 | +! |
- #' @description+ arm_var <- input$arm_var |
|
| 4 | -+ | ||
| 227 | +! |
- #' `r lifecycle::badge("stable")`
+ ANL <- data()[[dataname]] |
|
| 5 | +228 |
- #'+ |
|
| 6 | -+ | ||
| 229 | +! |
- #' Display butterfly plot as a shiny module+ anl_val <- ANL[[arm_var]] |
|
| 7 | -+ | ||
| 230 | +! |
- #'+ choices <- levels(anl_val) |
|
| 8 | +231 |
- #' @inheritParams teal.widgets::standard_layout+ |
|
| 9 | -+ | ||
| 232 | +! |
- #' @inheritParams argument_convention+ if (length(choices) == 1) {
|
|
| 10 | -+ | ||
| 233 | +! |
- #' @param filter_var (`choices_selected`) variable name of data filter, please see details regarding+ ref_index <- 1 |
|
| 11 | +234 |
- #' expected values, default is`NULL`.`choices`+ } else {
|
- |
| 12 | -+ | ||
| 235 | +! |
- #' vector with `filter_var` choices, default is+ ref_index <- 2 |
|
| 13 | +236 |
- #' `NULL`+ } |
|
| 14 | +237 |
- #' @param right_var (`choices_selected`) dichotomization variable for right side+ |
|
| 15 | -+ | ||
| 238 | +! |
- #' @param left_var (`choices_selected`) dichotomization variable for left side+ updateSelectInput( |
|
| 16 | -+ | ||
| 239 | +! |
- #' @param category_var (`choices_selected`) category (y axis) variable+ session, |
|
| 17 | -+ | ||
| 240 | +! |
- #' @param color_by_var (`choices_selected`) variable defines color blocks within each bar+ "arm_trt", |
|
| 18 | -+ | ||
| 241 | +! |
- #' @param count_by_var (`choices_selected`) variable defines how x axis is calculated+ selected = choices[1], |
|
| 19 | -+ | ||
| 242 | +! |
- #' @param facet_var (`choices_selected`) variable for row facets+ choices = choices |
|
| 20 | +243 |
- #' @param sort_by_var (`choices_selected`) argument for order of class and term elements in table,+ ) |
|
| 21 | -+ | ||
| 244 | +! |
- #' default here is "count"+ updateSelectInput( |
|
| 22 | -+ | ||
| 245 | +! |
- #' @param legend_on (`boolean`) value for whether legend is displayed+ session, |
|
| 23 | -+ | ||
| 246 | +! |
- #'+ "arm_ref", |
|
| 24 | -+ | ||
| 247 | +! |
- #' @details `filter_var` option is designed to work in conjunction with+ selected = choices[ref_index], |
|
| 25 | -+ | ||
| 248 | +! |
- #' filtering function provided by `teal` (encoding panel on the right+ choices = choices |
|
| 26 | +249 |
- #' hand side of the shiny app). It can be used as quick access to predefined+ ) |
|
| 27 | +250 |
- #' subsets of the domain datasets (not subject-level dataset) to be used for+ }) |
|
| 28 | +251 |
- #' analysis, denoted by an value of "Y". Each variable within the+ |
|
| 29 | -+ | ||
| 252 | +! |
- #' `filter_var_choices` is expected to contain values of either "Y" or+ observeEvent(list(input$ci, input$conf_level, input$arm_trt, input$arm_ref), {
|
|
| 30 | -+ | ||
| 253 | +! |
- #' "N". If multiple variables are selected as `filter_var`, only+ diff_ci_method <- input$ci |
|
| 31 | -+ | ||
| 254 | +! |
- #' observations with "Y" value in each and every selected variables will be+ conf_level <- input$conf_level |
|
| 32 | -+ | ||
| 255 | +! |
- #' used for subsequent analysis. Flag variables (from `ADaM` datasets) can be+ trt <- input$arm_trt |
|
| 33 | -+ | ||
| 256 | +! |
- #' used directly as filter.+ ref <- input$arm_ref |
|
| 34 | -+ | ||
| 257 | +! |
- #'+ updateTextAreaInput( |
|
| 35 | -+ | ||
| 258 | +! |
- #' @inherit argument_convention return+ session, |
|
| 36 | -+ | ||
| 259 | +! |
- #'+ "foot", |
|
| 37 | -+ | ||
| 260 | +! |
- #' @export+ value = sprintf( |
|
| 38 | -+ | ||
| 261 | +! |
- #'+ "Note: %d%% CI is calculated using %s\nTRT: %s; CONT: %s", |
|
| 39 | -+ | ||
| 262 | +! |
- #' @template author_zhanc107+ round(conf_level * 100), |
|
| 40 | -+ | ||
| 263 | +! |
- #' @template author_liaoc10+ name_ci(diff_ci_method), |
|
| 41 | -+ | ||
| 264 | +! |
- #'+ trt, |
|
| 42 | -+ | ||
| 265 | +! |
- #' @examples+ ref |
|
| 43 | +266 |
- #' # Example using stream (ADaM) dataset+ ) |
|
| 44 | +267 |
- #' data <- teal_data() |>+ ) |
|
| 45 | +268 |
- #' within({
+ }) |
|
| 46 | +269 |
- #' library(dplyr)+ |
|
| 47 | -+ | ||
| 270 | +! |
- #' set.seed(23)+ observeEvent(input$groups, {
|
|
| 48 | -+ | ||
| 271 | +! |
- #' ADSL <- rADSL+ ANL <- data()[[dataname]] |
|
| 49 | -+ | ||
| 272 | +! |
- #' ADAE <- rADAE+ output$grouplabel_output <- renderUI({
|
|
| 50 | -+ | ||
| 273 | +! |
- #' ADSL <- mutate(ADSL, DOSE = paste(sample(1:3, n(), replace = TRUE), "UG"))+ grps <- input$groups |
|
| 51 | -+ | ||
| 274 | +! |
- #' ADAE <- mutate(+ lo <- lapply(seq_along(grps), function(index) {
|
|
| 52 | -+ | ||
| 275 | +! |
- #' ADAE,+ grp <- grps[index] |
|
| 53 | -+ | ||
| 276 | +! |
- #' flag1 = ifelse(AETOXGR == 1, 1, 0),+ choices <- levels(ANL[[grp]]) |
|
| 54 | -+ | ||
| 277 | +! |
- #' flag2 = ifelse(AETOXGR == 2, 1, 0),+ sel <- teal.widgets::optionalSelectInput( |
|
| 55 | -+ | ||
| 278 | +! |
- #' flag3 = ifelse(AETOXGR == 3, 1, 0),+ session$ns(sprintf("groups__%s", index)),
|
|
| 56 | -+ | ||
| 279 | +! |
- #' flag1_filt = rep("Y", n())
+ grp, |
|
| 57 | -+ | ||
| 280 | +! |
- #' )+ choices, |
|
| 58 | -+ | ||
| 281 | +! |
- #' })+ multiple = TRUE, |
|
| 59 | -+ | ||
| 282 | +! |
- #'+ selected = choices |
|
| 60 | +283 |
- #' datanames(data) <- c("ADSL", "ADAE")
+ ) |
|
| 61 | -+ | ||
| 284 | +! |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ textname <- sprintf("text_%s_out", index)
|
|
| 62 | -+ | ||
| 285 | +! |
- #'+ txt <- uiOutput(session$ns(textname)) |
|
| 63 | -+ | ||
| 286 | +! |
- #' app <- init(+ observeEvent( |
|
| 64 | -+ | ||
| 287 | +! |
- #' data = data,+ eventExpr = input[[sprintf("groups__%s", index)]],
|
|
| 65 | -+ | ||
| 288 | +! |
- #' modules = modules(+ handlerExpr = {
|
|
| 66 | -+ | ||
| 289 | +! |
- #' tm_g_butterfly(+ output[[textname]] <- renderUI({
|
|
| 67 | -+ | ||
| 290 | +! |
- #' label = "Butterfly Plot",+ if (!is.null(input[[sprintf("groups__%s", index)]])) {
|
|
| 68 | -+ | ||
| 291 | +! |
- #' dataname = "ADAE",+ l <- input[[sprintf("groups__%s", index)]]
|
|
| 69 | -+ | ||
| 292 | +! |
- #' right_var = choices_selected(+ l2 <- lapply(seq_along(l), function(i) {
|
|
| 70 | -+ | ||
| 293 | +! |
- #' selected = "SEX",+ nm <- sprintf("groups__%s__level__%s", index, i)
|
|
| 71 | -+ | ||
| 294 | +! |
- #' choices = c("SEX", "ARM", "RACE")
+ label <- sprintf("Label for %s, Level %s", grp, l[i])
|
|
| 72 | -+ | ||
| 295 | +! |
- #' ),+ textInput(session$ns(nm), label, l[i]) |
|
| 73 | +296 |
- #' left_var = choices_selected(+ }) |
|
| 74 | -+ | ||
| 297 | +! |
- #' selected = "RACE",+ tagList(textInput( |
|
| 75 | -+ | ||
| 298 | +! |
- #' choices = c("SEX", "ARM", "RACE")
+ session$ns( |
|
| 76 | -+ | ||
| 299 | +! |
- #' ),+ sprintf("groups__%s__level__%s", index, "all")
|
|
| 77 | +300 |
- #' category_var = choices_selected(+ ), |
|
| 78 | -+ | ||
| 301 | +! |
- #' selected = "AEBODSYS",+ sprintf("Label for %s", grp), grp
|
|
| 79 | -+ | ||
| 302 | +! |
- #' choices = c("AEDECOD", "AEBODSYS")
+ ), l2) |
|
| 80 | +303 |
- #' ),+ } |
|
| 81 | +304 |
- #' color_by_var = choices_selected(+ }) |
|
| 82 | +305 |
- #' selected = "AETOXGR",+ } |
|
| 83 | +306 |
- #' choices = c("AETOXGR", "None")
+ ) |
|
| 84 | -+ | ||
| 307 | +! |
- #' ),+ tagList(sel, txt) |
|
| 85 | +308 |
- #' count_by_var = choices_selected(+ }) |
|
| 86 | -+ | ||
| 309 | +! |
- #' selected = "# of patients",+ ret <- tagList(lo) |
|
| 87 | -+ | ||
| 310 | +! |
- #' choices = c("# of patients", "# of AEs")
+ ret |
|
| 88 | +311 |
- #' ),+ }) |
|
| 89 | +312 |
- #' facet_var = choices_selected(+ }) |
|
| 90 | +313 |
- #' selected = NULL,+ |
|
| 91 | -+ | ||
| 314 | +! |
- #' choices = c("RACE", "SEX", "ARM")
+ output_q <- shiny::debounce( |
|
| 92 | -+ | ||
| 315 | +! |
- #' ),+ millis = 200, |
|
| 93 | -+ | ||
| 316 | +! |
- #' sort_by_var = choices_selected(+ r = reactive({
|
|
| 94 | -+ | ||
| 317 | +! |
- #' selected = "count",+ ANL <- data()[[dataname]] |
|
| 95 | -+ | ||
| 318 | +! |
- #' choices = c("count", "alphabetical")
+ ADSL <- data()[["ADSL"]] |
|
| 96 | +319 |
- #' ),+ |
|
| 97 | -+ | ||
| 320 | +! |
- #' legend_on = TRUE,+ teal::validate_has_data(ANL, min_nrow = 10, msg = sprintf("%s has not enough data", dataname))
|
|
| 98 | +321 |
- #' plot_height = c(600, 200, 2000)+ |
|
| 99 | -+ | ||
| 322 | +! |
- #' )+ teal::validate_inputs(iv()) |
|
| 100 | +323 |
- #' )+ |
|
| 101 | -+ | ||
| 324 | +! |
- #' )+ validate(need( |
|
| 102 | -+ | ||
| 325 | +! |
- #' if (interactive()) {
+ input$arm_trt %in% ANL[[input$arm_var]] && input$arm_ref %in% ANL[[input$arm_var]], |
|
| 103 | -+ | ||
| 326 | +! |
- #' shinyApp(app$ui, app$server)+ "Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?" |
|
| 104 | +327 |
- #' }+ )) |
|
| 105 | +328 |
- #'+ |
|
| 106 | -+ | ||
| 329 | +! |
- tm_g_butterfly <- function(label,+ group_labels <- lapply(seq_along(input$groups), function(x) {
|
|
| 107 | -+ | ||
| 330 | +! |
- dataname,+ items <- input[[sprintf("groups__%s", x)]]
|
|
| 108 | -+ | ||
| 331 | +! |
- filter_var = NULL,+ if (length(items) > 0) {
|
|
| 109 | -+ | ||
| 332 | +! |
- right_var,+ l <- lapply(seq_along(items), function(y) {
|
|
| 110 | -+ | ||
| 333 | +! |
- left_var,+ input[[sprintf("groups__%s__level__%s", x, y)]]
|
|
| 111 | +334 |
- category_var,+ }) |
|
| 112 | -+ | ||
| 335 | +! |
- color_by_var,+ names(l) <- items |
|
| 113 | -+ | ||
| 336 | +! |
- count_by_var,+ l[["Total"]] <- input[[sprintf("groups__%s__level__%s", x, "all")]]
|
|
| 114 | -+ | ||
| 337 | +! |
- facet_var = NULL,+ l |
|
| 115 | +338 |
- sort_by_var = teal.transform::choices_selected(+ } |
|
| 116 | +339 |
- selected = "count", choices = c("count", "alphabetical")
+ }) |
|
| 117 | +340 |
- ),+ |
|
| 118 | -+ | ||
| 341 | +! |
- legend_on = TRUE,+ group_labels_call <- if (length(unlist(group_labels)) == 0) {
|
|
| 119 | -+ | ||
| 342 | +! |
- plot_height = c(600L, 200L, 2000L),+ quote(group_labels <- NULL) |
|
| 120 | +343 |
- plot_width = NULL,+ } else {
+ |
+ |
| 344 | +! | +
+ bquote(group_labels <- setNames(.(group_labels), .(input$groups))) |
|
| 121 | +345 |
- pre_output = NULL,+ } |
|
| 122 | +346 |
- post_output = NULL) {
+
|
|
| 123 | +347 | ! |
- message("Initializing tm_g_butterfly")
+ teal.code::eval_code(data(), code = group_labels_call) %>% |
| 124 | +348 | ! |
- checkmate::assert_string(label)+ teal.code::eval_code(code = "") %>% |
| 125 | +349 | ! |
- checkmate::assert_string(dataname)+ teal.code::eval_code( |
| 126 | +350 | ! |
- checkmate::assert_class(filter_var, classes = "choices_selected", null.ok = TRUE)+ code = as.expression(c( |
| 127 | +351 | ! |
- checkmate::assert_class(right_var, classes = "choices_selected")+ bquote( |
| 128 | +352 | ! |
- checkmate::assert_class(left_var, classes = "choices_selected")+ plot <- osprey::g_ae_sub( |
| 129 | +353 | ! |
- checkmate::assert_class(category_var, classes = "choices_selected")+ id = .(as.name(dataname))$USUBJID, |
| 130 | +354 | ! |
- checkmate::assert_class(color_by_var, classes = "choices_selected")+ arm = as.factor(.(as.name(dataname))[[.(input$arm_var)]]), |
| 131 | +355 | ! |
- checkmate::assert_class(count_by_var, classes = "choices_selected")+ arm_sl = as.character(ADSL[[.(input$arm_var)]]), |
| 132 | +356 | ! |
- checkmate::assert_class(facet_var, classes = "choices_selected", null.ok = TRUE)+ trt = .(input$arm_trt), |
| 133 | +357 | ! |
- checkmate::assert_class(sort_by_var, classes = "choices_selected")+ ref = .(input$arm_ref), |
| 134 | +358 | ! |
- checkmate::assert_flag(legend_on)+ subgroups = .(as.name(dataname))[.(input$groups)], |
| 135 | +359 | ! |
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ subgroups_sl = ADSL[.(input$groups)], |
| 136 | +360 | ! |
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ subgroups_levels = group_labels, |
| 137 | +361 | ! |
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ conf_level = .(input$conf_level), |
| 138 | +362 | ! |
- checkmate::assert_numeric(+ diff_ci_method = .(input$ci), |
| 139 | +363 | ! |
- plot_width[1],+ fontsize = .(font_size()), |
| 140 | +364 | ! |
- lower = plot_width[2],+ arm_n = .(input$arm_n), |
| 141 | +365 | ! |
- upper = plot_width[3],+ draw = TRUE |
| 142 | -! | +||
| 366 | +
- null.ok = TRUE,+ )+ |
+ ||
| 367 | ++ |
+ ), |
|
| 143 | +368 | ! |
- .var.name = "plot_width"+ quote(plot) |
| 144 | +369 |
- )+ )) |
|
| 145 | +370 |
-
+ ) |
|
| 146 | -! | +||
| 371 | +
- args <- as.list(environment())+ }) |
||
| 147 | +372 |
-
+ ) |
|
| 148 | -! | +||
| 373 | +
- module(+ |
||
| 149 | +374 | ! |
- label = label,+ plot_r <- reactive(output_q()[["plot"]]) |
| 150 | -! | +||
| 375 | +
- datanames = c("ADSL", dataname),
+
|
||
| 151 | +376 | ! |
- server = srv_g_butterfly,+ teal.widgets::verbatim_popup_srv( |
| 152 | +377 | ! |
- server_args = list(dataname = dataname, label = label, plot_height = plot_height, plot_width = plot_width),+ id = "rcode", |
| 153 | +378 | ! |
- ui = ui_g_butterfly,+ verbatim_content = reactive(teal.code::get_code(output_q())), |
| 154 | +379 | ! |
- ui_args = args- |
-
| 155 | -- |
- )+ title = paste("R code for", label),
|
|
| 156 | +380 |
- }+ ) |
|
| 157 | +381 | ||
| 158 | +382 |
- ui_g_butterfly <- function(id, ...) {
+ ### REPORTER |
|
| 159 | +383 | ! |
- ns <- NS(id)+ if (with_reporter) {
|
| 160 | +384 | ! |
- a <- list(...)- |
-
| 161 | -- |
-
+ card_fun <- function(comment, label) {
|
|
| 162 | +385 | ! |
- teal.widgets::standard_layout(+ card <- teal::report_card_template( |
| 163 | +386 | ! |
- output = teal.widgets::white_small_well(+ title = "AE Subgroups", |
| 164 | +387 | ! |
- teal.widgets::plot_with_settings_ui(id = ns("butterflyplot"))
- |
-
| 165 | -- |
- ),+ label = label, |
|
| 166 | +388 | ! |
- encoding = tags$div(- |
-
| 167 | -- |
- ### Reporter+ with_filter = with_filter, |
|
| 168 | +389 | ! |
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ filter_panel_api = filter_panel_api |
| 169 | +390 |
- ###- |
- |
| 170 | -! | -
- tags$label("Encodings", class = "text-primary"),
- |
- |
| 171 | -! | -
- helpText("Dataset is:", tags$code(a$dataname)),
+ ) |
|
| 172 | +391 | ! |
- if (!is.null(a$filter_var)) {
+ card$append_text("Plot", "header3")
|
| 173 | +392 | ! |
- teal.widgets::optionalSelectInput(+ card$append_plot(plot_r(), dim = pws$dim()) |
| 174 | +393 | ! |
- ns("filter_var"),
+ if (!comment == "") {
|
| 175 | +394 | ! |
- label =+ card$append_text("Comment", "header3")
|
| 176 | +395 | ! |
- "Preset Data Filters Observations with value of 'Y' for selected variable(s) will be used for analysis",+ card$append_text(comment) |
| 177 | -! | +||
| 396 | +
- choices = get_choices(a$filter_var$choices),+ } |
||
| 178 | +397 | ! |
- selected = a$filter_var$selected,+ card$append_src(teal.code::get_code(output_q())) |
| 179 | +398 | ! |
- multiple = TRUE+ card |
| 180 | +399 |
- )+ } |
|
| 181 | -+ | ||
| 400 | +! |
- },+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
|
| 182 | -! | +||
| 401 | +
- teal.widgets::optionalSelectInput(+ } |
||
| 183 | -! | +||
| 402 | +
- ns("right_var"),
+ }) |
||
| 184 | -! | +||
| 403 | +
- "Right Dichotomization Variable",+ } |
||
| 185 | -! | +
| 1 | +
- get_choices(a$right_var$choices),+ #' Teal module for the `AE` overview |
||
| 186 | -! | +||
| 2 | +
- a$right_var$selected,+ #' |
||
| 187 | -! | +||
| 3 | +
- multiple = FALSE+ #' @description |
||
| 188 | +4 |
- ),+ #' `r lifecycle::badge("stable")`
|
|
| 189 | -! | +||
| 5 | +
- teal.widgets::optionalSelectInput(+ #' |
||
| 190 | -! | +||
| 6 | +
- ns("right_val"),
+ #' Display the `AE` overview plot as a shiny module |
||
| 191 | -! | +||
| 7 | +
- "Choose Up To 2:",+ #' |
||
| 192 | -! | +||
| 8 | +
- multiple = TRUE,+ #' @inheritParams teal.widgets::standard_layout |
||
| 193 | -! | +||
| 9 | +
- options = list(+ #' @inheritParams argument_convention |
||
| 194 | -! | +||
| 10 | +
- `max-options` = 2L,+ #' @param flag_var_anl ([`teal.transform::choices_selected`]) |
||
| 195 | -! | +||
| 11 | +
- `max-options-text` = "no more than 2",+ #' `choices_selected` object with variables used to count adverse event |
||
| 196 | -! | +||
| 12 | +
- `actions-box` = FALSE+ #' sub-groups (e.g. Serious events, Related events, etc.) |
||
| 197 | +13 |
- )+ #' |
|
| 198 | +14 |
- ),+ #' @inherit argument_convention return |
|
| 199 | -! | +||
| 15 | +
- teal.widgets::optionalSelectInput(+ #' |
||
| 200 | -! | +||
| 16 | +
- ns("left_var"),
+ #' @export |
||
| 201 | -! | +||
| 17 | +
- "Left Dichotomization Variable",+ #' |
||
| 202 | -! | +||
| 18 | +
- get_choices(a$left_var$choices),+ #' @examples |
||
| 203 | -! | +||
| 19 | +
- a$left_var$selected,+ #' data <- teal_data() |> |
||
| 204 | -! | +||
| 20 | +
- multiple = FALSE+ #' within({
|
||
| 205 | +21 |
- ),+ #' ADSL <- rADSL |
|
| 206 | -! | +||
| 22 | +
- teal.widgets::optionalSelectInput(+ #' ADAE <- rADAE |
||
| 207 | -! | +||
| 23 | +
- ns("left_val"),
+ #' .add_event_flags <- function(dat) {
|
||
| 208 | -! | +||
| 24 | +
- "Choose Up To 2:",+ #' dat <- dat |> |
||
| 209 | -! | +||
| 25 | +
- multiple = TRUE,+ #' mutate( |
||
| 210 | -! | +||
| 26 | +
- options = list(+ #' TMPFL_SER = AESER == "Y", |
||
| 211 | -! | +||
| 27 | +
- `max-options` = 2L,+ #' TMPFL_REL = AEREL == "Y", |
||
| 212 | -! | +||
| 28 | +
- `max-options-text` = "no more than 2",+ #' TMPFL_GR5 = AETOXGR == "5", |
||
| 213 | -! | +||
| 29 | +
- `actions-box` = FALSE+ #' AEREL1 = (AEREL == "Y" & ACTARM == "A: Drug X"), |
||
| 214 | +30 |
- )+ #' AEREL2 = (AEREL == "Y" & ACTARM == "B: Placebo") |
|
| 215 | +31 |
- ),+ #' ) |
|
| 216 | -! | +||
| 32 | +
- teal.widgets::optionalSelectInput(+ #' labels <- c( |
||
| 217 | -! | +||
| 33 | +
- ns("category_var"),
+ #' "Serious AE", "Related AE", "Grade 5 AE", |
||
| 218 | -! | +||
| 34 | +
- "Category Variable",+ #' "AE related to A: Drug X", "AE related to B: Placebo" |
||
| 219 | -! | +||
| 35 | +
- get_choices(a$category_var$choices),+ #' ) |
||
| 220 | -! | +||
| 36 | +
- a$category_var$selected,+ #' cols <- c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2")
|
||
| 221 | -! | +||
| 37 | +
- multiple = FALSE+ #' for (i in seq_along(labels)) {
|
||
| 222 | +38 |
- ),+ #' attr(dat[[cols[i]]], "label") <- labels[i] |
|
| 223 | -! | +||
| 39 | +
- radioButtons(+ #' } |
||
| 224 | -! | +||
| 40 | +
- ns("color_by_var"),
+ #' dat |
||
| 225 | -! | +||
| 41 | +
- "Color Block By Variable",+ #' } |
||
| 226 | -! | +||
| 42 | +
- get_choices(a$color_by_var$choices),+ #' ADAE <- .add_event_flags(ADAE) |
||
| 227 | -! | +||
| 43 | +
- a$color_by_var$selected+ #' }) |
||
| 228 | +44 |
- ),+ #' |
|
| 229 | -! | +||
| 45 | +
- radioButtons(+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
||
| 230 | -! | +||
| 46 | +
- ns("count_by_var"),
+ #' |
||
| 231 | -! | +||
| 47 | +
- "Count By Variable",+ #' ADAE <- data[["ADAE"]] |
||
| 232 | -! | +||
| 48 | +
- get_choices(a$count_by_var$choices),+ #' |
||
| 233 | -! | +||
| 49 | +
- a$count_by_var$selected+ #' app <- init( |
||
| 234 | +50 |
- ),+ #' data = data, |
|
| 235 | -! | +||
| 51 | +
- if (!is.null(a$facet_var)) {
+ #' modules = modules( |
||
| 236 | -! | +||
| 52 | +
- teal.widgets::optionalSelectInput(+ #' tm_g_ae_oview( |
||
| 237 | -! | +||
| 53 | +
- ns("facet_var"),
+ #' label = "AE Overview", |
||
| 238 | -! | +||
| 54 | +
- "Facet By Variable",+ #' dataname = "ADAE", |
||
| 239 | -! | +||
| 55 | +
- get_choices(a$facet_var$choices),+ #' arm_var = choices_selected( |
||
| 240 | -! | +||
| 56 | +
- a$facet_var$selected,+ #' selected = "ACTARM", |
||
| 241 | -! | +||
| 57 | +
- multiple = TRUE+ #' choices = c("ACTARM", "ACTARMCD")
|
||
| 242 | +58 |
- )+ #' ), |
|
| 243 | +59 |
- },+ #' flag_var_anl = choices_selected( |
|
| 244 | -! | +||
| 60 | +
- radioButtons(+ #' selected = "AEREL1", |
||
| 245 | -! | +||
| 61 | +
- ns("sort_by_var"),
+ #' choices = variable_choices( |
||
| 246 | -! | +||
| 62 | +
- "Sort By Variable",+ #' ADAE, |
||
| 247 | -! | +||
| 63 | +
- get_choices(a$sort_by_var$choices),+ #' c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2")
|
||
| 248 | -! | +||
| 64 | +
- a$sort_by_var$selected+ #' ), |
||
| 249 | +65 |
- ),+ #' ), |
|
| 250 | -! | +||
| 66 | +
- checkboxInput(+ #' plot_height = c(600, 200, 2000) |
||
| 251 | -! | +||
| 67 | +
- ns("legend_on"),
+ #' ) |
||
| 252 | -! | +||
| 68 | +
- "Add legend",+ #' ) |
||
| 253 | -! | +||
| 69 | +
- value = a$legend_on+ #' ) |
||
| 254 | +70 |
- )+ #' if (interactive()) {
|
|
| 255 | +71 |
- ),+ #' shinyApp(app$ui, app$server) |
|
| 256 | -! | +||
| 72 | +
- forms = tagList(+ #' } |
||
| 257 | -! | +||
| 73 | +
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ #' |
||
| 258 | +74 |
- ),+ tm_g_ae_oview <- function(label, |
|
| 259 | -! | +||
| 75 | +
- pre_output = a$pre_output,+ dataname, |
||
| 260 | -! | +||
| 76 | +
- post_output = a$post_output+ arm_var, |
||
| 261 | +77 |
- )+ flag_var_anl, |
|
| 262 | +78 |
- }+ fontsize = c(5, 3, 7), |
|
| 263 | +79 |
-
+ plot_height = c(600L, 200L, 2000L), |
|
| 264 | +80 |
- srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, label, plot_height, plot_width) {
+ plot_width = NULL) {
|
|
| 265 | +81 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ message("Initializing tm_g_ae_oview")
|
| 266 | +82 | ! |
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ checkmate::assert_class(arm_var, classes = "choices_selected") |
| 267 | +83 | ! |
- checkmate::assert_class(data, "reactive")+ checkmate::assert_class(flag_var_anl, classes = "choices_selected") |
| 268 | +84 | ! |
- checkmate::assert_class(shiny::isolate(data()), "teal_data")+ checkmate::assert( |
| 269 | -+ | ||
| 85 | +! |
-
+ checkmate::check_number(fontsize, finite = TRUE), |
|
| 270 | +86 | ! |
- moduleServer(id, function(input, output, session) {
+ checkmate::assert( |
| 271 | +87 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ combine = "and", |
| 272 | +88 | ! |
- iv <- reactive({
+ .var.name = "fontsize", |
| 273 | +89 | ! |
- ADSL <- data()[["ADSL"]]+ checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE), |
| 274 | +90 | ! |
- ANL <- data()[[dataname]]+ checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
| 275 | +91 |
-
+ ) |
|
| 276 | -! | +||
| 92 | +
- iv <- shinyvalidate::InputValidator$new()+ ) |
||
| 277 | +93 | ! |
- iv$add_rule("category_var", shinyvalidate::sv_required(
+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 278 | +94 | ! |
- message = "Category Variable is required"- |
-
| 279 | -- |
- ))+ checkmate::assert_numeric(plot_height[1], |
|
| 280 | +95 | ! |
- iv$add_rule("right_var", shinyvalidate::sv_required(
+ lower = plot_height[2], upper = plot_height[3], |
| 281 | +96 | ! |
- message = "Right Dichotomization Variable is required"+ .var.name = "plot_height" |
| 282 | +97 |
- ))+ ) |
|
| 283 | +98 | ! |
- iv$add_rule("left_var", shinyvalidate::sv_required(
+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 284 | +99 | ! |
- message = "Left Dichotomization Variable is required"- |
-
| 285 | -- |
- ))+ checkmate::assert_numeric( |
|
| 286 | +100 | ! |
- iv$add_rule("right_var", ~ if (!is.factor(ANL[[.]])) {
+ plot_width[1], |
| 287 | +101 | ! |
- "Right Dichotomization Variable must be a factor variable, contact developer"+ lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" |
| 288 | +102 |
- })+ ) |
|
| 289 | -! | +||
| 103 | +
- iv$add_rule("left_var", ~ if (!is.factor(ANL[[.]])) {
+
|
||
| 290 | +104 | ! |
- "Left Dichotomization Variable must be a factor variable, contact developer"+ args <- as.list(environment()) |
| 291 | +105 |
- })+ |
|
| 292 | +106 | ! |
- iv$add_rule("right_val", shinyvalidate::sv_required(
+ module( |
| 293 | +107 | ! |
- message = "At least one value of Right Dichotomization Variable must be selected"+ label = label, |
| 294 | -+ | ||
| 108 | +! |
- ))+ server = srv_g_ae_oview, |
|
| 295 | +109 | ! |
- iv$add_rule("left_val", shinyvalidate::sv_required(
+ server_args = list( |
| 296 | +110 | ! |
- message = "At least one value of Left Dichotomization Variable must be selected"+ label = label, |
| 297 | -+ | ||
| 111 | +! |
- ))+ dataname = dataname, |
|
| 298 | +112 | ! |
- iv$enable()+ plot_height = plot_height, |
| 299 | +113 | ! |
- iv+ plot_width = plot_width |
| 300 | +114 |
- })+ ), |
|
| 301 | -+ | ||
| 115 | +! |
-
+ ui = ui_g_ae_oview, |
|
| 302 | +116 | ! |
- options <- reactiveValues(r = NULL, l = NULL)+ ui_args = args, |
| 303 | +117 | ! |
- vars <- reactiveValues(r = NULL, l = NULL)+ datanames = c("ADSL", dataname)
|
| 304 | +118 | ++ |
+ )+ |
+
| 119 | ++ |
+ }+ |
+ |
| 120 | |||
| 305 | +121 |
- # dynamic options for dichotomization variable+ ui_g_ae_oview <- function(id, ...) {
|
|
| 306 | +122 | ! |
- observeEvent(input$right_var,+ ns <- NS(id) |
| 307 | +123 | ! |
- handlerExpr = {
+ args <- list(...) |
| 308 | +124 | ! |
- right_var <- input$right_var+ teal.widgets::standard_layout( |
| 309 | +125 | ! |
- right_val <- isolate(input$right_val)+ output = teal.widgets::white_small_well( |
| 310 | +126 | ! |
- current_r_var <- isolate(vars$r)+ plot_decorate_output(id = ns(NULL)) |
| 311 | -! | +||
| 127 | +
- if (is.null(right_var)) {
+ ), |
||
| 312 | +128 | ! |
- teal.widgets::updateOptionalSelectInput(+ encoding = tags$div( |
| 313 | -! | +||
| 129 | +
- session,+ ### Reporter |
||
| 314 | +130 | ! |
- "right_val",+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ |
+
| 131 | ++ |
+ ### |
|
| 315 | +132 | ! |
- choices = character(0),+ teal.widgets::optionalSelectInput( |
| 316 | +133 | ! |
- selected = character(0)+ ns("arm_var"),
|
| 317 | -+ | ||
| 134 | +! |
- )+ "Arm Variable", |
|
| 318 | -+ | ||
| 135 | +! |
- } else {
+ choices = get_choices(args$arm_var$choices), |
|
| 319 | +136 | ! |
- options$r <- if (right_var %in% names(data()[["ADSL"]])) {
+ selected = args$arm_var$selected, |
| 320 | +137 | ! |
- levels(data()[["ADSL"]][[right_var]])+ multiple = FALSE |
| 321 | +138 |
- } else {
+ ), |
|
| 322 | +139 | ! |
- levels(data()[[dataname]][[right_var]])+ selectInput( |
| 323 | -+ | ||
| 140 | +! |
- }+ ns("arm_ref"),
|
|
| 324 | -+ | ||
| 141 | +! |
-
+ "Control", |
|
| 325 | +142 | ! |
- selected <- if (length(right_val) > 0) {
+ choices = get_choices(args$arm_var$choices), |
| 326 | +143 | ! |
- left_over <- right_val[right_val %in% options$r]+ selected = args$arm_var$selected+ |
+
| 144 | ++ |
+ ), |
|
| 327 | +145 | ! |
- if (length(left_over) > 0 && !is.null(current_r_var) && current_r_var == right_var) {
+ selectInput( |
| 328 | +146 | ! |
- left_over+ ns("arm_trt"),
|
| 329 | -+ | ||
| 147 | +! |
- } else {
+ "Treatment", |
|
| 330 | +148 | ! |
- options$r[1]+ choices = get_choices(args$arm_var$choices), |
| 331 | -+ | ||
| 149 | +! |
- }+ selected = args$arm_var$selected |
|
| 332 | +150 |
- } else {
+ ), |
|
| 333 | +151 | ! |
- options$r[1]+ selectInput( |
| 334 | -+ | ||
| 152 | +! |
- }+ ns("flag_var_anl"),
|
|
| 335 | +153 | ! |
- teal.widgets::updateOptionalSelectInput(+ "Flags", |
| 336 | +154 | ! |
- session, "right_val",+ choices = get_choices(args$flag_var_anl$choices), |
| 337 | +155 | ! |
- choices = as.character(options$r), selected = selected, label = "Choose Up To 2:"+ selected = args$flag_var_anl$selected, |
| 338 | -+ | ||
| 156 | +! |
- )+ multiple = TRUE |
|
| 339 | +157 |
- }+ ), |
|
| 340 | +158 | ! |
- vars$r <- right_var+ teal.widgets::panel_item( |
| 341 | -+ | ||
| 159 | +! |
- },+ "Confidence interval settings", |
|
| 342 | +160 | ! |
- ignoreNULL = FALSE+ teal.widgets::optionalSelectInput( |
| 343 | -+ | ||
| 161 | +! |
- )+ ns("diff_ci_method"),
|
|
| 344 | -+ | ||
| 162 | +! |
-
+ "Method for Difference of Proportions CI", |
|
| 345 | +163 | ! |
- observeEvent(input$left_var,+ choices = ci_choices, |
| 346 | +164 | ! |
- handlerExpr = {
+ selected = ci_choices[1], |
| 347 | +165 | ! |
- left_var <- input$left_var+ multiple = FALSE+ |
+
| 166 | ++ |
+ ), |
|
| 348 | +167 | ! |
- left_val <- isolate(input$left_val)+ teal.widgets::optionalSliderInput( |
| 349 | +168 | ! |
- current_l_var <- isolate(vars$l)+ ns("conf_level"),
|
| 350 | +169 | ! |
- if (is.null(left_var)) {
+ "Confidence Level", |
| 351 | +170 | ! |
- teal.widgets::updateOptionalSelectInput(+ min = 0.5, |
| 352 | +171 | ! |
- session, "left_val",+ max = 1, |
| 353 | +172 | ! |
- choices = character(0), selected = character(0)+ value = 0.95 |
| 354 | +173 |
- )+ ) |
|
| 355 | +174 |
- } else {
+ ), |
|
| 356 | +175 | ! |
- options$l <- if (left_var %in% names(data()[["ADSL"]])) {
+ teal.widgets::optionalSelectInput( |
| 357 | +176 | ! |
- levels(data()[["ADSL"]][[left_var]])+ ns("axis"),
|
| 358 | -+ | ||
| 177 | +! |
- } else {
+ "Axis Side", |
|
| 359 | +178 | ! |
- levels(data()[[dataname]][[left_var]])+ choices = c("Left" = "left", "Right" = "right"),
|
| 360 | -+ | ||
| 179 | +! |
- }+ selected = "left",+ |
+ |
| 180 | +! | +
+ multiple = FALSE |
|
| 361 | +181 |
-
+ ), |
|
| 362 | +182 | ! |
- selected <- if (length(left_val) > 0) {
+ ui_g_decorate( |
| 363 | +183 | ! |
- left_over <- left_val[left_val %in% options$l]+ ns(NULL), |
| 364 | +184 | ! |
- if (length(left_over) > 0 && !is.null(current_l_var) && current_l_var == left_var) {
+ fontsize = args$fontsize, |
| 365 | +185 | ! |
- left_over- |
-
| 366 | -- |
- } else {
+ titles = "AE Overview", |
|
| 367 | +186 | ! |
- options$l[1]+ footnotes = "" |
| 368 | +187 |
- }+ ) |
|
| 369 | +188 |
- } else {
+ ), |
|
| 370 | +189 | ! |
- options$l[1]+ forms = tagList( |
| 371 | -+ | ||
| 190 | +! |
- }+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
|
| 372 | +191 |
-
+ ) |
|
| 373 | -! | +||
| 192 | +
- teal.widgets::updateOptionalSelectInput(+ ) |
||
| 374 | -! | +||
| 193 | +
- session, "left_val",+ } |
||
| 375 | -! | +||
| 194 | +
- choices = as.character(options$l), selected = selected, label = "Choose Up To 2:"+ |
||
| 376 | +195 |
- )+ srv_g_ae_oview <- function(id, |
|
| 377 | +196 |
- }+ data, |
|
| 378 | -! | +||
| 197 | +
- vars$l <- left_var+ filter_panel_api, |
||
| 379 | +198 |
- },+ reporter, |
|
| 380 | -! | +||
| 199 | +
- ignoreNULL = FALSE+ dataname, |
||
| 381 | +200 |
- )+ label, |
|
| 382 | +201 |
-
+ plot_height, |
|
| 383 | -! | +||
| 202 | +
- output_q <- shiny::debounce(+ plot_width) {
|
||
| 384 | +203 | ! |
- millis = 200,+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
| 385 | +204 | ! |
- r = reactive({
+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
| 386 | +205 | ! |
- ADSL <- data()[["ADSL"]]+ checkmate::assert_class(data, "reactive") |
| 387 | +206 | ! |
- ANL <- data()[[dataname]]+ checkmate::assert_class(isolate(data()), "teal_data") |
| 388 | +207 | ||
| 389 | +208 | ! |
- teal::validate_has_data(ADSL, min_nrow = 0, msg = sprintf("%s Data is empty", "ADSL"))
+ moduleServer(id, function(input, output, session) {
|
| 390 | +209 | ! |
- teal::validate_has_data(ANL, min_nrow = 0, msg = sprintf("%s Data is empty", dataname))
+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 391 | -+ | ||
| 210 | +! |
-
+ iv <- reactive({
|
|
| 392 | +211 | ! |
- teal::validate_inputs(iv())+ ANL <- data()[[dataname]] |
| 393 | +212 | ||
| 394 | +213 | ! |
- validate(+ iv <- shinyvalidate::InputValidator$new() |
| 395 | +214 | ! |
- need(+ iv$add_rule("arm_var", shinyvalidate::sv_required(
|
| 396 | +215 | ! |
- all(input$right_val %in% ADSL[[input$right_var]]) &&+ message = "Arm Variable is required" |
| 397 | -! | +||
| 216 | +
- all(input$left_val %in% ADSL[[input$left_var]]),+ )) |
||
| 398 | +217 | ! |
- "No observations for selected dichotomization values (filtered out?)"+ iv$add_rule("arm_var", ~ if (!is.factor(ANL[[.]])) {
|
| 399 | -+ | ||
| 218 | +! |
- )+ "Arm Var must be a factor variable" |
|
| 400 | +219 |
- )+ }) |
|
| 401 | -+ | ||
| 220 | +! |
-
+ iv$add_rule("arm_var", ~ if (nlevels(ANL[[.]]) < 2L) {
|
|
| 402 | +221 | ! |
- right_var <- isolate(input$right_var)+ "Selected Arm Var must have at least two levels" |
| 403 | -! | +||
| 222 | +
- left_var <- isolate(input$left_var)+ }) |
||
| 404 | +223 | ! |
- right_val <- input$right_val+ iv$add_rule("flag_var_anl", shinyvalidate::sv_required(
|
| 405 | +224 | ! |
- left_val <- input$left_val+ message = "At least one Flag is required" |
| 406 | -! | +||
| 225 | +
- category_var <- input$category_var+ )) |
||
| 407 | +226 | ! |
- color_by_var <- input$color_by_var+ rule_diff <- function(value, other) {
|
| 408 | +227 | ! |
- count_by_var <- input$count_by_var+ if (isTRUE(value == other)) "Control and Treatment must be different"+ |
+
| 228 | ++ |
+ } |
|
| 409 | +229 | ! |
- legend_on <- input$legend_on+ iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
|
| 410 | +230 | ! |
- facet_var <- input$facet_var+ iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
|
| 411 | +231 | ! |
- sort_by_var <- input$sort_by_var+ iv$enable() |
| 412 | +232 | ! |
- filter_var <- input$filter_var+ iv |
| 413 | +233 |
-
+ }) |
|
| 414 | +234 |
- # if variable is not in ADSL, then take from domain VADs+ |
|
| 415 | +235 | ! |
- varlist <- c(category_var, color_by_var, facet_var, filter_var, right_var, left_var)+ decorate_output <- srv_g_decorate( |
| 416 | +236 | ! |
- varlist_from_adsl <- intersect(varlist, names(ADSL))+ id = NULL, plt = plot_r, |
| 417 | +237 | ! |
- varlist_from_anl <- intersect(varlist, setdiff(names(ANL), names(ADSL)))+ plot_height = plot_height, plot_width = plot_width |
| 418 | +238 |
-
+ ) |
|
| 419 | +239 | ! |
- adsl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_adsl))
+ font_size <- decorate_output$font_size |
| 420 | +240 | ! |
- anl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_anl))
+ pws <- decorate_output$pws |
| 421 | +241 | ||
| 422 | +242 | ! |
- q1 <- teal.code::eval_code(+ observeEvent(list(input$diff_ci_method, input$conf_level), {
|
| 423 | +243 | ! |
- data(),+ req(!is.null(input$diff_ci_method) && !is.null(input$conf_level)) |
| 424 | +244 | ! |
- code = bquote({
+ diff_ci_method <- input$diff_ci_method |
| 425 | +245 | ! |
- ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame()+ conf_level <- input$conf_level |
| 426 | +246 | ! |
- ANL <- .(as.name(dataname))[, .(anl_vars)] %>% as.data.frame()+ updateTextAreaInput(session, |
| 427 | -+ | ||
| 247 | +! |
- })+ "foot", |
|
| 428 | -+ | ||
| 248 | +! |
- )+ value = sprintf( |
|
| 429 | -+ | ||
| 249 | +! |
-
+ "Note: %d%% CI is calculated using %s", |
|
| 430 | +250 | ! |
- if (!("NULL" %in% filter_var) && !is.null(filter_var)) {
+ round(conf_level * 100), |
| 431 | +251 | ! |
- q1 <- teal.code::eval_code(+ name_ci(diff_ci_method) |
| 432 | -! | +||
| 252 | +
- q1,+ ) |
||
| 433 | -! | +||
| 253 | +
- code = bquote(+ ) |
||
| 434 | -! | +||
| 254 | +
- ANL <- quick_filter(.(filter_var), ANL) %>%+ })+ |
+ ||
| 255 | ++ | + | |
| 435 | +256 | ! |
- droplevels() %>%+ observeEvent(input$arm_var, ignoreNULL = TRUE, {
|
| 436 | +257 | ! |
- as.data.frame()+ ANL <- data()[[dataname]] |
| 437 | -+ | ||
| 258 | +! |
- )+ arm_var <- input$arm_var |
|
| 438 | -+ | ||
| 259 | +! |
- )+ arm_val <- ANL[[arm_var]] |
|
| 439 | -+ | ||
| 260 | +! |
- }+ choices <- levels(arm_val) |
|
| 440 | +261 | ||
| 441 | -! | -
- q1 <- teal.code::eval_code(- |
- |
| 442 | +262 | ! |
- q1,+ if (length(choices) == 1) {
|
| 443 | +263 | ! |
- code = bquote({
+ trt_index <- 1 |
| 444 | -! | +||
| 264 | +
- ANL_f <- left_join(ADSL, ANL, by = c("USUBJID", "STUDYID")) %>% as.data.frame()
+ } else {
|
||
| 445 | +265 | ! |
- ANL_f <- na.omit(ANL_f)+ trt_index <- 2 |
| 446 | +266 |
- })+ } |
|
| 447 | +267 |
- )+ |
|
| 448 | -+ | ||
| 268 | +! |
-
+ updateSelectInput( |
|
| 449 | +269 | ! |
- if (!is.null(right_val) && !is.null(right_val)) {
+ session, |
| 450 | +270 | ! |
- q1 <- teal.code::eval_code(+ "arm_ref", |
| 451 | +271 | ! |
- q1,+ selected = choices[1], |
| 452 | +272 | ! |
- code = bquote({
+ choices = choices+ |
+
| 273 | ++ |
+ ) |
|
| 453 | +274 | ! |
- right <- ANL_f[, .(right_var)] %in% .(right_val)+ updateSelectInput( |
| 454 | +275 | ! |
- right_name <- paste(.(right_val), collapse = " - ")+ session, |
| 455 | +276 | ! |
- left <- ANL_f[, .(left_var)] %in% .(left_val)+ "arm_trt", |
| 456 | +277 | ! |
- left_name <- paste(.(left_val), collapse = " - ")+ selected = choices[trt_index], |
| 457 | -+ | ||
| 278 | +! |
- })+ choices = choices |
|
| 458 | +279 |
- )+ ) |
|
| 459 | +280 |
- }+ }) |
|
| 460 | +281 | ||
| 461 | +282 | ! |
- if (!is.null(right_val) && !is.null(left_val)) {
+ output_q <- shiny::debounce( |
| 462 | +283 | ! |
- q1 <- teal.code::eval_code(+ millis = 200, |
| 463 | +284 | ! |
- q1,+ r = reactive({
|
| 464 | +285 | ! |
- code = bquote(+ ANL <- data()[[dataname]] |
| 465 | -! | +||
| 286 | +
- plot <- osprey::g_butterfly(+ |
||
| 466 | +287 | ! |
- category = ANL_f[, .(category_var)],+ teal::validate_has_data(ANL, min_nrow = 10, msg = sprintf("%s has not enough data", dataname))
|
| 467 | -! | +||
| 288 | +
- right_flag = right,+ |
||
| 468 | +289 | ! |
- left_flag = left,+ teal::validate_inputs(iv()) |
| 469 | -! | +||
| 290 | +
- group_names = c(right_name, left_name),+ |
||
| 470 | +291 | ! |
- block_count = .(count_by_var),+ validate(need( |
| 471 | +292 | ! |
- block_color = .(if (color_by_var != "None") {
+ input$arm_trt %in% ANL[[input$arm_var]] && input$arm_ref %in% ANL[[input$arm_var]], |
| 472 | +293 | ! |
- bquote(ANL_f[, .(color_by_var)])+ "Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?" |
| 473 | +294 |
- } else {
- |
- |
| 474 | -! | -
- NULL+ )) |
|
| 475 | +295 |
- }),- |
- |
| 476 | -! | -
- id = ANL_f$USUBJID,+ |
|
| 477 | +296 | ! |
- facet_rows = .(if (!is.null(facet_var)) {
+ q1 <- teal.code::eval_code( |
| 478 | +297 | ! |
- bquote(ANL_f[, .(facet_var)])- |
-
| 479 | -- |
- } else {
+ data(), |
|
| 480 | +298 | ! |
- NULL- |
-
| 481 | -- |
- }),+ code = as.expression(c( |
|
| 482 | +299 | ! |
- x_label = .(count_by_var),+ bquote(anl_labels <- formatters::var_labels(.(as.name(dataname)), fill = FALSE)), |
| 483 | +300 | ! |
- y_label = .(category_var),+ bquote( |
| 484 | +301 | ! |
- legend_label = .(color_by_var),+ flags <- .(as.name(dataname)) %>% |
| 485 | +302 | ! |
- sort_by = .(sort_by_var),+ select(all_of(.(input$flag_var_anl))) %>% |
| 486 | +303 | ! |
- show_legend = .(legend_on)- |
-
| 487 | -- |
- )+ rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x])) |
|
| 488 | +304 |
) |
|
| 489 | +305 |
- )+ )) |
|
| 490 | +306 |
- }+ ) |
|
| 491 | +307 | ||
| 492 | +308 | ! |
- teal.code::eval_code(q1, quote(plot))+ teal.code::eval_code( |
| 493 | -+ | ||
| 309 | +! |
- })+ q1, |
|
| 494 | -+ | ||
| 310 | +! |
- )+ code = as.expression(c( |
|
| 495 | -+ | ||
| 311 | +! |
-
+ bquote( |
|
| 496 | +312 | ! |
- plot_r <- reactive(output_q()[["plot"]])+ plot <- osprey::g_events_term_id( |
| 497 | -+ | ||
| 313 | +! |
-
+ term = flags, |
|
| 498 | -+ | ||
| 314 | +! |
- # Insert the plot into a plot_with_settings module from teal.widgets+ id = .(as.name(dataname))[["USUBJID"]], |
|
| 499 | +315 | ! |
- pws <- teal.widgets::plot_with_settings_srv(+ arm = .(as.name(dataname))[[.(input$arm_var)]], |
| 500 | +316 | ! |
- id = "butterflyplot",+ arm_N = table(ADSL[[.(input$arm_var)]]), |
| 501 | +317 | ! |
- plot_r = plot_r,+ ref = .(input$arm_ref), |
| 502 | +318 | ! |
- height = plot_height,+ trt = .(input$arm_trt), |
| 503 | +319 | ! |
- width = plot_width+ diff_ci_method = .(input$diff_ci_method), |
| 504 | -+ | ||
| 320 | +! |
- )+ conf_level = .(input$conf_level), |
|
| 505 | -+ | ||
| 321 | +! |
-
+ axis_side = .(input$axis), |
|
| 506 | +322 | ! |
- teal.widgets::verbatim_popup_srv(+ fontsize = .(font_size()), |
| 507 | +323 | ! |
- id = "rcode",+ draw = TRUE |
| 508 | -! | +||
| 324 | +
- title = paste("R code for", label),
+ )+ |
+ ||
| 325 | ++ |
+ ), |
|
| 509 | +326 | ! |
- verbatim_content = reactive(teal.code::get_code(output_q()))+ quote(plot) |
| 510 | +327 |
- )+ )) |
|
| 511 | +328 |
-
+ ) |
|
| 512 | +329 |
- ### REPORTER+ }) |
|
| 513 | -! | +||
| 330 | +
- if (with_reporter) {
+ ) |
||
| 514 | -! | +||
| 331 | +
- card_fun <- function(comment, label) {
+
|
||
| 515 | +332 | ! |
- card <- teal::report_card_template(+ plot_r <- reactive(output_q()[["plot"]]) |
| 516 | -! | +||
| 333 | +
- title = "Butterfly Plot",+ |
||
| 517 | +334 | ! |
- label = label,+ teal.widgets::verbatim_popup_srv( |
| 518 | +335 | ! |
- with_filter = with_filter,+ id = "rcode", |
| 519 | +336 | ! |
- filter_panel_api = filter_panel_api- |
-
| 520 | -- |
- )+ verbatim_content = reactive(teal.code::get_code(output_q())), |
|
| 521 | +337 | ! |
- if (!is.null(input$filter_var) || !is.null(input$facet_var) || !is.null(input$sort_by_var)) {
+ title = paste("R code for", label)
|
| 522 | -! | +||
| 338 | +
- card$append_text("Selected Options", "header3")
+ ) |
||
| 523 | +339 |
- }+ ### REPORTER |
|
| 524 | +340 | ! |
- if (!is.null(input$filter_var)) {
+ if (with_reporter) {
|
| 525 | +341 | ! |
- card$append_text(paste0("Preset Data Filters: ", paste(input$filter_var, collapse = ", "), "."))
- |
-
| 526 | -- |
- }+ card_fun <- function(comment, label) {
|
|
| 527 | +342 | ! |
- if (!is.null(input$facet_var)) {
+ card <- teal::report_card_template( |
| 528 | +343 | ! |
- card$append_text(paste0("Faceted by: ", paste(input$facet_var, collapse = ", "), "."))
+ title = "AE Overview", |
| 529 | -+ | ||
| 344 | +! |
- }+ label = label, |
|
| 530 | +345 | ! |
- if (!is.null(input$sort_by_var)) {
+ with_filter = with_filter, |
| 531 | +346 | ! |
- card$append_text(paste0("Sorted by: ", paste(input$sort_by_var, collapse = ", "), "."))
+ filter_panel_api = filter_panel_api |
| 532 | +347 |
- }+ ) |
|
| 533 | +348 | ! |
card$append_text("Plot", "header3")
|
| 534 | +349 | ! |
card$append_plot(plot_r(), dim = pws$dim()) |
| 535 | +350 | ! |
if (!comment == "") {
|
| 536 | +351 | ! |
card$append_text("Comment", "header3")
|
| 537 | +352 | ! |
card$append_text(comment) |
| 538 | +353 |
} |
|
| 539 | +354 | ! |
card$append_src(teal.code::get_code(output_q())) |
| 540 | +355 | ! |
card |
| 541 | +356 |
} |
|
| 542 | +357 | ! |
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
| 543 | +358 |
} |
|
| 544 | +359 |
}) |
|
| 545 | +360 |
}@@ -26824,14 +26663,14 @@ teal.osprey coverage - 0.14% |
| 1 |
- #' Teal Module for `Swimlane` Plot+ #' Spider plot Teal Module |
||
| 6 |
- #' This is teal module that generates a `swimlane` plot (bar plot with markers) for `ADaM` data+ #' Display spider plot as a shiny module |
||
| 10 |
- #' @param dataname analysis data used for plotting, needs to be available in the list passed to the `data`+ #' @param x_var x-axis variables |
||
| 11 |
- #' argument of [teal::init()]. If no markers are to be plotted in the module, `"ADSL"` should be+ #' @param y_var y-axis variables |
||
| 12 |
- #' the input. If markers are to be plotted, data name for the marker data should be the input+ #' @param marker_var variable dictates marker symbol |
||
| 13 |
- #' @param bar_var [teal.transform::choices_selected] subject-level numeric variable from dataset+ #' @param line_colorby_var variable dictates line color |
||
| 14 |
- #' to plot as the bar length+ #' @param vref_line vertical reference lines |
||
| 15 |
- #' @param bar_color_var [teal.transform::choices_selected] color by variable (subject-level)+ #' @param href_line horizontal reference lines |
||
| 16 |
- #' @param sort_var `choices_selected` sort by variable (subject-level)+ #' @param anno_txt_var annotation text |
||
| 17 |
- #' @param marker_pos_var [teal.transform::choices_selected] variable for marker position from marker data+ #' @param legend_on boolean value for whether legend is displayed |
||
| 18 |
- #' (Note: make sure that marker position has the same relative start day as bar length variable `bar_var`+ #' @param xfacet_var variable for x facets |
||
| 19 |
- #' @param marker_shape_var [teal.transform::choices_selected] marker shape variable from marker data+ #' @param yfacet_var variable for y facets |
||
| 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,+ #' @inherit argument_convention return |
||
| 22 |
- #' otherwise shape will be assigned by `ggplot` default+ #' @export |
||
| 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).+ #' @template author_zhanc107 |
||
| 25 |
- #' If not `NULL`, please make sure this contains all possible values for `marker_color_var` values,+ #' @template author_liaoc10 |
||
| 26 |
- #' otherwise color will be assigned by `ggplot` default+ #' |
||
| 27 |
- #' @param vref_line vertical reference lines+ #' @examples |
||
| 28 |
- #' @param anno_txt_var character vector with subject-level variable names that are selected as annotation+ #' # Example using stream (ADaM) dataset |
||
| 29 |
- #' @param x_label the label of the x axis+ #' data <- teal_data() |> |
||
| 30 |
- #'+ #' within({
|
||
| 31 |
- #' @inherit argument_convention return+ #' ADSL <- rADSL |
||
| 32 |
- #'+ #' ADTR <- rADTR |
||
| 33 |
- #' @export+ #' }) |
||
| 35 |
- #' @template author_qit3+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
||
| 37 |
- #' @examples+ #' app <- init( |
||
| 38 |
- #' # Example using stream (ADaM) dataset+ #' data = data, |
||
| 39 |
- #' data <- teal_data() |>+ #' modules = modules( |
||
| 40 |
- #' within({
+ #' tm_g_spiderplot( |
||
| 41 |
- #' library(dplyr)+ #' label = "Spider plot", |
||
| 42 |
- #' ADSL <- rADSL %>%+ #' dataname = "ADTR", |
||
| 43 |
- #' mutate(TRTDURD = as.integer(TRTEDTM - TRTSDTM) + 1) %>%+ #' paramcd = choices_selected( |
||
| 44 |
- #' filter(STRATA1 == "A" & ARMCD == "ARM A")+ #' choices = "SLDINV", |
||
| 45 |
- #' ADRS <- rADRS %>%+ #' selected = "SLDINV" |
||
| 46 |
- #' filter(PARAMCD == "LSTASDI" & DCSREAS == "Death") %>%+ #' ), |
||
| 47 |
- #' mutate(AVALC = DCSREAS, ADY = EOSDY) %>%+ #' x_var = choices_selected( |
||
| 48 |
- #' rbind(rADRS %>% filter(PARAMCD == "OVRINV" & AVALC != "NE")) %>%+ #' choices = "ADY", |
||
| 49 |
- #' arrange(USUBJID)+ #' selected = "ADY" |
||
| 50 |
- #' })+ #' ), |
||
| 51 |
- #'+ #' y_var = choices_selected( |
||
| 52 |
- #' datanames(data) <- c("ADSL", "ADRS")
+ #' choices = c("PCHG", "CHG", "AVAL"),
|
||
| 53 |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ #' selected = "PCHG" |
||
| 54 |
- #'+ #' ), |
||
| 55 |
- #' ADSL <- data[["ADSL"]]+ #' marker_var = choices_selected( |
||
| 56 |
- #' ADRS <- data[["ADRS"]]+ #' choices = c("SEX", "RACE", "USUBJID"),
|
||
| 57 |
- #'+ #' selected = "SEX" |
||
| 58 |
- #' app <- init(+ #' ), |
||
| 59 |
- #' data = data,+ #' line_colorby_var = choices_selected( |
||
| 60 |
- #' modules = modules(+ #' choices = c("SEX", "USUBJID", "RACE"),
|
||
| 61 |
- #' tm_g_swimlane(+ #' selected = "SEX" |
||
| 62 |
- #' label = "Swimlane Plot",+ #' ), |
||
| 63 |
- #' dataname = "ADRS",+ #' xfacet_var = choices_selected( |
||
| 64 |
- #' bar_var = choices_selected(+ #' choices = c("SEX", "ARM"),
|
||
| 65 |
- #' selected = "TRTDURD",+ #' selected = "SEX" |
||
| 66 |
- #' choices = c("TRTDURD", "EOSDY")
+ #' ), |
||
| 67 |
- #' ),+ #' yfacet_var = choices_selected( |
||
| 68 |
- #' bar_color_var = choices_selected(+ #' choices = c("SEX", "ARM"),
|
||
| 69 |
- #' selected = "EOSSTT",+ #' selected = "ARM" |
||
| 70 |
- #' choices = c("EOSSTT", "ARM", "ARMCD", "ACTARM", "ACTARMCD", "SEX")
+ #' ), |
||
| 71 |
- #' ),+ #' vref_line = "10, 37", |
||
| 72 |
- #' sort_var = choices_selected(+ #' href_line = "-20, 0" |
||
| 73 |
- #' selected = "ACTARMCD",+ #' ) |
||
| 74 |
- #' choices = c("USUBJID", "SITEID", "ACTARMCD", "TRTDURD")
+ #' ) |
||
| 75 |
- #' ),+ #' ) |
||
| 76 |
- #' marker_pos_var = choices_selected(+ #' if (interactive()) {
|
||
| 77 |
- #' selected = "ADY",+ #' shinyApp(app$ui, app$server) |
||
| 78 |
- #' choices = c("ADY")
+ #' } |
||
| 79 |
- #' ),+ #' |
||
| 80 |
- #' marker_shape_var = choices_selected(+ tm_g_spiderplot <- function(label, |
||
| 81 |
- #' selected = "AVALC",+ dataname, |
||
| 82 |
- #' c("AVALC", "AVISIT")
+ paramcd, |
||
| 83 |
- #' ),+ x_var, |
||
| 84 |
- #' marker_shape_opt = c("CR" = 16, "PR" = 17, "SD" = 18, "PD" = 15, "Death" = 8),
+ y_var, |
||
| 85 |
- #' marker_color_var = choices_selected(+ marker_var, |
||
| 86 |
- #' selected = "AVALC",+ line_colorby_var, |
||
| 87 |
- #' choices = c("AVALC", "AVISIT")
+ xfacet_var = NULL, |
||
| 88 |
- #' ),+ yfacet_var = NULL, |
||
| 89 |
- #' marker_color_opt = c(+ vref_line = NULL, |
||
| 90 |
- #' "CR" = "green", "PR" = "blue", "SD" = "goldenrod",+ href_line = NULL, |
||
| 91 |
- #' "PD" = "red", "Death" = "black"+ anno_txt_var = TRUE, |
||
| 92 |
- #' ),+ legend_on = FALSE, |
||
| 93 |
- #' vref_line = c(30, 60),+ plot_height = c(600L, 200L, 2000L), |
||
| 94 |
- #' anno_txt_var = choices_selected(+ plot_width = NULL, |
||
| 95 |
- #' selected = c("ACTARM", "SEX"),
+ pre_output = NULL, |
||
| 96 |
- #' choices = c(+ post_output = NULL) {
|
||
| 97 | -+ | ! |
- #' "ARM", "ARMCD", "ACTARM", "ACTARMCD", "AGEGR1",+ message("Initializing tm_g_spiderplot")
|
| 98 | -+ | ! |
- #' "SEX", "RACE", "COUNTRY", "DCSREAS", "DCSREASP"+ checkmate::assert_class(paramcd, classes = "choices_selected") |
| 99 | -+ | ! |
- #' )+ checkmate::assert_class(x_var, classes = "choices_selected") |
| 100 | -+ | ! |
- #' )+ checkmate::assert_class(y_var, classes = "choices_selected") |
| 101 | -+ | ! |
- #' )+ checkmate::assert_class(marker_var, classes = "choices_selected") |
| 102 | -+ | ! |
- #' )+ checkmate::assert_class(line_colorby_var, classes = "choices_selected") |
| 103 | -+ | ! |
- #' )+ checkmate::assert_class(xfacet_var, classes = "choices_selected") |
| 104 | -+ | ! |
- #' if (interactive()) {
+ checkmate::assert_class(yfacet_var, classes = "choices_selected") |
| 105 | -+ | ! |
- #' shinyApp(app$ui, app$server)+ checkmate::assert_string(vref_line) |
| 106 | -+ | ! |
- #' }+ checkmate::assert_string(href_line) |
| 107 | -+ | ! |
- #'+ checkmate::assert_flag(anno_txt_var) |
| 108 | -+ | ! |
- tm_g_swimlane <- function(label,+ checkmate::assert_flag(legend_on) |
| 109 | -+ | ! |
- dataname,+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 110 | -+ | ! |
- bar_var,+ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 111 | -+ | ! |
- bar_color_var = NULL,+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 112 | -+ | ! |
- sort_var = NULL,+ checkmate::assert_numeric( |
| 113 | -+ | ! |
- marker_pos_var = NULL,+ plot_width[1], |
| 114 | -+ | ! |
- marker_shape_var = NULL,+ lower = plot_width[2], |
| 115 | -+ | ! |
- marker_shape_opt = NULL,+ upper = plot_width[3], |
| 116 | -+ | ! |
- marker_color_var = NULL,+ null.ok = TRUE, |
| 117 | -+ | ! |
- marker_color_opt = NULL,+ .var.name = "plot_width" |
| 118 |
- anno_txt_var = NULL,+ ) |
||
| 119 |
- vref_line = NULL,+ |
||
| 120 | -+ | ! |
- plot_height = c(1200L, 400L, 5000L),+ args <- as.list(environment()) |
| 121 | -+ | ! |
- plot_width = NULL,+ module( |
| 122 | -+ | ! |
- pre_output = NULL,+ label = label, |
| 123 | -+ | ! |
- post_output = NULL,+ datanames = c("ADSL", dataname),
|
| 124 | -+ | ! |
- x_label = "Time from First Treatment (Day)") {
+ server = srv_g_spider, |
| 125 | ! |
- message("Initializing tm_g_swimlane")
+ server_args = list( |
|
| 126 | ! |
- args <- as.list(environment())+ dataname = dataname, |
|
| 127 | -+ | ! |
-
+ paramcd = paramcd, |
| 128 | ! |
- checkmate::assert_string(label)+ label = label, |
|
| 129 | ! |
- checkmate::assert_string(dataname)+ plot_height = plot_height, |
|
| 130 | ! |
- checkmate::assert_class(bar_var, classes = "choices_selected")+ plot_width = plot_width |
|
| 131 | -! | +
- checkmate::assert_class(bar_color_var, classes = "choices_selected")+ ), |
|
| 132 | ! |
- checkmate::assert_class(marker_pos_var, classes = "choices_selected")+ ui = ui_g_spider, |
|
| 133 | ! |
- checkmate::assert_class(marker_shape_var, classes = "choices_selected")+ ui_args = args |
|
| 134 | -! | +
- checkmate::assert_numeric(marker_shape_opt, min.len = 1, any.missing = FALSE)+ ) |
|
| 135 | -! | +
- checkmate::assert_class(marker_color_var, classes = "choices_selected")+ } |
|
| 136 | -! | +
- checkmate::assert_character(marker_color_opt, min.len = 1, any.missing = FALSE, null.ok = TRUE)+ |
|
| 137 | -! | +
- checkmate::assert_class(anno_txt_var, classes = "choices_selected")+ ui_g_spider <- function(id, ...) {
|
|
| 138 | ! |
- checkmate::assert_numeric(vref_line, min.len = 1, null.ok = TRUE, any.missing = FALSE)+ ns <- NS(id) |
|
| 139 | ! |
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ a <- list(...) |
|
| 140 | ! |
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ shiny::tagList( |
|
| 141 | ! |
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ include_css_files("custom"),
|
|
| 142 | ! |
- checkmate::assert_numeric(+ teal.widgets::standard_layout( |
|
| 143 | ! |
- plot_width[1],+ output = teal.widgets::white_small_well( |
|
| 144 | ! |
- lower = plot_width[2],+ teal.widgets::plot_with_settings_ui(id = ns("spiderplot"))
|
|
| 145 | -! | +
- upper = plot_width[3],+ ), |
|
| 146 | ! |
- null.ok = TRUE,+ encoding = tags$div( |
|
| 147 | -! | +
- .var.name = "plot_width"+ ### Reporter |
|
| 148 | -+ | ! |
- )+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
|
| 149 | -! | +
- checkmate::assert_string(x_label)+ ### |
|
| 150 | -+ | ! |
-
+ tags$label("Encodings", class = "text-primary"),
|
| 151 | -+ | ! |
-
+ helpText("Analysis data:", tags$code(a$dataname)),
|
| 152 | ! |
- module(+ tags$div( |
|
| 153 | ! |
- label = label,+ class = "pretty-left-border", |
|
| 154 | ! |
- ui = ui_g_swimlane,+ teal.widgets::optionalSelectInput( |
|
| 155 | ! |
- ui_args = args,+ ns("paramcd"),
|
|
| 156 | ! |
- server = srv_g_swimlane,+ paste("Parameter - from", a$dataname),
|
|
| 157 | ! |
- server_args = list(+ multiple = FALSE |
|
| 158 | -! | +
- dataname = dataname,+ ), |
|
| 159 | ! |
- marker_pos_var = marker_pos_var,+ teal.widgets::optionalSelectInput( |
|
| 160 | ! |
- marker_shape_var = marker_shape_var,+ ns("x_var"),
|
|
| 161 | ! |
- marker_shape_opt = marker_shape_opt,+ "X-axis Variable", |
|
| 162 | ! |
- marker_color_var = marker_color_var,+ get_choices(a$x_var$choices), |
|
| 163 | ! |
- marker_color_opt = marker_color_opt,+ a$x_var$selected, |
|
| 164 | ! |
- label = label,+ multiple = FALSE |
|
| 165 | -! | +
- plot_height = plot_height,+ ), |
|
| 166 | ! |
- plot_width = plot_width,+ teal.widgets::optionalSelectInput( |
|
| 167 | ! |
- x_label = x_label+ ns("y_var"),
|
|
| 168 | -+ | ! |
- ),+ "Y-axis Variable", |
| 169 | ! |
- datanames = c("ADSL", dataname)
+ get_choices(a$y_var$choices), |
|
| 170 | -+ | ! |
- )+ a$y_var$selected, |
| 171 | -+ | ! |
- }+ multiple = FALSE |
| 172 |
-
+ ), |
||
| 173 | -+ | ! |
-
+ teal.widgets::optionalSelectInput( |
| 174 | -+ | ! |
- ui_g_swimlane <- function(id, ...) {
+ ns("line_colorby_var"),
|
| 175 | ! |
- a <- list(...)+ "Color By Variable (Line)", |
|
| 176 | ! |
- ns <- NS(id)+ get_choices(a$line_colorby_var$choices), |
|
| 177 | -+ | ! |
-
+ a$line_colorby_var$selected, |
| 178 | ! |
- shiny::tagList(+ multiple = FALSE |
|
| 179 | -! | +
- include_css_files("custom"),
+ ), |
|
| 180 | ! |
- teal.widgets::standard_layout(+ teal.widgets::optionalSelectInput( |
|
| 181 | ! |
- output = teal.widgets::white_small_well(+ ns("marker_var"),
|
|
| 182 | ! |
- teal.widgets::plot_with_settings_ui(id = ns("swimlaneplot"))
+ "Marker Symbol By Variable", |
|
| 183 | -+ | ! |
- ),+ get_choices(a$marker_var$choices), |
| 184 | ! |
- encoding = tags$div(+ a$marker_var$selected, |
|
| 185 | -+ | ! |
- ### Reporter+ multiple = FALSE |
| 186 | -! | +
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ ), |
|
| 187 | -+ | ! |
- ###+ teal.widgets::optionalSelectInput( |
| 188 | ! |
- tags$label("Encodings", class = "text-primary"),
+ ns("xfacet_var"),
|
|
| 189 | ! |
- helpText("Analysis data:", tags$code(a$dataname)),
+ "X-facet By Variable", |
|
| 190 | ! |
- tags$div(+ get_choices(a$xfacet_var$choices), |
|
| 191 | ! |
- class = "pretty-left-border",+ a$xfacet_var$selected, |
|
| 192 | ! |
- teal.widgets::optionalSelectInput(+ multiple = TRUE |
|
| 193 | -! | +
- ns("bar_var"),
+ ), |
|
| 194 | ! |
- "Bar Length",+ teal.widgets::optionalSelectInput( |
|
| 195 | ! |
- choices = get_choices(a$bar_var$choices),+ ns("yfacet_var"),
|
|
| 196 | ! |
- selected = a$bar_var$selected,+ "Y-facet By Variable", |
|
| 197 | ! |
- multiple = FALSE,+ get_choices(a$yfacet_var$choices), |
|
| 198 | ! |
- label_help = helpText("from ", tags$code("ADSL"))
+ a$yfacet_var$selected, |
|
| 199 | -+ | ! |
- ),+ multiple = TRUE |
| 200 | -! | +
- teal.widgets::optionalSelectInput(+ ) |
|
| 201 | -! | +
- ns("bar_color_var"),
+ ), |
|
| 202 | ! |
- "Bar Color",+ checkboxInput( |
|
| 203 | ! |
- choices = get_choices(a$bar_color_var$choices),+ ns("anno_txt_var"),
|
|
| 204 | ! |
- selected = a$bar_color_var$selected,+ "Add subject ID label", |
|
| 205 | ! |
- multiple = FALSE,+ value = a$anno_txt_var |
|
| 206 | -! | +
- label_help = helpText("from ", tags$code("ADSL"))
+ ), |
|
| 207 | -+ | ! |
- )+ checkboxInput( |
| 208 | -+ | ! |
- ),+ ns("legend_on"),
|
| 209 | ! |
- teal.widgets::optionalSelectInput(+ "Add legend", |
|
| 210 | ! |
- ns("sort_var"),
+ value = a$legend_on |
|
| 211 | -! | +
- "Sort by",+ ), |
|
| 212 | ! |
- choices = get_choices(a$sort_var$choices),+ textInput( |
|
| 213 | ! |
- selected = a$sort_var$selected,+ ns("vref_line"),
|
|
| 214 | ! |
- multiple = FALSE,+ label = tags$div( |
|
| 215 | ! |
- label_help = helpText("from ", tags$code("ADSL"))
+ "Vertical Reference Line(s)", |
|
| 216 | -+ | ! |
- ),+ tags$br(), |
| 217 | ! |
- tags$div(+ helpText("Enter numeric value(s) of vertical reference lines, separated by comma (eg. -2, 1)")
|
|
| 218 | -! | +
- class = "pretty-left-border",+ ), |
|
| 219 | ! |
- if (a$dataname == "ADSL") {
+ value = a$vref_line |
|
| 220 | -! | +
- NULL+ ), |
|
| 221 | ! |
- } else if (is.null(a$marker_pos_var)) {
+ textInput( |
|
| 222 | ! |
- NULL+ ns("href_line"),
|
|
| 223 | -+ | ! |
- } else {
+ label = tags$div( |
| 224 | ! |
- teal.widgets::optionalSelectInput(+ "Hortizontal Reference Line(s)", |
|
| 225 | ! |
- ns("marker_pos_var"),
+ tags$br(), |
|
| 226 | ! |
- "Marker Position",+ helpText("Enter numeric value(s) of horizontal reference lines, separated by comma (eg. -2, 1)")
|
|
| 227 | -! | +
- choices = get_choices(a$marker_pos_var$choices),+ ), |
|
| 228 | ! |
- selected = a$marker_pos_var$selected,+ value = a$href_line |
|
| 229 | -! | +
- multiple = FALSE,+ ) |
|
| 230 | -! | +
- label_help = helpText("from ", tags$code(a$dataname))
+ ), |
|
| 231 | -+ | ! |
- )+ forms = tagList( |
| 232 | -+ | ! |
- },+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
| 233 | -! | +
- uiOutput(ns("marker_shape_sel")),
+ ), |
|
| 234 | ! |
- uiOutput(ns("marker_color_sel"))
+ pre_output = a$pre_output, |
|
| 235 | -+ | ! |
- ),+ post_output = a$post_output |
| 236 | -! | +
- teal.widgets::optionalSelectInput(+ ) |
|
| 237 | -! | +
- ns("anno_txt_var"),
+ ) |
|
| 238 | -! | +
- "Annotation Variables",+ } |
|
| 239 | -! | +
- choices = get_choices(a$anno_txt_var$choices),+ |
|
| 240 | -! | +
- selected = a$anno_txt_var$selected,+ srv_g_spider <- function(id, data, filter_panel_api, paramcd, reporter, dataname, label, plot_height, plot_width) {
|
|
| 241 | ! |
- multiple = TRUE,+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
|
| 242 | ! |
- label_help = helpText("from ", tags$code("ADSL"))
+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
|
| 243 | -+ | ! |
- ),+ checkmate::assert_class(data, "reactive") |
| 244 | ! |
- textInput(+ checkmate::assert_class(shiny::isolate(data()), "teal_data") |
|
| 245 | -! | +
- ns("vref_line"),
+
|
|
| 246 | ! |
- label = tags$div(+ moduleServer(id, function(input, output, session) {
|
|
| 247 | ! |
- "Vertical Reference Line(s)",+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
|
| 248 | -! | +
- tags$br(),+ |
|
| 249 | ! |
- helpText("Enter numeric value(s) of reference lines, separated by comma (eg. 100, 200)")
+ env <- as.list(isolate(data())) |
|
| 250 | -+ | ! |
- ),+ resolved_paramcd <- teal.transform::resolve_delayed(paramcd, env) |
| 251 | -! | +
- value = paste(a$vref_line, collapse = ", ")+ |
|
| 252 | -+ | ! |
- )+ teal.widgets::updateOptionalSelectInput( |
| 253 | -+ | ! |
- ),+ session = session, |
| 254 | ! |
- forms = tagList(+ inputId = "paramcd", |
|
| 255 | ! |
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+ choices = resolved_paramcd$choices, |
|
| 256 | -+ | ! |
- ),+ selected = resolved_paramcd$selected |
| 257 | -! | +
- pre_output = a$pre_output,+ ) |
|
| 258 | -! | +
- post_output = a$post_output+ |
|
| 259 | -+ | ! |
- )+ iv <- reactive({
|
| 260 | -+ | ! |
- )+ ADSL <- data()[["ADSL"]] |
| 261 | -+ | ! |
- }+ ADTR <- data()[[dataname]] |
| 263 | -+ | ! |
- srv_g_swimlane <- function(id,+ iv <- shinyvalidate::InputValidator$new() |
| 264 | -+ | ! |
- data,+ iv$add_rule("paramcd", shinyvalidate::sv_required(
|
| 265 | -+ | ! |
- filter_panel_api,+ message = "Parameter is required" |
| 266 |
- reporter,+ )) |
||
| 267 | -+ | ! |
- dataname,+ iv$add_rule("x_var", shinyvalidate::sv_required(
|
| 268 | -+ | ! |
- marker_pos_var,+ message = "X Axis Variable is required" |
| 269 |
- marker_shape_var,+ )) |
||
| 270 | -+ | ! |
- marker_shape_opt,+ iv$add_rule("y_var", shinyvalidate::sv_required(
|
| 271 | -+ | ! |
- marker_color_var,+ message = "Y Axis Variable is required" |
| 272 |
- marker_color_opt,+ )) |
||
| 273 | -+ | ! |
- label,+ iv$add_rule("line_colorby_var", shinyvalidate::sv_required(
|
| 274 | -+ | ! |
- plot_height,+ message = "Color Variable is required" |
| 275 |
- plot_width,+ )) |
||
| 276 | -+ | ! |
- x_label) {
+ iv$add_rule("marker_var", shinyvalidate::sv_required(
|
| 277 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ message = "Marker Symbol Variable is required" |
|
| 278 | -! | +
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ )) |
|
| 279 | ! |
- checkmate::assert_class(data, "reactive")+ fac_dupl <- function(value, other) {
|
|
| 280 | ! |
- checkmate::assert_class(shiny::isolate(data()), "teal_data")+ if (length(value) * length(other) > 0L && anyDuplicated(c(value, other))) {
|
|
| 281 | -+ | ! |
-
+ "X- and Y-facet Variables must not overlap" |
| 282 | -! | +
- moduleServer(id, function(input, output, session) {
+ } |
|
| 283 | -! | +
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ } |
|
| 284 | ! |
- iv <- reactive({
+ iv$add_rule("xfacet_var", fac_dupl, other = input$yfacet_var)
|
|
| 285 | ! |
- iv <- shinyvalidate::InputValidator$new()+ iv$add_rule("yfacet_var", fac_dupl, other = input$xfacet_var)
|
|
| 286 | ! |
- iv$add_rule("bar_var", shinyvalidate::sv_required(
+ iv$add_rule("vref_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
|
| 287 | ! |
- message = "Bar Length is required"+ "Vertical Reference Line(s) are invalid" |
|
| 288 |
- ))- |
- ||
| 289 | -- |
- # If reference lines are requested+ }) |
|
| 290 | +289 | ! |
- iv$add_rule("vref_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
+ iv$add_rule("href_line", ~ if (anyNA(suppressWarnings(as_numeric_from_comma_sep_str(.)))) {
|
| 291 | +290 | ! |
- "Vertical Reference Line(s) are invalid"+ "Horizontal Reference Line(s) are invalid" |
| 292 | +291 |
}) |
|
| 293 | +292 | ! |
iv$enable() |
| 294 | -! | +||
| 293 | +
- iv+ }) |
||
| 295 | +294 |
- })+ + |
+ |
| 295 | +! | +
+ vals <- reactiveValues(spiderplot = NULL) |
|
| 297 |
- # if marker position is NULL, then hide options for marker shape and color+ # render plot |
||
| 298 | ! |
- output$marker_shape_sel <- renderUI({
+ output_q <- reactive({
|
|
| 299 | -! | +
- if (dataname == "ADSL" || is.null(marker_shape_var) || is.null(input$marker_pos_var)) {
+ # get datasets --- |
|
| 300 | ! |
- NULL+ ADSL <- data()[["ADSL"]] |
|
| 301 | -+ | ! |
- } else {
+ ADTR <- data()[[dataname]] |
| 302 | -! | +
- ns <- session$ns+ |
|
| 303 | ! |
- teal.widgets::optionalSelectInput(+ teal::validate_inputs(iv()) |
|
| 304 | -! | +
- ns("marker_shape_var"), "Marker Shape",
+
|
|
| 305 | ! |
- choices = get_choices(marker_shape_var$choices),+ teal::validate_has_data(ADSL, min_nrow = 1, msg = sprintf("%s data has zero rows", "ADSL"))
|
|
| 306 | ! |
- selected = marker_shape_var$selected, multiple = FALSE,+ teal::validate_has_data(ADTR, min_nrow = 1, msg = sprintf("%s data has zero rows", dataname))
|
|
| 307 | -! | +
- label_help = helpText("from ", tags$code(dataname))
+
|
|
| 308 | -+ | ! |
- )+ paramcd <- input$paramcd |
| 309 | -+ | ! |
- }+ x_var <- input$x_var |
| 310 | -+ | ! |
- })+ y_var <- input$y_var |
| 311 | ! |
- output$marker_color_sel <- renderUI({
+ marker_var <- input$marker_var |
|
| 312 | ! |
- if (dataname == "ADSL" || is.null(marker_color_var) || is.null(input$marker_pos_var)) {
+ line_colorby_var <- input$line_colorby_var |
|
| 313 | ! |
- NULL+ anno_txt_var <- input$anno_txt_var |
|
| 314 | -+ | ! |
- } else {
+ legend_on <- input$legend_on |
| 315 | ! |
- ns <- session$ns+ xfacet_var <- input$xfacet_var |
|
| 316 | ! |
- teal.widgets::optionalSelectInput(+ yfacet_var <- input$yfacet_var |
|
| 317 | ! |
- ns("marker_color_var"), "Marker Color",
+ vref_line <- input$vref_line |
|
| 318 | ! |
- choices = get_choices(marker_color_var$choices),+ href_line <- input$href_line |
|
| 319 | -! | +
- selected = marker_color_var$selected, multiple = FALSE,+ |
|
| 320 | -! | +
- label_help = helpText("from ", tags$code(dataname))
+ # reference lines preprocessing |
|
| 321 | -+ | ! |
- )+ vref_line <- as_numeric_from_comma_sep_str(vref_line) |
| 322 | -+ | ! |
- }+ href_line <- as_numeric_from_comma_sep_str(href_line) |
| 323 |
- })+ |
||
| 324 |
-
+ # define variables --- |
||
| 325 |
- # create plot+ # if variable is not in ADSL, then take from domain VADs |
||
| 326 | ! |
- output_q <- reactive({
+ varlist <- c(xfacet_var, yfacet_var, marker_var, line_colorby_var) |
|
| 327 | ! |
- teal::validate_inputs(iv())+ varlist_from_adsl <- varlist[varlist %in% names(ADSL)] |
|
| 328 | -+ | ! |
-
+ varlist_from_anl <- varlist[!varlist %in% names(ADSL)] |
| 329 | -! | +
- validate(need("ADSL" %in% teal.data::datanames(data()), "'ADSL' not included in data"))
+
|
|
| 330 | ! |
- validate(need(+ adsl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_adsl))
|
|
| 331 | ! |
- (length(teal.data::datanames(data())) == 1 && dataname == "ADSL") ||+ adtr_vars <- unique(c("USUBJID", "STUDYID", "PARAMCD", x_var, y_var, varlist_from_anl))
|
|
| 332 | -! | +
- (length(teal.data::datanames(data())) >= 2 && dataname != "ADSL"), paste(+ |
|
| 333 | -! | +
- "Please either add just 'ADSL' as dataname when just ADSL is available.",+ # preprocessing of datasets to qenv --- |
|
| 334 | -! | +
- "In case 2 datasets are available ADSL is not supposed to be the dataname."+ |
|
| 335 |
- )+ # vars definition |
||
| 336 | -+ | ! |
- ))+ adtr_vars <- adtr_vars[adtr_vars != "None"] |
| 337 | -+ | ! |
-
+ adtr_vars <- adtr_vars[!is.null(adtr_vars)] |
| 338 | -! | +
- ADSL <- data()[["ADSL"]]+ |
|
| 339 |
-
+ # merge |
||
| 340 | ! |
- anl_vars <- unique(c(+ q1 <- teal.code::eval_code( |
|
| 341 | ! |
- "USUBJID", "STUDYID",+ data(), |
|
| 342 | ! |
- input$marker_pos_var, input$marker_shape_var, input$marker_color_var+ code = bquote({
|
|
| 343 | -+ | ! |
- ))+ ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame() |
| 344 | ! |
- adsl_vars <- unique(c(+ ADTR <- .(as.name(dataname))[, .(adtr_vars)] %>% as.data.frame() |
|
| 345 | -! | +
- "USUBJID", "STUDYID",+ |
|
| 346 | ! |
- input$bar_var, input$bar_color_var, input$sort_var, input$anno_txt_var+ ANL <- merge(ADSL, ADTR, by = c("USUBJID", "STUDYID"))
|
|
| 347 | -+ | ! |
- ))+ ANL <- ANL %>% |
| 348 | -+ | ! |
-
+ group_by(USUBJID, PARAMCD) %>% |
| 349 | ! |
- if (dataname == "ADSL") {
+ arrange(ANL[, .(x_var)]) %>% |
|
| 350 | ! |
- teal::validate_has_data(ADSL, min_nrow = 3)+ as.data.frame() |
|
| 351 | -! | +
- teal::validate_has_variable(ADSL, adsl_vars)+ }) |
|
| 352 |
- } else {
+ ) |
||
| 353 | -! | +
- anl <- data()[[dataname]]+ |
|
| 354 | -! | +
- teal::validate_has_data(anl, min_nrow = 3)+ # format and filter |
|
| 355 | ! |
- teal::validate_has_variable(anl, anl_vars)+ q1 <- teal.code::eval_code( |
|
| 356 | -+ | ! |
-
+ q1, |
| 357 | ! |
- validate(need(+ code = bquote({
|
|
| 358 | ! |
- !any(c(marker_pos_var, marker_shape_var, marker_color_var) %in% adsl_vars),+ ANL$USUBJID <- unlist(lapply(strsplit(ANL$USUBJID, "-", fixed = TRUE), tail, 1)) |
|
| 359 | ! |
- "marker-related variables need to come from marker data"+ ANL_f <- ANL %>% |
|
| 360 | -+ | ! |
- ))+ filter(PARAMCD == .(paramcd)) %>% |
| 361 | -+ | ! |
- }+ as.data.frame() |
| 362 |
-
+ }) |
||
| 363 |
- # VARIABLE GETTERS+ ) |
||
| 364 |
- # lookup bar variables+ |
||
| 365 | -! | +
- bar_var <- input$bar_var+ # label |
|
| 366 | ! |
- bar_color_var <- input$bar_color_var+ q1 <- if (anno_txt_var) {
|
|
| 367 | ! |
- sort_var <- input$sort_var+ teal.code::eval_code( |
|
| 368 | ! |
- anno_txt_var <- input$anno_txt_var+ q1, |
|
| 369 | -+ | ! |
-
+ code = quote(lbl <- list(txt_ann = as.factor(ANL_f$USUBJID))) |
| 370 |
- # Check if marker inputs can be used+ ) |
||
| 371 | -! | +
- if (dataname == "ADSL") {
+ } else {
|
|
| 372 | ! |
- marker_pos_var <- NULL+ teal.code::eval_code(q1, code = quote(lbl <- NULL)) |
|
| 373 | -! | +
- marker_shape_var <- NULL+ } |
|
| 374 | -! | +
- marker_color_var <- NULL+ |
|
| 375 |
- } else {
+ # plot code to qenv --- |
||
| 376 | -! | +
- marker_pos_var <- input$marker_pos_var+ |
|
| 377 | ! |
- marker_shape_var <- input$marker_shape_var+ q1 <- teal.code::eval_code( |
|
| 378 | ! |
- marker_color_var <- input$marker_color_var+ q1, |
|
| 379 | -+ | ! |
- }+ code = bquote({
|
| 380 | ! |
- vref_line <- suppressWarnings(as_numeric_from_comma_sep_str(debounce(reactive(input$vref_line), 1500)()))+ plot <- osprey::g_spiderplot( |
|
| 381 | -+ | ! |
-
+ marker_x = ANL_f[, .(x_var)], |
| 382 | ! |
- q1 <- data()+ marker_id = ANL_f$USUBJID, |
|
| 383 | -+ | ! |
-
+ marker_y = ANL_f[, .(y_var)], |
| 384 | ! |
- q2 <- teal.code::eval_code(+ line_colby = .(if (line_colorby_var != "None") {
|
|
| 385 | ! |
- q1,+ bquote(ANL_f[, .(line_colorby_var)]) |
|
| 386 | -! | +
- code = bquote({
+ } else {
|
|
| 387 | ! |
- bar_var <- .(bar_var)+ NULL |
|
| 388 | -! | +
- bar_color_var <- .(bar_color_var)+ }), |
|
| 389 | ! |
- sort_var <- .(sort_var)+ marker_shape = .(if (marker_var != "None") {
|
|
| 390 | ! |
- marker_pos_var <- .(marker_pos_var)+ bquote(ANL_f[, .(marker_var)]) |
|
| 391 | -! | +
- marker_shape_var <- .(marker_shape_var)+ } else {
|
|
| 392 | ! |
- marker_color_var <- .(marker_color_var)+ NULL |
|
| 393 | -! | +
- anno_txt_var <- .(anno_txt_var)+ }), |
|
| 394 | -+ | ! |
- })+ marker_size = 4, |
| 395 | -+ | ! |
- )+ datalabel_txt = lbl, |
| 396 | -+ | ! |
-
+ facet_rows = .(if (!is.null(yfacet_var)) {
|
| 397 | -+ | ! |
- # WRITE DATA SELECTION TO qenv+ bquote(data.frame(ANL_f[, .(yfacet_var)])) |
| 398 | -! | +
- q3 <- if (dataname == "ADSL") {
+ } else {
|
|
| 399 | ! |
- teal.code::eval_code(+ NULL |
|
| 400 | -! | +
- q2,+ }), |
|
| 401 | ! |
- code = bquote({
+ facet_columns = .(if (!is.null(xfacet_var)) {
|
|
| 402 | ! |
- ADSL_p <- ADSL+ bquote(data.frame(ANL_f[, .(xfacet_var)])) |
|
| 403 | -! | +
- ADSL <- ADSL_p[, .(adsl_vars)]+ } else {
|
|
| 404 | -+ | ! |
- # only take last part of USUBJID+ NULL |
| 405 | -! | +
- ADSL$USUBJID <- unlist(lapply(strsplit(ADSL$USUBJID, "-", fixed = TRUE), tail, 1))+ }), |
|
| 406 | -+ | ! |
- })+ vref_line = .(vref_line), |
| 407 | -+ | ! |
- )+ href_line = .(href_line), |
| 408 | -+ | ! |
- } else {
+ x_label = if (is.null(formatters::var_labels(ADTR[.(x_var)], fill = FALSE))) {
|
| 409 | ! |
- teal.code::eval_code(+ .(x_var) |
|
| 410 | -! | +
- q2,+ } else {
|
|
| 411 | ! |
- code = bquote({
+ formatters::var_labels(ADTR[.(x_var)], fill = FALSE) |
|
| 412 | -! | +
- ADSL_p <- ADSL+ }, |
|
| 413 | ! |
- ANL_p <- .(as.name(dataname))+ y_label = if (is.null(formatters::var_labels(ADTR[.(y_var)], fill = FALSE))) {
|
|
| 414 | -+ | ! |
-
+ .(y_var) |
| 415 | -! | +
- ADSL <- ADSL_p[, .(adsl_vars)]+ } else {
|
|
| 416 | ! |
- ANL <- merge(+ formatters::var_labels(ADTR[.(y_var)], fill = FALSE) |
|
| 417 | -! | +
- x = ADSL,+ }, |
|
| 418 | ! |
- y = ANL_p[, .(anl_vars)],+ show_legend = .(legend_on) |
|
| 419 | -! | +
- all.x = FALSE, all.y = FALSE,+ ) |
|
| 420 | -! | +
- by = c("USUBJID", "STUDYID")
+
|
|
| 421 | -+ | ! |
- )+ plot |
| 422 |
- # only take last part of USUBJID+ }) |
||
| 423 | -! | +
- ADSL$USUBJID <- unlist(lapply(strsplit(ADSL$USUBJID, "-", fixed = TRUE), tail, 1))+ ) |
|
| 424 | -! | +
- ANL$USUBJID <- unlist(lapply(strsplit(ANL$USUBJID, "-", fixed = TRUE), tail, 1))+ }) |
|
| 425 |
- })+ |
||
| 426 | -+ | ! |
- )+ plot_r <- reactive(output_q()[["plot"]]) |
| 427 |
- }+ |
||
| 428 | -+ | ! |
-
+ pws <- teal.widgets::plot_with_settings_srv( |
| 429 | ! |
- plot_call <- if (dataname == "ADSL") {
+ id = "spiderplot", |
|
| 430 | ! |
- bquote(+ plot_r = plot_r, |
|
| 431 | ! |
- plot <- osprey::g_swimlane(+ height = plot_height, |
|
| 432 | ! |
- bar_id = ADSL[["USUBJID"]],+ width = plot_width |
|
| 433 | -! | +
- bar_length = ADSL[[bar_var]],+ ) |
|
| 434 | -! | +
- sort_by = .(if (length(sort_var) > 0) quote(ADSL[[sort_var]]) else NULL),+ |
|
| 435 | ! |
- col_by = .(if (length(bar_color_var) > 0) quote(ADSL[[bar_color_var]]) else NULL),+ teal.widgets::verbatim_popup_srv( |
|
| 436 | ! |
- marker_id = NULL,+ id = "rcode", |
|
| 437 | ! |
- marker_pos = NULL,+ title = paste("R code for", label),
|
|
| 438 | ! |
- marker_shape = NULL,+ verbatim_content = reactive(teal.code::get_code(output_q())) |
|
| 439 | -! | +
- marker_shape_opt = NULL,+ ) |
|
| 440 | -! | +
- marker_color = NULL,+ |
|
| 441 | -! | +
- marker_color_opt = NULL,+ ### REPORTER |
|
| 442 | ! |
- anno_txt = .(if (length(anno_txt_var) > 0) quote(ADSL[, anno_txt_var]) else NULL),+ if (with_reporter) {
|
|
| 443 | ! |
- xref_line = .(vref_line),+ card_fun <- function(comment, label) {
|
|
| 444 | ! |
- xtick_at = waiver(),+ card <- teal::report_card_template( |
|
| 445 | ! |
- xlab = .(x_label),+ title = "Spider Plot", |
|
| 446 | ! |
- title = "Swimlane Plot"+ label = label, |
|
| 447 | -+ | ! |
- )+ with_filter = with_filter, |
| 448 | -+ | ! |
- )+ filter_panel_api = filter_panel_api |
| 449 |
- } else {
+ ) |
||
| 450 | ! |
- bquote(+ if (!is.null(input$paramcd) || !is.null(input$xfacet_var) || !is.null(input$yfacet_var)) {
|
|
| 451 | ! |
- plot <- osprey::g_swimlane(+ card$append_text("Selected Options", "header3")
|
|
| 452 | -! | +
- bar_id = ADSL[["USUBJID"]],+ } |
|
| 453 | ! |
- bar_length = ADSL[[bar_var]],+ if (!is.null(input$paramcd)) {
|
|
| 454 | ! |
- sort_by = .(if (length(sort_var) > 0) {
+ card$append_text(paste0("Parameter - (from ", dataname, "): ", input$paramcd, "."))
|
|
| 455 | -! | +
- quote(ADSL[[sort_var]])+ } |
|
| 456 | -+ | ! |
- } else {
+ if (!is.null(input$xfacet_var)) {
|
| 457 | ! |
- NULL+ card$append_text(paste0("Faceted horizontally by: ", paste(input$xfacet_var, collapse = ", "), "."))
|
|
| 458 |
- }),+ } |
||
| 459 | ! |
- col_by = .(if (length(bar_color_var) > 0) {
+ if (!is.null(input$yfacet_var)) {
|
|
| 460 | ! |
- quote(ADSL[[bar_color_var]])+ card$append_text(paste0("Faceted vertically by: ", paste(input$yfacet_var, collapse = ", "), "."))
|
|
| 461 |
- } else {
+ } |
||
| 462 | ! |
- NULL+ card$append_text("Plot", "header3")
|
|
| 463 | -+ | ! |
- }),+ card$append_plot(plot_r(), dim = pws$dim()) |
| 464 | ! |
- marker_id = ANL[["USUBJID"]],+ if (!comment == "") {
|
|
| 465 | ! |
- marker_pos = .(if (length(marker_pos_var) > 0) {
+ card$append_text("Comment", "header3")
|
|
| 466 | ! |
- quote(ANL[[marker_pos_var]])+ card$append_text(comment) |
|
| 467 |
- } else {
+ } |
||
| 468 | ! |
- NULL+ card$append_src(teal.code::get_code(output_q())) |
|
| 469 | -+ | ! |
- }),+ card |
| 470 | -! | +
- marker_shape = .(if (length(marker_shape_var) > 0) {
+ } |
|
| 471 | ! |
- quote(ANL[[marker_shape_var]])+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
|
|
| 472 |
- } else {
+ } |
||
| 473 | -! | +
- NULL+ }) |
|
| 474 |
- }),+ } |
||
| 475 | -! | +
| 1 | +
- marker_shape_opt = .(if (length(marker_shape_var) == 0) {
+ #' Teal module for the heatmap by grade |
||
| 476 | -! | +||
| 2 | +
- NULL+ #' |
||
| 477 | -! | +||
| 3 | +
- } else if (length(marker_shape_var) > 0 && all(unique(anl[[marker_shape_var]]) %in% names(marker_shape_opt))) { # nolint: line_length.
+ #' @description |
||
| 478 | -! | +||
| 4 | +
- bquote(.(marker_shape_opt))+ #' `r lifecycle::badge("stable")`
|
||
| 479 | +5 |
- } else {
+ #' |
|
| 480 | -! | +||
| 6 | +
- NULL+ #' Display the heatmap by grade as a shiny module |
||
| 481 | +7 |
- }),+ #' |
|
| 482 | -! | +||
| 8 | +
- marker_color = .(if (length(marker_color_var) > 0) {
+ #' @inheritParams teal.widgets::standard_layout |
||
| 483 | -! | +||
| 9 | +
- quote(ANL[[marker_color_var]])+ #' @inheritParams argument_convention |
||
| 484 | +10 |
- } else {
+ #' @param sl_dataname (`character`) subject level dataset name, |
|
| 485 | -! | +||
| 11 | +
- NULL+ #' needs to be available in the list passed to the `data` |
||
| 486 | +12 |
- }),+ #' argument of [teal::init()] |
|
| 487 | -! | +||
| 13 | +
- marker_color_opt = .(if (length(marker_color_var) == 0) {
+ #' @param ex_dataname (`character`) exposures dataset name, |
||
| 488 | -! | +||
| 14 | +
- NULL+ #' needs to be available in the list passed to the `data` |
||
| 489 | -! | +||
| 15 | +
- } else if (length(marker_color_var) > 0 && all(unique(anl[[marker_color_var]]) %in% names(marker_color_opt))) { # nolint: line_length.
+ #' argument of [teal::init()] \cr |
||
| 490 | -! | +||
| 16 | +
- bquote(.(marker_color_opt))+ #' @param ae_dataname (`character`) adverse events dataset name, |
||
| 491 | +17 |
- } else {
+ #' needs to be available in the list passed to the `data` |
|
| 492 | -! | +||
| 18 | +
- NULL+ #' argument of [teal::init()] \cr |
||
| 493 | +19 |
- }),+ #' @param cm_dataname (`character`) concomitant medications dataset name, |
|
| 494 | -! | +||
| 20 | +
- anno_txt = .(if (length(anno_txt_var) > 0) {
+ #' needs to be available in the list passed to the `data` |
||
| 495 | -! | +||
| 21 | +
- quote(ADSL[, anno_txt_var])+ #' argument of [teal::init()] \cr |
||
| 496 | +22 |
- } else {
+ #' specify to `NA` if no concomitant medications data is available |
|
| 497 | -! | +||
| 23 | +
- NULL+ #' @param id_var (`choices_seleced`) unique subject ID variable |
||
| 498 | +24 |
- }),+ #' @param visit_var (`choices_seleced`) analysis visit variable |
|
| 499 | -! | +||
| 25 | +
- xref_line = .(vref_line),+ #' @param ongo_var (`choices_seleced`) study ongoing status variable. |
||
| 500 | -! | +||
| 26 | +
- xtick_at = waiver(),+ #' 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 | ++ |
+ #' |
|
| 501 | -! | +||
| 32 | +
- xlab = .(x_label),+ #' @inherit argument_convention return |
||
| 502 | -! | +||
| 33 | +
- title = "Swimlane Plot"+ #' |
||
| 503 | +34 |
- )+ #' @export |
|
| 504 | +35 |
- )+ #' |
|
| 505 | +36 |
- }+ #' @examples |
|
| 506 | +37 |
-
+ #' data <- teal_data() |> |
|
| 507 | -! | +||
| 38 | +
- q4 <- teal.code::eval_code(q3, code = plot_call)+ #' within({
|
||
| 508 | -! | +||
| 39 | +
- teal.code::eval_code(q4, quote(plot))+ #' library(dplyr) |
||
| 509 | +40 |
- })+ #' ADSL <- rADSL %>% slice(1:30) |
|
| 510 | +41 |
-
+ #' ADEX <- rADEX %>% filter(USUBJID %in% ADSL$USUBJID) |
|
| 511 | -! | +||
| 42 | +
- plot_r <- reactive(output_q()[["plot"]])+ #' ADAE <- rADAE %>% filter(USUBJID %in% ADSL$USUBJID) |
||
| 512 | +43 |
-
+ #' ADCM <- rADCM %>% filter(USUBJID %in% ADSL$USUBJID) |
|
| 513 | +44 |
- # Insert the plot into a plot_with_settings module from teal.widgets+ #' # This preprocess is only to force legacy standard on ADCM |
|
| 514 | -! | +||
| 45 | +
- pws <- teal.widgets::plot_with_settings_srv(+ #' ADCM <- ADCM %>% |
||
| 515 | -! | +||
| 46 | +
- id = "swimlaneplot",+ #' select(-starts_with("ATC")) %>%
|
||
| 516 | -! | +||
| 47 | +
- plot_r = plot_r,+ #' unique() |
||
| 517 | -! | +||
| 48 | +
- height = plot_height,+ #' # function to derive AVISIT from ADEX |
||
| 518 | -! | +||
| 49 | +
- width = plot_width+ #' .add_visit <- function(data_need_visit) {
|
||
| 519 | +50 |
- )+ #' visit_dates <- ADEX %>% |
|
| 520 | +51 |
-
+ #' filter(PARAMCD == "DOSE") %>% |
|
| 521 | -! | +||
| 52 | +
- teal.widgets::verbatim_popup_srv(+ #' distinct(USUBJID, AVISIT, ASTDTM) %>% |
||
| 522 | -! | +||
| 53 | +
- id = "rcode",+ #' group_by(USUBJID) %>% |
||
| 523 | -! | +||
| 54 | +
- title = paste("R code for", label),
+ #' arrange(ASTDTM) %>% |
||
| 524 | -! | +||
| 55 | +
- verbatim_content = reactive(teal.code::get_code(output_q()))+ #' mutate(next_vis = lead(ASTDTM), is_last = ifelse(is.na(next_vis), TRUE, FALSE)) %>% |
||
| 525 | +56 |
- )+ #' rename(this_vis = ASTDTM) |
|
| 526 | +57 |
-
+ #' data_visit <- data_need_visit %>% |
|
| 527 | +58 |
- ### REPORTER+ #' select(USUBJID, ASTDTM) %>% |
|
| 528 | -! | +||
| 59 | +
- if (with_reporter) {
+ #' left_join(visit_dates, by = "USUBJID") %>% |
||
| 529 | -! | +||
| 60 | +
- card_fun <- function(comment, label) {
+ #' filter(ASTDTM > this_vis & (ASTDTM < next_vis | is_last == TRUE)) %>% |
||
| 530 | -! | +||
| 61 | +
- card <- teal::report_card_template(+ #' left_join(data_need_visit) %>% |
||
| 531 | -! | +||
| 62 | +
- title = "Swimlane Plot",+ #' distinct() |
||
| 532 | -! | +||
| 63 | +
- label = label,+ #' return(data_visit) |
||
| 533 | -! | +||
| 64 | +
- with_filter = with_filter,+ #' } |
||
| 534 | -! | +||
| 65 | +
- filter_panel_api = filter_panel_api+ #' # derive AVISIT for ADAE and ADCM |
||
| 535 | +66 |
- )+ #' ADAE <- .add_visit(ADAE) |
|
| 536 | -! | +||
| 67 | +
- if (!is.null(input$sort_var)) {
+ #' ADCM <- .add_visit(ADCM) |
||
| 537 | -! | +||
| 68 | +
- card$append_text("Selected Options", "header3")
+ #' # derive ongoing status variable for ADEX |
||
| 538 | -! | +||
| 69 | +
- card$append_text(paste("Sorted by:", input$sort_var))
+ #' ADEX <- ADEX %>% |
||
| 539 | +70 |
- }+ #' filter(PARCAT1 == "INDIVIDUAL") %>% |
|
| 540 | -! | +||
| 71 | +
- card$append_text("Plot", "header3")
+ #' mutate(ongo_status = (EOSSTT == "ONGOING")) |
||
| 541 | -! | +||
| 72 | +
- card$append_plot(plot_r(), dim = pws$dim())+ #' }) |
||
| 542 | -! | +||
| 73 | +
- if (!comment == "") {
+ #' |
||
| 543 | -! | +||
| 74 | +
- card$append_text("Comment", "header3")
+ #' join_keys(data) <- default_cdisc_join_keys[names(data)] |
||
| 544 | -! | +||
| 75 | +
- card$append_text(comment)+ #' |
||
| 545 | +76 |
- }+ #' ADCM <- data[["ADCM"]] |
|
| 546 | -! | +||
| 77 | +
- card$append_src(teal.code::get_code(output_q()))+ #' |
||
| 547 | -! | +||
| 78 | +
- card+ #' app <- init( |
||
| 548 | +79 |
- }+ #' data = data, |
|
| 549 | -! | +||
| 80 | +
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
+ #' modules = modules( |
||
| 550 | +81 |
- }+ #' tm_g_heat_bygrade( |
|
| 551 | +82 |
- })+ #' label = "Heatmap by grade", |
|
| 552 | +83 |
- }+ #' sl_dataname = "ADSL", |
| 1 | +84 |
- #' Helper UI function to decorate plot output UI+ #' ex_dataname = "ADEX", |
|
| 2 | +85 |
- #'+ #' ae_dataname = "ADAE", |
|
| 3 | +86 |
- #' @description+ #' cm_dataname = "ADCM", |
|
| 4 | +87 |
- #' `r lifecycle::badge("stable")`
+ #' id_var = choices_selected( |
|
| 5 | +88 |
- #'+ #' selected = "USUBJID", |
|
| 6 | +89 |
- #' This is used in [tm_g_ae_oview()] and [tm_g_events_term_id()].+ #' choices = c("USUBJID", "SUBJID")
|
|
| 7 | +90 |
- #'+ #' ), |
|
| 8 | +91 |
- #' @param id (`character`) id of this module. set to `NULL` if you want to make it identical+ #' visit_var = choices_selected( |
|
| 9 | +92 |
- #' to the module who called it.+ #' selected = "AVISIT", |
|
| 10 | +93 |
- #' @param titles (`character`) default titles+ #' choices = c("AVISIT")
|
|
| 11 | +94 |
- #' @param footnotes (`character`) default footnotes+ #' ), |
|
| 12 | +95 |
- #' @inheritParams argument_convention+ #' ongo_var = choices_selected( |
|
| 13 | +96 |
- #' @export+ #' selected = "ongo_status", |
|
| 14 | +97 |
- ui_g_decorate <- function(id,+ #' choices = c("ongo_status")
|
|
| 15 | +98 |
- titles = "Titles",+ #' ), |
|
| 16 | +99 |
- footnotes = "footnotes",+ #' anno_var = choices_selected( |
|
| 17 | +100 |
- fontsize = c(5, 4, 11)) {
+ #' selected = c("SEX", "COUNTRY"),
|
|
| 18 | -! | +||
| 101 | +
- ns <- NS(id)+ #' choices = c("SEX", "COUNTRY", "USUBJID")
|
||
| 19 | -! | +||
| 102 | +
- tagList(+ #' ), |
||
| 20 | -! | +||
| 103 | +
- teal.widgets::optionalSliderInputValMinMax(+ #' heat_var = choices_selected( |
||
| 21 | -! | +||
| 104 | +
- ns("fontsize"),
+ #' selected = "AETOXGR", |
||
| 22 | -! | +||
| 105 | +
- "Font Size",+ #' choices = c("AETOXGR")
|
||
| 23 | -! | +||
| 106 | +
- value_min_max = fontsize,+ #' ), |
||
| 24 | -! | +||
| 107 | +
- step = 0.1+ #' conmed_var = choices_selected( |
||
| 25 | +108 |
- ),+ #' selected = "CMDECOD", |
|
| 26 | -! | +||
| 109 | +
- textInput(ns("title"), "Title", value = titles),
+ #' choices = c("CMDECOD")
|
||
| 27 | -! | +||
| 110 | +
- textAreaInput(ns("foot"), "Footnote", value = footnotes, resize = "none")
+ #' ), |
||
| 28 | +111 |
- )+ #' plot_height = c(600, 200, 2000) |
|
| 29 | +112 |
- }+ #' ) |
|
| 30 | +113 |
-
+ #' ) |
|
| 31 | +114 |
- #' Helper server function to decorate plot output+ #' ) |
|
| 32 | +115 |
- #'+ #' if (interactive()) {
|
|
| 33 | +116 |
- #' @description+ #' shinyApp(app$ui, app$server) |
|
| 34 | +117 |
- #' `r lifecycle::badge("stable")`
+ #' } |
|
| 35 | +118 |
#' |
|
| 36 | +119 |
- #' This is used in [tm_g_ae_oview()] and [tm_g_events_term_id()].+ tm_g_heat_bygrade <- function(label, |
|
| 37 | +120 |
- #'+ sl_dataname, |
|
| 38 | +121 |
- #' @inheritParams shared_params+ ex_dataname, |
|
| 39 | +122 |
- #' @param id (`character`) id of the module+ ae_dataname, |
|
| 40 | +123 |
- #' @param plot_id (`character`) id for plot output+ cm_dataname = NA, |
|
| 41 | +124 |
- #' @param plt (`reactive`) a reactive object of graph object+ id_var, |
|
| 42 | +125 |
- #'+ visit_var, |
|
| 43 | +126 |
- #' @export+ ongo_var, |
|
| 44 | +127 |
- srv_g_decorate <- function(id,+ anno_var, |
|
| 45 | +128 |
- plot_id = "out",+ heat_var, |
|
| 46 | +129 |
- plt = reactive(NULL),+ conmed_var = NULL, |
|
| 47 | +130 |
- plot_height,+ fontsize = c(5, 3, 7), |
|
| 48 | +131 |
- plot_width) {
+ plot_height = c(600L, 200L, 2000L), |
|
| 49 | -! | +||
| 132 | +
- moduleServer(id, function(input, output, session) {
+ plot_width = NULL) {
|
||
| 50 | +133 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ message("Initializing tm_g_heat_bygrade")
|
| 51 | +134 | ! |
- plot_g <- reactive({
+ args <- as.list(environment()) |
| 52 | -! | +||
| 135 | +
- g <- tern::decorate_grob(+ |
||
| 53 | +136 | ! |
- plt(),+ checkmate::assert_string(label) |
| 54 | +137 | ! |
- titles = input$title,+ checkmate::assert_string(sl_dataname) |
| 55 | +138 | ! |
- footnotes = input$foot,+ checkmate::assert_string(ex_dataname) |
| 56 | +139 | ! |
- gp_titles = grid::gpar(+ checkmate::assert_string(ae_dataname) |
| 57 | +140 | ! |
- fontsize = input$fontsize * ggplot2::.pt,+ checkmate::assert_string(cm_dataname, na.ok = TRUE) |
| 58 | +141 | ! |
- col = "black",+ checkmate::assert_class(id_var, classes = "choices_selected") |
| 59 | +142 | ! |
- fontface = "bold"- |
-
| 60 | -- |
- ),+ checkmate::assert_class(visit_var, classes = "choices_selected") |
|
| 61 | +143 | ! |
- gp_footnotes = grid::gpar(fontsize = input$fontsize * ggplot2::.pt, col = "black")- |
-
| 62 | -- |
- )- |
- |
| 63 | -- |
- })- |
- |
| 64 | -- |
-
+ checkmate::assert_class(ongo_var, classes = "choices_selected") |
|
| 65 | +144 | ! |
- plot_r <- function() {
+ checkmate::assert_class(anno_var, classes = "choices_selected") |
| 66 | +145 | ! |
- grid::grid.newpage()+ checkmate::assert_class(heat_var, classes = "choices_selected") |
| 67 | +146 | ! |
- grid::grid.draw(plot_g())+ checkmate::assert_class(conmed_var, classes = "choices_selected", null.ok = TRUE) |
| 68 | +147 | ! |
- plot_g()- |
-
| 69 | -- |
- }- |
- |
| 70 | -- |
-
+ checkmate::assert( |
|
| 71 | +148 | ! |
- class(plot_r) <- c(class(plot_r), "reactive")- |
-
| 72 | -- |
-
+ checkmate::check_number(fontsize, finite = TRUE), |
|
| 73 | +149 | ! |
- pws <- teal.widgets::plot_with_settings_srv(+ checkmate::assert( |
| 74 | +150 | ! |
- id = plot_id,+ combine = "and", |
| 75 | +151 | ! |
- plot_r = plot_r,+ .var.name = "fontsize", |
| 76 | +152 | ! |
- height = plot_height,+ checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE), |
| 77 | +153 | ! |
- width = plot_width+ checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3]) |
| 78 | +154 |
) |
|
| 79 | +155 |
-
+ ) |
|
| 80 | +156 | ! |
- return(+ checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) |
| 81 | +157 | ! |
- list(+ checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") |
| 82 | +158 | ! |
- font_size = reactive(input$fontsize),+ checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) |
| 83 | +159 | ! |
- pws = pws- |
-
| 84 | -- |
- )- |
- |
| 85 | -- |
- )- |
- |
| 86 | -- |
- })+ checkmate::assert_numeric( |
|
| 87 | -+ | ||
| 160 | +! |
- }+ plot_width[1], |
|
| 88 | -+ | ||
| 161 | +! |
-
+ lower = plot_width[2], |
|
| 89 | -+ | ||
| 162 | +! |
- #' Helper function to plot decorated output UI+ upper = plot_width[3], |
|
| 90 | -+ | ||
| 163 | +! |
- #'+ null.ok = TRUE, |
|
| 91 | -+ | ||
| 164 | +! |
- #' @description+ .var.name = "plot_width" |
|
| 92 | +165 |
- #' `r lifecycle::badge("stable")`
+ ) |
|
| 93 | +166 |
- #'+ |
|
| 94 | -+ | ||
| 167 | +! |
- #' @param id (`character`) id of this element+ module( |
|
| 95 | -+ | ||
| 168 | +! |
- #'+ label = label, |
|
| 96 | -+ | ||
| 169 | +! |
- #' @export+ server = srv_g_heatmap_bygrade, |
|
| 97 | -+ | ||
| 170 | +! |
- plot_decorate_output <- function(id) {
+ server_args = list( |
|
| 98 | +171 | ! |
- ns <- NS(id)+ label = label, |
| 99 | +172 | ! |
- teal.widgets::plot_with_settings_ui(id = ns("out"))
+ sl_dataname = sl_dataname, |
| 100 | -+ | ||
| 173 | +! |
- }+ ex_dataname = ex_dataname, |
| 1 | -+ | ||
| 174 | +! |
- #' Events by Term Plot Teal Module+ ae_dataname = ae_dataname, |
|
| 2 | -+ | ||
| 175 | +! |
- #'+ cm_dataname = cm_dataname, |
|
| 3 | -+ | ||
| 176 | +! |
- #' @description+ plot_height = plot_height, |
|
| 4 | -+ | ||
| 177 | +! |
- #' `r lifecycle::badge("stable")`
+ plot_width = plot_width |
|
| 5 | +178 |
- #'+ ), |
|
| 6 | -+ | ||
| 179 | +! |
- #' Display Events by Term plot as a shiny module+ ui = ui_g_heatmap_bygrade, |
|
| 7 | -+ | ||
| 180 | +! |
- #'+ ui_args = args, |
|
| 8 | -+ | ||
| 181 | +! |
- #' @inheritParams teal.widgets::standard_layout+ datanames = "all" |
|
| 9 | +182 |
- #' @inheritParams argument_convention+ ) |
|
| 10 | +183 |
- #' @param term_var [teal.transform::choices_selected] object with all available choices+ } |
|
| 11 | +184 |
- #' and pre-selected option names that can be used to specify the term for events+ |
|
| 12 | +185 |
- #'+ ui_g_heatmap_bygrade <- function(id, ...) {
|
|
| 13 | -+ | ||
| 186 | +! |
- #' @inherit argument_convention return+ ns <- NS(id) |
|
| 14 | -+ | ||
| 187 | +! |
- #'+ args <- list(...) |
|
| 15 | +188 |
- #' @export+ |
|
| 16 | -+ | ||
| 189 | +! |
- #'+ shiny::tagList( |
|
| 17 | -+ | ||
| 190 | +! |
- #' @author Liming Li (lil128) \email{liming.li@roche.com}
+ include_css_files("custom"),
|
|
| 18 | -+ | ||
| 191 | +! |
- #' @author Molly He (hey59) \email{hey59@gene.com}
+ teal.widgets::standard_layout( |
|
| 19 | -+ | ||
| 192 | +! |
- #'+ output = teal.widgets::white_small_well( |
|
| 20 | -+ | ||
| 193 | +! |
- #' @examples+ plot_decorate_output(id = ns(NULL)) |
|
| 21 | +194 |
- #' data <- teal_data() |>+ ), |
|
| 22 | -+ | ||
| 195 | +! |
- #' within({
+ encoding = tags$div( |
|
| 23 | +196 |
- #' ADSL <- rADSL+ ### Reporter |
|
| 24 | -+ | ||
| 197 | +! |
- #' ADAE <- rADAE+ teal.reporter::simple_reporter_ui(ns("simple_reporter")),
|
|
| 25 | +198 |
- #' })+ ### |
|
| 26 | -+ | ||
| 199 | +! |
- #'+ teal.widgets::optionalSelectInput( |
|
| 27 | -+ | ||
| 200 | +! |
- #' datanames(data) <- c("ADSL", "ADAE")
+ ns("id_var"),
|
|
| 28 | -+ | ||
| 201 | +! |
- #' join_keys(data) <- default_cdisc_join_keys[datanames(data)]+ "ID Variable", |
|
| 29 | -+ | ||
| 202 | +! |
- #'+ choices = get_choices(args$id_var$choices), |
|
| 30 | -+ | ||
| 203 | +! |
- #' app <- init(+ selected = args$id_var$selected, |
|
| 31 | -+ | ||
| 204 | +! |
- #' data = data,+ multiple = FALSE |
|
| 32 | +205 |
- #' modules = modules(+ ), |
|
| 33 | -+ | ||
| 206 | +! |
- #' tm_g_events_term_id(+ teal.widgets::optionalSelectInput( |
|
| 34 | -+ | ||
| 207 | +! |
- #' label = "Common AE",+ ns("visit_var"),
|
|
| 35 | -+ | ||
| 208 | +! |
- #' dataname = "ADAE",+ "Visit Variable", |
|
| 36 | -+ | ||
| 209 | +! |
- #' term_var = choices_selected(+ choices = get_choices(args$visit_var$choices), |
|
| 37 | -+ | ||
| 210 | +! |
- #' selected = "AEDECOD",+ selected = args$visit_var$selected, |
|
| 38 | -+ | ||
| 211 | +! |
- #' choices = c(+ multiple = FALSE |
|
| 39 | +212 |
- #' "AEDECOD", "AETERM",+ ), |
|
| 40 | -+ | ||
| 213 | +! |
- #' "AEHLT", "AELLT", "AEBODSYS"+ teal.widgets::optionalSelectInput( |
|
| 41 | -+ | ||
| 214 | +! |
- #' )+ ns("ongo_var"),
|
|
| 42 | -+ | ||
| 215 | +! |
- #' ),+ "Study Ongoing Status Variable", |
|
| 43 | -+ | ||
| 216 | +! |
- #' arm_var = choices_selected(+ choices = get_choices(args$ongo_var$choices), |
|
| 44 | -+ | ||
| 217 | +! |
- #' selected = "ACTARMCD",+ selected = args$ongo_var$selected, |
|
| 45 | -+ | ||
| 218 | +! |
- #' choices = c("ACTARM", "ACTARMCD")
+ multiple = FALSE |
|
| 46 | +219 |
- #' ),+ ), |
|
| 47 | -+ | ||
| 220 | +! |
- #' plot_height = c(600, 200, 2000)+ teal.widgets::optionalSelectInput( |
|
| 48 | -+ | ||
| 221 | +! |
- #' )+ ns("anno_var"),
|
|
| 49 | -+ | ||
| 222 | +! |
- #' )+ "Annotation Variables", |
|
| 50 | -+ | ||
| 223 | +! |
- #' )+ choices = get_choices(args$anno_var$choices), |
|
| 51 | -+ | ||
| 224 | +! |
- #' if (interactive()) {
+ selected = args$anno_var$selected, |
|
| 52 | -+ | ||
| 225 | +! |
- #' shinyApp(app$ui, app$server)+ multiple = TRUE |
|
| 53 | +226 |
- #' }+ ), |
|
| 54 | -+ | ||
| 227 | +! |
- #'+ teal.widgets::optionalSelectInput( |
|
| 55 | -+ | ||
| 228 | +! |
- tm_g_events_term_id <- function(label,+ ns("heat_var"),
|
|
| 56 | -+ | ||
| 229 | +! |
- dataname,+ "Heat Variable", |
|
| 57 | -+ | ||
| 230 | +! |
- term_var,+ choices = get_choices(args$heat_var$choices), |
|
| 58 | -+ | ||
| 231 | +! |
- arm_var,+ selected = args$heat_var$selected, |
|
| 59 | -+ | ||
| 232 | +! |
- fontsize = c(5, 3, 7),+ multiple = FALSE |
|
| 60 | +233 |
- plot_height = c(600L, 200L, 2000L),+ ), |
|
| 61 | -+ | ||
| 234 | +! |
- plot_width = NULL) {
+ helpText("Plot conmed"),
|
|
| 62 | +235 | ! |
- message("Initializing tm_g_events_term_id")
+ tags$div( |
| 63 | +236 | ! |
- checkmate::assert_string(label)+ class = "pretty-left-border", |
| 64 | +237 | ! |
- checkmate::assert_class(term_var, classes = "choices_selected")+ if (!is.na(args$cm_dataname)) {
|
| 65 | +238 | ! |
- checkmate::assert_class(arm_var, classes = "choices_selected")+ checkboxInput( |
| 66 | +239 | ! |
- checkmate::assert(+ ns("plot_cm"),
|
| 67 | +240 | ! |
- checkmate::check_number(fontsize, finite = TRUE),+ "Yes", |
| 68 | +241 | ! |
- checkmate::assert(+ value = !is.na(args$cm_dataname) |
| 69 | -! | +||
| 242 | +
- combine = "and",+ )+ |
+ ||
| 243 | ++ |
+ }+ |
+ |
| 244 | ++ |
+ ), |
|
| 70 | +245 | ! |
- .var.name = "fontsize",+ conditionalPanel( |
| 71 | +246 | ! |
- checkmate::check_numeric(fontsize, len = 3, any.missing = FALSE, finite = TRUE),+ paste0("input['", ns("plot_cm"), "']"),
|
| 72 | +247 | ! |
- checkmate::check_numeric(fontsize[1], lower = fontsize[2], upper = fontsize[3])+ teal.widgets::optionalSelectInput( |
| 73 | -+ | ||
| 248 | +! |
- )+ ns("conmed_var"),
|
|
| 74 | -+ | ||
| 249 | +! |
- )+ "Conmed Variable", |
|
| 75 | +250 | ! |
- checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)+ choices = get_choices(args$conmed_var$choices), |
| 76 | +251 | ! |
- checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")+ selected = args$conmed_var$selected, |
| 77 | +252 | ! |
- checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)+ multiple = FALSE+ |
+
| 253 | ++ |
+ ), |
|
| 78 | +254 | ! |
- checkmate::assert_numeric(+ selectInput( |
| 79 | +255 | ! |
- plot_width[1],+ ns("conmed_level"),
|
| 80 | +256 | ! |
- lower = plot_width[2],+ "Conmed Levels", |
| 81 | +257 | ! |
- upper = plot_width[3],+ choices = get_choices(args$conmed_var$choices), |
| 82 | +258 | ! |
- null.ok = TRUE,+ selected = args$conmed_var$selected, |
| 83 | +259 | ! |
- .var.name = "plot_width"+ multiple = TRUE |
| 84 | +260 |
- )+ ) |
|
| 85 | +261 |
-
+ ), |
|
| 86 | +262 | ! |
- args <- as.list(environment())+ ui_g_decorate( |
| 87 | -+ | ||
| 263 | +! |
-
+ ns(NULL), |
|
| 88 | +264 | ! |
- module(+ fontsize = args$fontsize, |
| 89 | +265 | ! |
- label = label,+ titles = "Heatmap by Grade", |
| 90 | +266 | ! |
- server = srv_g_events_term_id,+ footnotes = "" |
| 91 | -! | +||
| 267 | +
- server_args = list(label = label, dataname = dataname, plot_height = plot_height, plot_width = plot_width),+ ) |
||
| 92 | -! | +||
| 268 | +
- ui = ui_g_events_term_id,+ ), |
||
| 93 | +269 | ! |
- ui_args = args,+ forms = tagList( |
| 94 | +270 | ! |
- datanames = c("ADSL", dataname)
+ teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
|
| 95 | +271 | ++ |
+ )+ |
+
| 272 | ++ |
+ )+ |
+ |
| 273 |
) |
||
| 96 | +274 |
} |
|
| 97 | +275 | ||
| 98 | +276 |
- ui_g_events_term_id <- function(id, ...) {
+ srv_g_heatmap_bygrade <- function(id, |
|
| 99 | -! | +||
| 277 | +
- ns <- NS(id)+ data, |
||
| 100 | -! | +||
| 278 | +
- args <- list(...)+ filter_panel_api, |
||
| 101 | -! | +||
| 279 | +
- teal.widgets::standard_layout(+ reporter, |
||
| 102 | -! | +||
| 280 | +
- output = teal.widgets::white_small_well(+ sl_dataname, |
||
| 103 | -! | +||
| 281 | +
- plot_decorate_output(id = ns(NULL))+ ex_dataname, |
||
| 104 | +282 |
- ),+ ae_dataname, |
|
| 105 | -! | +||
| 283 | +
- encoding = tags$div(+ cm_dataname, |
||
| 106 | +284 |
- ### Reporter+ label, |
|
| 107 | -! | +||
| 285 | +
- teal.reporter::simple_reporter_ui(ns("simple_reporter")),
+ plot_height, |
||
| 108 | +286 |
- ###+ plot_width) {
|
|
| 109 | +287 | ! |
- teal.widgets::optionalSelectInput(+ with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") |
| 110 | +288 | ! |
- ns("term"),
+ with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") |
| 111 | +289 | ! |
- "Term Variable",+ checkmate::assert_class(data, "reactive") |
| 112 | +290 | ! |
- choices = get_choices(args$term_var$choices),+ checkmate::assert_class(shiny::isolate(data()), "teal_data") |
| 113 | +291 | ! |
- selected = args$term_var$selected+ if (!is.na(sl_dataname)) checkmate::assert_names(sl_dataname, subset.of = names(data)) |
| 114 | -+ | ||
| 292 | +! |
- ),+ if (!is.na(ex_dataname)) checkmate::assert_names(ex_dataname, subset.of = names(data)) |
|
| 115 | +293 | ! |
- teal.widgets::optionalSelectInput(+ if (!is.na(ae_dataname)) checkmate::assert_names(ae_dataname, subset.of = names(data)) |
| 116 | +294 | ! |
- ns("arm_var"),
+ if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data)) |
| 117 | -! | +||
| 295 | +
- "Arm Variable",+ |
||
| 118 | +296 | ! |
- choices = get_choices(args$arm_var$choices),+ moduleServer(id, function(input, output, session) {
|
| 119 | +297 | ! |
- selected = args$arm_var$selected+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
| 120 | -+ | ||
| 298 | +! |
- ),+ iv <- reactive({
|
|
| 121 | +299 | ! |
- selectInput(+ ADSL <- data()[[sl_dataname]] |
| 122 | +300 | ! |
- ns("arm_ref"),
+ ADEX <- data()[[ex_dataname]] |
| 123 | +301 | ! |
- "Control",+ ADAE <- data()[[ae_dataname]] |
| 124 | +302 | ! |
- choices = get_choices(args$arm_var$choices),+ if (isTRUE(input$plot_cm)) {
|
| 125 | +303 | ! |
- selected = args$arm_var$selected+ ADCM <- data()[[cm_dataname]] |
| 126 | +304 |
- ),- |
- |
| 127 | -! | -
- selectInput(+ } |
|
| 128 | -! | +||
| 305 | +
- ns("arm_trt"),
+
|
||
| 129 | +306 | ! |
- "Treatment",+ iv <- shinyvalidate::InputValidator$new() |
| 130 | +307 | ! |
- choices = get_choices(args$arm_var$choices),+ iv$add_rule("id_var", shinyvalidate::sv_required(
|
| 131 | +308 | ! |
- selected = args$arm_var$selected+ message = "ID Variable is required" |
| 132 | +309 |
- ),- |
- |
| 133 | -! | -
- teal.widgets::optionalSelectInput(- |
- |
| 134 | -! | -
- ns("sort"),
+ )) |
|
| 135 | +310 | ! |
- "Sort By",+ iv$add_rule("visit_var", shinyvalidate::sv_required(
|
| 136 | +311 | ! |
- choices = c(+ message = "Visit Variable is required" |
| 137 | -! | +||
| 312 | +
- "Term" = "term",+ )) |
||
| 138 | +313 | ! |
- "Risk Difference" = "riskdiff",+ iv$add_rule("ongo_var", shinyvalidate::sv_required(
|
| 139 | +314 | ! |
- "Mean Risk" = "meanrisk"+ message = "Study Ongoing Status Variable is required" |
| 140 | +315 |
- ),+ )) |
|
| 141 | +316 | ! |
- selected = NULL+ iv$add_rule("ongo_var", shinyvalidate::sv_in_set(
|
| 142 | -+ | ||
| 317 | +! |
- ),+ set = names(ADEX), |
|
| 143 | +318 | ! |
- teal.widgets::panel_item(+ message_fmt = sprintf("Study Ongoing Status must be a variable in %s", ex_dataname)
|
| 144 | -! | +||
| 319 | +
- "Confidence interval settings",+ )) |
||
| 145 | +320 | ! |
- teal.widgets::optionalSelectInput(+ iv$add_rule("ongo_var", ~ if (!is.logical(ADEX[[req(.)]])) {
|
| 146 | +321 | ! |
- ns("diff_ci_method"),
+ "Study Ongoing Status must be a logical variable" |
| 147 | -! | +||
| 322 | +
- "Method for Difference of Proportions CI",+ }) |
||
| 148 | +323 | ! |
- choices = ci_choices,+ iv$add_rule("anno_var", shinyvalidate::sv_required(
|
| 149 | +324 | ! |
- selected = ci_choices[1]+ message = "Annotation Variables is required" |
| 150 | +325 |
- ),+ )) |
|
| 151 | +326 | ! |
- teal.widgets::optionalSliderInput(+ iv$add_rule("anno_var", ~ if (length(.) > 2L) {
|
| 152 | +327 | ! |
- ns("conf_level"),
+ "No more than two Annotation Variables are allowed" |
| 153 | -! | +||
| 328 | +
- "Confidence Level",+ }) |
||
| 154 | +329 | ! |
- min = 0.5,+ iv$add_rule("anno_var", shinyvalidate::sv_in_set(
|
| 155 | +330 | ! |
- max = 1,+ set = names(ADSL), |
| 156 | +331 | ! |
- value = 0.95+ message_fmt = sprintf("Study Ongoing Status must be a variable in %s", sl_dataname)
|
| 157 | +332 |
- )+ )) |
|
| 158 | -+ | ||
| 333 | +! |
- ),+ iv$add_rule("anno_var", ~ if (isTRUE(input$id_var %in% .)) {
|
|
| 159 | +334 | ! |
- teal.widgets::panel_item(+ sprintf("Deselect %s in Annotation Variables", input$id_var)
|
| 160 | -! | +||
| 335 | +
- "Additional plot settings",+ }) |
||
| 161 | +336 | ! |
- teal.widgets::optionalSelectInput(+ iv$add_rule("heat_var", shinyvalidate::sv_required(
|
| 162 | +337 | ! |
- ns("axis"),
+ message = "Heat Variable is required" |
| 163 | -! | +||
| 338 | +
- "Axis Side",+ )) |
||
| 164 | +339 | ! |
- choices = c("Left" = "left", "Right" = "right"),
+ iv$enable() |
| 165 | +340 | ! |
- selected = "left"+ iv |
| 166 | +341 |
- ),+ }) |
|
| 167 | +342 | ! |
- sliderInput(+ iv_cm <- reactive({
|
| 168 | +343 | ! |
- ns("raterange"),
+ ADSL <- data()[[sl_dataname]] |
| 169 | +344 | ! |
- "Overall Rate Range",+ ADEX <- data()[[ex_dataname]] |
| 170 | +345 | ! |
- min = 0,+ ADAE <- data()[[ae_dataname]] |
| 171 | +346 | ! |
- max = 1,+ if (isTRUE(input$plot_cm)) {
|
| 172 | +347 | ! |
- value = c(0.1, 1),+ ADCM <- data()[[cm_dataname]] |
| 173 | -! | +||
| 348 | +
- step = 0.01+ } |
||
| 174 | +349 |
- ),+ |
|
| 175 | +350 | ! |
- sliderInput(+ iv_cm <- shinyvalidate::InputValidator$new() |
| 176 | +351 | ! |
- ns("diffrange"),
+ iv_cm$condition(~ isTRUE(input$plot_cm)) |
| 177 | +352 | ! |
- "Rate Difference Range",+ iv_cm$add_rule("conmed_var", shinyvalidate::sv_required(
|
| 178 | +353 | ! |
- min = -1,+ message = "Conmed Variable is required"+ |
+
| 354 | ++ |
+ )) |
|
| 179 | +355 | ! |
- max = 1,+ iv_cm$add_rule("conmed_var", shinyvalidate::sv_in_set(
|
| 180 | +356 | ! |
- value = c(-0.5, 0.5),+ set = names(ADCM), |
| 181 | +357 | ! |
- step = 0.01+ message_fmt = sprintf("Conmed Variable must be a variable in %s", cm_dataname)
|
| 182 | +358 |
- ),- |
- |
| 183 | -! | -
- checkboxInput(ns("reverse"),
+ )) |
|
| 184 | +359 | ! |
- "Reverse Order",+ iv_cm$add_rule("conmed_var", ~ if (!is.factor(ADCM[[.]])) {
|
| 185 | +360 | ! |
- value = FALSE- |
-
| 186 | -- |
- )+ "Study Ongoing Status must be a factor variable" |
|
| 187 | +361 |
- ),+ }) |
|
| 188 | +362 | ! |
- ui_g_decorate(+ iv_cm$add_rule("conmed_level", shinyvalidate::sv_required(
|
| 189 | +363 | ! |
- ns(NULL),+ "Select Conmed Levels" |
| 190 | -! | +||
| 364 | +
- fontsize = args$fontsize,+ )) |
||
| 191 | +365 | ! |
- titles = "Common AE Table",+ iv_cm$add_rule("conmed_level", ~ if (length(.) > 3L) {
|
| 192 | +366 | ! |
- footnotes = ""- |
-
| 193 | -- |
- )+ "No more than three Conmed Levels are allowed" |
|
| 194 | +367 |
- ),+ }) |
|
| 195 | +368 | ! |
- forms = tagList(+ iv_cm$enable() |
| 196 | +369 | ! |
- teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
- |
-
| 197 | -- |
- )+ iv_cm |
|
| 198 | +370 |
- )+ }) |
|
| 199 | +371 |
- }+ |
|
| 200 | -+ | ||
| 372 | +! |
-
+ decorate_output <- srv_g_decorate( |
|
| 201 | -+ | ||
| 373 | +! |
- srv_g_events_term_id <- function(id,+ id = NULL, |
|
| 202 | -+ | ||
| 374 | +! |
- data,+ plt = plot_r, |
|
| 203 | -+ | ||
| 375 | +! |
- filter_panel_api,+ plot_height = plot_height, |
|
| 204 | -+ | ||
| 376 | +! |
- reporter,+ plot_width = plot_width |
|
| 205 | +377 |
- dataname,+ ) |
|
| 206 | -+ | ||
| 378 | +! |
- label,+ font_size <- decorate_output$font_size |
|
| 207 | -+ | ||
| 379 | +! |
- plot_height,+ pws <- decorate_output$pws |
|
| 208 | +380 |
- plot_width) {
+
|
|
| 209 | +381 | ! |
- with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")+ if (!is.na(cm_dataname)) {
|
| 210 | +382 | ! |
- with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")+ observeEvent(input$conmed_var, {
|
| 211 | +383 | ! |
- checkmate::assert_class(data, "reactive")+ ADCM <- data()[[cm_dataname]] |
| 212 | +384 | ! |
- checkmate::assert_class(shiny::isolate(data()), "teal_data")+ choices <- levels(ADCM[[input$conmed_var]]) |
| 213 | +385 | ||
| 214 | +386 | ! |
- moduleServer(id, function(input, output, session) {
+ updateSelectInput( |
| 215 | +387 | ! |
- teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")+ session, |
| 216 | +388 | ! |
- iv <- reactive({
+ "conmed_level", |
| 217 | +389 | ! |
- iv <- shinyvalidate::InputValidator$new()+ selected = choices[1:3], |
| 218 | +390 | ! |
- iv$add_rule("term", shinyvalidate::sv_required(
+ choices = choices |
| 219 | -! | +||
| 391 | +
- message = "Term Variable is required"+ ) |
||
| 220 | +392 |
- ))+ })+ |
+ |
| 393 | ++ |
+ }+ |
+ |
| 394 | ++ | + | |
| 221 | +395 | ! |
- iv$add_rule("arm_var", shinyvalidate::sv_required(
+ output_q <- shiny::debounce( |
| 222 | +396 | ! |
- message = "Arm Variable is required"+ millis = 200, |
| 223 | -+ | ||
| 397 | +! |
- ))+ r = reactive({
|
|
| 224 | +398 | ! |
- rule_diff <- function(value, other) {
+ ADSL <- data()[[sl_dataname]] |
| 225 | +399 | ! |
- if (isTRUE(value == other)) "Control and Treatment must be different"+ ADEX <- data()[[ex_dataname]]+ |
+
| 400 | +! | +
+ ADAE <- data()[[ae_dataname]]+ |
+ |
| 401 | +! | +
+ ADCM <- data()[[cm_dataname]] |
|
| 226 | +402 |
- }+ |
|
| 227 | +403 | ! |
- iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
+ teal::validate_has_data(ADSL, min_nrow = 1, msg = sprintf("%s contains no data", sl_dataname))
|
| 228 | +404 | ! |
- iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
+ teal::validate_inputs(iv(), iv_cm()) |
| 229 | +405 | ! |
- iv$enable()+ if (isTRUE(input$plot_cm)) {
|
| 230 | +406 | ! |
- iv+ shiny::validate(shiny::need(all(input$conmed_level %in% ADCM[[input$conmed_var]]), "Updating Conmed Levels")) |
| 231 | +407 |
- })+ } |
|
| 232 | +408 | ||
| 233 | +409 | ! |
- decorate_output <- srv_g_decorate(+ qenv <- data()+ |
+
| 410 | ++ | + | |
| 234 | +411 | ! |
- id = NULL, plt = plot_r, plot_height = plot_height, plot_width = plot_width+ if (isTRUE(input$plot_cm)) {
|
| 235 | -+ | ||
| 412 | +! |
- )+ ADCM <- qenv[[cm_dataname]] |
|
| 236 | +413 | ! |
- font_size <- decorate_output$font_size+ qenv <- teal.code::eval_code( |
| 237 | +414 | ! |
- pws <- decorate_output$pws+ qenv, |
| 238 | -+ | ||
| 415 | +! |
-
+ code = substitute( |
|
| 239 | +416 | ! |
- observeEvent(list(input$diff_ci_method, input$conf_level), {
+ expr = {
|
| 240 | +417 | ! |
- req(!is.null(input$diff_ci_method) && !is.null(input$conf_level))+ conmed_data <- ADCM %>% |
| 241 | +418 | ! |
- diff_ci_method <- input$diff_ci_method+ filter(conmed_var_name %in% conmed_level) |
| 242 | +419 | ! |
- conf_level <- input$conf_level+ conmed_data[[conmed_var]] <- |
| 243 | +420 | ! |
- updateTextAreaInput(+ factor(conmed_data[[conmed_var]], levels = unique(conmed_data[[conmed_var]])) |
| 244 | +421 | ! |
- session,+ formatters::var_labels(conmed_data)[conmed_var] <- |
| 245 | +422 | ! |
- "foot",+ formatters::var_labels(ADCM, fill = FALSE)[conmed_var]+ |
+
| 423 | ++ |
+ }, |
|
| 246 | +424 | ! |
- value = sprintf(+ env = list( |
| 247 | +425 | ! |
- "Note: %d%% CI is calculated using %s",+ ADCM = as.name(cm_dataname), |
| 248 | +426 | ! |
- round(conf_level * 100),+ conmed_var = input$conmed_var, |
| 249 | +427 | ! |
- name_ci(diff_ci_method)+ conmed_var_name = as.name(input$conmed_var),+ |
+
| 428 | +! | +
+ conmed_level = input$conmed_level |
|
| 250 | +429 |
- )+ ) |
|
| 251 | +430 |
- )+ ) |
|
| 252 | +431 |
- })+ ) |
|
| 253 | +432 |
-
+ } |
|
| 254 | +433 | ||
| 255 | +434 | ! |
- observeEvent(input$sort,+ qenv <- teal.code::eval_code( |
| 256 | -+ | ||
| 435 | +! |
- {
+ qenv, |
|
| 257 | +436 | ! |
- sort <- if (is.null(input$sort)) " " else input$sort+ code = bquote( |
| 258 | +437 | ! |
- updateTextInput(+ plot <- osprey::g_heat_bygrade( |
| 259 | +438 | ! |
- session,+ id_var = .(input$id_var), |
| 260 | +439 | ! |
- "title",+ exp_data = .(as.name(ex_dataname)) %>% filter(PARCAT1 == "INDIVIDUAL"), |
| 261 | +440 | ! |
- value = sprintf(+ visit_var = .(input$visit_var), |
| 262 | +441 | ! |
- "Common AE Table %s",+ ongo_var = .(input$ongo_var), |
| 263 | +442 | ! |
- c(+ anno_data = .(as.name(sl_dataname))[c(.(input$anno_var), .(input$id_var))], |
| 264 | +443 | ! |
- "term" = "Sorted by Term",+ anno_var = .(input$anno_var), |
| 265 | +444 | ! |
- "riskdiff" = "Sorted by Risk Difference",+ heat_data = .(as.name(ae_dataname)) %>% |
| 266 | +445 | ! |
- "meanrisk" = "Sorted by Mean Risk",+ select(.(as.name(input$id_var)), .(as.name(input$visit_var)), .(as.name(input$heat_var))), |
| 267 | -+ | ||
| 446 | +! |
- " " = ""+ heat_color_var = .(input$heat_var), |
|
| 268 | +447 | ! |
- )[sort]+ conmed_data = .(if (isTRUE(input$plot_cm)) as.name("conmed_data")),
+ |
+
| 448 | +! | +
+ conmed_var = .(if (isTRUE(input$plot_cm)) input$conmed_var), |
|
| 269 | +449 |
- )+ ) |
|
| 270 | +450 |
- )+ ) |
|
| 271 | +451 |
- },+ ) |
|
| 272 | +452 | ! |
- ignoreNULL = FALSE+ teal.code::eval_code(qenv, quote(plot)) |
| 273 | +453 | ++ |
+ })+ |
+
| 454 |
) |
||
| 274 | +455 | ||
| 275 | +456 | ! |
- observeEvent(input$arm_var,+ plot_r <- reactive(output_q()[["plot"]]) |
| 276 | +457 |
- {
+
|
|
| 277 | +458 | ! |
- arm_var <- input$arm_var+ teal.widgets::verbatim_popup_srv( |
| 278 | +459 | ! |
- ANL <- data()[[dataname]]+ id = "rcode", |
| 279 | -+ | ||
| 460 | +! |
-
+ title = paste("R code for", label),
|
|
| 280 | +461 | ! |
- choices <- levels(ANL[[arm_var]])+ verbatim_content = reactive(teal.code::get_code(output_q())) |
| 281 | +462 | ++ |
+ )+ |
+
| 463 | |||
| 464 | ++ |
+ ### REPORTER+ |
+ |
| 282 | +465 | ! |
- if (length(choices) == 1) {
+ if (with_reporter) {
|
| 283 | +466 | ! |
- trt_index <- 1+ card_fun <- function(comment, label) {
|
| 284 | -+ | ||
| 467 | +! |
- } else {
+ card <- teal::report_card_template( |
|
| 285 | +468 | ! |
- trt_index <- 2+ title = "Heatmap by Grade", |
| 286 | -+ | ||
| 469 | +! |
- }+ label = label,+ |
+ |
| 470 | +! | +
+ with_filter = with_filter,+ |
+ |
| 471 | +! | +
+ filter_panel_api = filter_panel_api |
|
| 287 | +472 |
-
+ ) |
|
| 288 | +473 | ! |
- updateSelectInput(+ card$append_text("Plot", "header3")
|
| 289 | +474 | ! |
- session,+ card$append_plot(plot_r(), dim = pws$dim()) |
| 290 | +475 | ! |
- "arm_ref",+ if (!comment == "") {
|
| 291 | +476 | ! |
- selected = choices[1],+ card$append_text("Comment", "header3")
|
| 292 | +477 | +! | +
+ card$append_text(comment)+ |
+
| 478 | ++ |
+ }+ |
+ |
| 479 | ! |
- choices = choices+ card$append_src(teal.code::get_code(output_q()))+ |
+ |
| 480 | +! | +
+ card+ |
+ |
| 481 | ++ |
+ }+ |
+ |
| 482 | +! | +
+ teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
+ |
+ |
| 483 | ++ |
+ }+ |
+ |
| 484 | ++ |
+ }) |
|
| 293 | +485 |
- )+ } |
|
| 294 | -! | +
| 1 | +
- updateSelectInput(+ #' Shared Parameters |
||
| 295 | -! | +||
| 2 | +
- session,+ #' |
||
| 296 | -! | +||
| 3 | +
- "arm_trt",+ #' @description Contains arguments that are shared between multiple functions |
||
| 297 | -! | +||
| 4 | +
- selected = choices[trt_index],+ #' in the package to avoid repetition using `inheritParams`. |
||
| 298 | -! | +||
| 5 | +
- choices = choices+ #' |
||
| 299 | +6 |
- )+ #' @param plot_height (`numeric`) optional vector of length three with `c(value, min, max)`. Specifies |
|
| 300 | +7 |
- },+ #' the height of the main plot. |
|
| 301 | -! | +||
| 8 | +
- ignoreNULL = TRUE+ #' @param plot_width (`numeric`) optional vector of length three with `c(value, min, max)`. Specifies |
||
| 302 | +9 |
- )+ #' the width of the main plot and renders a slider on the plot to interactively adjust the plot width. |
|
| 303 | +10 |
-
+ #' @param label (`character`) module label in the teal app. Please note that this module is developed based on |
|
| 304 | -! | +||
| 11 | +
- output_q <- reactive({
+ #' `ADaM` data structure and `ADaM` variables. |
||
| 305 | -! | +||
| 12 | +
- ANL <- data()[[dataname]]+ #' |
||
| 306 | +13 |
-
+ #' @name shared_params |
|
| 307 | -! | +||
| 14 | +
- teal::validate_inputs(iv())+ #' @keywords internal |
||
| 308 | +15 |
-
+ #' |
|
| 309 | -! | +||
| 16 | +
- shiny::validate(+ NULL |
||
| 310 | -! | +||
| 17 | +
- shiny::need(is.factor(ANL[[input$arm_var]]), "Arm Var must be a factor variable. Contact developer."),+ |
||
| 311 | -! | +||
| 18 | +
- shiny::need(+ #' Utility function for quick filter |
||
| 312 | -! | +||
| 19 | +
- input$arm_trt %in% ANL[[req(input$arm_var)]] && input$arm_ref %in% ANL[[req(input$arm_var)]],+ #' `r lifecycle::badge("stable")`
|
||
| 313 | -! | +||
| 20 | +
- "Cannot generate plot. The dataset does not contain subjects from both the control and treatment arms."+ #' |
||
| 314 | +21 |
- )+ #' |
|
| 315 | +22 |
- )+ #' @param filter_opt vector of string names of flag variable to filter (keep Y rows only) |
|
| 316 | +23 |
-
+ #' @param ANL input dataset |
|
| 317 | -! | +||
| 24 | +
- adsl_vars <- unique(c("USUBJID", "STUDYID", input$arm_var))
+ #' |
||
| 318 | -! | +||
| 25 | +
- anl_vars <- c("USUBJID", "STUDYID", input$term)
+ #' @return a filtered dataframe |
||
| 319 | +26 |
-
+ #' |
|
| 320 | -! | +||
| 27 | +
- q1 <- teal.code::eval_code(+ #' @export |
||
| 321 | -! | +||
| 28 | +
- data(),+ #' |
||
| 322 | -! | +||
| 29 | +
- code = bquote(+ #' @template author_zhanc107 |
||
| 323 | -! | +||
| 30 | +
- ANL <- merge(+ #' |
||
| 324 | -! | +||
| 31 | +
- x = ADSL[, .(adsl_vars), drop = FALSE],+ quick_filter <- function(filter_opt, ANL) {
|
||
| 325 | +32 | ! |
- y = .(as.name(dataname))[, .(anl_vars), drop = FALSE],+ for (i in seq_along(filter_opt)) {
|
| 326 | +33 | ! |
- all.x = FALSE,+ ANL <- ANL[ANL[, filter_opt[i]] == "Y", ] |
| 327 | -! | +||
| 34 | +
- all.y = FALSE,+ } |
||
| 328 | +35 | ! |
- by = c("USUBJID", "STUDYID")
+ return(ANL) |
| 329 | +36 |
- )+ } |
|
| 330 | +37 |
- )+ |
|
| 331 | +38 |
- )+ #' Automatically switch variable labels for standard `AE` variables in `AE` osprey functions |
|
| 332 | +39 | - - | -|
| 333 | -! | -
- teal::validate_has_data(q1[["ANL"]],+ #' `r lifecycle::badge("stable")`
|
|
| 334 | -! | +||
| 40 | +
- min_nrow = 10,+ #' |
||
| 335 | -! | +||
| 41 | +
- msg = "Analysis data set must have at least 10 data points"+ #' @param x variable key |
||
| 336 | +42 |
- )+ #' |
|
| 337 | +43 |
-
+ #' @export |
|
| 338 | -! | +||
| 44 | +
- q2 <- teal.code::eval_code(+ label_aevar <- function(x) {
|
||
| 339 | +45 | ! |
- q1,+ lifecycle::deprecate_soft( |
| 340 | +46 | ! |
- code = bquote(+ when = "0.1.15", |
| 341 | +47 | ! |
- plot <- osprey::g_events_term_id(+ what = "label_aevar()", |
| 342 | +48 | ! |
- term = ANL[[.(input$term)]],+ details = "label_aevar is deprecated and will be unexported in the next release." |
| 343 | -! | +||
| 49 | +
- id = ANL$USUBJID,+ ) |
||
| 344 | -! | +||
| 50 | +
- arm = ANL[[.(input$arm_var)]],+ |
||
| 345 | -! | +||
| 51 | +
- arm_N = table(ADSL[[.(input$arm_var)]]),+ # Display full variable labels for standard AE variables |
||
| 346 | +52 | ! |
- ref = .(input$arm_ref),+ ae_varlabel <- c( |
| 347 | +53 | ! |
- trt = .(input$arm_trt),+ AEBODSYS = "MedDRA System Organ Class", |
| 348 | +54 | ! |
- sort_by = .(input$sort),+ AESOC = "MedDRA Primary System Organ Class", |
| 349 | +55 | ! |
- rate_range = .(input$raterange),+ AEHLGT = "MedDRA High Level Group Term", |
| 350 | +56 | ! |
- diff_range = .(input$diffrange),+ AEHLT = "MedDRA High Level Term", |
| 351 | +57 | ! |
- reversed = .(input$reverse),+ AELLT = "MedDRA Lowest Level Term", |
| 352 | +58 | ! |
- conf_level = .(input$conf_level),+ AEDECOD = "MedDRA Preferred Term", |
| 353 | +59 | ! |
- diff_ci_method = .(input$diff_ci_method),+ AETERM = "Reported Adverse Event Term", |
| 354 | +60 | ! |
- axis_side = .(input$axis),+ AEMODIFY = "Modified Reported Term", |
| 355 | +61 | ! |
- fontsize = .(font_size()),+ AETOXGR = "NCI-CTCAE Grade", |
| 356 | +62 | ! |
- draw = TRUE+ AEITOXGR = "Initial Toxicity Grade" |
| 357 | +63 |
- )+ ) |
|
| 358 | +64 |
- )+ |
|
| 359 | -+ | ||
| 65 | +! |
- )+ which_aevar <- match(x, names(ae_varlabel)) |
|
| 360 | -+ | ||
| 66 | +! |
-
+ out_label <- ifelse(is.na(which_aevar), x, ae_varlabel[which_aevar]) |
|
| 361 | +67 | ! |
- teal.code::eval_code(q2, quote(plot))+ return(out_label) |
| 362 | +68 |
- })+ } |
|
| 363 | +69 | ||
| 364 | -! | +||
| 70 | +
- plot_r <- reactive(output_q()[["plot"]])+ #' retrieve name of ci method |
||
| 365 | +71 |
-
+ #' @param x ci method to retrieve its name |
|
| 366 | -! | +||
| 72 | +
- teal.widgets::verbatim_popup_srv(+ #' @keywords internal |
||
| 367 | -! | +||
| 73 | +
- id = "rcode",+ #' |
||
| 368 | -! | +||
| 74 | +
- title = paste("R code for", label),
+ name_ci <- function(x) {
|
||
| 369 | -! | +||
| 75 | +
- verbatim_content = reactive(teal.code::get_code(output_q()))+ names(ci_choices)[which(ci_choices == x)] |
||
| 370 | +76 |
- )+ } |
|
| 371 | +77 | ||
| 372 | +78 |
- ### REPORTER- |
- |
| 373 | -! | -
- if (with_reporter) {
- |
- |
| 374 | -! | -
- card_fun <- function(comment, label) {
- |
- |
| 375 | -! | -
- card <- teal::report_card_template(- |
- |
| 376 | -! | -
- title = "Events by Term",- |
- |
| 377 | -! | -
- label = label,- |
- |
| 378 | -! | -
- with_filter = with_filter,+ ci_choices <- setNames( |
|
| 379 | -! | +||
| 79 | +
- filter_panel_api = filter_panel_api+ c("wald", "waldcc", "ac", "scorecc", "score", "mn", "mee", "blj", "ha"),
|
||
| 380 | +80 |
- )+ c( |
|
| 381 | -! | +||
| 81 | +
- card$append_text("Plot", "header3")
+ "Wald", "Corrected Wald", "Agresti-Caffo", "Newcombe", |
||
| 382 | -! | +||
| 82 | +
- card$append_plot(plot_r(), dim = pws$dim())+ "Score", "Miettinen and Nurminen", "Mee", |
||
| 383 | -! | +||
| 83 | +
- if (!comment == "") {
+ "Brown, Li's Jeffreys", "Hauck-Anderson" |
||
| 384 | -! | +||
| 84 | +
- card$append_text("Comment", "header3")
+ ) |
||
| 385 | -! | +||
| 85 | +
- card$append_text(comment)+ ) |
||
| 386 | +86 |
- }+ |
|
| 387 | -! | +||
| 87 | +
- card$append_src(teal.code::get_code(output_q()))+ #' retrieve detailed name of ci method |
||
| 388 | -! | +||
| 88 | +
- card+ #' @param x ci method to retrieve its name |
||
| 389 | +89 |
- }+ name_ci <- function(x = ci_choices) {
|
|
| 390 | +90 | ! |
- teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
+ x <- match.arg(x) |
| 391 | -+ | ||
| 91 | +! |
- }+ return(paste0(names(x), " (", x, ")"))
|
|
| 392 | +92 |
- })+ } |
|
| 393 | +93 |
- }+ |
| 1 | +94 |
- #' Shared Parameters+ |
|
| 2 | +95 |
- #'+ #' takes input_string, splits by "," and returns a numeric vector |
|
| 3 | +96 |
- #' @description Contains arguments that are shared between multiple functions+ #' with NAs where the split-strings are not numeric. |
|
| 4 | +97 |
- #' in the package to avoid repetition using `inheritParams`.+ #' e.g. as_numeric_from_comma_separated_string("4 ,hello,5,, 3")
|
|
| 5 | +98 |
- #'+ #' is c(4, NA, 5, NA, 3). |
|
| 6 | +99 |
- #' @param plot_height (`numeric`) optional vector of length three with `c(value, min, max)`. Specifies+ #' If input argument is NULL or just whitespace then NULL is returned |
|
| 7 | +100 |
- #' the height of the main plot.+ #' @param input_string string to be split into numeric vector |
|
| 8 | +101 |
- #' @param plot_width (`numeric`) optional vector of length three with `c(value, min, max)`. Specifies+ #' @keywords internal |
|
| 9 | +102 |
- #' the width of the main plot and renders a slider on the plot to interactively adjust the plot width.+ #' |
|
| 10 | +103 |
- #' @param label (`character`) module label in the teal app. Please note that this module is developed based on+ as_numeric_from_comma_sep_str <- function(input_string) {
|
|
| 11 | -+ | ||
| 104 | +10x |
- #' `ADaM` data structure and `ADaM` variables.+ if (!is.null(input_string) && trimws(input_string) != "") {
|
|
| 12 | -+ | ||
| 105 | +7x |
- #'+ ref_line <- unlist(strsplit(trimws(input_string), ",")) |
|
| 13 | -+ | ||
| 106 | +7x |
- #' @name shared_params+ ref_line <- as.numeric(ref_line) |
|
| 14 | +107 |
- #' @keywords internal+ } else {
|
|
| 15 | -+ | ||
| 108 | +3x |
- #'+ ref_line <- NULL |
|
| 16 | +109 |
- NULL+ }+ |
+ |
| 110 | +10x | +
+ return(ref_line) |
|
| 17 | +111 |
-
+ } |
|
| 18 | +112 |
- #' Utility function for quick filter+ |
|
| 19 | +113 |
- #' `r lifecycle::badge("stable")`
+ #' Include `CSS` files from `/inst/css/` package directory to application header |
|
| 20 | +114 |
#' |
|
| 21 | +115 |
- #'+ #' `system.file` should not be used to access files in other packages, it does |
|
| 22 | +116 |
- #' @param filter_opt vector of string names of flag variable to filter (keep Y rows only)+ #' not work with `devtools`. Therefore, we redefine this method in each package |
|
| 23 | +117 |
- #' @param ANL input dataset+ #' as needed. Thus, we do not export this method. |
|
| 24 | +118 |
#' |
|
| 25 | +119 |
- #' @return a filtered dataframe+ #' @param pattern (`character`) pattern of files to be included |
|
| 26 | +120 |
#' |
|
| 27 | +121 |
- #' @export+ #' @return HTML code that includes `CSS` files |
|
| 28 | +122 |
- #'+ #' @keywords internal |
|
| 29 | +123 |
- #' @template author_zhanc107+ include_css_files <- function(pattern = "*") {
|
|
| 30 | -+ | ||
| 124 | +! |
- #'+ css_files <- list.files(+ |
+ |
| 125 | +! | +
+ system.file("css", package = "teal.osprey", mustWork = TRUE),
+ |
+ |
| 126 | +! | +
+ pattern = pattern, full.names = TRUE |
|
| 31 | +127 |
- quick_filter <- function(filter_opt, ANL) {
+ ) |
|
| 32 | +128 | ! |
- for (i in seq_along(filter_opt)) {
+ if (length(css_files) == 0) {
|
| 33 | +129 | ! |
- ANL <- ANL[ANL[, filter_opt[i]] == "Y", ]+ return(NULL) |
| 34 | +130 |
} |
|
| 35 | +131 | ! |
- return(ANL)+ return(shiny::singleton(shiny::tags$head(lapply(css_files, shiny::includeCSS)))) |
| 36 | +132 |
} |
|
| 37 | +133 | ||
| 38 | +134 |
- #' Automatically switch variable labels for standard `AE` variables in `AE` osprey functions+ #' Get Choices |
|
| 39 | +135 |
- #' `r lifecycle::badge("stable")`
+ #' |
|
| 40 | +136 |
- #'+ #' This function returns choices based on the class of the input. |
|
| 41 | +137 |
- #' @param x variable key+ #' If the input is of class `delayed_data`, it returns the `subset` of the input. |
|
| 42 | +138 |
- #'+ #' If `subset` is NULL and the input contains `var_label` and `var_choices`, |
|
| 43 | +139 |
- #' @export+ #' it throws an error prompting to resolve delayed inputs. |
|
| 44 | +140 |
- label_aevar <- function(x) {
- |
- |
| 45 | -! | -
- lifecycle::deprecate_soft(- |
- |
| 46 | -! | -
- when = "0.1.15",+ #' Otherwise, it returns the input as is. |
|
| 47 | -! | +||
| 141 | +
- what = "label_aevar()",+ #' |
||
| 48 | -! | +||
| 142 | +
- details = "label_aevar is deprecated and will be unexported in the next release."+ #' @param choices An object that contains choices. |
||
| 49 | +143 |
- )+ #' @return A vector of choices. |
|
| 50 | +144 |
-
+ #' @keywords internal |
|
| 51 | +145 |
- # Display full variable labels for standard AE variables+ get_choices <- function(choices) {
|
|
| 52 | +146 | ! |
- ae_varlabel <- c(+ if (inherits(choices, "delayed_data")) {
|
| 53 | +147 | ! |
- AEBODSYS = "MedDRA System Organ Class",+ if (is.null(choices$subset)) {
|
| 54 | +148 | ! |
- AESOC = "MedDRA Primary System Organ Class",+ if (!is.null(choices$var_label) && !is.null(choices$var_choices)) {
|
| 55 | +149 | ! |
- AEHLGT = "MedDRA High Level Group Term",+ stop( |
| 56 | +150 | ! |
- AEHLT = "MedDRA High Level Term",+ "Resolve delayed inputs by evaluating the code within the provided datasets. |
| 57 | +151 | ! |
- AELLT = "MedDRA Lowest Level Term",+ Check ?teal.transform::resolve_delayed for more information." |
| 58 | -! | +||
| 152 | +
- AEDECOD = "MedDRA Preferred Term",+ ) |
||
| 59 | -! | +||
| 153 | +
- AETERM = "Reported Adverse Event Term",+ } else {
|
||
| 60 | +154 | ! |
- AEMODIFY = "Modified Reported Term",+ stop("Subset is NULL and necessary fields are missing.")
|
| 61 | -! | +||
| 155 | +
- AETOXGR = "NCI-CTCAE Grade",+ }+ |
+ ||
| 156 | ++ |
+ } else {
|
|
| 62 | +157 | ! |
- AEITOXGR = "Initial Toxicity Grade"+ choices$subset |
| 63 | +158 |
- )+ } |
|
| 64 | +159 |
-
+ } else {
|
|
| 65 | +160 | ! |
- which_aevar <- match(x, names(ae_varlabel))+ choices |
| 66 | -! | +||
| 161 | +
- out_label <- ifelse(is.na(which_aevar), x, ae_varlabel[which_aevar])+ } |
||
| 67 | -! | +||
| 162 | +
- return(out_label)+ } |
| 68 | +1 |
- }+ .onLoad <- function(libname, pkgname) {
|
|
| 69 | +2 |
-
+ # Fixes R CMD check note on "All declared Imports should be used." |
|
| 70 | +3 |
- #' retrieve name of ci method+ # teal.data is necessary to access S3 method names.teal_data+ |
+ |
| 4 | +! | +
+ teal.data::teal_data |
|
| 71 | +5 |
- #' @param x ci method to retrieve its name+ + |
+ |
| 6 | +! | +
+ teal.logger::register_logger(namespace = "teal.osprey")+ |
+ |
| 7 | +! | +
+ teal.logger::register_handlers("teal.osprey")
|
|
| 72 | +8 |
- #' @keywords internal+ } |
| 73 | +1 | ++ |
+ #' Helper UI function to decorate plot output UI+ |
+
| 2 |
#' |
||
| 74 | +3 |
- name_ci <- function(x) {
+ #' @description |
|
| 75 | +4 | ++ |
+ #' `r lifecycle::badge("stable")`
+ |
+
| 5 |
- names(ci_choices)[which(ci_choices == x)]+ #' |
||
| 76 | +6 |
- }+ #' This is used in [tm_g_ae_oview()] and [tm_g_events_term_id()]. |
|
| 77 | +7 |
-
+ #' |
|
| 78 | +8 |
- ci_choices <- setNames(+ #' @param id (`character`) id of this module. set to `NULL` if you want to make it identical |
|
| 79 | +9 |
- c("wald", "waldcc", "ac", "scorecc", "score", "mn", "mee", "blj", "ha"),
+ #' to the module who called it. |
|
| 80 | +10 |
- c(+ #' @param titles (`character`) default titles |
|
| 81 | +11 |
- "Wald", "Corrected Wald", "Agresti-Caffo", "Newcombe",+ #' @param footnotes (`character`) default footnotes |
|
| 82 | +12 |
- "Score", "Miettinen and Nurminen", "Mee",+ #' @inheritParams argument_convention |
|
| 83 | +13 |
- "Brown, Li's Jeffreys", "Hauck-Anderson"+ #' @export |
|
| 84 | +14 |
- )+ ui_g_decorate <- function(id, |
|
| 85 | +15 |
- )+ titles = "Titles", |
|
| 86 | +16 |
-
+ footnotes = "footnotes", |
|
| 87 | +17 |
- #' retrieve detailed name of ci method+ fontsize = c(5, 4, 11)) {
|
|
| 88 | -+ | ||
| 18 | +! |
- #' @param x ci method to retrieve its name+ ns <- NS(id) |
|
| 89 | -+ | ||
| 19 | +! |
- name_ci <- function(x = ci_choices) {
+ tagList( |
|
| 90 | +20 | ! |
- x <- match.arg(x)+ teal.widgets::optionalSliderInputValMinMax( |
| 91 | +21 | ! |
- return(paste0(names(x), " (", x, ")"))
+ ns("fontsize"),
|
| 92 | -+ | ||
| 22 | +! |
- }+ "Font Size", |
|
| 93 | -+ | ||
| 23 | +! |
-
+ value_min_max = fontsize, |
|
| 94 | -+ | ||
| 24 | +! |
-
+ step = 0.1 |
|
| 95 | +25 |
- #' takes input_string, splits by "," and returns a numeric vector+ ), |
|
| 96 | -+ | ||
| 26 | +! |
- #' with NAs where the split-strings are not numeric.+ textInput(ns("title"), "Title", value = titles),
|
|
| 97 | -+ | ||
| 27 | +! |
- #' e.g. as_numeric_from_comma_separated_string("4 ,hello,5,, 3")
+ textAreaInput(ns("foot"), "Footnote", value = footnotes, resize = "none")
|
|
| 98 | +28 |
- #' is c(4, NA, 5, NA, 3).+ ) |
|
| 99 | +29 |
- #' If input argument is NULL or just whitespace then NULL is returned+ } |
|
| 100 | +30 |
- #' @param input_string string to be split into numeric vector+ |
|
| 101 | +31 |
- #' @keywords internal+ #' Helper server function to decorate plot output |
|
| 102 | +32 |
#' |
|
| 103 | +33 |
- as_numeric_from_comma_sep_str <- function(input_string) {
+ #' @description |
|
| 104 | -10x | +||
| 34 | +
- if (!is.null(input_string) && trimws(input_string) != "") {
+ #' `r lifecycle::badge("stable")`
|
||
| 105 | -7x | +||
| 35 | +
- ref_line <- unlist(strsplit(trimws(input_string), ","))+ #' |
||
| 106 | -7x | +||
| 36 | +
- ref_line <- as.numeric(ref_line)+ #' This is used in [tm_g_ae_oview()] and [tm_g_events_term_id()]. |
||
| 107 | +37 |
- } else {
+ #' |
|
| 108 | -3x | +||
| 38 | +
- ref_line <- NULL+ #' @inheritParams shared_params |
||
| 109 | +39 |
- }+ #' @param id (`character`) id of the module |
|
| 110 | -10x | +||
| 40 | +
- return(ref_line)+ #' @param plot_id (`character`) id for plot output |
||
| 111 | +41 |
- }+ #' @param plt (`reactive`) a reactive object of graph object |
|
| 112 | +42 |
-
+ #' |
|
| 113 | +43 |
- #' Include `CSS` files from `/inst/css/` package directory to application header+ #' @export |
|
| 114 | +44 |
- #'+ srv_g_decorate <- function(id, |
|
| 115 | +45 |
- #' `system.file` should not be used to access files in other packages, it does+ plot_id = "out", |
|
| 116 | +46 |
- #' not work with `devtools`. Therefore, we redefine this method in each package+ plt = reactive(NULL), |
|
| 117 | +47 |
- #' as needed. Thus, we do not export this method.+ plot_height, |
|
| 118 | +48 |
- #'+ plot_width) {
|
|
| 119 | -+ | ||
| 49 | +! |
- #' @param pattern (`character`) pattern of files to be included+ moduleServer(id, function(input, output, session) {
|
|
| 120 | -+ | ||
| 50 | +! |
- #'+ teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey") |
|
| 121 | -+ | ||
| 51 | +! |
- #' @return HTML code that includes `CSS` files+ plot_g <- reactive({
|
|
| 122 | -+ | ||
| 52 | +! |
- #' @keywords internal+ g <- tern::decorate_grob( |
|
| 123 | -+ | ||
| 53 | +! |
- include_css_files <- function(pattern = "*") {
+ plt(), |
|
| 124 | +54 | ! |
- css_files <- list.files(+ titles = input$title, |
| 125 | +55 | ! |
- system.file("css", package = "teal.osprey", mustWork = TRUE),
+ footnotes = input$foot, |
| 126 | +56 | ! |
- pattern = pattern, full.names = TRUE+ gp_titles = grid::gpar( |
| 127 | -+ | ||
| 57 | +! |
- )+ fontsize = input$fontsize * ggplot2::.pt, |
|
| 128 | +58 | ! |
- if (length(css_files) == 0) {
+ col = "black", |
| 129 | +59 | ! |
- return(NULL)+ fontface = "bold" |
| 130 | +60 |
- }+ ), |
|
| 131 | +61 | ! |
- return(shiny::singleton(shiny::tags$head(lapply(css_files, shiny::includeCSS))))+ gp_footnotes = grid::gpar(fontsize = input$fontsize * ggplot2::.pt, col = "black") |
| 132 | +62 |
- }+ ) |
|
| 133 | +63 |
-
+ }) |
|
| 134 | +64 |
- #' Get Choices+ |
|
| 135 | -+ | ||
| 65 | +! |
- #'+ plot_r <- function() {
|
|
| 136 | -+ | ||
| 66 | +! |
- #' This function returns choices based on the class of the input.+ grid::grid.newpage() |
|
| 137 | -+ | ||
| 67 | +! |
- #' If the input is of class `delayed_data`, it returns the `subset` of the input.+ grid::grid.draw(plot_g()) |
|
| 138 | -+ | ||
| 68 | +! |
- #' If `subset` is NULL and the input contains `var_label` and `var_choices`,+ plot_g() |
|
| 139 | +69 |
- #' it throws an error prompting to resolve delayed inputs.+ } |
|
| 140 | +70 |
- #' Otherwise, it returns the input as is.+ |
|
| 141 | -+ | ||
| 71 | +! |
- #'+ class(plot_r) <- c(class(plot_r), "reactive") |
|
| 142 | +72 |
- #' @param choices An object that contains choices.+ |
|
| 143 | -+ | ||
| 73 | +! |
- #' @return A vector of choices.+ pws <- teal.widgets::plot_with_settings_srv( |
|
| 144 | -+ | ||
| 74 | +! |
- #' @keywords internal+ id = plot_id, |
|
| 145 | -+ | ||
| 75 | +! |
- get_choices <- function(choices) {
+ plot_r = plot_r, |
|
| 146 | +76 | ! |
- if (inherits(choices, "delayed_data")) {
+ height = plot_height, |
| 147 | +77 | ! |
- if (is.null(choices$subset)) {
+ width = plot_width+ |
+
| 78 | ++ |
+ )+ |
+ |
| 79 | ++ | + | |
| 148 | +80 | ! |
- if (!is.null(choices$var_label) && !is.null(choices$var_choices)) {
+ return( |
| 149 | +81 | ! |
- stop(+ list( |
| 150 | +82 | ! |
- "Resolve delayed inputs by evaluating the code within the provided datasets.+ font_size = reactive(input$fontsize), |
| 151 | +83 | ! |
- Check ?teal.transform::resolve_delayed for more information."+ pws = pws |
| 152 | +84 |
- )+ ) |
|
| 153 | +85 |
- } else {
+ ) |
|
| 154 | -! | +||
| 86 | +
- stop("Subset is NULL and necessary fields are missing.")
+ }) |
||
| 155 | +87 |
- }+ } |
|
| 156 | +88 |
- } else {
+
|
|
| 157 | -! | +||
| 89 | +
- choices$subset+ #' Helper function to plot decorated output UI |
||
| 158 | +90 |
- }+ #' |
|
| 159 | +91 |
- } else {
+ #' @description |
|
| 160 | -! | +||
| 92 | +
- choices+ #' `r lifecycle::badge("stable")`
|
||
| 161 | +93 |
- }+ #' |
|
| 162 | +94 |
- }+ #' @param id (`character`) id of this element |
| 1 | +95 |
- .onLoad <- function(libname, pkgname) {
+ #'+ |
+ |
| 96 | ++ |
+ #' @export+ |
+ |
| 97 | ++ |
+ plot_decorate_output <- function(id) {
|
|
| 2 | +98 | ! |
- teal.logger::register_logger(namespace = "teal.osprey")+ ns <- NS(id) |
| 3 | +99 | ! |
- teal.logger::register_handlers("teal.osprey")
+ teal.widgets::plot_with_settings_ui(id = ns("out"))
|
| 4 | +100 |
} |