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)

R/dplyr_methods.R

@@ -875,3 +875,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 title description details sections source
+#'
+#' @param .data A `tidySingleCellExperiment` object
+#' @param ... The grouping variables by which to split the object
+#'
+#' @export
+#'
+#' @examples
+#' data(pbmc_small)
+#' pbmc_small |> group_split(pbmc_small, groups)
+group_split.SingleCellExperiment <- function(.data, ...) {
+
+  var_list <- enquos(...)
+
+  group_df <- .data |> 
+      as_tibble()
+
+  group_df <- group_df |> 
+      unite("group_col", !!!var_list, remove = FALSE)
+
+  group_list <- group_df$group_col
+
+  groups <- group_list |> 
+      unique()
+
+  v <- vector(mode = "list", length = length(groups))
+
+  for (i in seq_along(v)) {
+      v[[i]] <- .data[,group_list == groups[[i]]]
+  }
+
+  v
+
+}
+

tests/testthat/test-dplyr_methods.R

@@ -318,3 +318,19 @@ 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")
+    expect_equal(length(fd), length(unique(df$groups)))
+
+    fd <- df |> 
+    group_split("groups")
+    expect_equal(length(fd), length(unique(df$groups)))
+
+    fd <- df |> 
+      group_split(groups, ident)
+    expect_equal(length(fd), length(unique(df$groups)) *
+                   length(unique(df$ident)))
+})
+