## ---- 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()

