Update modules' code for reproducibility (#1399)

# Pull Request

<!--- Replace `#nnn` with your issue link for reference. -->

Related to
insightsengineering/coredev-tasks#646 and
insightsengineering/teal.gallery#212
Fixes:
#1401
Fixes:
#1402
Fixes:
#1403
Fixes: insightsengineering/teal.gallery#214

---------

Signed-off-by: Lluís Revilla <[email protected]>
Co-authored-by: André Veríssimo <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>

Author: 3 people

.lintr

@@ -1,6 +1,5 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
-  cyclocomp_linter = NULL,
   object_usage_linter = NULL,
   object_name_linter = object_name_linter(
     styles = c("snake_case", "symbols"),

DESCRIPTION

@@ -43,11 +43,11 @@ Imports:
     cowplot (>= 0.7.0),
     dplyr (>= 1.0.5),
     DT (>= 0.13),
+    formatters (>= 0.5.11),
     ggplot2 (>= 3.4.0),
     ggrepel (>= 0.9.6),
     grid,
     lifecycle (>= 0.2.0),
-    methods,
     rlistings (>= 0.2.10),
     rmarkdown (>= 2.23),
     rtables (>= 0.6.11),
@@ -90,8 +90,8 @@ Remotes:
 Config/Needs/verdepcheck: insightsengineering/teal,
     insightsengineering/teal.slice, insightsengineering/teal.transform,
     insightsengineering/tern, tidymodels/broom, mllg/checkmate,
-    wilkelab/cowplot, tidyverse/dplyr, rstudio/DT, tidyverse/ggplot2,
-    slowkow/ggrepel, r-lib/lifecycle, daroczig/logger,
+    wilkelab/cowplot, tidyverse/dplyr, rstudio/DT, insightsengineering/formatters,
+    tidyverse/ggplot2, slowkow/ggrepel, r-lib/lifecycle, daroczig/logger,
     insightsengineering/rlistings, rstudio/rmarkdown,
     insightsengineering/rtables, r-lib/scales, rstudio/shiny,
     daattali/shinyjs, rstudio/shinyvalidate, dreamRs/shinyWidgets,

NAMESPACE

@@ -71,5 +71,3 @@ import(teal.transform)
 import(tern)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,.data)
-importFrom(methods,is)
-importFrom(tern.gee,lsmeans)

R/teal.modules.clinical.R

@@ -10,8 +10,6 @@
 #' @import teal.transform
 #' @import tern
 #' @importFrom dplyr %>% .data
-#' @importFrom methods is
-#' @importFrom tern.gee lsmeans
 
 # We need this to avoid R CMD check warning about missing global definitions.
 utils::globalVariables(c(

R/tm_a_gee.R

@@ -70,8 +70,8 @@ template_a_gee <- function(output_table,
         substitute(
           expr = {
             table <- tern.gee::as.rtable(model_fit, type = "cov")
-            subtitles(table) <- st
-            main_footer(table) <- mf
+            rtables::subtitles(table) <- st
+            rtables::main_footer(table) <- mf
           },
           env = list(
             st = basic_table_args$subtitles,
@@ -82,8 +82,8 @@ template_a_gee <- function(output_table,
         substitute(
           expr = {
             table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients))
-            subtitles(table) <- st
-            main_footer(table) <- mf
+            rtables::subtitles(table) <- st
+            rtables::main_footer(table) <- mf
           },
           env = list(
             conf_level = conf_level,
@@ -103,8 +103,8 @@ template_a_gee <- function(output_table,
                 alt_counts_df = dataname_lsmeans
               )
 
-            subtitles(table) <- st
-            main_footer(table) <- mf
+            rtables::subtitles(table) <- st
+            rtables::main_footer(table) <- mf
           },
           env = list(
             dataname_lsmeans = as.name(dataname_lsmeans),

R/tm_a_mmrm.R

@@ -65,15 +65,15 @@ template_fit_mmrm <- function(parentname,
       data_list <- add_expr(
         data_list,
         substitute_names(
-          expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
+          expr = dplyr::mutate(arm_var = tern::combine_levels(arm_var, levels = comp_arm)),
           names = list(arm_var = as.name(arm_var)),
           others = list(comp_arm = comp_arm)
         )
       )
       parent_list <- add_expr(
         parent_list,
         substitute_names(
-          expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
+          expr = dplyr::mutate(arm_var = tern::combine_levels(arm_var, levels = comp_arm)),
           names = list(arm_var = as.name(arm_var)),
           others = list(comp_arm = comp_arm)
         )
@@ -100,8 +100,8 @@ template_fit_mmrm <- function(parentname,
       )
     )
   }
-  data_list <- add_expr(data_list, quote(df_explicit_na(na_level = default_na_str())))
-  parent_list <- add_expr(parent_list, quote(df_explicit_na(na_level = default_na_str())))
+  data_list <- add_expr(data_list, quote(tern::df_explicit_na(na_level = tern::default_na_str())))
+  parent_list <- add_expr(parent_list, quote(tern::df_explicit_na(na_level = tern::default_na_str())))
 
   y$data <- substitute(
     expr = {
@@ -206,7 +206,7 @@ template_mmrm_tables <- function(parentname,
         layout_list,
         substitute(
           expr = rtables::split_rows_by(visit_var) %>%
-            append_varlabels(dataname, visit_var) %>%
+            tern::append_varlabels(dataname, visit_var) %>%
             tern.mmrm::summarize_lsmeans(
               .stats = c(
                 "n",
@@ -230,7 +230,7 @@ template_mmrm_tables <- function(parentname,
         layout_list,
         substitute(
           expr = rtables::split_rows_by(visit_var) %>%
-            append_varlabels(dataname, visit_var) %>%
+            tern::append_varlabels(dataname, visit_var) %>%
             tern.mmrm::summarize_lsmeans(show_relative = show_relative) %>%
             rtables::append_topleft(paste0("  ", paramcd)),
           env = list(
@@ -270,7 +270,7 @@ template_mmrm_tables <- function(parentname,
         expr = {
           lsmeans_table <- rtables::build_table(
             lyt = lyt,
-            df = df_explicit_na(broom::tidy(fit_mmrm), na_level = default_na_str()),
+            df = tern::df_explicit_na(broom::tidy(fit_mmrm), na_level = tern::default_na_str()),
             alt_counts_df = parentname
           )
         },
@@ -284,7 +284,7 @@ template_mmrm_tables <- function(parentname,
       y$cov_matrix <- substitute(
         expr = {
           covariance_table <- tern.mmrm::as.rtable(fit_mmrm, type = "cov")
-          subtitles(covariance_table) <- st
+          rtables::subtitles(covariance_table) <- st
         },
         env = list(
           fit_mmrm = as.name(fit_name),
@@ -296,7 +296,7 @@ template_mmrm_tables <- function(parentname,
       y$fixed_effects <- substitute(
         expr = {
           fixed_effects_table <- tern.mmrm::as.rtable(fit_mmrm, type = "fixed")
-          subtitles(fixed_effects_table) <- st
+          rtables::subtitles(fixed_effects_table) <- st
         },
         env = list(
           fit_mmrm = as.name(fit_name),
@@ -308,7 +308,7 @@ template_mmrm_tables <- function(parentname,
       y$diagnostic_table <- substitute(
         expr = {
           diagnostic_table <- tern.mmrm::as.rtable(fit_mmrm, type = "diagnostic")
-          subtitles(diagnostic_table) <- st
+          rtables::subtitles(diagnostic_table) <- st
         },
         env = list(
           fit_mmrm = as.name(fit_name),
@@ -887,11 +887,11 @@ ui_mmrm <- function(id, ...) {
             )
           )
         )
+      ),
+      forms = tagList(
+        teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
       )
     ),
-    forms = tagList(
-      teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
-    ),
     pre_output = a$pre_output,
     post_output = a$post_output
   )
@@ -1028,8 +1028,18 @@ srv_mmrm <- function(id,
       anl_name = "ANL_ADSL"
     )
 
+    # Set tern default for missing values for reproducibility (on .onLoad for the examples)
+    data_with_tern_options_r <- reactive({
+      within(data(),
+        {
+          tern::set_default_na_str(default_na_str)
+        },
+        default_na_str = getOption("tern_default_na_str", default = "<Missing>")
+      )
+    })
+
     anl_q <- reactive({
-      data() %>%
+      data_with_tern_options_r() %>%
         teal.code::eval_code(code = as.expression(anl_inputs()$expr)) %>%
         teal.code::eval_code(code = as.expression(adsl_merge_inputs()$expr))
     })
@@ -1554,7 +1564,7 @@ srv_mmrm <- function(id,
       id = "rcode",
       verbatim_content = source_code_r,
       disabled = disable_r_code,
-      title = "R Code for the Current MMRM Analysis"
+      title = label
     )
 
     ### REPORTER

R/tm_g_barchart_simple.R

@@ -222,6 +222,7 @@ tm_g_barchart_simple <- function(x = NULL,
       fill = fill,
       x_facet = x_facet,
       y_facet = y_facet,
+      label = label,
       plot_height = plot_height,
       plot_width = plot_width,
       ggplot2_args = ggplot2_args,
@@ -351,13 +352,13 @@ ui_g_barchart_simple <- function(id, ...) {
             )
           )
         )
-      )
-    ),
-    forms = tagList(
-      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
-    ),
-    pre_output = args$pre_output,
-    post_output = args$post_output
+      ),
+      forms = tagList(
+        teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
+      ),
+      pre_output = args$pre_output,
+      post_output = args$post_output
+    )
   )
 }
 
@@ -370,6 +371,7 @@ srv_g_barchart_simple <- function(id,
                                   fill,
                                   x_facet,
                                   y_facet,
+                                  label,
                                   plot_height,
                                   plot_width,
                                   ggplot2_args,
@@ -499,7 +501,7 @@ srv_g_barchart_simple <- function(id,
       groupby_vars <- as.list(r_groupby_vars()) # so $ access works below
 
       y_lab <- substitute(
-        column_annotation_label(counts, y_name),
+        teal.modules.clinical::column_annotation_label(counts, y_name),
         list(y_name = get_n_name(groupby_vars))
       )
 
@@ -593,7 +595,7 @@ srv_g_barchart_simple <- function(id,
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
       verbatim_content = source_code_r,
-      title = "Bar Chart"
+      title = label
     )
 
     ### REPORTER
@@ -751,7 +753,11 @@ make_barchart_simple_call <- function(y_name,
   # add legend for fill
   if (!is.null(fill_name)) {
     plot_args <- c(plot_args, bquote(
-      ggplot2::guides(fill = ggplot2::guide_legend(title = column_annotation_label(counts, .(fill_name))))
+      ggplot2::guides(
+        fill = ggplot2::guide_legend(
+          title = teal.modules.clinical::column_annotation_label(counts, .(fill_name))
+        )
+      )
     ))
   }
 

R/tm_g_ci.R

@@ -82,8 +82,8 @@ template_g_ci <- function(dataname,
         ),
         env = list(
           fun = switch(stat,
-            mean = substitute(stat_mean_ci),
-            median = substitute(stat_median_ci)
+            mean = substitute(tern::stat_mean_ci),
+            median = substitute(tern::stat_median_ci)
           )
         )
       )
@@ -101,11 +101,11 @@ template_g_ci <- function(dataname,
         env = list(
           fun = switch(stat,
             mean = substitute(
-              expr = function(x) stat_mean_ci(x, conf_level = conf_level),
+              expr = function(x) tern::stat_mean_ci(x, conf_level = conf_level),
               env = list(conf_level = conf_level)
             ),
             median = substitute(
-              expr = function(x) stat_median_ci(x, conf_level = conf_level),
+              expr = function(x) tern::stat_median_ci(x, conf_level = conf_level),
               env = list(conf_level = conf_level)
             )
           )
@@ -473,10 +473,10 @@ srv_g_ci <- function(id,
         )
       )
 
-      x_label <- column_annotation_label(data()[[attr(x, "dataname")]], x)
-      y_label <- column_annotation_label(data()[[attr(y, "dataname")]], y)
+      x_label <- teal.modules.clinical::column_annotation_label(data()[[attr(x, "dataname")]], x)
+      y_label <- teal.modules.clinical::column_annotation_label(data()[[attr(y, "dataname")]], y)
       color_label <- if (length(color)) {
-        column_annotation_label(data()[[attr(color, "dataname")]], color)
+        teal.modules.clinical::column_annotation_label(data()[[attr(color, "dataname")]], color)
       } else {
         NULL
       }

R/tm_g_forest_rsp.R

@@ -94,7 +94,7 @@ template_forest_rsp <- function(dataname = "ANL",
   anl_list <- add_expr(
     anl_list,
     substitute_names(
-      expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
+      expr = dplyr::mutate(arm_var = tern::combine_levels(arm_var, levels = comp_arm)),
       names = list(arm_var = as.name(arm_var)),
       others = list(comp_arm = comp_arm)
     )
@@ -125,7 +125,7 @@ template_forest_rsp <- function(dataname = "ANL",
   parent_list <- add_expr(
     parent_list,
     substitute_names(
-      expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
+      expr = dplyr::mutate(arm_var = tern::combine_levels(arm_var, levels = comp_arm)),
       names = list(arm_var = as.name(arm_var)),
       others = list(comp_arm = comp_arm)
     )
@@ -149,7 +149,7 @@ template_forest_rsp <- function(dataname = "ANL",
   summary_list <- add_expr(
     summary_list,
     substitute(
-      expr = df <- extract_rsp_subgroups(
+      expr = df <- tern::extract_rsp_subgroups(
         variables = list(
           rsp = "is_rsp", arm = arm_var, subgroups = subgroup_var, strata = strata_var
         ),
@@ -171,7 +171,7 @@ template_forest_rsp <- function(dataname = "ANL",
   # Table output.
   y$table <- substitute(
     expr = result <- rtables::basic_table() %>%
-      tabulate_rsp_subgroups(df, vars = stats, riskdiff = riskdiff),
+      tern::tabulate_rsp_subgroups(df, vars = stats, riskdiff = riskdiff),
     env = list(stats = stats, riskdiff = riskdiff)
   )
 
@@ -191,7 +191,7 @@ template_forest_rsp <- function(dataname = "ANL",
     plot_list,
     substitute(
       expr = {
-        f <- g_forest(
+        f <- tern::g_forest(
           tbl = result,
           col_symbol_size = col_s_size,
           font_size = font_size,
@@ -790,7 +790,10 @@ srv_g_forest_rsp <- function(id,
       id = "decorator",
       data = all_q,
       decorators = select_decorators(decorators, "plot"),
-      expr = plot
+      expr = {
+        table
+        plot
+      }
     )
 
     plot_r <- reactive({