## ---- echo=FALSE, results="hide", message=FALSE------------------------------- knitr::opts_chunk$set(error=FALSE, message=FALSE, warning=FALSE) library(BiocStyle) ## ----------------------------------------------------------------------------- library(SingleR) hpca.se <- HumanPrimaryCellAtlasData() hpca.se ## ----------------------------------------------------------------------------- library(scRNAseq) hESCs <- LaMannoBrainData('human-es') hESCs <- hESCs[,1:100] # SingleR() expects log-counts, but the function will also happily take raw # counts for the test dataset. The reference, however, must have log-values. library(scater) hESCs <- logNormCounts(hESCs) ## ----------------------------------------------------------------------------- pred.hesc <- SingleR(test = hESCs, ref = hpca.se, labels = hpca.se$label.main) pred.hesc ## ----------------------------------------------------------------------------- table(pred.hesc$labels) ## ----------------------------------------------------------------------------- library(scRNAseq) sceM <- MuraroPancreasData() # One should normally do cell-based quality control at this point, but for # brevity's sake, we will just remove the unlabelled libraries here. sceM <- sceM[,!is.na(sceM$label)] sceM <- logNormCounts(sceM) ## ----------------------------------------------------------------------------- sceG <- GrunPancreasData() sceG <- sceG[,colSums(counts(sceG)) > 0] # Remove libraries with no counts. sceG <- logNormCounts(sceG) sceG <- sceG[,1:100] ## ----------------------------------------------------------------------------- pred.grun <- SingleR(test=sceG, ref=sceM, labels=sceM$label, de.method="wilcox") table(pred.grun$labels) ## ----------------------------------------------------------------------------- plotScoreHeatmap(pred.grun) ## ----------------------------------------------------------------------------- plotScoreHeatmap(pred.grun, annotation_col=as.data.frame(colData(sceG)[,"donor",drop=FALSE])) ## ----------------------------------------------------------------------------- to.remove <- pruneScores(pred.grun) summary(to.remove) ## ----------------------------------------------------------------------------- plotScoreDistribution(pred.grun, show = "delta.med", ncol = 3, show.nmads = 3) ## ----------------------------------------------------------------------------- new.pruned <- pred.grun$labels new.pruned[pruneScores(pred.grun, nmads=5)] <- NA table(new.pruned, useNA="always") ## ----------------------------------------------------------------------------- all.markers <- metadata(pred.grun)$de.genes sceG$labels <- pred.grun$labels # Beta cell-related markers plotHeatmap(sceG, order_columns_by="labels", features=unique(unlist(all.markers$beta))) ## ---- fig.show="hide"--------------------------------------------------------- for (lab in unique(pred.grun$labels)) { plotHeatmap(sceG, order_columns_by=list(I(pred.grun$labels)), features=unique(unlist(all.markers[[lab]]))) } ## ---- echo=FALSE, message=FALSE----------------------------------------------- library(knitr) library(SingleR) ref <- BlueprintEncodeData() samples <- cbind(ref$label.main, ref$label.fine) colnames(samples) <- c("label.main", "label.fine") kable(unique(samples), format = "markdown") ## ---- echo=FALSE, message=FALSE----------------------------------------------- library(knitr) library(SingleR) ref <- HumanPrimaryCellAtlasData() samples <- cbind(ref$label.main, ref$label.fine) colnames(samples) <- c("label.main", "label.fine") kable(unique(samples), format = "markdown") ## ---- echo=FALSE, message=FALSE----------------------------------------------- library(knitr) library(SingleR) ref <- DatabaseImmuneCellExpressionData() samples <- cbind(ref$label.main, ref$label.fine) colnames(samples) <- c("label.main", "label.fine") kable(unique(samples), format = "markdown") ## ---- echo=FALSE, message=FALSE----------------------------------------------- library(knitr) library(SingleR) ref <- NovershternHematopoieticData() samples <- cbind(ref$label.main, ref$label.fine) colnames(samples) <- c("label.main", "label.fine") kable(unique(samples), format = "markdown") ## ---- echo=FALSE, message=FALSE----------------------------------------------- library(knitr) library(SingleR) ref <- MonacoImmuneData() samples <- cbind(ref$label.main, ref$label.fine) colnames(samples) <- c("label.main", "label.fine") kable(unique(samples), format = "markdown") ## ---- echo=FALSE, message=FALSE----------------------------------------------- library(knitr) library(SingleR) ref <- ImmGenData() samples <- cbind(ref$label.main, ref$label.fine) colnames(samples) <- c("label.main", "label.fine") kable(unique(samples), format = "markdown") ## ---- echo=FALSE, message=FALSE----------------------------------------------- library(knitr) library(SingleR) ref <- MouseRNAseqData() samples <- cbind(ref$label.main, ref$label.fine) colnames(samples) <- c("label.main", "label.fine") kable(unique(samples), format = "markdown") ## ----------------------------------------------------------------------------- set.seed(100) # for the k-means step. aggr <- aggregateReference(sceM, labels=sceM$label) aggr ## ----------------------------------------------------------------------------- pred.aggr <- SingleR(sceG, aggr, labels=aggr$label) table(pred.aggr$labels) ## ----------------------------------------------------------------------------- bp.se <- BlueprintEncodeData() pred.combined <- SingleR(test = hESCs, ref = list(BP=bp.se, HPCA=hpca.se), labels = list(bp.se$label.main, hpca.se$label.main)) ## ----------------------------------------------------------------------------- table(pred.combined$labels) ## ---- fig.wide=TRUE, fig.asp=1------------------------------------------------ matched <- matchReferences(bp.se, hpca.se, bp.se$label.main, hpca.se$label.main) pheatmap::pheatmap(matched, col=viridis::plasma(100)) ## ----------------------------------------------------------------------------- common <- intersect(rownames(hESCs), rownames(hpca.se)) trained <- trainSingleR(hpca.se[common,], labels=hpca.se$label.main) pred.hesc2 <- classifySingleR(hESCs[common,], trained) table(pred.hesc$labels, pred.hesc2$labels) ## ----------------------------------------------------------------------------- library(scran) out <- pairwiseTTests(logcounts(sceM), sceM$label, direction="up") markers <- getTopMarkers(out$statistics, out$pairs, n=10) ## ----------------------------------------------------------------------------- pred.grun2 <- SingleR(test=sceG, ref=sceM, labels=sceM$label, genes=markers) table(pred.grun2$labels) ## ----------------------------------------------------------------------------- label.markers <- lapply(markers, unlist, recursive=FALSE) pred.grun3 <- SingleR(test=sceG, ref=sceM, labels=sceM$label, genes=label.markers) table(pred.grun$labels, pred.grun3$labels) ## ----------------------------------------------------------------------------- sessionInfo()