westerlund is a toolkit for single-cell RNA-sequencing analysis built on top of Seurat providing functions to quickly and comprehensively assess clustering results. Inspired by many publications and prior packages (highlighted below), westerlund enables data sketching, cluster bootstrapping, automatic and assisted resolution scanning, and metric visualizations.
westerlund utilizes many ideas and functions developed and published by wonderful researchers cited here and within functions. Please cite original and derivative work if possible and deemed appropriate. If you come across work within this package that is derivative but not appropriately cited, please contact us right away so we can include that documentation.
westerlund ?The functions within westerlund provide additional critical functionality for common single-cell analyses that have been implemented in a range of outstanding publications. ✔️ indicate completed implementation. Functions include:
leidenbase algorithm by the Trapnell Lab,future framework,These functions are plug and play with Seurat objects and can enable easy expansion of available scRNA-seq analytical tools.
library(tidyverse)
library(Seurat)
library(SeuratData)
library(westerlund)
#SeuratData::InstallData("pbmc3k")
#SeuratData::InstalledData()
object <- SeuratData::LoadData("pbmc3k")
object <- UpdateSeuratObject(object)
object$seurat_annotations <- as.character(object$seurat_annotations)
object$seurat_annotations[is.na(object$seurat_annotations)] <- "Unassigned"
Idents(object) <- "seurat_annotations"
object <- ReduceDims(seurat.obj = object, n.var.features = 3000, n.pcs = 50, remove.genes = NULL)
object <- Seurat::RunUMAP(object = object, reduction = "pca", reduction.name = "pca_umap",
dims = 1:object@misc$pca_metrics$tp_pc, seed.use = 1, verbose = FALSE)
# plotting
plot <- DimPlot(object, reduction = "pca_umap", group.by = "seurat_annotations", pt.size = 1, shuffle = TRUE, label = FALSE, label.size = 6, repel = TRUE)
plot + theme_classic(base_size = 18) +
#NoLegend() +
RemoveAxes() + RemoveBackgrounds(outline = FALSE) + SpaceAxesTitles() +
colorspace::scale_color_discrete_qualitative("Dark 3") +
labs(x = "UMAP1", y = "UMAP2", title = "")
object$cell_type <- object$seurat_annotations
object$cell_lineage <- recode(object$cell_type, `CD14+ Mono` = "Myeloid", DC = "Myeloid", `FCGR3A+ Mono` = "Myeloid",
`CD8 T` = "TNK", `Memory CD4 T` = "TNK", `Naive CD4 T` = "TNK", NK = "TNK")
DimPlot(object, reduction = "pca_umap", group.by = "cell_lineage", pt.size = 1, shuffle = TRUE, label = FALSE, label.size = 6, repel = TRUE)
# marker identification
markers <- DefineMarkers(object, "seurat_annotations")
object@misc$markers <- markers
# module scoring
Bcell_markers <- markers %>% filter(group == "B") %>% top_n(100, auc) %>% pull(feature)
object <- AddModuleScoreScaled(object, list(Bcell_markers), name = "SMS")
object <- AddModuleScore(object, list(Bcell_markers), name = "MS", nbin = 20, ctrl = 100)
#object@meta.data[, grep("^MS|^SMS", colnames(object[[]]))] <- NULL
colnames(object@meta.data)[grep("^MS", colnames(object[[]]))] <- "B_unscaled_score"
colnames(object@meta.data)[grep("^SMS", colnames(object[[]]))] <- "B_scaled_score"
FeatureScatter(object, "B_unscaled_score", "B_scaled_score", span = T, smooth = F)
# save object
usethis::use_data(object, overwrite = TRUE)
saveRDS(object, "data/pbmc3k_processed.rds")
anno_df <- object[[]] %>% select(cell_lineage, cell_type) %>% distinct()
anno <- anno_df$cell_type
names(anno) <- anno_df$cell_lineage
input_data <- GetAssayData(object, slot = "counts")
TP10K <- sweep(input_data, 2, object$nCount_RNA, '/')*10000
contam <- DetectAmbientRNA(data = TP10K,
lineages = object$cell_lineage,
types = object$cell_type,
batches = object$orig.ident,
anno = NULL)
tnk_model <- contam$lineage_models$TNK
p <- PlotAmbientRNA(u1 = tnk_model$u1, u2 = tnk_model$u2, coefs = tnk_model$coefs,
residuals = tnk_model$residuals, fit.cutoff = 2, genes_fit = tnk_model$lab.fit,
label_n = 10)
p
gene <- "AIF1"
object <- schex::make_hexbin(object, nbins = sqrt(ncol(object)), dimension_reduction = "pca_umap")
schex::plot_hexbin_gene(object, type = "data", gene = gene, action = "median") +
labs(x = "UMAP1", y = "UMAP2", title = gene) +
scale_fill_continuous(low = "gray75",
high = colorspace::sequential_hcl(palette = "Reds", n = 5)[1], name = "Median\nlog(TP10K+1)") +
theme_classic(base_size = 18) + RemoveAxes() + RemoveBackgrounds() + SpaceAxesTitles()
FeaturePlot(object, gene, cols = c("gray75", colorspace::sequential_hcl(palette = "Reds", n = 5)[1]), order = TRUE) +
RemoveAxes() + RemoveBackgrounds(outline = FALSE) + SpaceAxesTitles() + labs(x = "UMAP1", y = "UMAP2")
OutlinedDotPlot(object, features = tnk_model$lab.con[1:10], cols = c("gray80", "black")) +
coord_flip() + RotatedAxis() + labs(x = "Type", y = "Gene") + SpaceAxesTitles() + RemoveBackgrounds(outline = TRUE)