group_split

NAMESPACE

@@ -13,6 +13,7 @@ S3method(full_join,SingleCellExperiment)
 S3method(ggplot,SingleCellExperiment)
 S3method(glimpse,tidySingleCellExperiment)
 S3method(group_by,SingleCellExperiment)
+S3method(group_split,SingleCellExperiment)
 S3method(inner_join,SingleCellExperiment)
 S3method(join_transcripts,Seurat)
 S3method(join_transcripts,default)
@@ -73,6 +74,7 @@ importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
 importFrom(dplyr,group_by_drop_default)
+importFrom(dplyr,group_rows)
 importFrom(dplyr,group_split)
 importFrom(dplyr,inner_join)
 importFrom(dplyr,left_join)

R/dplyr_methods.R

@@ -820,3 +820,41 @@ pull.SingleCellExperiment <- function(.data, var=-1, name=NULL, ...) {
         as_tibble() %>%
         dplyr::pull(var=!!var, name=!!name, ...)
 }
+
+#' @name group_split
+#' @rdname group_split
+#' @inherit dplyr::group_split
+#' 
+#' @examples
+#' data(pbmc_small)
+#' pbmc_small |> group_split(groups)
+#' 
+#' @importFrom ellipsis check_dots_used
+#' @importFrom dplyr group_by
+#' @importFrom dplyr group_rows
+#' @export
+group_split.SingleCellExperiment <- function(.tbl, ..., .keep = TRUE) {
+
+  var_list <- enquos(...)
+
+  group_list <- .tbl |> 
+      as_tibble() |> 
+      dplyr::group_by(!!!var_list)
+
+  groups <- group_list |> 
+      dplyr::group_rows()
+
+  v <- vector(mode = "list", length = length(groups))
+
+  for (i in seq_along(v)) {
+      v[[i]] <- .tbl[,groups[[i]]]
+
+      if(.keep == FALSE) {
+        v[[i]] <- select(v[[i]], !(!!!var_list))
+      }
+  }
+
+  v
+
+}
+

tests/testthat/test-dplyr_methods.R

@@ -376,3 +376,11 @@ test_that("rowwise()", {
     expect_equal(dim(fd), c(ncol(df), 1))
     expect_identical(fd[[1]], sapply(df$lys, sum))
 })
+
+test_that("group_split()", {
+    fd <- df |> 
+      group_split(groups, ident)
+    expect_equal(length(fd), length(unique(df$groups)) *
+                   length(unique(df$ident)))
+})
+