Test aggregating SFE with sf data frames and when some cells are not …

…in any grid
pachterlab · Nov 23, 2024 · 6e4508d · 6e4508d
1 parent be522f7
commit 6e4508d
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 4 deletions.
diff --git a/R/aggregate.R b/R/aggregate.R
@@ -189,6 +189,10 @@ aggregateTxTech <- function(data_dir, df = NULL, by = NULL,
         cat_agg <- matrix(NA, nrow = length(inds), ncol = length(names_not_num))
         colnames(cat_agg) <- names_not_num
         cat_agg <- data.frame(cat_agg)
+        if (nrow(df_bin) != nrow(df)) {
+            df_inds <- data.frame(index = seq_len(nrow(df)))
+            df_bin <- merge(df_inds, df_bin, all.x = TRUE, by = "index")
+        }
         for (n in names_not_num)
             cat_agg[[n]] <- split(df[[n]], df_bin$bin)
         cd_agg <- cbind(cat_agg, cd_agg)
@@ -264,7 +268,7 @@ aggregateTxTech <- function(data_dir, df = NULL, by = NULL,
             by <- .make_grid_samples(x, sample_id,
                                      cellsize, square, flat_topped)
         }
-        if (is.list(by) && !inherits(by, "sfc")) {
+        if (is.list(by) && !inherits(by, "sfc") && !inherits(by, "sf")) {
             if (!any(sample_id %in% names(by)))
                 stop("None of the geometries in `by` correspond to sample_id")
             by <- by[intersect(sample_id, names(by))]
@@ -275,6 +279,8 @@ aggregateTxTech <- function(data_dir, df = NULL, by = NULL,
                 if (inherits(by, "sfc") || !"sample_id" %in% names(by))
                     stop("`by` must be an sf data frame with a column `sample_id`")
                 by <- split(st_geometry(by), by$sample_id)
+            } else if (inherits(by, "sf")) {
+                by <- st_geometry(by)
             }
         }
         if (inherits(by, "sfc")) by <- setNames(list(by), sample_id)

diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R
@@ -82,7 +82,6 @@ test_that("aggregateTxTech for Xenium", {
     expect_true(st_contains(img_bbox, grid_bbox, sparse = FALSE))
 })
 
-try(sfe <- readXenium(fn))
 sfe <- readXenium(fn, add_molecules = TRUE)
 # Deal with logical and categorical variables in colData
 set.seed(29)
@@ -117,9 +116,30 @@ test_that("aggregate for SFE by cells, manually supply `by` argument", {
     expect_true(all(agg$logical >= 0L))
 })
 
+test_that("aggregate for SFE by cells, sf `by` argument, single sample", {
+    grid_sf <- st_sf(geometry = grid2)
+    agg <- aggregate(sfe, by = grid_sf)
+    expect_true(ncol(agg) <= length(grid2) & ncol(agg) > 0)
+    expect_true(all(colSums(counts(agg)) > 0))
+})
+
+test_that("aggregate with sf `by` argument, multiple samples", {
+    grid3 <- rbind(st_sf(geometry = grid2, sample_id = "sample01"),
+                   st_sf(geometry = grid2, sample_id = "sample02"))
+    agg <- aggregate(sfe2, by = grid3)
+    expect_true(ncol(agg) <= nrow(grid3) & ncol(agg) > 0)
+    expect_true(all(colSums(counts(agg)) > 0))
+})
+
+test_that("aggregate when some cells are outside bins", {
+    grid4 <- grid2[seq_len(floor(length(grid2)/2))]
+    agg <- aggregate(sfe, by = grid4)
+    expect_true(ncol(agg) <= length(grid4) & ncol(agg) > 0)
+    expect_true(all(colSums(counts(agg)) > 0))
+})
+
 test_that("aggregate.SFE use a row* function", {
-    #agg2 <- aggregate(sfe, by = grid2, FUN = rowMedians) # doesn't work MatrixGenerics::rowMedians
-    agg2 <- aggregate(sfe, by = grid2, FUN = rowMeans2) # works MatrixGenerics::rowMeans2
+    agg2 <- aggregate(sfe, by = grid2, FUN = rowMedians)
     expect_s4_class(agg2, "SpatialFeatureExperiment")
     # empty grid cells were removed
     expect_true(ncol(agg2) <= length(grid2) & ncol(agg2) > 0)