getChannelSummaryStats() : limit case with one flowFrame was still no…

…t working according to expectations :-)
UCLouvain-CBIO · Jan 4, 2024 · 4bed6bf · 4bed6bf
1 parent c1d403b
commit 4bed6bf
Show file tree

Hide file tree

Showing 3 changed files with 39 additions and 28 deletions.
diff --git a/R/stats.R b/R/stats.R
@@ -1009,8 +1009,11 @@ pairwiseEMDDist <- function(
 #' This list can be named, in that case, these names will be transfered to the
 #' returned value.
 #' @param ... additional parameters passed to `getEMDDist()`
-#' @return a matrix of which the columns are the channel statistics 
-#' for all flowFrames of the flowSet. 
+#' @return a list of named statistic matrices. 
+#' In each stat matrix, the columns are the channel statistics 
+#' for all flowFrames of the flowSet.
+#' Exception: if only one stat function (and not a list) is passed in
+#' `statFUNs`, the return value is simplified to the stat matrix itself.
 #' @importFrom CytoPipeline areSignalCols
 #' @export
 #' 
@@ -1132,28 +1135,28 @@ getChannelSummaryStats <- function(
                 chRes <- flowCore::fsApply(
                     fs,
                     FUN = function(ff){
-                        statFUNList[[fu]](flowCore::exprs(ff)[, ch], 
-                                na.rm = TRUE)
+                        statFUNList[[fu]](
+                            flowCore::exprs(ff)[, ch, drop = FALSE],
+                            na.rm = TRUE)
                     })
             },
             FUN.VALUE = numeric(length = nFF))
 
-        if (is.vector(statList[[fu]])) {
-            names(statList[[fu]]) <- channelNames
-        } else { # matrix
-            colnames(statList[[fu]]) <- channelNames
-            rowNames <- flowCore::pData(fs)$name
-            if (!is.null(rowNames)) {
-                rownames(statList[[fu]]) <- rowNames
-            }
+        if (!is.matrix(statList[[fu]]) ) {
+            statList[[fu]] <- matrix(statList[[fu]], nrow = 1)
+        } 
+        colnames(statList[[fu]]) <- channelNames
+        rowNames <- flowCore::pData(fs)$name
+        if (!is.null(rowNames)) {
+            rownames(statList[[fu]]) <- rowNames
         }
     }
 
     # transfer function names to return value
     names(statList) <- names(statFUNList)
 
     # if only one stat function => unlist to return one single matrix
-    if (nStats == 1){
+    if (nStats == 1 && !is.list(statFUNs)){
         statList <- statList[[1]]
     }
 

diff --git a/man/getChannelSummaryStats.Rd b/man/getChannelSummaryStats.Rd
diff --git a/tests/testthat/test-stats.R b/tests/testthat/test-stats.R
@@ -716,6 +716,8 @@ test_that("getChannelSummaryStats works", {
         statFUNs = stats::median,
         verbose = FALSE)
 
+
+    expect_equal(unname(rownames(ret)), flowCore::sampleNames(fsAll))
     expect_equal(unname(colnames(ret)), channelsOrMarkers)
 
     expect_equal(unname(ret[2,1]), 1.941572819633120)
@@ -729,29 +731,30 @@ test_that("getChannelSummaryStats works", {
         verbose = FALSE)
 
     expect_equal(names(ret), c("mean", "std.dev"))
+    expect_equal(unname(rownames(ret[[1]])), flowCore::sampleNames(fsAll))
     expect_equal(unname(colnames(ret[[1]])), channelsOrMarkers)
     expect_equal(unname(ret[[1]][2,1]), 1.961771149533659)
     expect_equal(unname(ret[[1]][3,2]), 1.393034241892733)
     expect_equal(unname(ret[[1]][4,3]), 1.907561024702794)
 
-
+    expect_equal(unname(rownames(ret[[2]])), flowCore::sampleNames(fsAll))
     expect_equal(unname(colnames(ret[[2]])), channelsOrMarkers)
-
     expect_equal(unname(ret[[2]][2,1]), 0.5942291770870205)
     expect_equal(unname(ret[[2]][3,2]), 0.7352746696905406)
     expect_equal(unname(ret[[2]][4,3]), 0.8420740225208073)
 
-    # test with only one flow frame => should return a vector 
-    # instead of a matrix
+    # test with only one flow frame 
     ret <- getChannelSummaryStats(
         fsAll[1],
         channels = channelsOrMarkers,
         statFUNs = list("mean" = mean, "std.dev" = stats::sd),
         verbose = FALSE)
 
     expect_equal(names(ret), c("mean", "std.dev"))
-    expect_equal(unname(names(ret[[1]])), channelsOrMarkers)
-    expect_equal(unname(names(ret[[2]])), channelsOrMarkers)
+    expect_equal(unname(rownames(ret[[1]])), "Donor1")
+    expect_equal(unname(rownames(ret[[2]])), "Donor1")
+    expect_equal(unname(colnames(ret[[1]])), channelsOrMarkers)
+    expect_equal(unname(colnames(ret[[2]])), channelsOrMarkers)
     expect_equal(unname(ret[[1]][1]), 1.900298)
     expect_equal(unname(ret[[1]][2]), 1.39186533)
     expect_equal(unname(ret[[1]][3]), 1.8544648)
@@ -766,10 +769,11 @@ test_that("getChannelSummaryStats works", {
         statFUNs = list("mean" = mean),
         verbose = FALSE)
 
-    expect_equal(names(ret), channelsOrMarkers)
-    expect_equal(unname(ret[1]), 1.900298)
-    expect_equal(unname(ret[2]), 1.39186533)
-    expect_equal(unname(ret[3]), 1.8544648)
+    expect_equal(as.character(rownames(ret[[1]])), "Donor1")
+    expect_equal(unname(colnames(ret[[1]])), channelsOrMarkers)
+    expect_equal(unname(ret[[1]][1,1]), 1.900298)
+    expect_equal(unname(ret[[1]][1,2]), 1.39186533)
+    expect_equal(unname(ret[[1]][1,3]), 1.8544648)
 
     # one flow frame, one stat (bis with direct impact of stat FUN)
     ret <- getChannelSummaryStats(
@@ -778,10 +782,11 @@ test_that("getChannelSummaryStats works", {
         statFUNs = mean,
         verbose = FALSE)
 
-    expect_equal(names(ret), channelsOrMarkers)
-    expect_equal(unname(ret[1]), 1.900298)
-    expect_equal(unname(ret[2]), 1.39186533)
-    expect_equal(unname(ret[3]), 1.8544648)
+    expect_equal(as.character(rownames(ret)), "Donor1")
+    expect_equal(unname(colnames(ret)), channelsOrMarkers)
+    expect_equal(unname(ret[1,1]), 1.900298)
+    expect_equal(unname(ret[1,2]), 1.39186533)
+    expect_equal(unname(ret[1,3]), 1.8544648)
 })
 
 test_that("computeMetricMDS works", {