Use the signatures declared in the Seurat tutorial to identify the proportion of each cluster positive for each signature.

Seurat_PBMC3k_proportion_signatures_per_cluster.Rmd

---
title: "Proportion of cells matching signatures"
author: "Kevin Rue-Albrecht"
date: "25/11/2018"
output: html_document
editor_options: 
  chunk_output_type: console
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
suppressPackageStartupMessages({
    library(BiocFileCache)
    library(S4Vectors)
    library(knitr)
    library(ComplexHeatmap)
})
```

Load the preprocessed SingleCellExperiment object of 10x PBMC 3k

```{r}
bfc <- BiocFileCache()
rpath <- subset(bfcinfo(bfc), rname == "sce_pbmc3k", "rpath", drop=TRUE)
sce <- readRDS(rpath)
sce
```

Define the signatures used in the tutorial

```{r}
markers <- list(
    "CD4 T cells" = c("IL7R"),
    "CD14+ Monocytes" = c("CD14", "LYZ"),
    "B cells" = c("MS4A1"),
    "CD8 T cells" = c("CD8A"),
    "FCGR3A+ Monocytes" = c("FCGR3A", "MS4A7"),
    "NK cells" = c("GNLY", "NKG7"),
    "Dendritic Cells" = c("FCER1A", "CST3"),
    "Megakaryocytes" = c("PPBP")
)
```

Identify the complete list of markers used across all signatures above.
Act as if the markers above could be overlapping, even though they're not.

```{r}
markers_unique <- unique(unlist(markers))
stopifnot(all(markers_unique %in% rownames(sce)))
```

Identify the cells positive for each marker

```{r}
isGeneDetected <- function(gene, sce, threshold=0, assay="counts") {
    cellsDetected <- assay(sce, assay)[gene, ] > threshold
    cellsDetected
}
makeMarkerDetectionMatrix <- function(sce, markers, threshold=0, assay="counts") {
    detectedMarkers <- matrix(
        data=FALSE,
        nrow=ncol(sce), ncol=length(markers),
        dimnames=list(colnames(sce), markers))
    for (gene in markers) {
        detectedMarkers[, gene] <- isGeneDetected(gene, sce, threshold, assay)
    }
    detectedMarkers
}
markerDetectionMatrix <- makeMarkerDetectionMatrix(sce, markers_unique)
```

Use filter rules to identify cells matching each signature

```{r}
filts <- lapply(
    names(markers),
    function(x){ parse(text=paste(markers[[x]], collapse="&")) }
)
names(filts) <- names(markers)
filters <- FilterRules(filts)
es <- evalSeparately(filters, as.data.frame(markerDetectionMatrix))
```

Tabulate the proportion of cells displaying each signature in each cluster

```{r}
proportionSignatureByCluster <- matrix(
    data=FALSE,
    nrow=nlevels(sce$ident), ncol=length(filts),
    dimnames=list(levels(sce$ident), names(filts)))
numberCellsInCluster <- table(colData(sce)[, "ident"])
for (cellTypeName in names(filts)) {
    countSignatureInCluster <- table(colData(sce)[, "ident"], es[, cellTypeName])[, "TRUE"]
    proportionSignatureByCluster[, cellTypeName] <- countSignatureInCluster / numberCellsInCluster
}
kable(proportionSignatureByCluster * 100, digits = 1)
```

Visualize the result as a heat map.
See how the diagonal (displaying the tutorial annotations) shows high proportions of cells matching the annotated signature.

```{r}
colnames(proportionSignatureByCluster) <- paste(
    colnames(proportionSignatureByCluster),
    lapply(markers, paste, collapse = ","),
    sep="\n"
)
Heatmap(matrix = t(proportionSignatureByCluster), cluster_rows = FALSE, cluster_columns = FALSE)
```

Let signatures and clusters of cells cluster in the heat map.
Unsurprisingly, the clusters annotated as "CD14+ Monocytes" and "FCGR3A+ Monocytes" show some similarity, as do the clusters annotated as "CD4 T cells" and "CD8 T cells".

```{r}
Heatmap(matrix = t(proportionSignatureByCluster))
```