Merge pull request #57 from william-hutchison/master

Added aggregate cells function and dependencies

Author: stemangiola

DESCRIPTION

@@ -31,7 +31,8 @@ Imports:
     pillar,
     stringr,
     cli,
-    fansi
+    fansi,
+    Matrix
 Suggests:
     BiocStyle,
     testthat,
@@ -44,7 +45,6 @@ Suggests:
     tidyHeatmap,
     igraph,
     GGally,
-    Matrix,
     uwot,
     celldex,
     dittoSeq,

NAMESPACE

@@ -41,6 +41,7 @@ S3method(unite,SingleCellExperiment)
 S3method(unnest,tidySingleCellExperiment_nested)
 export("%>%")
 export(add_count)
+export(aggregate_cells)
 export(arrange)
 export(as_tibble)
 export(bind_cols)
@@ -76,6 +77,9 @@ export(tidy)
 export(unite)
 export(unnest)
 export(unnest_single_cell_experiment)
+import(dplyr)
+import(tidyr)
+importFrom(Matrix,rowSums)
 importFrom(S4Vectors,"metadata<-")
 importFrom(S4Vectors,DataFrame)
 importFrom(S4Vectors,metadata)
@@ -89,6 +93,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)
@@ -114,12 +119,15 @@ importFrom(ggplot2,ggplot)
 importFrom(lifecycle,deprecate_warn)
 importFrom(magrittr,"%$%")
 importFrom(magrittr,"%>%")
+importFrom(magrittr,equals)
+importFrom(magrittr,set_rownames)
 importFrom(methods,as)
 importFrom(pillar,align)
 importFrom(pillar,get_extent)
 importFrom(pillar,style_subtle)
 importFrom(pillar,tbl_format_header)
 importFrom(plotly,plot_ly)
+importFrom(purrr,as_mapper)
 importFrom(purrr,imap)
 importFrom(purrr,map)
 importFrom(purrr,map2)
@@ -135,6 +143,9 @@ importFrom(rlang,flatten_if)
 importFrom(rlang,is_empty)
 importFrom(rlang,is_spliced)
 importFrom(rlang,names2)
+importFrom(rlang,quo_is_null)
+importFrom(rlang,quo_is_symbol)
+importFrom(rlang,quo_is_symbolic)
 importFrom(rlang,quo_name)
 importFrom(rlang,quo_squash)
 importFrom(stringr,regex)
@@ -153,5 +164,6 @@ importFrom(tidyr,unite)
 importFrom(tidyr,unnest)
 importFrom(tidyselect,eval_select)
 importFrom(ttservice,join_features)
+importFrom(utils,data)
 importFrom(utils,tail)
 importFrom(vctrs,new_data_frame)

R/methods.R

@@ -131,5 +131,67 @@ tidy.SingleCellExperiment <- function(object) {
   object
 }
 
-
-
+#' 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
+#'
+#' @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 SummarizedExperiment object
+#' 
+#' @examples 
+#' data("pbmc_small")
+#' pbmc_small_pseudo_bulk <- pbmc_small |>
+#'   aggregate_cells(c(groups, ident), assays = "counts")
+#'
+#' @export
+aggregate_cells <- function(.data, .sample = NULL, slot = "data", assays = NULL, aggregation_function = rowSums) {
+  
+  .sample = enquo(.sample)
+  
+  # Subset only wanted assays
+  if(!is.null(assays)){
+    .data@assays@data = .data@assays@data[assays]
+  }
+  
+  .data %>%
+    
+    nest(data = -!!.sample) %>%
+    mutate(.aggregated_cells = as.integer(map(data, ~ ncol(.x)))) %>% 
+    mutate(data = map(data, ~ 
+                        
+                        # loop over assays
+                        map2(
+                          as.list(assays(.x)), names(.x@assays),
+                          
+                          # Get counts
+                          ~  .x %>%
+                            aggregation_function(na.rm = T) %>%
+                            enframe(
+                              name  = "feature",
+                              value = sprintf("%s", .y)
+                            ) %>%
+                            mutate(feature = as.character(feature)) 
+                        ) %>%
+                        Reduce(function(...) full_join(..., by=c("feature")), .)
+                      
+    )) %>%
+    left_join(.data %>% as_tibble() %>% subset(!!.sample), by = quo_names(.sample)) %>%
+    unnest(data) %>%
+    
+    drop_class("tidySingleCellExperiment_nested") |> 
+    
+    as_SummarizedExperiment(.sample = !!.sample, .transcript = feature, .abundance = !!as.symbol(names(.data@assays)))
+}