11IMMUNARCH_METHOD_REGISTRY <- new.env(parent = emptyenv())
22
3+ IMMUNARCH_VIS_REGISTRY <- new.env(parent = emptyenv())
34
4- # ' Common arguments for immundata helpers
5+ IMMUNARCH_CLASS_PREFIX <- " immunarch_res"
6+
7+
8+ # ---------------------------------------------------------------------------- #
9+ # --- Common arguments
10+ # ---------------------------------------------------------------------------- #
11+
12+
13+ # ' Common arguments for immunarch helpers
514# ' @keywords internal
615# ' @param autojoin Logical. If TRUE, join repertoire metadata by the schema repertoire id.
716# ' Change the default behaviour by calling `options(immunarch.autojoin = FALSE)`.
@@ -13,6 +22,42 @@ im_common_args <- function(
1322 format = c(" long" " wide" # nocov
1423
1524
25+ # ---------------------------------------------------------------------------- #
26+ # --- Immunarch results attributes
27+ # ---------------------------------------------------------------------------- #
28+
29+
30+ im_norm <- function (x ) {
31+ x <- tolower(x )
32+ gsub(" [^a-z0-9]+" " _" x )
33+ }
34+
35+
36+ im_result_class <- function (family , name = NULL ) {
37+ fam <- im_norm(family )
38+ if (is.null(name )) {
39+ paste0(IMMUNARCH_CLASS_PREFIX , " _" fam )
40+ } else {
41+ nm <- im_norm(name )
42+ paste0(IMMUNARCH_CLASS_PREFIX , " _" fam , " _" nm )
43+ }
44+ }
45+
46+
47+ im_as_result <- function (x , family , name ) {
48+ # Wrap any object as an Immunarch result, preserving original classes
49+ cls_full <- im_result_class(family , name )
50+ cls_fam <- im_result_class(family , NULL )
51+ # TODO: maybe I need the "airr" or "receptor" instead of IMMUNARCH_CLASS_PREFIX?
52+ structure(x , class = c(cls_full , cls_fam , IMMUNARCH_CLASS_PREFIX , class(x )))
53+ }
54+
55+
56+ # ---------------------------------------------------------------------------- #
57+ # --- Immunarch methods
58+ # ---------------------------------------------------------------------------- #
59+
60+
1661im_method <- function (core , family , name , required_cols = NULL , need_repertoires = TRUE ) {
1762 checkmate :: assert_function(core , args = c(" idata"
1863 checkmate :: assert_string(family )
@@ -96,6 +141,9 @@ im_method <- function(core, family, name, required_cols = NULL, need_repertoires
96141 }
97142 }
98143
144+ # Wrap the output to assign correct classes
145+ out <- im_as_result(out , family , name )
146+
99147 out
100148 },
101149 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
180228 ), silent = TRUE )
181229 }
182230
231+ # Link visualisation to a method if visualisation was already created
232+ im_ensure_vis_s3_for(family , name )
233+
183234 fn
184235}
236+
237+
238+ # ---------------------------------------------------------------------------- #
239+ # --- Immunarch visualisations
240+ # ---------------------------------------------------------------------------- #
241+
242+
243+ IMMUNARCH_VIS_REGISTRY <- new.env(parent = emptyenv())
244+
245+ .im_ns <- function () asNamespace(" immunarch"
246+
247+ im_vis_s3_exists <- function (class ) {
248+ ! is.null(utils :: getS3method(" vis" class , optional = TRUE ))
249+ }
250+
251+ im_ensure_vis_s3_for <- function (family , name ) {
252+ cls <- im_result_class(family , name )
253+ fn <- IMMUNARCH_VIS_REGISTRY [[cls ]]
254+ if (! is.function(fn )) {
255+ return (invisible (FALSE ))
256+ }
257+ if (im_vis_s3_exists(cls )) {
258+ return (invisible (FALSE ))
259+ }
260+
261+ method <- function (.data , ... ) {
262+ f <- IMMUNARCH_VIS_REGISTRY [[cls ]]
263+ if (! is.function(f )) cli :: cli_abort(" Visualization for {.code {cls}} not found."
264+ f(.data , ... )
265+ }
266+
267+ base :: registerS3method(" vis" cls , method , envir = .im_ns())
268+ invisible (TRUE )
269+ }
270+
271+ register_immunarch_visualisation <- function (fn , family , name ) {
272+ checkmate :: assert_function(fn , args = c(" .data"
273+ checkmate :: assert_string(family )
274+ checkmate :: assert_string(name )
275+
276+ cls <- im_result_class(family , name )
277+ assign(cls , fn , envir = IMMUNARCH_VIS_REGISTRY )
278+
279+ # immediate S3 registration (errors if vis generic not yet defined)
280+ if (! exists(" vis" envir = .im_ns(), inherits = FALSE )) {
281+ stop(" vis() generic must be defined before registering visualisations."
282+ }
283+ im_ensure_vis_s3_for(family , name )
284+ invisible (cls )
285+ }
0 commit comments