26 new chunks@main

.github/workflows/check.yaml

@@ -27,7 +27,6 @@ jobs:
     secrets:
       REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }}
   coverage:
-    if: github.event_name == 'pull_request'
     name: Coverage 📔 
     uses: insightsengineering/r.pkg.template/.github/workflows/test-coverage.yaml@main
     secrets:

NEWS.md

@@ -2,7 +2,9 @@
 
 ### Breaking changes
 * Soft deprecate function `label_aevar()`.
-
+* Replaced `chunks` with simpler `Quosure` class.
+* Replaced `datasets` argument containing `FilteredData` with the new arguments `data` (list of reactive datasets) and `filter_panel_api` (`FilterPanelAPI`).
+* `arm_var` have to point to the factor column in `ANL`. It can't be a character column anymore. 
 
 ### Enhancements
 * Added `teal.reporter` to all modules.

R/argument_convention.R

@@ -19,7 +19,7 @@
 #' @param arm_var (`choices_selected`)\cr
 #'  object with all available choices and the pre-selected option for variable
 #'  names that can be used as `arm_var`. See [teal.transform::choices_selected()] for
-#'  details.
+#'  details. Column `arm_var` in the `dataname` have to be a factor.
 #'
 #' @param paramcd (`character(1)` or `choices_selected`)\cr
 #'  variable value designating the studied parameter.

R/tm_g_ae_oview.R

@@ -136,7 +136,7 @@ tm_g_ae_oview <- function(label,
     ),
     ui = ui_g_ae_oview,
     ui_args = args,
-    filters = dataname
+    filters = c("ADSL", dataname)
   )
 }
 
@@ -208,22 +208,23 @@ ui_g_ae_oview <- function(id, ...) {
         footnotes = ""
       )
     ),
-    forms = get_rcode_ui(ns("rcode"))
+    forms = teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
   )
 }
 
 srv_g_ae_oview <- function(id,
-                           datasets,
+                           data,
+                           filter_panel_api,
                            reporter,
                            dataname,
                            label,
                            plot_height,
                            plot_width) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
+  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
 
   moduleServer(id, function(input, output, session) {
-    teal.code::init_chunks()
-    decorate_output <- srv_g_decorate(id = NULL, plt = plt, plot_height = plot_height, plot_width = plot_width)
+    decorate_output <- srv_g_decorate(id = NULL, plt = plot_r, plot_height = plot_height, plot_width = plot_width)
     font_size <- decorate_output$font_size
     pws <- decorate_output$pws
 
@@ -241,15 +242,12 @@ srv_g_ae_oview <- function(id,
       )
     })
 
-    observeEvent(input$arm_var, {
-      ANL <- datasets$get_data(dataname, filtered = FALSE) # nolint
-
-      req(!is.null(input$arm_var))
+    observeEvent(input$arm_var, ignoreNULL = TRUE, {
+      ANL <- data[[dataname]]() # nolint
       arm_var <- input$arm_var
+      arm_val <- ANL[[arm_var]]
+      choices <- levels(arm_val)
 
-      choices <- unique(ANL[[arm_var]])
-
-      validate(need(length(choices) > 0, "Please include multiple treatment"))
       if (length(choices) == 1) {
         trt_index <- 1
       } else {
@@ -270,8 +268,13 @@ srv_g_ae_oview <- function(id,
       )
     })
 
-    plt <- reactive({
+    output_q <- reactive({
+      ANL <- data[[dataname]]() # nolint
       validate(need(input$arm_var, "Please select an arm variable."))
+      validate(need(
+        is.factor(ANL[[input$arm_var]]),
+        "Selected arm variable needs to be a factor."
+      ))
       validate(need(input$flag_var_anl, "Please select at least one flag."))
       validate(need(
         input$arm_trt != input$arm_ref,
@@ -281,83 +284,61 @@ srv_g_ae_oview <- function(id,
           sep = "\n"
         )
       ))
-
-      ANL_UNFILTERED <- datasets$get_data(dataname, filtered = FALSE) # nolint
-      ADSL <- datasets$get_data("ADSL", filtered = TRUE) # nolint
-      ANL <- datasets$get_data(dataname, filtered = TRUE) # nolint
-
-      anl_name <- dataname
-      assign(anl_name, ANL)
-
-      teal.code::chunks_reset(envir = environment())
-
       validate(need(nlevels(ANL[[input$arm_var]]) > 1, "Arm needs to have at least 2 levels"))
       validate_has_data(ANL, min_nrow = 10)
-      if (all(c(input$arm_trt, input$arm_ref) %in% ANL_UNFILTERED[[input$arm_var]])) {
-        validate(
-          need(
-            input$arm_ref %in% ANL[[input$arm_var]],
-            paste0("Selected Control ", input$arm_var, ", ", input$arm_ref, ", is not in the data (filtered out?)")
-          ),
-          need(
-            input$arm_trt %in% ANL[[input$arm_var]],
-            paste0("Selected Treatment ", input$arm_var, ", ", input$arm_trt, ", is not in the data (filtered out?)")
-          )
+      validate(
+        need(
+          input$arm_ref %in% ANL[[input$arm_var]],
+          paste0("Selected Control ", input$arm_var, ", ", input$arm_ref, ", is not in the data (filtered out?)")
+        ),
+        need(
+          input$arm_trt %in% ANL[[input$arm_var]],
+          paste0("Selected Treatment ", input$arm_var, ", ", input$arm_trt, ", is not in the data (filtered out?)")
         )
-      }
+      )
       validate(need(all(c(input$arm_trt, input$arm_ref) %in% unique(ANL[[input$arm_var]])), "Plot loading"))
 
-      teal.code::chunks_push(
-        id = "variables call",
-        expression = bquote({
-          id <- .(as.name(anl_name))[["USUBJID"]]
-          arm <- .(as.name(anl_name))[[.(input$arm_var)]]
-          arm_N <- table(ADSL[[.(input$arm_var)]]) # nolint
-          trt <- .(input$arm_trt)
-          ref <- .(input$arm_ref)
-          anl_labels <- formatters::var_labels(.(as.name(anl_name)), fill = FALSE)
-          flags <- .(as.name(anl_name)) %>%
+      q1 <- teal.code::eval_code(
+        teal.code::new_quosure(data),
+        name = "variables call",
+        code = as.expression(c(
+          bquote(anl_labels <- formatters::var_labels(.(as.name(dataname)), fill = FALSE)),
+          bquote(flags <- .(as.name(dataname)) %>%
             select(all_of(.(input$flag_var_anl))) %>%
-            rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x]))
-        })
+            rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x])))
+        ))
       )
 
-      teal.code::chunks_push_new_line()
-
-      teal.code::chunks_safe_eval()
-
-      teal.code::chunks_push(
-        id = "g_events_term_id call",
-        expression = bquote({
-          osprey::g_events_term_id(
-            term = flags,
-            id = id,
-            arm = arm,
-            arm_N = arm_N,
-            ref = .(input$arm_ref),
-            trt = .(input$arm_trt),
-            diff_ci_method = .(input$diff_ci_method),
-            conf_level = .(input$conf_level),
-            axis_side = .(input$axis),
-            fontsize = .(font_size()),
-            draw = TRUE
-          )
-        })
+      teal.code::eval_code(
+        q1,
+        name = "g_events_term_id call",
+        code = as.expression(c(
+          bquote(
+            plot <- osprey::g_events_term_id(
+              term = flags,
+              id = .(as.name(dataname))[["USUBJID"]],
+              arm = .(as.name(dataname))[[.(input$arm_var)]],
+              arm_N = table(ADSL[[.(input$arm_var)]]),
+              ref = .(input$arm_ref),
+              trt = .(input$arm_trt),
+              diff_ci_method = .(input$diff_ci_method),
+              conf_level = .(input$conf_level),
+              axis_side = .(input$axis),
+              fontsize = .(font_size()),
+              draw = TRUE
+            )
+          ),
+          quote(print(plot))
+        ))
       )
-
-      teal.code::chunks_safe_eval()
     })
 
-    get_rcode_srv(
+    plot_r <- reactive(output_q()[["plot"]])
+
+    teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      datasets = datasets,
-      modal_title = paste("R code for", label),
-      datanames = unique(c(
-        dataname,
-        vapply(X = dataname, FUN.VALUE = character(1), function(x) {
-          if (inherits(datasets, "CDISCFilteredData")) datasets$get_parentname(x)
-        })
-      ))
+      verbatim_content = reactive(teal.code::get_code(output_q())),
+      title = paste("R code for", label)
     )
 
     ### REPORTER
@@ -366,19 +347,14 @@ srv_g_ae_oview <- function(id,
         card <- teal.reporter::TealReportCard$new()
         card$set_name("AE Overview")
         card$append_text("AE Overview", "header2")
-        card$append_fs(datasets$get_filter_state())
+        if (with_filter) card$append_fs(filter_panel_api$get_filter_state())
         card$append_text("Plot", "header3")
-        card$append_plot(plt(), dim = pws$dim())
+        card$append_plot(plot_r(), dim = pws$dim())
         if (!comment == "") {
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(paste(get_rcode(
-          chunks = teal.code::get_chunks_object(parent_idx = 2L),
-          datasets = datasets,
-          title = "",
-          description = ""
-        ), collapse = "\n"))
+        card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n"))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)