[r] add clustering + partialized function changes

r/DESCRIPTION

@@ -49,7 +49,9 @@ Suggests:
     IRanges,
     GenomicRanges,
     matrixStats,
-    igraph
+    igraph,
+    RcppHNSW,
+    RcppAnnoy
 Depends: 
     R (>= 4.0.0)
 Config/Needs/website: pkgdown, devtools, uwot, irlba, RcppHNSW, igraph, BiocManager, bioc::BSgenome.Hsapiens.UCSC.hg38, github::GreenleafLab/motifmatchr, github::GreenleafLab/chromVARmotifs, png, magrittr

r/NAMESPACE

@@ -21,6 +21,7 @@ export(canonical_gene_symbol)
 export(cellNames)
 export(checksum)
 export(chrNames)
+export(cluster_cells_graph)
 export(cluster_graph_leiden)
 export(cluster_graph_louvain)
 export(cluster_graph_seurat)

r/NEWS.md

@@ -1,3 +1,11 @@
+# BPCells 0.4.0 (in-progress main branch)
+
+## Breaking changes
+- Change first parameter name of `cluster_graph_leiden()`, `cluster_graph_louvain()` and `cluster_graph_seurat()` from `snn` to `mat` to more accurately reflect the input type.  (pull request #292)
+
+## Features
+- Create a wrapper function `cluster_cells_graph()` that wraps the steps of knn object creation, graph adjacency creation, and clustering all within a single function (pull request #292)
+
 # BPCells 0.3.1 (7/21/2025)
 
 The BPCells 0.3.1 release covers 7 months of changes and 40 commits from 5 contributors. Notable changes include writing matrices in AnnData's dense format, 

r/R/atac_utils.R

@@ -176,7 +176,7 @@ footprint <- function(fragments, ranges, zero_based_coords = !is(ranges, "GRange
 #' as `(monoNucleosomal + multiNucleosomal) / subNucleosomal`.
 #' @examples
 #' ## Prep data
-#' frags <- get_demo_frags()
+#' frags <- get_demo_frags(subset = FALSE)
 #' reference_dir <- file.path(tempdir(), "references")
 #' genes <- read_gencode_transcripts(
 #'   reference_dir, 

r/R/errorChecking.R

@@ -114,6 +114,13 @@ assert_is <- function(object, class, n = 1) {
   }
 }
 
+assert_is_mat <- function(object, n = 1) {
+  # matrices have length set to row*col instead of being 1, so we need to check dim as well
+  if (!canCoerce(object, "IterableMatrix")) {
+    pretty_error(object, "must either be an IterableMatrix or coercible to an IterableMatrix", n)
+  }
+}
+
 assert_true <- function(expr, n = 1) {
   if (!expr) pretty_error(expr, "is not true", n)
 }

r/R/utils.R

@@ -45,15 +45,91 @@ document_granges <- function(
   ), intro_noun, bullets)
 }
 
+# Add current timestamp to a character string.
+add_timestamp <- function(msg) {
+  return(paste0(format(Sys.time(), "%Y-%m-%d %H:%M:%S "), msg))
+}
+
 # Function which prints a message using shell echo.
 # Useful for printing messages from inside mclapply when running in Rstudio.
 log_progress <- function(msg, add_timestamp = TRUE){
   if (add_timestamp) {
-    msg <- paste0(format(Sys.time(), "%Y-%m-%d %H:%M:%S "), msg)
+    msg <- add_timestamp(msg)
   }
   if (.Platform$GUI == "RStudio") {
     system(sprintf('echo "%s"', paste0(msg, collapse="")))
   } else {
     message(msg)
   }
+}
+
+#' Helper to create partial functions
+#'
+#' Automatically creates a partial application of the caller
+#' function including all non-missing arguments. 
+#'
+#' @return A `bpcells_partial` object (a function with some extra attributes)
+#' @keywords internal
+create_partial <- function() {
+  env <- rlang::caller_env()
+  fn_sym <- rlang::caller_call()[[1]]
+  fn <- rlang::caller_fn()
+
+  args <- list()
+  for (n in names(formals(fn))) {
+    if (rlang::is_missing(env[[n]])) next
+    args[[n]] <- env[[n]]
+  }
+
+  ret <- do.call(partial_apply, c(fn, args))
+  attr(ret, "body")[[1]] <- fn_sym
+  return(ret)
+}
+
+
+#' Create partial function calls
+#' 
+#' Specify some but not all arguments to a function.
+#'
+#' @param f A function
+#' @param ... Named arguments to `f`
+#' @param .overwrite (bool) If `f` is already an output from
+#'   `partial_apply()`, whether parameter re-definitions should
+#'   be ignored or overwrite the existing definitions
+#' @param .missing_args_error (bool) If `TRUE`, passing in arguments
+#'  that are not in the function's signature will raise an error, otherwise
+#'  they will be ignored
+#' @return A `bpcells_partial` object (a function with some extra attributes)
+#' @keywords internal
+partial_apply <- function(f, ..., .overwrite = TRUE, .missing_args_error = TRUE) {
+  args <- rlang::list2(...)
+
+  if (is(f, "bpcells_partial")) {
+    prev_args <- attr(f, "args")
+    for (a in names(prev_args)) {
+      if (!(.overwrite && a %in% names(args))) {
+        args[[a]] <- prev_args[[a]]
+      }
+    }
+    f <- attr(f, "fn")
+    function_name <- attr(f, "body")[[1]]
+  } else {
+    function_name <- rlang::sym(rlang::caller_arg(f))
+  }
+  # See which arguments do not exist in f
+  missing_args <- which(!names(args) %in% names(formals(f)))
+  if (length(missing_args) > 0) {
+    if (.missing_args_error) {
+      stop(sprintf("Arguments %s are not in the function signature", paste0(names(args)[missing_args], collapse=", ")))
+    } else {
+      args <- args[-missing_args]}
+  }
+  partial_fn <- do.call(purrr::partial, c(f, args))
+  attr(partial_fn, "body")[[1]] <- function_name
+  structure(
+    partial_fn,
+    class = c("bpcells_partial", "purrr_function_partial", "function"),
+    args = args,
+    fn = f
+  )
 }

r/pkgdown/_pkgdown.yml

@@ -152,6 +152,7 @@ reference:
 
 - title: "Clustering"
 - contents:
+  - cluster_cells_graph
   - knn_hnsw
   - cluster_graph_leiden
   - knn_to_graph