Implements teal.picks picks on tm_outliers

.github/workflows/check.yaml

@@ -10,6 +10,7 @@ on:
       - ready_for_review
     branches:
       - main
+      - redesign_extraction@main
   push:
     branches:
       - main

NAMESPACE

@@ -25,6 +25,8 @@ S3method(tm_g_scatterplot,default)
 S3method(tm_g_scatterplot,picks)
 S3method(tm_g_scatterplotmatrix,default)
 S3method(tm_g_scatterplotmatrix,picks)
+S3method(tm_outliers,default)
+S3method(tm_outliers,picks)
 S3method(tm_t_crosstable,default)
 S3method(tm_t_crosstable,picks)
 S3method(tools::toHTML,markdown_internal)

R/tm_outliers.R

@@ -53,91 +53,21 @@
 #'
 #' # general data example
 #' data <- teal_data()
-#' data <- within(data, {
-#'   CO2 <- CO2
-#'   CO2[["primary_key"]] <- seq_len(nrow(CO2))
-#' })
-#' join_keys(data) <- join_keys(join_key("CO2", "CO2", "primary_key"))
-#'
-#' vars <- choices_selected(variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")))
-#'
-#' app <- init(
-#'   data = data,
-#'   modules = modules(
-#'     tm_outliers(
-#'       outlier_var = list(
-#'         data_extract_spec(
-#'           dataname = "CO2",
-#'           select = select_spec(
-#'             label = "Select variable:",
-#'             choices = variable_choices(data[["CO2"]], c("conc", "uptake")),
-#'             selected = "uptake",
-#'             multiple = FALSE,
-#'             fixed = FALSE
-#'           )
-#'         )
-#'       ),
-#'       categorical_var = list(
-#'         data_extract_spec(
-#'           dataname = "CO2",
-#'           filter = filter_spec(
-#'             vars = vars,
-#'             choices = value_choices(data[["CO2"]], vars$selected),
-#'             selected = value_choices(data[["CO2"]], vars$selected),
-#'             multiple = TRUE
-#'           )
-#'         )
-#'       )
-#'     )
-#'   )
-#' )
-#' if (interactive()) {
-#'   shinyApp(app$ui, app$server)
-#' }
-#'
-#' @examplesShinylive
-#' library(teal.modules.general)
-#' interactive <- function() TRUE
-#' {{ next_example }}
-#' @examples
-#'
-#' # CDISC data example
-#' data <- teal_data()
-#' data <- within(data, {
-#'   ADSL <- teal.data::rADSL
-#' })
-#' join_keys(data) <- default_cdisc_join_keys[names(data)]
-#'
-#' fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor)))
-#' vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl))
-#'
+#' data <- within(data, CO2 <- CO2)
 #'
 #' app <- init(
 #'   data = data,
 #'   modules = modules(
 #'     tm_outliers(
-#'       outlier_var = list(
-#'         data_extract_spec(
-#'           dataname = "ADSL",
-#'           select = select_spec(
-#'             label = "Select variable:",
-#'             choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")),
-#'             selected = "AGE",
-#'             multiple = FALSE,
-#'             fixed = FALSE
-#'           )
-#'         )
+#'       outlier_var = teal.picks::picks(
+#'         datasets("CO2", "CO2"),
+#'         teal.picks::variables(c("conc", "uptake"), "uptake"),
+#'         teal.picks::values()
 #'       ),
-#'       categorical_var = list(
-#'         data_extract_spec(
-#'           dataname = "ADSL",
-#'           filter = filter_spec(
-#'             vars = vars,
-#'             choices = value_choices(data[["ADSL"]], vars$selected),
-#'             selected = value_choices(data[["ADSL"]], vars$selected),
-#'             multiple = TRUE
-#'           )
-#'         )
+#'       categorical_var = teal.picks::picks(
+#'         datasets("CO2", "CO2"),
+#'         teal.picks::variables(c("Plant", "Type", "Treatment"), "Plant"),
+#'         teal.picks::values()
 #'       )
 #'     )
 #'   )
@@ -159,37 +89,17 @@
 #' })
 #' join_keys(data) <- default_cdisc_join_keys[names(data)]
 #'
-#' fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor)))
-#' vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl))
-#'
-#'
 #' app <- init(
 #'   data = data,
 #'   modules = modules(
 #'     tm_outliers(
-#'       outlier_var = list(
-#'         teal.picks::picks(
-#'           datasets("ADSL"),
-#'           teal.picks::variables(
-#'             choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")),
-#'             selected = "AGE",
-#'             multiple = FALSE,
-#'             fixed = FALSE
-#'           ),
-#'           teal.picks::values()
-#'         )
+#'       outlier_var = teal.picks::picks(
+#'         datasets("ADSL", "ADSL"),
+#'         teal.picks::variables(c("AGE", "BMRKR1"), "AGE")
 #'       ),
-#'       categorical_var = list(
-#'         teal.picks::picks(
-#'           datasets("ADSL"),
-#'           teal.picks::variables(),
-#'           values(
-#'             vars = vars,
-#'             choices = value_choices(data[["ADSL"]], vars$selected),
-#'             selected = value_choices(data[["ADSL"]], vars$selected),
-#'             multiple = TRUE
-#'           )
-#'         )
+#'       categorical_var = teal.picks::picks(
+#'         datasets("ADSL", "ADSL"),
+#'         teal.picks::variables(teal.picks::is_categorical(min.len = 1, max.len = 10))
 #'       )
 #'     )
 #'   )
@@ -201,8 +111,18 @@
 #' @export
 #'
 tm_outliers <- function(label = "Outliers Module",
-                        outlier_var,
-                        categorical_var = NULL,
+                        outlier_var = teal.picks::picks(
+                          teal.picks::datasets(),
+                          teal.picks::variables(is.numeric, 1L, multiple = FALSE)
+                        ),
+                        categorical_var = teal.picks::picks(
+                          teal.picks::datasets(),
+                          teal.picks::variables(
+                            choices = teal.picks::is_categorical(min.len = 1, max.len = 10),
+                            selected = 1L,
+                            multiple = TRUE
+                          )
+                        ),
                         ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"),
                         ggplot2_args = teal.widgets::ggplot2_args(),
                         plot_height = c(600, 200, 2000),
@@ -211,6 +131,23 @@ tm_outliers <- function(label = "Outliers Module",
                         post_output = NULL,
                         transformators = list(),
                         decorators = list()) {
+  UseMethod("tm_outliers", outlier_var)
+}
+
+#' @export
+tm_outliers.default <- function(label = "Outliers Module",
+                                outlier_var,
+                                categorical_var = NULL,
+                                ggtheme = c(
+                                  "gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"
+                                ),
+                                ggplot2_args = teal.widgets::ggplot2_args(),
+                                plot_height = c(600, 200, 2000),
+                                plot_width = NULL,
+                                pre_output = NULL,
+                                post_output = NULL,
+                                transformators = list(),
+                                decorators = list()) {
   message("Initializing tm_outliers")
 
   # Normalize the parameters
@@ -594,17 +531,6 @@ srv_outliers <- function(id, data, outlier_var,
         input$percentile_slider
       }
 
-      # this is utils function that converts a %>% NULL %>% b into a %>% b
-      remove_pipe_null <- function(x) {
-        if (length(x) == 1) {
-          x
-        } else if (identical(x[[1]], as.name("%>%")) && is.null(x[[3]])) {
-          remove_pipe_null(x[[2]])
-        } else {
-          as.call(c(x[[1]], lapply(x[-1], remove_pipe_null)))
-        }
-      }
-
       qenv <- teal.code::eval_code(
         qenv,
         substitute(