picks

DESCRIPTION

@@ -28,6 +28,7 @@ Depends:
     R (>= 4.1),
     shiny (>= 1.8.1),
     teal (>= 1.2.0),
+    teal.picks (>= 0.1.0),
     teal.transform (>= 0.7.0)
 Imports:
     bslib (>= 0.8.0),
@@ -46,9 +47,11 @@ Imports:
     gridExtra (>= 2.3),
     htmlwidgets (>= 1.6.4),
     jsonlite (>= 1.8.9),
+    lattice,
     lifecycle (>= 0.2.0),
     MASS (>= 7.3-60),
     patchwork (>= 1.2.0),
+    rlang,
     rmarkdown (>= 2.23),
     rtables (>= 0.6.11),
     scales (>= 1.3.0),
@@ -67,14 +70,14 @@ Imports:
     tern (>= 0.9.7),
     tibble (>= 2.0.0),
     tidyr (>= 0.8.3),
+    tidyselect,
     tools,
     utils
 Suggests:
     knitr (>= 1.42),
     logger (>= 0.4.0),
     nestcolor (>= 0.1.0),
     pkgload,
-    rlang (>= 1.0.0),
     roxy.shinylive,
     rvest,
     shinytest2,

NAMESPACE

@@ -9,6 +9,24 @@ S3method(create_sparklines,factor)
 S3method(create_sparklines,logical)
 S3method(create_sparklines,numeric)
 S3method(teal.reporter::to_rmd,markdown_internal)
+S3method(tm_a_pca,default)
+S3method(tm_a_pca,picks)
+S3method(tm_a_regression,default)
+S3method(tm_a_regression,picks)
+S3method(tm_g_association,default)
+S3method(tm_g_association,picks)
+S3method(tm_g_bivariate,default)
+S3method(tm_g_bivariate,picks)
+S3method(tm_g_distribution,default)
+S3method(tm_g_distribution,picks)
+S3method(tm_g_response,default)
+S3method(tm_g_response,picks)
+S3method(tm_g_scatterplot,default)
+S3method(tm_g_scatterplot,picks)
+S3method(tm_g_scatterplotmatrix,default)
+S3method(tm_g_scatterplotmatrix,picks)
+S3method(tm_t_crosstable,default)
+S3method(tm_t_crosstable,picks)
 S3method(tools::toHTML,markdown_internal)
 export(add_facet_labels)
 export(geom_mosaic)
@@ -32,6 +50,17 @@ import(ggplot2)
 import(shiny)
 import(teal)
 import(teal.transform)
+import(tidyselect)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,.data)
+importFrom(forcats,fct_infreq)
+importFrom(forcats,fct_na_value_to_level)
+importFrom(forcats,fct_rev)
+importFrom(lattice,current.panel.limits)
+importFrom(lattice,panel.splom)
+importFrom(lattice,panel.text)
+importFrom(lattice,splom)
 importFrom(lifecycle,deprecated)
+importFrom(rlang,":=")
+importFrom(teal,validate_input)
+importFrom(utils,tail)

R/geom_mosaic.R

@@ -108,6 +108,7 @@ StatMosaic <- ggplot2::ggproto( # nolint: object_name_linter.
 #' left or right for y axes, top or bottom for x axes.
 #' @param ... other arguments passed to `continuous_scale()`.
 #' @keywords internal
+#' @noRd
 .scale_x_mosaic <- function(breaks = unique,
                             minor_breaks = NULL,
                             labels = unique,

R/picks-datanames.R

@@ -0,0 +1,16 @@
+.picks_datanames <- function(x) {
+  checkmate::assert_list(x, c("picks", "NULL"))
+  datanames_list <- lapply(x, function(x) {
+    if (is.character(x$datasets$choices)) {
+      x$datasets$choices
+    } else {
+      NULL
+    }
+  })
+
+  if (any(vapply(datanames_list, is.null, logical(1)))) {
+    "all"
+  } else {
+    unique(unlist(datanames_list))
+  }
+}

R/tm_a_pca.R

@@ -7,8 +7,7 @@
 #'
 #' @inheritParams teal::module
 #' @inheritParams shared_params
-#' @param dat (`data_extract_spec` or `list` of multiple `data_extract_spec`)
-#' specifying columns used to compute PCA.
+#' @param dat (`picks`) specifying columns used to compute PCA.
 #' @param font_size (`numeric`) optional, specifies font size.
 #' It controls the font size for plot titles, axis labels, and legends.
 #' - If vector of `length == 1` then the font sizes will have a fixed size.
@@ -67,16 +66,13 @@
 #'   modules = modules(
 #'     tm_a_pca(
 #'       "PCA",
-#'       dat = data_extract_spec(
-#'         dataname = "USArrests",
-#'         select = select_spec(
-#'           choices = variable_choices(
-#'             data = data[["USArrests"]], c("Murder", "Assault", "UrbanPop", "Rape")
-#'           ),
+#'       dat = teal.picks::picks(
+#'         datasets("USArrests"),
+#'         teal.picks::variables(
+#'           choices = c("Murder", "Assault", "UrbanPop", "Rape"),
 #'           selected = c("Murder", "Assault"),
 #'           multiple = TRUE
-#'         ),
-#'         filter = NULL
+#'         )
 #'       )
 #'     )
 #'   )
@@ -103,17 +99,13 @@
 #'   data = data,
 #'   modules = modules(
 #'     tm_a_pca(
-#'       "PCA",
-#'       dat = data_extract_spec(
-#'         dataname = "ADSL",
-#'         select = select_spec(
-#'           choices = variable_choices(
-#'             data = data[["ADSL"]], c("BMRKR1", "AGE", "EOSDY")
-#'           ),
+#'       dat = teal.picks::picks(
+#'         datasets("ADSL"),
+#'         teal.picks::variables(
+#'           choices = c("BMRKR1", "AGE", "EOSDY"),
 #'           selected = c("BMRKR1", "AGE"),
 #'           multiple = TRUE
-#'         ),
-#'         filter = NULL
+#'         )
 #'       )
 #'     )
 #'   )
@@ -125,7 +117,14 @@
 #' @export
 #'
 tm_a_pca <- function(label = "Principal Component Analysis",
-                     dat,
+                     dat = teal.picks::picks(
+                       teal.picks::datasets(),
+                       teal.picks::variables(
+                         choices = tidyselect::where(~ is.numeric(.x) && all(!is.na(.x))),
+                         selected = tidyselect::everything(),
+                         multiple = TRUE
+                       )
+                     ),
                      plot_height = c(600, 200, 2000),
                      plot_width = NULL,
                      ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"),
@@ -138,6 +137,24 @@
                      post_output = NULL,
                      transformators = list(),
                      decorators = list()) {
+  UseMethod("tm_a_pca", dat)
+}
+
+#' @export
+tm_a_pca.default <- function(label = "Principal Component Analysis",
+                             dat,
+                             plot_height = c(600, 200, 2000),
+                             plot_width = NULL,
+                             ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"),
+                             ggplot2_args = teal.widgets::ggplot2_args(),
+                             rotate_xaxis_labels = FALSE,
+                             font_size = c(12, 8, 20),
+                             alpha = c(1, 0, 1),
+                             size = c(2, 1, 8),
+                             pre_output = NULL,
+                             post_output = NULL,
+                             transformators = list(),
+                             decorators = list()) {
   message("Initializing tm_a_pca")
 
   # Normalize the parameters
@@ -198,8 +215,8 @@
 
   ans <- module(
     label = label,
-    server = srv_a_pca,
-    ui = ui_a_pca,
+    server = srv_a_pca.default,
+    ui = ui_a_pca.default,
     ui_args = args,
     server_args = c(
       data_extract_list,
@@ -218,7 +235,7 @@
 }
 
 # UI function for the PCA module
-ui_a_pca <- function(id, ...) {
+ui_a_pca.default <- function(id, ...) {
   ns <- NS(id)
   args <- list(...)
   is_single_dataset_value <- teal.transform::is_single_dataset(args$dat)
@@ -347,7 +364,7 @@
 }
 
 # Server function for the PCA module
-srv_a_pca <- function(id, data, dat, plot_height, plot_width, ggplot2_args, decorators) {
+srv_a_pca.default <- function(id, data, dat, plot_height, plot_width, ggplot2_args, decorators) {
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {