apply: add names for each row/col

Yunuuuu · Jul 6, 2024 · b1725f0 · b1725f0
1 parent b58501c
commit b1725f0
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 8 deletions.
diff --git a/R/Method-apply.R b/R/Method-apply.R
@@ -37,9 +37,9 @@ methods::setMethod(
         }
         seed <- to_BPCells(X@seed)
         values <- integer(dim(seed)[3L - MARGIN]) # nolint
-        nms <- switch(MARGIN,
-            rownames(seed),
-            colnames(seed)
+        names(values) <- switch(MARGIN,
+            colnames(seed),
+            rownames(seed)
         )
         .fun <- switch(MARGIN,
             function(.value, .row_index, .col_index, ...) {
@@ -67,20 +67,24 @@ methods::setMethod(
                 BPCells::apply_by_col(mat = seed, fun = .fun, ...)
             }
         )
+        ans_nms <- switch(MARGIN,
+            rownames(seed),
+            colnames(seed)
+        )
         if (simplify) {
             lens <- lengths(ans)
             if (all(lens == .subset(lens, 1L))) {
                 if (.subset(lens, 1L) == 1L) {
                     ans <- unlist(ans, recursive = FALSE, use.names = FALSE)
-                    names(ans) <- nms
+                    names(ans) <- ans_nms
                 } else {
                     ans <- do.call(cbind, ans)
-                    colnames(ans) <- nms
+                    colnames(ans) <- ans_nms
                 }
                 return(ans)
             }
         }
-        names(ans) <- nms
+        names(ans) <- ans_nms
         ans
     }
 )
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
@@ -10,6 +10,23 @@ test_methods <- function(
     mat <- mat %||% as.matrix(obj)
     mat <- convert_mode(mat, mode)
 
+    ########################################################
+    cli::cli_inform("{.field as} for seed {name} works as expected")
+    testthat::test_that(
+        sprintf("`as()` for seed %s works as expected", name),
+        {
+            obj <- BPCellsMatrix(obj)
+            testthat::expect_s4_class(
+                methods::as(obj, "IterableMatrix"),
+                "IterableMatrix"
+            )
+            testthat::expect_identical(
+                methods::as(obj, "IterableMatrix"),
+                to_BPCells(obj@seed)
+            )
+        }
+    )
+
     ########################################################
     cli::cli_inform("{.field convert_mode} for seed {name} works as expected")
     testthat::test_that(
@@ -522,6 +539,10 @@ test_methods <- function(
                 apply(obj, 1, stats::quantile),
                 apply(mat, 1, stats::quantile)
             )
+            testthat::expect_equal(
+                apply(obj, 1, function(x) x[x > 0L]),
+                apply(mat, 1, function(x) x[x > 0L])
+            )
             testthat::expect_equal(
                 apply(obj, 1, stats::quantile, simplify = FALSE),
                 apply(mat, 1, stats::quantile, simplify = FALSE)
@@ -539,18 +560,20 @@ test_methods <- function(
                 apply(mat, 2L, sum)
             )
 
-
             testthat::expect_equal(apply(obj, 2L, mean), apply(mat, 2L, mean))
             testthat::expect_equal(
                 apply(transpose_axis(obj), 2L, mean),
                 apply(mat, 2L, mean)
             )
 
-
             testthat::expect_equal(
                 apply(obj, 2L, stats::quantile),
                 apply(mat, 2L, stats::quantile)
             )
+            testthat::expect_equal(
+                apply(obj, 2L, function(x) x[x > 0L]),
+                apply(mat, 2L, function(x) x[x > 0L])
+            )
             testthat::expect_equal(
                 apply(obj, 2L, stats::quantile, simplify = FALSE),
                 apply(mat, 2L, stats::quantile, simplify = FALSE)