feat: return of the vis() for v1

Author: vadimnazarov

.Rbuildignore

@@ -28,3 +28,5 @@
 ^vignettes/articles$
 ^vignettes/.quarto$
 ^CRAN-SUBMISSION$
+^immdata-.*$
+^immdata*$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: immunarch
 Type: Package
 Title: Multi-Modal Immune Repertoire Analytics for Immunotherapy and Vaccine Design in R
-Version: 0.10.1
+Version: 0.10.2
 Authors@R: c(
     person("Vadim I.", "Nazarov", , "support@immunomind.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-3659-2709")),
@@ -22,7 +22,7 @@ License: Apache License (>= 2.0)
 URL: https://immunomind.github.io/docs/, https://github.com/immunomind/immunarch
 BugReports: https://github.com/immunomind/immunarch/issues
 Depends:
-    R (>= 4.1.0),
+    R (>= 4.2.0),
     ggplot2 (>= 3.1.0),
     immundata (>= 0.0.5),
     patchwork
@@ -53,16 +53,19 @@ Imports:
     utils,
     glue,
     checkmate,
-    duckplyr (>= 1.1.0),
+    duckplyr (>= 1.1.2),
     dbplyr,
     lifecycle,
     purrr,
-    stats
+    stats,
+    vctrs,
+    ggthemes,
+    ggsci
 LinkingTo: Rcpp
 Suggests:
     knitr (>= 1.8),
     roxygen2 (>= 3.0.0),
-    testthat (>= 2.1.0),
+    testthat (>= 3.0.0),
     pkgdown (>= 0.1.0),
     assertthat,
     rmarkdown,
@@ -90,3 +93,4 @@ LazyData: true
 LazyDataCompression: xz
 Roxygen: list(markdown = TRUE)
 Config/Needs/website: rmarkdown
+Config/testthat/edition: 3

NAMESPACE

@@ -145,8 +145,11 @@ importFrom(checkmate,assert_character)
 importFrom(checkmate,assert_choice)
 importFrom(checkmate,assert_data_frame)
 importFrom(checkmate,assert_logical)
+importFrom(checkmate,assert_matrix)
 importFrom(checkmate,assert_numeric)
 importFrom(checkmate,assert_r6)
+importFrom(checkmate,assert_string)
+importFrom(checkmate,assert_subset)
 importFrom(circlize,chordDiagram)
 importFrom(cli,cli_alert_info)
 importFrom(cli,cli_alert_success)
@@ -189,6 +192,7 @@ importFrom(dplyr,group_by)
 importFrom(dplyr,group_by_at)
 importFrom(dplyr,group_keys)
 importFrom(dplyr,group_map)
+importFrom(dplyr,inner_join)
 importFrom(dplyr,intersect)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
@@ -213,6 +217,8 @@ importFrom(dplyr,union_all)
 importFrom(dtplyr,lazy_dt)
 importFrom(duckplyr,as_duckdb_tibble)
 importFrom(duckplyr,as_tbl)
+importFrom(ggsci,scale_fill_locuszoom)
+importFrom(ggthemes,theme_few)
 importFrom(glue,glue)
 importFrom(grDevices,colorRampPalette)
 importFrom(graphics,plot)
@@ -310,4 +316,5 @@ importFrom(utils,read.table)
 importFrom(utils,setTxtProgressBar)
 importFrom(utils,tail)
 importFrom(utils,txtProgressBar)
+importFrom(vctrs,s3_register)
 useDynLib(immunarch, .registration = TRUE)

R/aaa-registry.R

@@ -1,7 +1,16 @@
 IMMUNARCH_METHOD_REGISTRY <- new.env(parent = emptyenv())
 
+IMMUNARCH_VIS_REGISTRY <- new.env(parent = emptyenv())
 
-#' Common arguments for immundata helpers
+IMMUNARCH_CLASS_PREFIX <- "immunarch_res"
+
+
+# ---------------------------------------------------------------------------- #
+# --- Common arguments
+# ---------------------------------------------------------------------------- #
+
+
+#' Common arguments for immunarch helpers
 #' @keywords internal
 #' @param autojoin Logical. If TRUE, join repertoire metadata by the schema repertoire id.
 #'  Change the default behaviour by calling `options(immunarch.autojoin = FALSE)`.
@@ -13,6 +22,42 @@ im_common_args <- function(
     format   = c("long", "wide")) {} # nocov
 
 
+# ---------------------------------------------------------------------------- #
+# --- Immunarch results attributes
+# ---------------------------------------------------------------------------- #
+
+
+im_norm <- function(x) {
+  x <- tolower(x)
+  gsub("[^a-z0-9]+", "_", x)
+}
+
+
+im_result_class <- function(family, name = NULL) {
+  fam <- im_norm(family)
+  if (is.null(name)) {
+    paste0(IMMUNARCH_CLASS_PREFIX, "_", fam)
+  } else {
+    nm <- im_norm(name)
+    paste0(IMMUNARCH_CLASS_PREFIX, "_", fam, "_", nm)
+  }
+}
+
+
+im_as_result <- function(x, family, name) {
+  # Wrap any object as an Immunarch result, preserving original classes
+  cls_full <- im_result_class(family, name)
+  cls_fam <- im_result_class(family, NULL)
+  # TODO: maybe I need the "airr" or "receptor" instead of IMMUNARCH_CLASS_PREFIX?
+  structure(x, class = c(cls_full, cls_fam, IMMUNARCH_CLASS_PREFIX, class(x)))
+}
+
+
+# ---------------------------------------------------------------------------- #
+# --- Immunarch methods
+# ---------------------------------------------------------------------------- #
+
+
 im_method <- function(core, family, name, required_cols = NULL, need_repertoires = TRUE) {
   checkmate::assert_function(core, args = c("idata"))
   checkmate::assert_string(family)
@@ -96,6 +141,9 @@ im_method <- function(core, family, name, required_cols = NULL, need_repertoires
         }
       }
 
+      # Wrap the output to assign correct classes
+      out <- im_as_result(out, family, name)
+
       out
     },
     list(core = core, core_fmls = core_fmls, required_cols = required_cols)
@@ -180,5 +228,58 @@ register_immunarch_method <- function(core, family, name, register_family = TRUE
     ), silent = TRUE)
   }
 
+  # Link visualisation to a method if visualisation was already created
+  im_ensure_vis_s3_for(family, name)
+
   fn
 }
+
+
+# ---------------------------------------------------------------------------- #
+# --- Immunarch visualisations
+# ---------------------------------------------------------------------------- #
+
+
+IMMUNARCH_VIS_REGISTRY <- new.env(parent = emptyenv())
+
+.im_ns <- function() asNamespace("immunarch")
+
+im_vis_s3_exists <- function(class) {
+  !is.null(utils::getS3method("vis", class, optional = TRUE))
+}
+
+im_ensure_vis_s3_for <- function(family, name) {
+  cls <- im_result_class(family, name)
+  fn <- IMMUNARCH_VIS_REGISTRY[[cls]]
+  if (!is.function(fn)) {
+    return(invisible(FALSE))
+  }
+  if (im_vis_s3_exists(cls)) {
+    return(invisible(FALSE))
+  }
+
+  method <- function(.data, ...) {
+    f <- IMMUNARCH_VIS_REGISTRY[[cls]]
+    if (!is.function(f)) cli::cli_abort("Visualization for {.code {cls}} not found.")
+    f(.data, ...)
+  }
+
+  base::registerS3method("vis", cls, method, envir = .im_ns())
+  invisible(TRUE)
+}
+
+register_immunarch_visualisation <- function(fn, family, name) {
+  checkmate::assert_function(fn, args = c(".data"))
+  checkmate::assert_string(family)
+  checkmate::assert_string(name)
+
+  cls <- im_result_class(family, name)
+  assign(cls, fn, envir = IMMUNARCH_VIS_REGISTRY)
+
+  # immediate S3 registration (errors if vis generic not yet defined)
+  if (!exists("vis", envir = .im_ns(), inherits = FALSE)) {
+    stop("vis() generic must be defined before registering visualisations.")
+  }
+  im_ensure_vis_s3_for(family, name)
+  invisible(cls)
+}

R/globals.R

@@ -8,7 +8,9 @@ utils::globalVariables(c(
   "ch",
   "clonal_prop_bin",
   "clonal_rank_bin",
-  "prop"
+  "prop",
+  ".val",
+  "size"
 ))
 
 #' @keywords internal

R/immunarch-package.R

@@ -3,8 +3,11 @@
 #' @importFrom checkmate assert_choice
 #' @importFrom checkmate assert_data_frame
 #' @importFrom checkmate assert_logical
+#' @importFrom checkmate assert_matrix
 #' @importFrom checkmate assert_numeric
 #' @importFrom checkmate assert_r6
+#' @importFrom checkmate assert_string
+#' @importFrom checkmate assert_subset
 #' @importFrom cli cli_alert_info
 #' @importFrom cli cli_alert_success
 #' @importFrom cli cli_alert_warning
@@ -23,6 +26,7 @@
 #' @importFrom dplyr count
 #' @importFrom dplyr distinct
 #' @importFrom dplyr filter
+#' @importFrom dplyr inner_join
 #' @importFrom dplyr intersect
 #' @importFrom dplyr left_join
 #' @importFrom dplyr mutate
@@ -37,6 +41,8 @@
 #' @importFrom dplyr union_all
 #' @importFrom duckplyr as_duckdb_tibble
 #' @importFrom duckplyr as_tbl
+#' @importFrom ggsci scale_fill_locuszoom
+#' @importFrom ggthemes theme_few
 #' @importFrom immundata imd_schema
 #' @importFrom immundata ImmunData
 #' @importFrom lifecycle deprecated
@@ -57,6 +63,7 @@
 #' @importFrom tidyr as_tibble
 #' @importFrom utils adist
 #' @importFrom utils globalVariables
+#' @importFrom vctrs s3_register
 #' @useDynLib immunarch, .registration = TRUE
 ## usethis namespace: end
 NULL

R/v0_data_docs.R

@@ -93,22 +93,3 @@ AA_TABLE_REVERSED <- AA_TABLE_REVERSED[order(names(AA_TABLE_REVERSED))]
 #'   ...
 #' }
 "bcrdata"
-
-
-#' Paired chain immune repertoire dataset
-#'
-#' @concept data
-#'
-#' @description A dataset with paired chain IG data for testing and examplatory purposes.
-#'
-#' @format A list of four elements:
-#' "data" is a list with data frames with clonotype tables.
-#' "meta" is a metadata table.
-#' "bc_patients" is a list of barcodes corresponding to specific patients.
-#' "bc_clusters" is a list of barcodes corresponding to specific cell clusters.
-#' \describe{
-#'   \item{data}{List of immune repertoire data frames.}
-#'   \item{meta}{Metadata}
-#'   ...
-#' }
-"scdata"