In Figure 3 of the pre-print, we validated Signac with flow cytometry and compared Signac to SingleR. We reproduced that analysis using Seurat in this vignette, and provide interactive access to the data here. We start with raw counts.

all_times <- list()  # store the time for each chunk
knitr::knit_hooks$set(time_it = local({
  now <- NULL
  function(before, options) {
    if (before) {
      now <<- Sys.time()
    } else {
      res <- difftime(Sys.time(), now, units = "secs")
      all_times[[options$label]] <<- res
    }
  }
}))
knitr::opts_chunk$set(
  tidy = TRUE,
  tidy.opts = list(width.cutoff = 95),
  message = FALSE,
  warning = FALSE,
  time_it = TRUE
)
celltypes = readRDS(file = "fls/celltypes_amp_synovium.rds")
True_labels = readRDS(file = "fls/celltypes_amp_synovium_true.rds")
load(file = "fls/SingleR_Results.rda")

Load data

Read the CEL-seq2 data.

ReadCelseq <- function (counts.file, meta.file)
{
  E = suppressWarnings(readr::read_tsv(counts.file));
  gns <- E$gene;
  E = E[,-1]
  E = Matrix::Matrix(as.matrix(E), sparse = TRUE)
  rownames(E) <- gns
  E
}

counts.file = "./fls/celseq_matrix_ru10_molecules.tsv.gz"
meta.file = "./fls/celseq_meta.immport.723957.tsv"

E = ReadCelseq(counts.file = counts.file, meta.file = meta.file)
M = suppressWarnings(readr::read_tsv(meta.file))

# filter data based on depth and number of genes detected
kmu = Matrix::colSums(E != 0)
kmu2 = Matrix::colSums(E)
E = E[,kmu > 200 & kmu2 > 500]

# filter by mitochondrial percentage
logik = grepl("^MT-", rownames(E))
MitoFrac = Matrix::colSums(E[logik,]) / Matrix::colSums(E) * 100
E = E[,MitoFrac < 20]

SingleR

require(SingleR)
data("hpca")
Q = SingleR(sc_data = E, ref_data = hpca$data, types = hpca$main_types, fine.tune = F, numCores = 4)
save(file = "fls/SingleR_Results.rda", Q)
True_labels = M$type[match(colnames(E), M$cell_name)]
saveRDS(True_labels, file = "fls/celltypes_amp_synovium_true.rds")

Seurat

Start with the standard pre-processing steps for a Seurat object.

library(Seurat)

Create a Seurat object, and then perform SCTransform normalization. Note:

# load data
synovium <- CreateSeuratObject(counts = E, project = "FACs")

# run sctransform
synovium <- SCTransform(synovium, verbose = F)

Perform dimensionality reduction by PCA and UMAP embedding. Note:

# These are now standard steps in the Seurat workflow for visualization and clustering
synovium <- RunPCA(synovium, verbose = FALSE)
synovium <- RunUMAP(synovium, dims = 1:30, verbose = FALSE)
synovium <- FindNeighbors(synovium, dims = 1:30, verbose = FALSE)

SignacX

library(SignacX)

Generate Signac labels for the Seurat object. Note:

# Run Signac
labels <- Signac(synovium, num.cores = 4)
celltypes = GenerateLabels(labels, E = synovium)

Compare SignacX and SingleR with FACs labels

xx = celltypes$CellTypes
xx = as.character(xx)
xx[xx == "Plasma.cells"] = "B"
xx[xx == "NonImmune"] = as.character(celltypes$CellStates)[xx == "NonImmune"]
xx[xx == "B"] = "B"
xx[xx == "Fibroblasts"] = "F"
xx[xx == "MPh"] = "M"
xx[xx == "TNK"] = "T"
xx[celltypes$CellStates == "NK"] = "NK"
xy = xx
True_labels[True_labels == "B cell"] = "B"
True_labels[True_labels == "Fibroblast"] = "F"
True_labels[True_labels == "Monocyte"] = "M"
True_labels[True_labels == "T cell"] = "T"
tabsignac = table(FACs = True_labels, Signac = xy)

SignacX (rows are FACs labels, columns are SignacX)

knitr::kable(tabsignac, format = "html")
xx = Q$labels
xx[xx %in% c("Macrophage", "DC", "Monocyte", "Platelets", "Neutrophils")] = "M"
xx[xx %in% c("B_cell", "Pre-B_cell_CD34-", "Pro-B_cell_CD34+")] = "B"
xx[xx == "Fibroblasts"] = "F"
xx[xx == "T_cells"] = "T"
xx[xx %in% c("Astrocyte", "Osteoblasts", "Tissue_stem_cells", "Smooth_muscle_cells", "MSC")] = "NonImmune"
xx[xx == "NK_cell"] = "NK"
xx[xx == "Chondrocytes"] = "Chondr."
tab = table(FACs = True_labels, SingleR = xx)

SingleR (rows are FACs labels, columns are SingleR)

knitr::kable(tab, format = "html")

Note:

Signac accuracy

logik = xy != "Unclassified"
Signac_Accuracy = round(sum(xy[logik] == True_labels[logik]) / sum(logik) * 100, 2)
Signac_Accuracy

SingleR accuracy

SingleR_Accuracy = round(sum(xx == True_labels) / sum(logik) * 100, 2)
SingleR_Accuracy

Save results

saveRDS(synovium, file = "synovium_signac.rds")
saveRDS(celltypes, file = "synovium_signac_celltypes.rds")
write.csv(x = t(as.data.frame(all_times)), file = "fls/tutorial_times_signac-seurat_singler_AMP_RA.csv")

Session Info

sessionInfo()



mathewchamberlain/SignacX documentation built on March 3, 2023, 2:46 a.m.