Merge pull request #80 from B0ydT/boyd

`group_split`

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: tidyseurat
 Title: Brings Seurat to the Tidyverse 
-Version: 0.7.9
+Version: 0.8.0
 Authors@R: c(person("Stefano", "Mangiola", email = "[email protected]",
                   role = c("aut", "cre")),
             person("Maria", "Doyle", email = "[email protected]",

NAMESPACE

@@ -13,6 +13,7 @@ S3method(full_join,Seurat)
 S3method(ggplot,Seurat)
 S3method(glimpse,tidyseurat)
 S3method(group_by,Seurat)
+S3method(group_split,Seurat)
 S3method(inner_join,Seurat)
 S3method(join_transcripts,Seurat)
 S3method(join_transcripts,default)
@@ -71,6 +72,8 @@ 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)
 importFrom(dplyr,mutate)

R/dplyr_methods.R

@@ -966,3 +966,41 @@ pull.Seurat <- 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
+#' @importFrom dplyr group_split
+#' @export
+group_split.Seurat <- 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.R

@@ -214,3 +214,32 @@ test_that("rowwise", {
     ((pbmc_small[, 1]$nCount_RNA + pbmc_small[, 1]$nFeature_RNA) / 2) |> unname()
   )
 })
+
+test_that("group_split() works for one variable", {
+  fd <- pbmc_small |> 
+    group_split(groups)
+  expect_equal(length(fd), length(unique(pbmc_small$groups)))
+})
+
+test_that("group_split() works for combination of variables", {
+  fd <- pbmc_small |> 
+    group_split(groups, letter.idents)
+  expect_equal(length(fd), length(unique(pbmc_small$groups)) *
+                 length(unique(pbmc_small$letter.idents)))
+})
+
+test_that("group_split() works for one logical statement", {
+  fd_log <- pbmc_small |> 
+    group_split(groups=="g1")
+  fd_var <- pbmc_small |> 
+    group_split(groups=="g1")
+  expect_equal(lapply(fd_var, count), lapply(fd_log, count))
+})
+
+test_that("group_split() works for two logical statements", {
+  fd <- pbmc_small |>
+    group_split(PC_1>0 & groups=="g1")
+  fd_counts <- lapply(fd, count)
+  expect_equal(c(fd_counts[[1]], fd_counts[[2]], use.names = FALSE), 
+               list(75, 5))
+})