|
| 1 | +#' Create a data mask rectangular data structures in Bioconductor |
| 2 | +#' |
| 3 | +#' @description Tidy evaluation for rectangular |
| 4 | +#' data structures in Bioconductor. |
| 5 | +#' @details This is the backend for non-standard evaluation |
| 6 | +#' in `plyranges` and is used to provide semantics for non-standard |
| 7 | +#' evaluation used throughout the grammar. Generally, |
| 8 | +#' you will not need to interact with this function directly, |
| 9 | +#' but it can be useful if you're planning on extending |
| 10 | +#' `plyranges` functionality. |
| 11 | +#' |
| 12 | +#' @seealso [rlang::new_data_mask()], [rlang::eval_tidy()] |
| 13 | +bc_data_mask <- function(data) { |
| 14 | + # extract the namespace of the class |
| 15 | + pkg_scope <- rlang::pkg_env(packageSlot(class(data))) |
| 16 | + |
| 17 | + # place the generics at the top of the mask |
| 18 | + top <- bioc_generics() |
| 19 | + top <- rlang::new_environment(top) |
| 20 | + # enclose the mcols as middle |
| 21 | + mcols_names <- names(mcols(data)) |
| 22 | + mcols_fn <- lapply(mcols_names, |
| 23 | + function(nm) { |
| 24 | + function() mcols(data)[[nm]] |
| 25 | + }) |
| 26 | + names(mcols_fn) <- mcols_names |
| 27 | + |
| 28 | + mid <- rlang::env(top) |
| 29 | + rlang::env_bind_active(mid, !!!mcols_fn) |
| 30 | + # bottom is the vector |
| 31 | + vec_names <- parallelVectorNames(data) |
| 32 | + vec_fn <- lapply(vec_names, |
| 33 | + function(nm) { |
| 34 | + getter <- rlang::env_get(pkg_scope, nm) |
| 35 | + function() getter(data) |
| 36 | + }) |
| 37 | + names(vec_fn) <- vec_names |
| 38 | + bottom <- rlang::env(mid) |
| 39 | + rlang::env_bind_active(bottom, !!!vec_fn) |
| 40 | + |
| 41 | + mask <- rlang::new_data_mask(bottom, top = top) |
| 42 | + mask$.data <- rlang::as_data_pronoun(mask) |
| 43 | + mask |
| 44 | +} |
| 45 | + |
0 commit comments