Fixes 4 modules that had problems with migration to picks

NAMESPACE

@@ -7,11 +7,8 @@ S3method(as_num,logical)
 S3method(as_num,numeric)
 S3method(tm_g_barchart_simple,default)
 S3method(tm_g_barchart_simple,picks)
-S3method(tm_g_ci,choices_selected)
 S3method(tm_g_ci,data_extract_spec)
 S3method(tm_g_ci,default)
-S3method(tm_g_ci,picks)
-S3method(tm_g_ci,variables)
 export(add_expr)
 export(as_num)
 export(bracket_expr)

R/arm_ref_comp.R

@@ -122,34 +122,6 @@ arm_bucket_values <- function(buckets, name) {
   x[!is.na(x) & nzchar(x)]
 }
 
-#' Shiny validator for reference / comparison arm buckets only
-#'
-#' For modules using [teal.picks::picks_ui()], treatment column selection is validated via
-#' [teal.picks::picks_srv()] reactives; this validator only enforces `input$buckets` arms.
-#'
-#' @param id_ref (`character(1)`)\cr bucket name for reference arms.
-#' @param id_comp (`character(1)`)\cr bucket name for comparison arms.
-#'
-#' @return A `shinyvalidate::InputValidator`.
-#' @keywords internal
-#'
-arm_ref_comp_buckets_validator <- function(id_ref = "Ref", id_comp = "Comp") {
-  iv <- shinyvalidate::InputValidator$new()
-  iv$add_rule("buckets", function(value) {
-    if (length(arm_bucket_values(value, id_ref)) == 0L) {
-      return("A reference arm must be selected")
-    }
-    NULL
-  })
-  iv$add_rule("buckets", function(value) {
-    if (length(arm_bucket_values(value, id_comp)) == 0L) {
-      return("A comparison arm must be selected")
-    }
-    NULL
-  })
-  iv
-}
-
 #' Observer for Treatment reference variable
 #'
 #' @description
@@ -173,8 +145,7 @@ arm_ref_comp_buckets_validator <- function(id_ref = "Ref", id_comp = "Comp") {
 #' @param input_id (`character`)\cr unique id that the buckets will be referenced with.
 #' @param output_id (`character`)\cr name of the UI id that the output will be written to.
 #' @param arm_var_r (`reactive`)\cr reactive expression that returns the selected Treatment variable.
-#' @return A `shiny::reactive` that runs arm/bucket validation (call inside other reactives before
-#'   `teal::validate_inputs()`).
+#' @return A `shiny::reactive` that runs arm/bucket validation and returns `NULL`.
 #' @keywords internal
 #'
 arm_ref_comp_observer_picks <- function(session, # nolint: object_name.
@@ -235,7 +206,7 @@ arm_ref_comp_observer_picks <- function(session, # nolint: object_name.
 
   reactive({
     if (!isTRUE(on_off())) {
-      return(invisible(NULL))
+      return(NULL)
     }
     validate_input(
       inputId = id_arm_var,
@@ -256,6 +227,7 @@ arm_ref_comp_observer_picks <- function(session, # nolint: object_name.
       message = "A comparison arm must be selected.",
       session = session
     )
+    NULL
   })
 }
 

R/tm_a_gee.R

@@ -252,7 +252,7 @@ tm_a_gee <- function(label,
   aval_var <- create_picks_helper(teal.picks::datasets(dataname, dataname), aval_var)
   id_var <- create_picks_helper(teal.picks::datasets(dataname, dataname), id_var)
   arm_var <- create_picks_helper(teal.picks::datasets(parentname, parentname), arm_var)
-  visit_var <- create_picks_helper(teal.picks::datasets(dataname), visit_var)
+  visit_var <- create_picks_helper(teal.picks::datasets(dataname, dataname), visit_var)
   split_covariates <- create_picks_helper(
     teal.picks::datasets(dataname, dataname),
     split_choices_variables(cov_var)

R/tm_g_ci.R

@@ -241,30 +241,27 @@ template_g_ci <- function(dataname,
 #'   modules = modules(
 #'     tm_g_ci(
 #'       label = "Confidence Interval Plot",
-#'       x_var = variables(
-#'         choices = c("ARMCD", "BMRKR2"),
-#'         selected = "ARMCD",
-#'         multiple = FALSE
+#'       x_var = picks(
+#'         datasets("ADSL", "ADSL"),
+#'         variables(c("ARMCD", "BMRKR2"), "ARMCD")
 #'       ),
-#'       y_var = variables(
-#'         choices = c("AVAL", "CHG"),
-#'         selected = "AVAL",
-#'         multiple = FALSE
+#'       y_var = picks(
+#'         datasets("ADLB", "ADLB"),
+#'         variables(c("AVAL", "CHG"), "AVAL")
 #'       ),
-#'       color = variables(
-#'         choices = c("SEX", "STRATA1", "STRATA2"),
-#'         selected = "STRATA1",
-#'         multiple = FALSE
+#'       color = picks(
+#'         datasets("ADSL", "ADSL"),
+#'         variables(c("SEX", "STRATA1", "STRATA2"), "STRATA1")
 #'       ),
-#'       paramcd = values(
-#'         choices = levels(data[["ADLB"]]$PARAMCD),
-#'         selected = levels(data[["ADLB"]]$PARAMCD)[[1]],
-#'         multiple = FALSE
+#'       paramcd = picks(
+#'         datasets("ADLB", "ADLB"),
+#'         variables("PARAMCD", "PARAMCD"),
+#'         values(selected = "ALT", multiple = FALSE)
 #'       ),
-#'       avisit = values(
-#'         choices = levels(data[["ADLB"]]$AVISIT),
-#'         selected = levels(data[["ADLB"]]$AVISIT)[[1]],
-#'         multiple = FALSE
+#'       avisit = picks(
+#'         datasets("ADLB", "ADLB"),
+#'         variables("AVISIT", "AVISIT"),
+#'         values(selected = "SCREENING", multiple = FALSE)
 #'       )
 #'     )
 #'   )
@@ -291,32 +288,31 @@ tm_g_ci <- function(label,
                     decorators = list()) {
   message("Initializing tm_g_ci")
   checkmate::assert_string(label)
-  if (is.null(x_var)) {
-    stop("`x_var` must not be NULL.", call. = FALSE)
+  if (missing(x_var) || is.null(x_var)) {
+    stop("`x_var` must be provided.", call. = FALSE)
   }
   UseMethod("tm_g_ci", x_var)
 }
 
 #' @describeIn tm_g_ci Legacy encodings via `data_extract_spec` (merge-based UI).
 #' @export
-tm_g_ci.choices_selected <- function(label,
-                                     x_var,
-                                     y_var,
-                                     color,
-                                     stat = c("mean", "median"),
-                                     paramcd = NULL,
-                                     avisit = NULL,
-                                     conf_level = teal.transform::choices_selected(
-                                       c(0.95, 0.9, 0.8), 0.95,
-                                       keep_order = TRUE
-                                     ),
-                                     plot_height = c(700L, 200L, 2000L),
-                                     plot_width = NULL,
-                                     pre_output = NULL,
-                                     post_output = NULL,
-                                     ggplot2_args = teal.widgets::ggplot2_args(),
-                                     transformators = list(),
-                                     decorators = list()) {
+tm_g_ci.data_extract_spec <- function(label,
+                                      x_var,
+                                      y_var,
+                                      paramcd = NULL,
+                                      avisit = NULL,
+                                      color,
+                                      stat = c("mean", "median"),
+                                      conf_level = teal.transform::choices_selected(
+                                        c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE
+                                      ),
+                                      plot_height = c(700L, 200L, 2000L),
+                                      plot_width = NULL,
+                                      pre_output = NULL,
+                                      post_output = NULL,
+                                      ggplot2_args = teal.widgets::ggplot2_args(),
+                                      transformators = list(),
+                                      decorators = list()) {
   stat <- match.arg(stat)
   checkmate::assert_null(paramcd, .var.name = "paramcd")
   checkmate::assert_null(avisit, .var.name = "avisit")
@@ -350,7 +346,7 @@ tm_g_ci.choices_selected <- function(label,
 
   module(
     label = label,
-    server = srv_g_ci,
+    server = srv_g_ci.data_extract_spec,
     server_args = list(
       x_var = x_var,
       y_var = y_var,
@@ -362,14 +358,14 @@ tm_g_ci.choices_selected <- function(label,
       decorators = decorators
     ),
     transformators = transformators,
-    ui = ui_g_ci,
+    ui = ui_g_ci.data_extract_spec,
     ui_args = args,
     datanames = teal.transform::get_extract_datanames(data_extract_list)
   )
 }
 
 #' @keywords internal
-ui_g_ci <- function(id, ...) {
+ui_g_ci.data_extract_spec <- function(id, ...) { # nolint: object_name_linter.
   ns <- NS(id)
   args <- list(...)
 
@@ -415,16 +411,16 @@ ui_g_ci <- function(id, ...) {
 }
 
 #' @keywords internal
-srv_g_ci <- function(id,
-                     data,
-                     x_var,
-                     y_var,
-                     color,
-                     label,
-                     plot_height,
-                     plot_width,
-                     ggplot2_args,
-                     decorators) {
+srv_g_ci.data_extract_spec <- function(id, # nolint: object_name_linter.
+                                       data,
+                                       x_var,
+                                       y_var,
+                                       color,
+                                       label,
+                                       plot_height,
+                                       plot_width,
+                                       ggplot2_args,
+                                       decorators) {
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
 
@@ -538,7 +534,3 @@ srv_g_ci <- function(id,
     set_chunk_dims(pws, decorated_plot_q)
   })
 }
-
-#' @describeIn tm_g_ci Legacy encodings via `data_extract_spec` (merge-based UI).
-#' @export
-tm_g_ci.data_extract_spec <- tm_g_ci.choices_selected