Add picks variable selection to ae_oview module

.lintr

@@ -2,6 +2,7 @@ linters: linters_with_defaults(
     line_length_linter = line_length_linter(120),
     cyclocomp_linter = NULL,
     object_usage_linter = NULL,
+    pipe_consistency_linter = NULL,
     object_name_linter = object_name_linter(
       styles = c("snake_case", "symbols"),
       regexes = c(ANL = "^ANL_?[0-9A-Za-z_]*$", ADaM = "^r?AD[A-Z]{2,5}_?[0-9A-Za-z_]*$")

DESCRIPTION

@@ -37,6 +37,7 @@ Imports:
     teal.code (>= 0.7.0),
     teal.data (>= 0.8.0),
     teal.logger (>= 0.4.0),
+    teal.picks (>= 0.1.0),
     teal.reporter (>= 0.6.0),
     teal.widgets (>= 0.5.0),
     tern (>= 0.9.7),
@@ -49,10 +50,12 @@ Suggests:
     testthat (>= 3.2.3),
     withr (>= 3.0.0)
 Remotes:
-    insightsengineering/osprey
+    insightsengineering/osprey,
+    insightsengineering/teal.picks
 Config/Needs/verdepcheck: insightsengineering/osprey, rstudio/shiny,
-    insightsengineering/teal, insightsengineering/teal.slice,
-    insightsengineering/teal.transform, mllg/checkmate, tidyverse/dplyr,
+    insightsengineering/teal, insightsengineering/teal.picks,
+    insightsengineering/teal.slice, insightsengineering/teal.transform,
+    mllg/checkmate, tidyverse/dplyr,
     insightsengineering/formatters, tidyverse/ggplot2, r-lib/lifecycle,
     daroczig/logger, rstudio/shinyvalidate, insightsengineering/teal.code,
     insightsengineering/teal.logger, insightsengineering/teal.reporter,

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(tm_g_ae_oview,default)
+S3method(tm_g_ae_oview,pick)
 export(label_aevar)
 export(plot_decorate_output)
 export(quick_filter)

R/tm_g_ae_oview.R

@@ -1,21 +1,27 @@
-#' Teal module for the `AE` overview
+#' @title Teal module for the `AE` overview
 #'
 #' @description
 #'
 #' Display the `AE` overview plot as a shiny module
 #'
+#' This is an S3 generic that dispatches on the class of `flag_var_anl`:
+#' - [choices_selected][teal.transform::choices_selected()] dispatches to the
+#'   default method.
+#' - [picks][teal.picks::picks()] dispatches to the picks method.
+#'
 #' @inheritParams teal.widgets::standard_layout
 #' @inheritParams teal::module
 #' @inheritParams argument_convention
-#' @param flag_var_anl ([`teal.transform::choices_selected`])
-#'   `choices_selected` object with variables used to count adverse event
+#' @param flag_var_anl Either a ([`teal.transform::choices_selected`])
+#'   `choices_selected` object or a (`[teal.picks::variables()]`)
+#'   object with variables used to count adverse event
 #'   sub-groups (e.g. Serious events, Related events, etc.)
-#'
+#' @param dataname (`character(1)`) Name of the events dataset. Required when
+#'   using the default method with [choices_selected][teal.transform::choices_selected()].
+#'   Ignored by the `.picks` method.
 #' @inherit argument_convention return
 #' @inheritSection teal::example_module Reporting
 #'
-#' @export
-#'
 #' @examples
 #' data <- teal_data() %>%
 #'   within({
@@ -47,7 +53,7 @@
 #' join_keys(data) <- default_cdisc_join_keys[names(data)]
 #'
 #' ADAE <- data[["ADAE"]]
-#'
+#' # Using default method (choices selected)
 #' app <- init(
 #'   data = data,
 #'   modules = modules(
@@ -73,17 +79,33 @@
 #'   shinyApp(app$ui, app$server)
 #' }
 #'
+#' @export
 tm_g_ae_oview <- function(label,
                           dataname,
                           arm_var,
                           flag_var_anl,
-                          fontsize = c(5, 3, 7),
-                          plot_height = c(600L, 200L, 2000L),
-                          plot_width = NULL,
-                          transformators = list()) {
+                          fontsize,
+                          plot_height,
+                          plot_width,
+                          transformators) {
+  UseMethod("tm_g_ae_oview", arm_var)
+}
+
+#' @rdname tm_g_ae_oview
+#' @export
+tm_g_ae_oview.default <- function(label,
+                                  dataname,
+                                  arm_var,
+                                  flag_var_anl,
+                                  fontsize = c(5, 3, 7),
+                                  plot_height = c(600L, 200L, 2000L),
+                                  plot_width = NULL,
+                                  transformators = list()) {
   message("Initializing tm_g_ae_oview")
+
   checkmate::assert_class(arm_var, classes = "choices_selected")
   checkmate::assert_class(flag_var_anl, classes = "choices_selected")
+
   checkmate::assert(
     checkmate::check_number(fontsize, finite = TRUE),
     checkmate::assert(
@@ -104,235 +126,14 @@ tm_g_ae_oview <- function(label,
     lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
   )
 
-  args <- as.list(environment())
-
-  module(
+  tm_g_ae_oview.pick(
     label = label,
-    server = srv_g_ae_oview,
-    server_args = list(
-      label = label,
-      dataname = dataname,
-      plot_height = plot_height,
-      plot_width = plot_width
-    ),
-    ui = ui_g_ae_oview,
-    ui_args = args,
-    transformators = transformators,
-    datanames = c("ADSL", dataname)
+    dataname = dataname,
+    arm_var = teal.picks::as.picks(arm_var),
+    flag_var_anl = teal.picks::as.picks(flag_var_anl),
+    fontsize,
+    plot_height,
+    plot_width,
+    transformators
   )
 }
-
-ui_g_ae_oview <- function(id, ...) {
-  ns <- NS(id)
-  args <- list(...)
-  teal.widgets::standard_layout(
-    output = teal.widgets::white_small_well(
-      plot_decorate_output(id = ns(NULL))
-    ),
-    encoding = tags$div(
-      teal.widgets::optionalSelectInput(
-        ns("arm_var"),
-        "Arm Variable",
-        choices = get_choices(args$arm_var$choices),
-        selected = args$arm_var$selected,
-        multiple = FALSE
-      ),
-      selectInput(
-        ns("arm_ref"),
-        "Control",
-        choices = get_choices(args$arm_var$choices),
-        selected = args$arm_var$selected
-      ),
-      selectInput(
-        ns("arm_trt"),
-        "Treatment",
-        choices = get_choices(args$arm_var$choices),
-        selected = args$arm_var$selected
-      ),
-      selectInput(
-        ns("flag_var_anl"),
-        "Flags",
-        choices = get_choices(args$flag_var_anl$choices),
-        selected = args$flag_var_anl$selected,
-        multiple = TRUE
-      ),
-      teal.widgets::panel_item(
-        "Confidence interval settings",
-        teal.widgets::optionalSelectInput(
-          ns("diff_ci_method"),
-          "Method for Difference of Proportions CI",
-          choices = ci_choices,
-          selected = ci_choices[1],
-          multiple = FALSE
-        ),
-        teal.widgets::optionalSliderInput(
-          ns("conf_level"),
-          "Confidence Level",
-          min = 0.5,
-          max = 1,
-          value = 0.95
-        )
-      ),
-      teal.widgets::optionalSelectInput(
-        ns("axis"),
-        "Axis Side",
-        choices = c("Left" = "left", "Right" = "right"),
-        selected = "left",
-        multiple = FALSE
-      ),
-      ui_g_decorate(
-        ns(NULL),
-        fontsize = args$fontsize,
-        titles = "AE Overview",
-        footnotes = ""
-      )
-    )
-  )
-}
-
-srv_g_ae_oview <- function(id,
-                           data,
-                           dataname,
-                           label,
-                           plot_height,
-                           plot_width) {
-  checkmate::assert_class(data, "reactive")
-  checkmate::assert_class(isolate(data()), "teal_data")
-
-  moduleServer(id, function(input, output, session) {
-    teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")
-    iv <- reactive({
-      ANL <- data()[[dataname]]
-
-      iv <- shinyvalidate::InputValidator$new()
-      iv$add_rule("arm_var", shinyvalidate::sv_required(
-        message = "Arm Variable is required"
-      ))
-      iv$add_rule("arm_var", ~ if (!is.factor(ANL[[.]])) {
-        "Arm Var must be a factor variable"
-      })
-      iv$add_rule("arm_var", ~ if (nlevels(ANL[[.]]) < 2L) {
-        "Selected Arm Var must have at least two levels"
-      })
-      iv$add_rule("flag_var_anl", shinyvalidate::sv_required(
-        message = "At least one Flag is required"
-      ))
-      rule_diff <- function(value, other) {
-        if (isTRUE(value == other)) "Control and Treatment must be different"
-      }
-      iv$add_rule("arm_trt", rule_diff, other = input$arm_ref)
-      iv$add_rule("arm_ref", rule_diff, other = input$arm_trt)
-      iv$enable()
-      iv
-    })
-
-    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
-
-    observeEvent(list(input$diff_ci_method, input$conf_level), {
-      req(!is.null(input$diff_ci_method) && !is.null(input$conf_level))
-      diff_ci_method <- input$diff_ci_method
-      conf_level <- input$conf_level
-      updateTextAreaInput(session,
-        "foot",
-        value = sprintf(
-          "Note: %d%% CI is calculated using %s",
-          round(conf_level * 100),
-          name_ci(diff_ci_method)
-        )
-      )
-    })
-
-    observeEvent(input$arm_var, ignoreNULL = TRUE, {
-      ANL <- data()[[dataname]]
-      arm_var <- input$arm_var
-      arm_val <- ANL[[arm_var]]
-      choices <- levels(arm_val)
-
-      if (length(choices) == 1) {
-        trt_index <- 1
-      } else {
-        trt_index <- 2
-      }
-
-      updateSelectInput(
-        session,
-        "arm_ref",
-        selected = choices[1],
-        choices = choices
-      )
-      updateSelectInput(
-        session,
-        "arm_trt",
-        selected = choices[trt_index],
-        choices = choices
-      )
-    })
-
-    output_q <- shiny::debounce(
-      millis = 200,
-      r = reactive({
-        obj <- data()
-        teal.reporter::teal_card(obj) <-
-          c(
-            teal.reporter::teal_card(obj),
-            teal.reporter::teal_card("## Module's output(s)")
-          )
-        obj <- teal.code::eval_code(obj, "library(dplyr)")
-
-        ANL <- obj[[dataname]]
-
-        teal::validate_has_data(ANL, min_nrow = 10, msg = sprintf("%s has not enough data", dataname))
-
-        teal::validate_inputs(iv())
-
-        validate(need(
-          input$arm_trt %in% ANL[[input$arm_var]] && input$arm_ref %in% ANL[[input$arm_var]],
-          "Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?"
-        ))
-
-        q1 <- obj %>%
-          teal.code::eval_code(
-            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]))
-              )
-            ))
-          )
-
-        teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot")
-
-        teal.code::eval_code(
-          q1,
-          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
-              )
-            )
-          ))
-        )
-      })
-    )
-
-    plot_r <- reactive(output_q()[["plot"]])
-    set_chunk_dims(pws, output_q)
-  })
-}