search

insightsengineering / teal.widgets

shiny widgets for teal applications
https://insightsengineering.github.io/teal.widgets/
Other
4 stars 6 forks source link

[Bug]: plot with settings does not support bootstrap 4 and 5 #245

Open Polkas opened 3 months ago

Polkas commented 3 months ago

What happened?

The modal widget in plot with settings is too narrow for bootstrap 4 and 5. We will be happy to solve that. Please write if you are welcome for our collabo.

image

image

Reproducible Example for Safety app (line plot Module):

# We set bootsrap 5
options("teal.bs_theme" = bslib::bs_theme(version = "5"))

library(teal.modules.general)
library(teal.modules.clinical)
options(shiny.useragg = FALSE)

## Data reproducible code ----
data <- teal_data()
data <- within(data, {
    library(random.cdisc.data)
    library(dplyr)
    library(nestcolor)
    # optional libraries
    library(sparkline)

    ADSL <- radsl(seed = 1)
    ADAE <- radae(ADSL, seed = 1)
    ADAETTE <- radaette(ADSL, seed = 1)
    ADAETTE <- ADAETTE %>%
        mutate(is_event = case_when(
            grepl("TOT", .data$PARAMCD, fixed = TRUE) ~ TRUE,
            TRUE ~ CNSR == 0
        )) %>%
        mutate(n_events = case_when(
            grepl("TOT", .data$PARAMCD, fixed = TRUE) ~ as.integer(.data$AVAL),
            TRUE ~ as.integer(is_event)
        )) %>%
        teal.data::col_relabel(is_event = "Is an Event") %>%
        teal.data::col_relabel(n_events = "Number of Events")
    ADAETTE_AE <-
        filter(ADAETTE, grepl("TOT", .data$PARAMCD, fixed = TRUE)) %>% select(-"AVAL")
    ADAETTE_OTH <-
        filter(ADAETTE, !(grepl("TOT", .data$PARAMCD, fixed = TRUE)))

    ADAETTE_TTE <- ADAETTE %>%
        filter(PARAMCD == "AEREPTTE") %>%
        select(USUBJID, ARM, ARMCD, AVAL)

    ADAETTE_AE <-
        full_join(ADAETTE_AE, ADAETTE_TTE, by = c("USUBJID", "ARM", "ARMCD"))
    ADAETTE <- rbind(ADAETTE_AE, ADAETTE_OTH)

    ADEX <- radex(ADSL, seed = 1)
    ADEX_labels <- teal.data::col_labels(ADEX, fill = FALSE)
    # Below steps are done to simulate data with TDURD parameter as it is not in the ADEX data from `random.cdisc.data` package
    set.seed(1, kind = "Mersenne-Twister")
    ADEX <- ADEX %>%
        distinct(USUBJID, .keep_all = TRUE) %>%
        mutate(
            PARAMCD = "TDURD",
            PARAM = "Overall duration (days)",
            AVAL = sample(
                x = seq(1, 200),
                size = n(),
                replace = TRUE
            ),
            AVALU = "Days",
            PARCAT1 = "OVERALL"
        ) %>%
        bind_rows(ADEX)
    ADEX <- ADEX %>%
        filter(PARCAT1 == "OVERALL" &
                   PARAMCD %in% c("TDOSE", "TNDOSE", "TDURD"))
    teal.data::col_labels(ADEX) <- ADEX_labels

    ADLB <- radlb(ADSL, seed = 1)

    ADEG <- radeg(ADSL, seed = 1)

    # For real data, ADVS needs some preprocessing like group different ANRIND and BNRIND into abnormal
    ADVS <- radvs(ADSL, seed = 1) %>%
        mutate(ONTRTFL = ifelse(AVISIT %in% c("SCREENING", "BASELINE"), "", "Y")) %>%
        teal.data::col_relabel(ONTRTFL = "On Treatment Record Flag") %>%
        mutate(ANRIND = as.character(ANRIND), BNRIND = as.character(BNRIND)) %>%
        mutate(
            ANRIND = case_when(
                ANRIND == "HIGH HIGH" ~ "HIGH",
                ANRIND == "LOW LOW" ~ "LOW",
                TRUE ~ ANRIND
            ),
            BNRIND = case_when(
                BNRIND == "HIGH HIGH" ~ "HIGH",
                BNRIND == "LOW LOW" ~ "LOW",
                TRUE ~ BNRIND
            )
        )

    ADCM <- radcm(ADSL, seed = 1) %>% mutate(CMSEQ = as.integer(CMSEQ))

    # Add study-specific pre-processing: convert arm, param and visit variables to factors
    # Sample code:
    # ADSL$ACTARM <- factor(ADSL$ACTARM)
    # ADAE$AETOXGR <- factor(ADAE$AETOXGR)
    # ADLB <- ADLB %>%
    #   tern::df_explicit_na(omit_columns = setdiff(names(ADLB), c("PARAM", "PARAMCD", "AVISIT") ))
    # ADEX <- ADEX %>%
    #   tern::df_explicit_na(omit_columns = setdiff(names(ADEX), c("PARAM", "PARAMCD", "PARCAT2") ))

    # define study-specific analysis subgroups and baskets from ADAE
    add_event_flags <- function(dat) {
        dat %>%
            dplyr::mutate(
                TMPFL_SER = AESER == "Y",
                TMPFL_REL = AEREL == "Y",
                TMPFL_GR5 = AETOXGR == "5",
                TMP_SMQ01 = !is.na(SMQ01NAM),
                TMP_SMQ02 = !is.na(SMQ02NAM),
                TMP_CQ01 = !is.na(CQ01NAM)
            ) %>%
            teal.data::col_relabel(
                TMPFL_SER = "Serious AE",
                TMPFL_REL = "Related AE",
                TMPFL_GR5 = "Grade 5 AE",
                TMP_SMQ01 = aesi_label(dat$SMQ01NAM, dat$SMQ01SC),
                TMP_SMQ02 = aesi_label(dat$SMQ02NAM, dat$SMQ02SC),
                TMP_CQ01 = aesi_label(dat$CQ01NAM)
            )
    }

    ADAE <- ADAE %>%
        add_event_flags()
})

datanames <- c("ADSL", "ADAE", "ADAETTE", "ADEX", "ADLB", "ADEG", "ADVS", "ADCM")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

## App configuration ----
ADSL <- data[["ADSL"]]
ADAE <- data[["ADAE"]]
ADAETTE <- data[["ADAETTE"]]
ADEX <- data[["ADEX"]]
ADLB <- data[["ADLB"]]
ADEG <- data[["ADEG"]]
ADVS <- data[["ADVS"]]
ADCM <- data[["ADCM"]]

arm_vars <- c("ACTARMCD", "ACTARM")

## Create variable type lists
date_vars_adsl <-
    names(ADSL)[vapply(ADSL, function(x) {
        inherits(x, c("Date", "POSIXct", "POSIXlt"))
    }, logical(1))]
demog_vars_adsl <-
    names(ADSL)[!(names(ADSL) %in% c("USUBJID", "STUDYID", date_vars_adsl))]

cs_arm_var <-
    choices_selected(
        choices = variable_choices(ADSL, subset = arm_vars),
        selected = "ACTARM"
    )

ae_anl_vars <- names(ADAE)[startsWith(names(ADAE), "TMPFL_")]
# flag variables for AE baskets; set to NULL if not applicable to study
aesi_vars <-
    names(ADAE)[startsWith(names(ADAE), "TMP_SMQ") |
                    startsWith(names(ADAE), "TMP_CQ")]

## App header and footer ----
nest_logo <- "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png"
app_source <- "https://github.com/insightsengineering/teal.gallery/tree/main/safety"
gh_issues_page <- "https://github.com/insightsengineering/teal.gallery/issues"

header <- tags$span(
    style = "display: flex; align-items: center; justify-content: space-between; margin: 10px 0 10px 0;",
    tags$span("My first teal app", style = "font-size: 30px;"),
    tags$span(
        style = "display: flex; align-items: center;",
        tags$img(src = nest_logo, alt = "NEST logo", height = "45px", style = "margin-right:10px;"),
        tags$span(style = "font-size: 24px;", "NEST @ Roche")
    )
)

footer <- tags$p(
    "This teal app is brought to you by the NEST Team at Roche/Genentech.
        For more information, please visit:",
    tags$a(href = app_source, target = "_blank", "Source Code"), ", ",
    tags$a(href = gh_issues_page, target = "_blank", "Report Issues")
)

## Setup App
app <- teal::init(
    data = data,
    title = build_app_title("Safety Analysis Teal Demo App", nest_logo),
    header = header,
    footer = footer,
    # Set initial filter state as safety-evaluable population
    filter = teal_slices(
        count_type = "all",
        teal_slice(dataname = "ADSL", varname = "SAFFL", selected = "Y"),
        teal_slice(dataname = "ADSL", varname = "SEX"),
        teal_slice(dataname = "ADSL", varname = "AGE"),
        teal_slice(dataname = "ADLB", varname = "AVAL"),
        # default filter
        teal_slice(dataname = "ADEX", varname = "AVAL"),
        # default filter
        teal_slice(dataname = "ADEG", varname = "AVAL")
    ),
    modules = modules(
        tm_front_page(
            label = "App Info",
            header_text = c("Info about input data source" = "This app uses CDISC ADaM datasets randomly generated by `random.cdisc.data` R packages"),
            tables = list(`NEST packages used in this demo app` = data.frame(
                Packages = c(
                    "teal.modules.general",
                    "teal.modules.clinical",
                    "random.cdisc.data"
                )
            ))
        ),
        tm_data_table("Data Table"),
        tm_variable_browser("Variable Browser"),
        tm_t_summary(
            label = "Demographic Table",
            dataname = "ADSL",
            arm_var = cs_arm_var,
            summarize_vars = choices_selected(
                choices = variable_choices(ADSL, demog_vars_adsl),
                selected = c("SEX", "AGE", "RACE")
            )
        ),
        modules(
            label = "Adverse Events",
            tm_t_events_summary(
                label = "AE Summary",
                dataname = "ADAE",
                arm_var = cs_arm_var,
                flag_var_anl = choices_selected(
                    choices = variable_choices("ADAE", ae_anl_vars),
                    selected = ae_anl_vars,
                    keep_order = TRUE
                ),
                flag_var_aesi = choices_selected(
                    choices = variable_choices("ADAE", aesi_vars),
                    selected = aesi_vars,
                    keep_order = TRUE
                ),
                add_total = TRUE
            ),
            tm_t_events(
                label = "AE by Term",
                dataname = "ADAE",
                arm_var = cs_arm_var,
                llt = choices_selected(
                    choices = variable_choices(ADAE, c("AETERM", "AEDECOD")),
                    selected = c("AEDECOD")
                ),
                hlt = choices_selected(
                    choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")),
                    selected = "AEBODSYS"
                ),
                add_total = TRUE,
                event_type = "adverse event"
            ),
            tm_t_events_by_grade(
                label = "AE Table by Grade",
                dataname = "ADAE",
                arm_var = cs_arm_var,
                llt = choices_selected(
                    choices = variable_choices(ADAE, c("AEDECOD")),
                    selected = c("AEDECOD")
                ),
                hlt = choices_selected(
                    choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")),
                    selected = "AEBODSYS"
                ),
                grade = choices_selected(
                    choices = variable_choices(ADAE, c("AETOXGR")),
                    selected = "AETOXGR"
                ),
                add_total = TRUE
            ),
            tm_t_events_patyear(
                label = "AE Rates Adjusted for Patient-Years at Risk",
                dataname = "ADAETTE",
                arm_var = cs_arm_var,
                paramcd = choices_selected(
                    choices = value_choices(ADAETTE, "PARAMCD", "PARAM"),
                    selected = "AETTE1"
                ),
                events_var = choices_selected(
                    choices = variable_choices(ADAETTE, "n_events"),
                    selected = "n_events",
                    fixed = TRUE
                )
            ),
            tm_t_smq(
                label = "Adverse Events by SMQ Table",
                dataname = "ADAE",
                arm_var = choices_selected(
                    choices = variable_choices(ADSL, subset = c(arm_vars, "SEX")),
                    selected = "ACTARM"
                ),
                add_total = FALSE,
                baskets = choices_selected(
                    choices = variable_choices(ADAE, subset = grep("^(SMQ|CQ).*NAM$", names(ADAE), value = TRUE)),
                    selected = grep("^(SMQ|CQ).*NAM$", names(ADAE), value = TRUE)
                ),
                scopes = choices_selected(
                    choices = variable_choices(ADAE, subset = grep("^SMQ.*SC$", names(ADAE), value = TRUE)),
                    selected = grep("^SMQ.*SC$", names(ADAE), value = TRUE),
                    fixed = TRUE
                ),
                llt = choices_selected(
                    choices = variable_choices(ADAE, subset = c("AEDECOD")),
                    selected = "AEDECOD"
                )
            )
        ),
        modules(
            label = "Lab Tables",
            tm_t_summary_by(
                label = "Labs Summary",
                dataname = "ADLB",
                arm_var = cs_arm_var,
                by_vars = choices_selected(
                    choices = variable_choices(ADLB, c("PARAM", "AVISIT")),
                    selected = c("PARAM", "AVISIT"),
                    fixed = TRUE
                ),
                summarize_vars = choices_selected(
                    choices = variable_choices(ADLB, c("AVAL", "CHG")),
                    selected = c("AVAL")
                ),
                paramcd = choices_selected(
                    choices = value_choices(ADLB, "PARAMCD", "PARAM"),
                    selected = "ALT"
                )
            ),
            tm_t_shift_by_grade(
                label = "Grade Laboratory Abnormality Table",
                dataname = "ADLB",
                arm_var = cs_arm_var,
                paramcd = choices_selected(
                    choices = value_choices(ADLB, "PARAMCD", "PARAM"),
                    selected = "ALT"
                ),
                worst_flag_var = choices_selected(
                    choices = variable_choices(ADLB, subset = c(
                        "WGRLOVFL", "WGRLOFL", "WGRHIVFL", "WGRHIFL"
                    )),
                    selected = c("WGRLOVFL")
                ),
                worst_flag_indicator = choices_selected(
                    value_choices(ADLB, "WGRLOVFL"),
                    selected = "Y",
                    fixed = TRUE
                ),
                anl_toxgrade_var = choices_selected(
                    choices = variable_choices(ADLB, subset = c("ATOXGR")),
                    selected = c("ATOXGR"),
                    fixed = TRUE
                ),
                base_toxgrade_var = choices_selected(
                    choices = variable_choices(ADLB, subset = c("BTOXGR")),
                    selected = c("BTOXGR"),
                    fixed = TRUE
                ),
                add_total = FALSE
            ),
            tm_t_abnormality_by_worst_grade(
                label = "Laboratory test results with highest grade post-baseline",
                dataname = "ADLB",
                arm_var = choices_selected(
                    choices = variable_choices(ADSL, subset = c("ARM", "ARMCD")),
                    selected = "ARM"
                ),
                paramcd = choices_selected(
                    choices = value_choices(ADLB, "PARAMCD", "PARAM"),
                    selected = c("ALT", "CRP", "IGA")
                ),
                add_total = FALSE
            )
        ),
        modules(
            label = "Exposure",
            tm_t_summary_by(
                label = "Exposure Summary",
                dataname = "ADEX",
                arm_var = cs_arm_var,
                by_vars = choices_selected(
                    choices = variable_choices(ADEX, c("PARCAT2", "PARAM")),
                    selected = c("PARCAT2", "PARAM"),
                    fixed = TRUE
                ),
                summarize_vars = choices_selected(
                    choices = variable_choices(ADEX, "AVAL"),
                    selected = c("AVAL"),
                    fixed = TRUE
                ),
                paramcd = choices_selected(
                    choices = value_choices(ADEX, "PARAMCD", "PARAM"),
                    selected = "TDOSE"
                ),
                denominator = choices_selected(
                    choices = c("n", "N", "omit"),
                    selected = "n"
                )
            ),
            tm_t_exposure(
                label = "Duration of Exposure Table",
                dataname = "ADEX",
                paramcd = choices_selected(
                    choices = value_choices(ADEX, "PARAMCD", "PARAM"),
                    selected = "TDURD",
                    fixed = TRUE
                ),
                col_by_var = choices_selected(
                    choices = variable_choices(ADEX, subset = c(arm_vars, "SEX")),
                    selected = "SEX"
                ),
                row_by_var = choices_selected(
                    choices = variable_choices(
                        ADEX,
                        subset = c("RACE", "REGION1", "STRATA1", "SEX")
                    ),
                    selected = "RACE"
                ),
                parcat = choices_selected(
                    choices = value_choices(ADEX, "PARCAT2"),
                    selected = "Drug A"
                ),
                add_total = FALSE
            )
        ),
        tm_t_abnormality(
            label = "Vital Signs Abnormality",
            dataname = "ADVS",
            arm_var = cs_arm_var,
            id_var = choices_selected(
                choices = variable_choices(ADSL, subset = "USUBJID"),
                selected = "USUBJID",
                fixed = TRUE
            ),
            by_vars = choices_selected(
                choices = variable_choices(ADVS, subset = c("PARAM", "AVISIT")),
                selected = c("PARAM"),
                keep_order = TRUE
            ),
            grade = choices_selected(
                choices = variable_choices(ADVS, subset = "ANRIND"),
                selected = "ANRIND",
                fixed = TRUE
            ),
            abnormal = list(low = "LOW", high = "HIGH")
        ),
        tm_t_mult_events(
            label = "Concomitant Medication",
            dataname = "ADCM",
            arm_var = cs_arm_var,
            seq_var = choices_selected("CMSEQ", selected = "CMSEQ", fixed = TRUE),
            hlt = choices_selected(
                choices = variable_choices(ADCM, c(
                    "ATC1", "ATC2", "ATC3", "ATC4"
                )),
                selected = "ATC2"
            ),
            llt = choices_selected(
                choices = variable_choices(ADCM, c("CMDECOD")),
                selected = "CMDECOD",
                fixed = TRUE
            ),
            add_total = TRUE,
            event_type = "treatment"
        ),
        tm_t_shift_by_arm(
            label = "ECG Shift Table by Arm",
            dataname = "ADEG",
            arm_var = cs_arm_var,
            paramcd = choices_selected(value_choices(ADEG, "PARAMCD"),
                                       selected = "HR"
            ),
            visit_var = choices_selected(value_choices(ADEG, "AVISIT"),
                                         selected = "POST-BASELINE MINIMUM"
            ),
            aval_var = choices_selected(
                variable_choices(ADEG, subset = "ANRIND"),
                selected = "ANRIND",
                fixed = TRUE
            ),
            baseline_var = choices_selected(
                variable_choices(ADEG, subset = "BNRIND"),
                selected = "BNRIND",
                fixed = TRUE
            )
        ),
        tm_g_lineplot(
            label = "Line Plot",
            dataname = "ADLB",
            strata = cs_arm_var,
            x = choices_selected(variable_choices(ADLB, "AVISIT"), "AVISIT", fixed = TRUE),
            y = choices_selected(variable_choices(ADLB, c(
                "AVAL", "BASE", "CHG", "PCHG"
            )), "AVAL"),
            y_unit = choices_selected(variable_choices(ADLB, "AVALU"), "AVALU", fixed = TRUE),
            paramcd = choices_selected(variable_choices(ADLB, "PARAMCD"), "PARAMCD", fixed = TRUE),
            param = choices_selected(value_choices(ADLB, "PARAMCD", "PARAM"), "ALT"),
            plot_height = c(1000L, 200L, 4000L)
        )
    )
)

shinyApp(app$ui, app$server)

sessionInfo()

R version 4.2.2 (2022-10-31)

attached base packages:
[1] stats     graphics  grDevices datasets  utils     methods   base     

other attached packages:
 [1] efficacy_0.1.0              DT_0.32                     shinyWidgets_0.8.1         
 [4] teal.widgets_0.4.2          ggforce_0.4.2               forcats_1.0.0              
 [7] tidyr_1.3.1                 sparkline_2.0               nestcolor_0.1.2            
[10] dplyr_1.1.4                 random.cdisc.data_0.3.15    teal.modules.clinical_0.9.0
[13] tern_0.9.3                  rtables_0.6.6               magrittr_2.0.3             
[16] formatters_0.5.5            teal.modules.general_0.3.0  teal.transform_0.5.0       
[19] teal_0.15.2                 teal.slice_0.5.0            teal.data_0.5.0            
[22] teal.code_0.5.0             shiny_1.8.0                 ggmosaic_0.3.3             
[25] ggplot2_3.5.0              

loaded via a namespace (and not attached):
  [1] backports_1.4.1       Hmisc_5.1-2           lazyeval_0.2.2        splines_4.2.2        
  [5] crosstalk_1.2.1       teal.logger_0.1.3     usethis_2.2.3         TH.data_1.1-2        
  [9] tern.gee_0.1.3        digest_0.6.34         htmltools_0.5.7       fansi_1.0.6          
 [13] checkmate_2.3.1       memoise_2.0.1         cluster_2.1.4         remotes_2.4.2.1      
 [17] sandwich_3.1-0        timechange_0.3.0      colorspace_2.1-0      ggrepel_0.9.5        
 [21] haven_2.5.4           rbibutils_2.2.16      xfun_0.42             crayon_1.5.2         
 [25] jsonlite_1.8.8        survival_3.4-0        zoo_1.8-12            glue_1.7.0           
 [29] geepack_1.3.10        polyclip_1.10-6       gtable_0.3.4          emmeans_1.10.0       
 [33] pkgbuild_1.4.3        scales_1.3.0          mvtnorm_1.2-4         miniUI_0.1.1.1       
 [37] Rcpp_1.0.12           viridisLite_0.4.2     xtable_1.8-4          htmlTable_2.4.2      
 [41] foreign_0.8-83        Formula_1.2-5         profvis_0.3.8         htmlwidgets_1.6.4    
 [45] httr_1.4.7            ellipsis_0.3.2        urlchecker_1.0.1      pkgconfig_2.0.3      
 [49] farver_2.1.1          nnet_7.3-18           sass_0.4.8            utf8_1.2.4           
 [53] labeling_0.4.3        tidyselect_1.2.0      rlang_1.1.3           later_1.3.2          
 [57] munsell_0.5.0         tools_4.2.2           cachem_1.0.8          cli_3.6.2            
 [61] generics_0.1.3        devtools_2.4.5        broom_1.0.5           evaluate_0.23        
 [65] stringr_1.5.1         fastmap_1.1.1         yaml_2.3.8            knitr_1.45           
 [69] fs_1.6.3              shinycssloaders_1.0.0 purrr_1.0.2           teal.reporter_0.3.0  
 [73] nlme_3.1-160          mime_0.12             compiler_4.2.2        rstudioapi_0.15.0    
 [77] plotly_4.10.4         tibble_3.2.1          tweenr_2.0.3          bslib_0.6.1          
 [81] stringi_1.8.3         desc_1.4.3            logger_0.2.2          lattice_0.20-45      
 [85] Matrix_1.6-5          shinyjs_2.1.0         vctrs_0.6.5           pillar_1.9.0         
 [89] lifecycle_1.0.4       BiocManager_1.30.22   Rdpack_2.6            jquerylib_0.1.4      
 [93] estimability_1.4.1    cowplot_1.1.3         data.table_1.15.0     httpuv_1.6.14        
 [97] R6_2.5.1              promises_1.2.1        renv_1.0.4            gridExtra_2.3        
[101] sessioninfo_1.2.2     codetools_0.2-18      MASS_7.3-58.1         pkgload_1.3.4        
[105] fontawesome_0.5.2     rprojroot_2.0.4       withr_3.0.0           multcomp_1.4-25      
[109] hms_1.1.3             shinyvalidate_0.1.3   grid_4.2.2            rpart_4.1.19         
[113] rmarkdown_2.25        lubridate_1.9.3       base64enc_0.1-3

Relevant log output

No response

Code of Conduct

Contribution Guidelines

Security Policy

kumamiao commented 3 months ago

Hi @Polkas , yes we would like to collaborate on this. Please kindly start a pull request and we'd be happy to review. Thank you!