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

[Polkas]

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.

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

• I agree to follow this project's Code of Conduct.

Contribution Guidelines

• I agree to follow this project's Contribution Guidelines.

Security Policy

• I agree to follow this project's Security Policy.

[kumamiao]

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!

[chlebowa]

Is this issue active? I have a possible related problem where the plot overflows from the modal.
This is under bs5:

> packageVersion("teal.widgets")
[1] '0.4.2'

[vedhav]

There are quite a few issue when using BS5 and this is one of them. Luckily we plan to migrate completely to BS5 and also use bslib components over the default shiny UI components soon. Right now we have the changes in the test@bslib@main branch if you want to have a sneak peek into how that will look like.

Current main branch with BS5

Same app which uses the test@bslib@main branch

Here is the code to reproduce the app from the screenshot.

##### Install and load the main branch to see the plot overflow issue with BS5 popup.
# library(teal)
# library(teal.modules.clinical)
# options("teal.bs_theme" = bslib::bs_theme(version = "5"))
#####

##### Load the `test@bslib@main` branch for all these packages to see the new BS5 related changes
##### Note that there is no need to set the `teal.bs_theme` option as we will completely switch to BS5
devtools::load_all("teal.slice")
devtools::load_all("teal.widgets")
devtools::load_all("teal")
devtools::load_all("teal.modules.clinical")

simple_module <- function(transformators = list()) {
  module(
    label = "Simple iris plot",
    ui = function(id) {
      ns <- NS(id)
      teal.widgets::plot_with_settings_ui(
        id = ns("plot_with_settings")
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        plot_q <- reactive({
          data() |>
            within({
              library(ggplot2)
              ggplot(
                data = iris,
                aes(x = Sepal.Length, y = Sepal.Width, color = Species)
              ) +
                geom_point()
            })
        })
        teal.widgets::plot_with_settings_srv(
          id = "plot_with_settings",
          plot_r = reactive(get_code(plot_q())),
          height = c(400, 100, 1200),
          width = c(500, 250, 750)
        )
      })
    },
    datanames = "iris",
    transformators = transformators
  )
}

my_transformers <- list(
  teal_transform_module(
    label = "Dummy",
    ui = function(id) div("(does nothing)"),
    server = function(id, data) {
      moduleServer(id, function(input, output, session) data)
    }
  ),
  teal_transform_module(
    label = "Show head of iris?",
    ui = function(id) actionButton(NS(id, "button"), "Click to apply/remove"),
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          if (input$button %% 2 == 0) {
            data() # do nothing
          } else {
            within(data(), iris <- head(iris))
          }
        })
      })
    }
  )
)

data <- teal_data()
data <- within(data, {
  iris <- iris
  mtcars <- mtcars
  ADSL <- tmc_ex_adsl
  ADTTE <- tmc_ex_adtte
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

app <- init(
  data = data,
  modules = modules(
    tm_g_km(
      label = "Kaplan-Meier Plot",
      dataname = "ADTTE",
      arm_var = choices_selected(
        variable_choices("ADSL", c("ARM", "ARMCD", "ACTARMCD")),
        "ARM"
      ),
      paramcd = choices_selected(
        value_choices("ADTTE", "PARAMCD", "PARAM"),
        "OS"
      ),
      arm_ref_comp = list(
        ACTARMCD = list(
          ref = "ARM B",
          comp = c("ARM A", "ARM C")
        ),
        ARM = list(
          ref = "B: Placebo",
          comp = c("A: Drug X", "C: Combination")
        )
      ),
      strata_var = choices_selected(
        variable_choices("ADSL", c("SEX", "BMRKR2")),
        "SEX"
      ),
      facet_var = choices_selected(
        variable_choices("ADSL", c("SEX", "BMRKR2")),
        NULL
      )
    ),
    simple_module(transformators = my_transformers),
    example_module("Table view", transformators = my_transformers)
  )
)

shinyApp(app$ui, app$server)

[chlebowa]

Thanks @vedhav, I think this is good enough. The only question is when it is going to be released 😉

[donyunardi]

Hi @chlebowa,

Just to set expectations, the bslib release will likely align with our UI/UX update roadmap, which is planned for mid-year next year.

Right now, we're targeting an early release next year (as early as February or March at the latest) to deliver our other improvements.

[chlebowa]

Mid-year is a bit far. Would you accept a dirty patch in the meantime?