Merge pull request #61 from stemangiola/aggregate_cells

Aggregate cells

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: tidyseurat
 Title: Brings Seurat to the Tidyverse 
-Version: 0.5.10
+Version: 0.6.0
 Authors@R: c(person("Stefano", "Mangiola", email = "mangiolastefano@gmail.com",
                   role = c("aut", "cre")),
             person("Maria", "Doyle", email = "Maria.Doyle@petermac.org",
@@ -12,7 +12,7 @@ Description: It creates an invisible layer that allow to see the 'Seurat' object
 License: GPL-3
 Depends:
     R (>= 4.1.0),
-    ttservice,
+    ttservice (>= 0.3.5),
     SeuratObject
 Imports:
     Seurat,
@@ -34,7 +34,8 @@ Imports:
     stringr,
     cli,
     fansi,
-    pkgconfig
+    pkgconfig,
+    Matrix
 Suggests:
     testthat,
     knitr,

NAMESPACE

@@ -42,6 +42,7 @@ S3method(unite,Seurat)
 S3method(unnest,tidyseurat_nested)
 export("%>%")
 export(add_count)
+export(aggregate_cells)
 export(arrange)
 export(as_tibble)
 export(bind_cols)
@@ -80,6 +81,7 @@ export(tidy)
 export(unite)
 export(unnest)
 export(unnest_seurat)
+importFrom(Matrix,rowSums)
 importFrom(Seurat,Assays)
 importFrom(Seurat,GetAssayData)
 importFrom(Seurat,SplitObject)
@@ -90,6 +92,7 @@ importFrom(dplyr,add_count)
 importFrom(dplyr,arrange)
 importFrom(dplyr,count)
 importFrom(dplyr,distinct)
+importFrom(dplyr,distinct_at)
 importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
@@ -108,6 +111,7 @@ importFrom(dplyr,select_if)
 importFrom(dplyr,slice)
 importFrom(dplyr,slice_sample)
 importFrom(dplyr,summarise)
+importFrom(dplyr,vars)
 importFrom(ellipsis,check_dots_used)
 importFrom(fansi,strwrap_ctl)
 importFrom(ggplot2,aes)
@@ -127,6 +131,7 @@ importFrom(purrr,imap)
 importFrom(purrr,map)
 importFrom(purrr,map2)
 importFrom(purrr,map_chr)
+importFrom(purrr,map_int)
 importFrom(purrr,reduce)
 importFrom(purrr,when)
 importFrom(rlang,":=")
@@ -155,6 +160,7 @@ importFrom(tidyr,separate)
 importFrom(tidyr,spread)
 importFrom(tidyr,unite)
 importFrom(tidyr,unnest)
+importFrom(ttservice,aggregate_cells)
 importFrom(ttservice,join_features)
 importFrom(utils,packageDescription)
 importFrom(utils,tail)

R/methods.R

@@ -133,6 +133,89 @@ setMethod("join_features", "Seurat",  function(.data,
 })
 
 
+#' Aggregate cells
+#'
+#' @description Combine cells into groups based on shared variables and aggregate feature counts.
+#'
+#' @importFrom magrittr "%>%"
+#' @importFrom rlang enquo
+#' @importFrom tibble enframe
+#' @importFrom Matrix rowSums
+#' @importFrom purrr map_int
+#' @importFrom ttservice aggregate_cells
+#' 
+#' @name aggregate_cells
+#' @rdname aggregate_cells
+#' 
+#' @param .data A tidySingleCellExperiment object
+#' @param .sample A vector of variables by which cells are aggregated
+#' @param slot The slot to which the function is applied
+#' @param assays The assay to which the function is applied
+#' @param aggregation_function The method of cell-feature value aggregation
+#' 
+#' @return A tibble object
+#' 
+#' @examples 
+#' data("pbmc_small")
+#' pbmc_small |>
+#'   aggregate_cells(c(groups, letter.idents), assays = "RNA")
+#'
+#' @export
+#'
+NULL
+
+#' aggregate_cells
+#'
+#' @docType methods
+#' @rdname aggregate_cells
+#'
+#' @return An object containing the information.for the specified features
+#'
+setMethod("aggregate_cells", "Seurat",  function(.data,
+                                                 .sample = NULL, 
+                                                 slot = "data",
+                                                 assays = NULL, 
+                                                 aggregation_function = Matrix::rowSums){
+
+    .sample = enquo(.sample)
+
+    # Subset only wanted assays
+    if(!is.null(assays)){
+      DefaultAssay(.data) = assays[1]
+      .data@assays = .data@assays[assays]
+    }
+
+    .data %>%
+
+      tidyseurat::nest(data = -!!.sample) %>%
+      mutate(.aggregated_cells = map_int(data, ~ ncol(.x))) %>% 
+      mutate(data = map(data, ~ 
+
+                          # loop over assays
+                          map2(
+                            .x@assays, names(.x@assays),
+
+                            # Get counts
+                            ~ GetAssayData(.x, slot = slot) %>%
+                              aggregation_function(na.rm = T) %>%
+                              tibble::enframe(
+                                name  = ".feature",
+                                value = sprintf("%s", .y)
+                              ) %>%
+                              mutate(.feature = as.character(.feature)) 
+                          ) %>%
+                          Reduce(function(...) full_join(..., by=c(".feature")), .)
+
+      )) %>%
+      left_join(.data %>% tidyseurat::as_tibble() %>% subset_tidyseurat(!!.sample)) %>%
+      tidyseurat::unnest(data) %>%
+
+      tidyr::unite(".sample", !!.sample,  sep="___", remove = FALSE) |> 
+      select(.feature, .sample, names(.data@assays), everything()) |> 
+      drop_class("tidyseurat_nested") 
+
+
+  })
 
 
 

R/utilities.R

@@ -384,6 +384,7 @@ c_ =  function(x){
 #' @keywords internal
 #' @noRd
 #'
+#' @importFrom dplyr vars
 #'
 #' @param var A tibble
 #' @param attribute An object
@@ -393,4 +394,57 @@ c_ =  function(x){
 add_attr = function(var, attribute, name) {
   attr(var, name) <- attribute
   var
-}
+}
+
+
+#' @importFrom dplyr distinct_at
+#' @importFrom magrittr equals
+get_specific_annotation_columns = function(.data, .col){
+
+
+  # Comply with CRAN NOTES
+  . = NULL
+
+  # Make col names
+  .col = enquo(.col)
+
+  # x-annotation df
+  n_x = .data %>% distinct_at(vars(!!.col)) %>% nrow
+
+  # element wise columns
+  .data %>%
+    select(-!!.col) %>%
+    colnames %>%
+    map(
+      ~
+        .x %>%
+        when(
+          .data %>%
+            distinct_at(vars(!!.col, .x)) %>%
+            nrow() %>%
+            equals(n_x) ~ (.),
+          ~ NULL
+        )
+    ) %>%
+
+    # Drop NULL
+    {	(.)[lengths((.)) != 0]	} %>%
+    unlist
+
+}
+
+subset_tidyseurat = 		function(.data,	 .column)	{
+  # Make col names
+  .column = enquo(.column)
+
+  # Check if column present
+  if(quo_names(.column) %in% colnames(.data) %>% all %>% `!`)
+    stop("nanny says: some of the .column specified do not exist in the input data frame.")
+
+  .data %>%
+
+    # Selecting the right columns
+    select(	!!.column,	get_specific_annotation_columns(.data, !!.column)	) %>%
+    distinct()
+
+}