Merge branch 'main' into ia/cran-release-prep

Author: immanuelazn

r/R/atac_utils.R

@@ -206,17 +206,29 @@ qc_scATAC <- function(fragments, genes, blacklist) {
 
   # Compute signal & background regions for TSSEnrichment calculation
   tss_window_width <- 101L
-  tss_window <- tss %>% dplyr::mutate(start = start - 50L, end = start + tss_window_width)
+  tss_window <- tss %>%
+    dplyr::mutate(
+      start = as.integer(pmax(start - 50L, 0L)),
+      end = start + tss_window_width
+    )
 
   tss_flank_width <- 100L
   tss_flank <- dplyr::bind_rows(
-    dplyr::mutate(tss, start = start + 1901L, end = start + tss_flank_width),
-    dplyr::mutate(tss, start = start - 2000L, end = start + tss_flank_width)
+    dplyr::mutate(
+      tss,
+      start = as.integer(pmax(start + 1901L, 0L)),
+      end = start + tss_flank_width
+    ),
+    dplyr::mutate(
+      tss,
+      start = as.integer(pmax(start - 2000L, 0L)),
+      end = start + tss_flank_width
+    )
   )
 
   promoters <- genes %>%
     dplyr::mutate(
-      start = dplyr::if_else(strand, start - 2000L, end - 101L),
+      start = as.integer(pmax(dplyr::if_else(strand, start - 2000L, end - 101L), 0L)),
       end = start + 2000L + 101L
     )
 

r/R/errorChecking.R

@@ -1,4 +1,4 @@
-# Copyright 2021 BPCells contributors
+# Copyright 2025 BPCells contributors
 # 
 # Licensed under the Apache License, Version 2.0 <LICENSE-APACHE or
 # https://www.apache.org/licenses/LICENSE-2.0> or the MIT license
@@ -16,11 +16,46 @@
 #   skip over during error printing.
 
 argument_name <- function(arg, n) {
+  substitute_if_present <- function(expr, env) {
+    if (is.null(env) || !is.symbol(expr)) return(expr)
+    symbol <- as.character(expr)
+    if (!exists(symbol, envir = env, inherits = FALSE)) return(expr)
+    result <- do.call(substitute, list(expr, env))
+    if (!is.language(result)) return(expr)
+    result
+  }
+
   arg_name <- substitute(arg)
-  for (f in seq_len(n)) {
-    arg_name <- do.call(substitute, list(arg_name, parent.frame(f)))
+  if (n > 0) {
+    for (f in seq_len(n)) {
+      env <- parent.frame(f)
+      arg_name <- substitute_if_present(arg_name, env)
+    }
   }
-  arg_name <- deparse(arg_name)
+
+  # Continue walking up the call stack so wrappers (e.g., pkgdown example helpers)
+  # don't collapse names to temporary argument placeholders.
+  frame <- n
+  extra_steps <- 0
+  max_extra <- 200
+  while (extra_steps < max_extra) {
+    frame <- frame + 1
+    env <- parent.frame(frame)
+    arg_name_new <- substitute_if_present(arg_name, env)
+    if (identical(arg_name_new, arg_name)) {
+      if (identical(env, globalenv()) || identical(env, baseenv()) || identical(env, emptyenv())) break
+      extra_steps <- extra_steps + 1
+      next
+    }
+    arg_name <- arg_name_new
+    if (identical(env, globalenv()) || identical(env, baseenv()) || identical(env, emptyenv())) break
+    extra_steps <- extra_steps + 1
+  }
+
+  # `deparse()` can return multi-line output (length > 1) for large expressions.
+  # Collapse to a single string so downstream consumers that expect a scalar
+  # name (e.g., column labels) don't get tripped up by long vectors.
+  arg_name <- paste(deparse(arg_name), collapse = "")
   return(arg_name)
 }
 

r/R/plots.R

@@ -552,7 +552,7 @@ collect_features <- function(source, features = NULL, gene_mapping = human_gene_
 #'   cluster_graph_louvain()
 #' 
 #' 
-#' ## Plot embedding
+#' ## Plot embeddings
 #' print(length(clusts))
 #' 
 #' plot_embedding(clusts, umap)

r/man/plot_embedding.Rd

@@ -715,4 +715,29 @@ test_that("Regression test for gene_score_archr() Issues 185 + 188", {
   # Check that tile_width changing doesn't cause crashes in `gene_score_archr`
   bp_ans <- gene_score_archr(bp_frags, genes, chromosome_sizes, tile_width=1000)
   expect_identical(as(bp_ans, "dgCMatrix"), ans)
+})
+
+test_that("qc_scATAC handles genes near the start of a chromosome", {
+  frag_tbl <- tibble::tibble(
+    chr = "chr1",
+    start = c(0L, 25L, 50L, 75L),
+    end = start + 20L,
+    cell_id = rep(c("cell1", "cell2"), each = 2)
+  )
+  fragments <- convert_to_fragments(frag_tbl)
+
+  genes <- tibble::tibble(
+    chr = "chr1",
+    start = c(0L, 25L),
+    end = c(75L, 80L),
+    strand = c("+", "-")
+  )
+  blacklist <- tibble::tibble(
+    chr = "chr1",
+    start = 500L,
+    end = 550L
+  )
+
+  qc <- qc_scATAC(fragments, genes, blacklist)
+  expect_identical(sort(qc$cellName), sort(cellNames(fragments)))
 })

r/tests/testthat/test-atac_utils.R

@@ -191,6 +191,7 @@ test_that("Merge cells works", {
 
 test_that("GRanges conversion round-trips", {
   skip_if_not_installed("GenomicRanges")
+  skip_if_not_installed("GenomeInfoDb")
   frags <- open_fragments_10x("../data/mini_fragments.tsv.gz") #nolint
   raw <- write_fragments_memory(frags)
   ranges <- as(raw, "GRanges")