Merge remote-tracking branch 'seurat-private/fix/aggregate_expression…

…' into lis_vignette_updates
zm19911213 · Nov 14, 2023 · 82421fb · 82421fb
2 parents c68a678 + c17879f
commit 82421fb
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 18 deletions.
diff --git a/R/utilities.R b/R/utilities.R
@@ -1450,6 +1450,21 @@ PseudobulkExpression.Seurat <- function(
     data <- data[, which(num.levels > 1), drop = F]
   }
   category.matrix <- CreateCategoryMatrix(labels = data, method = method)
+  #check if column names are numeric
+  col.names <- colnames(category.matrix)
+  if (any(!(grepl("^[a-zA-Z]|^\\.[^0-9]", col.names)))) {
+    col.names <- ifelse(
+      !(grepl("^[a-zA-Z]|^\\.[^0-9]", col.names)),
+      paste0("g", col.names),
+      col.names
+    )
+    colnames(category.matrix) <- col.names
+    inform(
+      message = "Pseudobulk group.by variables are numeric, appending `g` to column names/cells of pseudobulked output.",
+      .frequency = "regularly",
+      .frequency_id = "PseudobulkExpression"
+    )
+  }
   data.return <- list()
   for (i in 1:length(x = assays)) {
     if (inherits(x = features, what = "list")) {
@@ -1568,17 +1583,24 @@ PseudobulkExpression.Seurat <- function(
         toRet <- ScaleData(object = toRet, verbose = verbose)
       }
     }
-    if ('ident' %in% group.by) {
-      first.cells <- sapply(
-        X = 1:ncol(x = category.matrix),
-        FUN = function(x) {
-          return(category.matrix[,x, drop = FALSE ]@i[1] + 1)
-        }
-      )
-      Idents(object = toRet,
-             cells = colnames(x = toRet)
-      ) <- Idents(object = object)[first.cells]
+    #add meta-data based on group.by variables
+    cells <- Cells(toRet)
+    for (i in 1:length(group.by)) {
+      if (group.by[i] != "ident") {
+        v <- sapply(
+          strsplit(cells, "_"),
+          function(x) {return(x[i])}
+        )
+        names(v) <- cells
+        toRet <- AddMetaData(toRet,
+                             metadata = v,
+                             col.name = group.by[i]
+        )
+      }
     }
+    #set idents to pseudobulk variables
+    Idents(toRet) <- cells
+    toRet$orig.ident <- cells
     return(toRet)
   } else {
     return(data.return)

diff --git a/vignettes/COVID_SCTMapping.Rmd b/vignettes/COVID_SCTMapping.Rmd
@@ -147,29 +147,25 @@ bulk <- AggregateExpression(object,
   assays  = 'RNA',
   group.by = c("predicted.celltype.l2", "donor_id", "disease")
 )
-
-bulk$celltype <- sapply(strsplit(Cells(bulk), split = "_"), '[', 1)
-bulk$donor <- sapply(strsplit(Cells(bulk), split = "_"), '[', 2)
-bulk$disease <- sapply(strsplit(Cells(bulk), split = "_"), '[', 3)
 ```
 
 ```{r} 
 bulk <- subset(bulk, subset = disease %in% c('normal', 'COVID-19') )
-bulk <- subset(bulk, subset = celltype !=  c('Doublet') )
+bulk <- subset(bulk, subset = predicted.celltype.l2 !=  'Doublet')
 bulk$disease <- factor(bulk$disease, levels = c('normal', 'COVID-19'))
 ```
 
 Once a pseudobulk object is created, we can perform cell type-specific differential expression analysis between healthy individuals and COVID-19 donors. Here, we only visualize certain interferon-stimulated genes which are often upregulated during viral infection.
 
 ```{r, fig.width=10, fig.height=12}
 p1 <- VlnPlot(
-  object = bulk, features = 'IFI6', group.by = 'celltype',
+  object = bulk, features = 'IFI6', group.by = 'predicted.celltype.l2',
   split.by = 'disease', cols = c("#377eb8", "#e41a1c"))
 p2 <- VlnPlot(
-  object = bulk, features = c('ISG15'), group.by = 'celltype',
+  object = bulk, features = c('ISG15'), group.by = 'predicted.celltype.l2',
   split.by = 'disease', cols = c("#377eb8", "#e41a1c"))
 p3 <- VlnPlot(
-  object = bulk, features = c('IFIT5'), group.by = 'celltype',
+  object = bulk, features = c('IFIT5'), group.by = 'predicted.celltype.l2',
   split.by = 'disease', cols = c("#377eb8", "#e41a1c"))
 p1 + p2 + p3 + plot_layout(ncol = 1)
 ```