Commit a4ce081d authored by Lars Velten's avatar Lars Velten
Browse files

vignettes now install correctly

parent 1ca3298b
......@@ -12,7 +12,7 @@ devtools::install_local("/path/to/rnamagnet_dir")
The vignette are still under seurat v2, but the functions work both with seurat v2 and seurat v3 objects.
To build the vignettes and make the demo data from our manuscript avaialable, please proceed as follows:
If you want to build the vignettes yourself or make the demo data from our manuscript avaialable, please proceed as follows:
* Download and unpack the tar.gz archive, e.g. to /path/to
* Then download our data bundle (2GB, containing all 10x and LCM data) from https://www.dropbox.com/s/wbnqaebqi74j5ic/RNAMagnetDataBundle.zip
* Move the content of the data bundle to the data/ folder of the package, e.g. /path/to/rnamagnet_dir/data
......
## ----setup, include = FALSE----------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## ---- echo = F-----------------------------------------------------------
NicheDataColors <-
c(Erythroblasts = "#bc7c7c", Chondrocytes = "#a6c7f7", Osteoblasts = "#0061ff",
`Fibro/Chondro p.` = "#70a5f9", `pro-B` = "#7b9696", `Arteriolar ECs` = "#b5a800",
`B cell` = "#000000", `large pre-B.` = "#495959", `Sinusoidal ECs` = "#ffee00",
Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "#567fba",
`Stromal fibro.` = "#465f82", `small pre-B.` = "#323d3d", `Adipo-CAR` = "#ffb556",
`Ng2+ MSCs` = "#ab51ff", Neutrophils = "#1f7700", `T cells` = "#915400",
`NK cells` = "#846232", `Schwann cells` = "#ff00fa", `Osteo-CAR` = "#ff0000",
`Dendritic cells` = "#44593c", Myofibroblasts = "#dddddd", Monocytes = "#8fff68",
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPC = "#c6f9a7")
## ---- echo =T, warning=F, message=F, fig.width=6,fig.height=4------------
require(RNAMagnet)
require(Seurat)
require(ggplot2)
n.pca <- prcomp(t(DESeq2::varianceStabilizingTransformation(as.matrix(NicheDataLCM)) ))
qplot(x = n.pca$x[,1], y = n.pca$x[,2], color = NicheMetaDataLCM$biological.class) + scale_color_discrete(name="Sample type") + xlab("PC1") + ylab("PC2")
outliers <- n.pca$x[,1] > 70 | n.pca$x[,2] < -40
remove <- colnames(NicheDataLCM)[outliers]
## ---- echo =T, warning=F, message=F, fig.width=4.5,fig.height=3.8--------
for (pop in c("Ery/Mk prog.","Neutro prog.","Mono prog.","Gran/Mono prog.","LMPPs","Mk prog.","Eo/Baso prog.","Ery prog.")) NicheData10x <- RenameIdent(NicheData10x, pop, "HSPC")
usegenes <- unique(NicheMarkers10x$gene[(NicheMarkers10x$myAUC > 0.8 |NicheMarkers10x$myAUC < 0.2) ])
mean_by_cluster <- do.call(cbind, lapply(unique(NicheData10x@ident), function(x) {
apply(NicheData10x@raw.data[usegenes,NicheData10x@cell.names][,NicheData10x@ident == x], 1,mean )
}))
colnames(mean_by_cluster) <- unique(NicheData10x@ident)
## ---- echo =T, warning=F, message=F, fig.width=4.5,fig.height=3.8--------
#character vector that maps column names of NicheDataLCM to sample type
LCM_design <- NicheMetaDataLCM$biological.class
names(LCM_design) <- NicheMetaDataLCM$id
CIBER <- runCIBERSORT(NicheDataLCM, mean_by_cluster, LCM_design, mc.cores=3)
head(CIBER)
## ---- echo =T, warning=F, message=F, fig.width=8,fig.height=6------------
CIBER <- subset(CIBER,CellType %in% c("Adipo-CAR","Ng2+ MSCs","Osteoblasts", "Arteriolar fibro.", "Sinusoidal ECs", "Osteo-CAR","Chondrocytes","Endosteal fibro.", "Fibro/Chondro p.", "Stromal fibro.", "Arteriolar ECs", "Smooth muscle") & !SampleID %in% remove)
labeler <- c("ARTERIES" = "Arteriolar", "ENDOSTEUM" = "Endosteal", "HIGH SINUSOIDS" = "Sinusoidal", "LOW SINUSOIDS" = "Non-vascular", "SUB-ENDOSTEUM" = "Sub-Endosteal", "Other" = "darkgrey")
ggplot(aes(x = SampleClass, y= Fraction,color = CellType),data=CIBER) + geom_point(stat="summary", fun.y=mean) + facet_wrap(~ CellType, scales="free_y") +
theme_bw(base_size=12) + theme(axis.text.x = element_text(angle=90, color="black"),axis.text.y = element_blank(), panel.grid = element_blank()) +
geom_errorbar(stat="summary", fun.ymin=function(x) mean(x)+sd(x)/sqrt(length(x)),fun.ymax=function(x) mean(x)-sd(x)/sqrt(length(x)), width=0.2) +
ylab("CIBERSORT estimate (a.u.)") + scale_color_manual(values = NicheDataColors, guide=F) + xlab("Niche") + scale_x_discrete(labels = labeler)
---
title: "CIBERSORT to decompose the composition of bone marrow niches"
author: "Vignette Author"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Vignette Title}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
```{r, echo = F}
NicheDataColors <-
c(Erythroblasts = "#bc7c7c", Chondrocytes = "#a6c7f7", Osteoblasts = "#0061ff",
`Fibro/Chondro p.` = "#70a5f9", `pro-B` = "#7b9696", `Arteriolar ECs` = "#b5a800",
`B cell` = "#000000", `large pre-B.` = "#495959", `Sinusoidal ECs` = "#ffee00",
Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "#567fba",
`Stromal fibro.` = "#465f82", `small pre-B.` = "#323d3d", `Adipo-CAR` = "#ffb556",
`Ng2+ MSCs` = "#ab51ff", Neutrophils = "#1f7700", `T cells` = "#915400",
`NK cells` = "#846232", `Schwann cells` = "#ff00fa", `Osteo-CAR` = "#ff0000",
`Dendritic cells` = "#44593c", Myofibroblasts = "#dddddd", Monocytes = "#8fff68",
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPC = "#c6f9a7")
```
## Unsupervised analysis
Object NicheDataLCM contains read counts of samples of microscopically defined niches. We first use PCA to have an unsupervised look at the data, and flag the two outliers driving PC1 and 2 for removal.
```{r, echo =T, warning=F, message=F, fig.width=6,fig.height=4}
require(RNAMagnet)
require(Seurat)
require(ggplot2)
n.pca <- prcomp(t(DESeq2::varianceStabilizingTransformation(as.matrix(NicheDataLCM)) ))
qplot(x = n.pca$x[,1], y = n.pca$x[,2], color = NicheMetaDataLCM$biological.class) + scale_color_discrete(name="Sample type") + xlab("PC1") + ylab("PC2")
outliers <- n.pca$x[,1] > 70 | n.pca$x[,2] < -40
remove <- colnames(NicheDataLCM)[outliers]
```
##CIBERSORT
Next, we used [!CIBERSORT](https://www.nature.com/articles/nmeth.3337) to decompose the "bulk" RNA-seq profiles from LCM-seq into the cell populations identified by single cell RNA sequencing. CIBERSORT is an algorithm for estimating the cell type composition of a bulk sample, given a gene expression profile of the sample and a known gene expression profile for each cell type potentially contributing to the sample. Mathematically, the expected expression level $x_j$ of gene $j$ in a bulk sample is the sum of cell type averages, $s_{ij}$, weighted by cell type fractions ai:
$$ x_j=\sum_i{a_i s_{ij}} $$
CIBERSORT uses support vector regression to robustly solve that well-defined system of linear equations. In our manuscript (supplementary note), we demonstrate that CIBERSORT excels at comparing relative cell type abundancies between niches (i.e. ???cell type X localizes to niche A over niche B and niche C???), but performs only moderately at estimating cell type proportions within a single niche (i.e. it cannot draw statements like ???niche A consists to 70% of cell type X and 30% of cell type Y???). It is therefore important to focus on analyses of the first type.
To set up CIBERSORT, we first comoute the population-wise mean expression of all marker genes. Since the different HSPC subpopulations are too similar to be reasonably distinguished by CIBERSORT, we merge them to one.
```{r, echo =T, warning=F, message=F, fig.width=4.5,fig.height=3.8}
for (pop in c("Ery/Mk prog.","Neutro prog.","Mono prog.","Gran/Mono prog.","LMPPs","Mk prog.","Eo/Baso prog.","Ery prog.")) NicheData10x <- RenameIdent(NicheData10x, pop, "HSPC")
usegenes <- unique(NicheMarkers10x$gene[(NicheMarkers10x$myAUC > 0.8 |NicheMarkers10x$myAUC < 0.2) ])
mean_by_cluster <- do.call(cbind, lapply(unique(NicheData10x@ident), function(x) {
apply(NicheData10x@raw.data[usegenes,NicheData10x@cell.names][,NicheData10x@ident == x], 1,mean )
}))
colnames(mean_by_cluster) <- unique(NicheData10x@ident)
```
...and we then run the function `runCIBERSORT`.
```{r, echo =T, warning=F, message=F, fig.width=4.5,fig.height=3.8}
#character vector that maps column names of NicheDataLCM to sample type
LCM_design <- NicheMetaDataLCM$biological.class
names(LCM_design) <- NicheMetaDataLCM$id
CIBER <- runCIBERSORT(NicheDataLCM, mean_by_cluster, LCM_design, mc.cores=3)
head(CIBER)
```
We can plot the result using standard R commands.
```{r, echo =T, warning=F, message=F, fig.width=8,fig.height=6}
CIBER <- subset(CIBER,CellType %in% c("Adipo-CAR","Ng2+ MSCs","Osteoblasts", "Arteriolar fibro.", "Sinusoidal ECs", "Osteo-CAR","Chondrocytes","Endosteal fibro.", "Fibro/Chondro p.", "Stromal fibro.", "Arteriolar ECs", "Smooth muscle") & !SampleID %in% remove)
labeler <- c("ARTERIES" = "Arteriolar", "ENDOSTEUM" = "Endosteal", "HIGH SINUSOIDS" = "Sinusoidal", "LOW SINUSOIDS" = "Non-vascular", "SUB-ENDOSTEUM" = "Sub-Endosteal", "Other" = "darkgrey")
ggplot(aes(x = SampleClass, y= Fraction,color = CellType),data=CIBER) + geom_point(stat="summary", fun.y=mean) + facet_wrap(~ CellType, scales="free_y") +
theme_bw(base_size=12) + theme(axis.text.x = element_text(angle=90, color="black"),axis.text.y = element_blank(), panel.grid = element_blank()) +
geom_errorbar(stat="summary", fun.ymin=function(x) mean(x)+sd(x)/sqrt(length(x)),fun.ymax=function(x) mean(x)-sd(x)/sqrt(length(x)), width=0.2) +
ylab("CIBERSORT estimate (a.u.)") + scale_color_manual(values = NicheDataColors, guide=F) + xlab("Niche") + scale_x_discrete(labels = labeler)
```
This diff is collapsed.
## ---- echo = T, message=F,warning=F--------------------------------------
require(RNAMagnet)
require(ggplot2)
ligrec <- getLigandsReceptors("1.0.0",cellularCompartment = c("ECM","Surface","Both"),manualAnnotation = "Correct")
head(ligrec)
## ---- echo = F-----------------------------------------------------------
NicheDataColors <-
c(Erythroblasts = "#bc7c7c", Chondrocytes = "#a6c7f7", Osteoblasts = "#0061ff",
`Fibro/Chondro p.` = "#70a5f9", `pro-B` = "#7b9696", `Arteriolar ECs` = "#b5a800",
`B cell` = "#000000", `large pre-B.` = "#495959", `Sinusoidal ECs` = "#ffee00",
Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "#567fba",
`Stromal fibro.` = "#465f82", `small pre-B.` = "#323d3d", `Adipo-CAR` = "#ffb556",
`Ng2+ MSCs` = "#ab51ff", Neutrophils = "#1f7700", `T cells` = "#915400",
`NK cells` = "#846232", `Schwann cells` = "#ff00fa", `Osteo-CAR` = "#ff0000",
`Dendritic cells` = "#44593c", Myofibroblasts = "#dddddd", Monocytes = "#8fff68",
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPCs = "#c6f9a7")
## ---- echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6--------
qplot(x = NicheData10x@dr$tsne@cell.embeddings[,1], y = NicheData10x@dr$tsne@cell.embeddings[,2], color =NicheData10x@ident) + scale_color_manual(values = NicheDataColors) + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
## ---- echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6--------
result <- RNAMagnetAnchors(NicheData10x, anchors = c("Sinusoidal ECs","Arteriolar ECs","Smooth muscle","Osteoblasts"), .version = "1.0.0")
## ---- echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6--------
head(result)
## ---- echo=TRUE, message =F, warning=F, fig.width=6, fig.height=4.5------
qplot(x =NicheData10x@dr$tsne@cell.embeddings[,1], y=NicheData10x@dr$tsne@cell.embeddings[,2], color = direction,size=I(0.75),alpha= adhesiveness,data=result) + scale_color_brewer(name = "RNAMagnet\nLocation",palette= "Set1") + scale_alpha_continuous(name = "RNAMagnet\nAdhesiveness") + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
## ---- echo=FALSE, message =F, warning=F, fig.width=4, fig.height=4.5-----
require(plyr)
require(reshape2)
require(pheatmap)
result$id <- NicheData10x@ident
summarised <- ddply(result, c("id"), summarise, RNAmagnet.score = table(direction) / length(direction), n = rep(length(direction),4), RNAmagnet.adhesiveness = rep(mean(adhesiveness),4), experiment = names(table(direction)))
castMagnet <- dcast(subset(summarised, RNAmagnet.adhesiveness > 35), id ~ experiment, value.var = "RNAmagnet.score")
rownames(castMagnet) <- castMagnet[,1]
castMagnet <- castMagnet[,-1]
castMagnet <- t(apply(castMagnet,1,function(x) (x-min(x)) / (max(x)-min(x))))
pheatmap(castMagnet, cluster_cols = F, annotation_legend = F, annotation_names_col = F, color = colorRampPalette(c("white","white","blue","red"))(100), fontsize=8, treeheight_row = 20)
---
title: "Infering physical interactions using RNAMagnet"
author: "Lars Velten"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{RNAMagnet for physical interactions}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
This vignette demonstrates the use of RNAMagnet for infering spatial co-localization in the context of data from the bone marrow niche. [A second vignette](rnamagnet-signaling.html) describes the use of RNAMagnet for signaling analyses.
Let's assume that our organ of interest has a number of **scaffold structures**. In the context of bone marrow, those would be arteriolar and sinusoidal blood vessels, as well as the 'endosteal' surface of the bone. These scaffolds can be defined by **anchor cell types**, i.e. cell types we know to define our scaffolds. In the context on bone marrow, those would be **sinusoidal endothelial cells (ECs)**, **arteriolar ECs**, and **osteoblasts**; **Smooth muscle cells**, which exclusively line arterioles, are a possible fourth anchor.
The idea behind of RNAMagnet is to identify, for each single cell from a dataset, which of these anchors it is most likely to bind to. Potential physical interactions between cells and anchors are scored based on the mutual expression level of receptors that bind to surface molecules expressed on a second cell (e.g. Selectin P ligand-Selectin P, or homophilic interactions of cadherins), or based on receptors binding to structural extracellular matrix components (e.g. Integrin a1b1-Collagen). We can retrieve the underlying receptor-ligand lists using `getLigandsReceptors`.
```{r, echo = T, message=F,warning=F}
require(RNAMagnet)
require(ggplot2)
ligrec <- getLigandsReceptors("1.0.0",cellularCompartment = c("ECM","Surface","Both"),manualAnnotation = "Correct")
head(ligrec)
```
## The data at hand
Let's familiarize ourselves with the dataset at hand: Our dataset contains 7497 cells from 32 populations and is stored as an object of class **seurat**.
```{r, echo = F}
NicheDataColors <-
c(Erythroblasts = "#bc7c7c", Chondrocytes = "#a6c7f7", Osteoblasts = "#0061ff",
`Fibro/Chondro p.` = "#70a5f9", `pro-B` = "#7b9696", `Arteriolar ECs` = "#b5a800",
`B cell` = "#000000", `large pre-B.` = "#495959", `Sinusoidal ECs` = "#ffee00",
Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "#567fba",
`Stromal fibro.` = "#465f82", `small pre-B.` = "#323d3d", `Adipo-CAR` = "#ffb556",
`Ng2+ MSCs` = "#ab51ff", Neutrophils = "#1f7700", `T cells` = "#915400",
`NK cells` = "#846232", `Schwann cells` = "#ff00fa", `Osteo-CAR` = "#ff0000",
`Dendritic cells` = "#44593c", Myofibroblasts = "#dddddd", Monocytes = "#8fff68",
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPCs = "#c6f9a7")
```
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6}
qplot(x = NicheData10x@dr$tsne@cell.embeddings[,1], y = NicheData10x@dr$tsne@cell.embeddings[,2], color =NicheData10x@ident) + scale_color_manual(values = NicheDataColors) + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
```
## Running RNAMagnet for physical interactions
Simply run `RNAMagnetAnchors`:
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6}
result <- RNAMagnetAnchors(NicheData10x, anchors = c("Sinusoidal ECs","Arteriolar ECs","Smooth muscle","Osteoblasts"), .version = "1.0.0")
```
The result is a dataframe that contains
* The anchor population that a cell is most specifically interacting with ('direction')
* The overall strength of the interaction ('adhesiveness')
* Specificity scores for interaction with each of the anchor populations.
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6}
head(result)
```
The result can easily be highlighted on a t-SNE...
```{r, echo=TRUE, message =F, warning=F, fig.width=6, fig.height=4.5}
qplot(x =NicheData10x@dr$tsne@cell.embeddings[,1], y=NicheData10x@dr$tsne@cell.embeddings[,2], color = direction,size=I(0.75),alpha= adhesiveness,data=result) + scale_color_brewer(name = "RNAMagnet\nLocation",palette= "Set1") + scale_alpha_continuous(name = "RNAMagnet\nAdhesiveness") + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
```
...or we can compute population-level summaries, maybe after subsetting for popualtions that have a certain level of adhesiveness:
```{r, echo=FALSE, message =F, warning=F, fig.width=4, fig.height=4.5}
require(plyr)
require(reshape2)
require(pheatmap)
result$id <- NicheData10x@ident
summarised <- ddply(result, c("id"), summarise, RNAmagnet.score = table(direction) / length(direction), n = rep(length(direction),4), RNAmagnet.adhesiveness = rep(mean(adhesiveness),4), experiment = names(table(direction)))
castMagnet <- dcast(subset(summarised, RNAmagnet.adhesiveness > 35), id ~ experiment, value.var = "RNAmagnet.score")
rownames(castMagnet) <- castMagnet[,1]
castMagnet <- castMagnet[,-1]
castMagnet <- t(apply(castMagnet,1,function(x) (x-min(x)) / (max(x)-min(x))))
pheatmap(castMagnet, cluster_cols = F, annotation_legend = F, annotation_names_col = F, color = colorRampPalette(c("white","white","blue","red"))(100), fontsize=8, treeheight_row = 20)
```
As we detail in our manuscript and in the [CIBERSORT vignette](cibersort.html), these assignments are confirmed by the analysis of LCM-seq data, and micropscopy.
This diff is collapsed.
## ---- echo = T, message=F,warning=F--------------------------------------
require(RNAMagnet)
require(ggplot2)
ligrec <- getLigandsReceptors("1.0.0",cellularCompartment = c("Secreted","Both"),manualAnnotation = "Correct")
head(ligrec)
## ---- echo = F-----------------------------------------------------------
NicheDataColors <-
c(Erythroblasts = "#bc7c7c", Chondrocytes = "#a6c7f7", Osteoblasts = "#0061ff",
`Fibro/Chondro p.` = "#70a5f9", `pro-B` = "#7b9696", `Arteriolar ECs` = "#b5a800",
`B cell` = "#000000", `large pre-B.` = "#495959", `Sinusoidal ECs` = "#ffee00",
Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "#567fba",
`Stromal fibro.` = "#465f82", `small pre-B.` = "#323d3d", `Adipo-CAR` = "#ffb556",
`Ng2+ MSCs` = "#ab51ff", Neutrophils = "#1f7700", `T cells` = "#915400",
`NK cells` = "#846232", `Schwann cells` = "#ff00fa", `Osteo-CAR` = "#ff0000",
`Dendritic cells` = "#44593c", Myofibroblasts = "#dddddd", Monocytes = "#8fff68",
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPCs = "#c6f9a7")
## ---- echo=TRUE, message =F, warning=F, fig.width=8, fig.height=5--------
qplot(x = NicheData10x@dr$tsne@cell.embeddings[,1], y = NicheData10x@dr$tsne@cell.embeddings[,2], color =NicheData10x@ident) + scale_color_manual(values = NicheDataColors) + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
## ---- echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6--------
result <- RNAMagnetSignaling(NicheData10x, .version = "1.0.0")
## ---- echo=TRUE, message =F, warning=F, fig.width=6, fig.height=4.5------
qplot(x =NicheData10x@dr$tsne@cell.embeddings[,1], y=NicheData10x@dr$tsne@cell.embeddings[,2], color = result@specificity[,"Adipo-CAR"] ,size=I(0.75)) + scale_color_gradientn(name = "Strength of signal\nfrom Adipo-CAR",colours = c("black","blue","red")) + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
## ---- echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6--------
PlotSignalingNetwork(result, threshold = 0.01)
## ---- echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6--------
getRNAMagnetGenes(result, "Osteo-CAR", "pro-B")
---
title: "Infering signaling interactions using RNAMagnet"
author: "Lars Velten"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{RNAMagnet for signaling interactions}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
This vignette demonstrates the use of RNAMagnet for infering putative signaling interactinos in the context of data from the bone marrow niche. [A second vignette](rnamagnet-physical.html) describes the use of RNAMagnet for analyzing cellular co-localization and physical cell-cell interactions.
The idea behind of RNAMagnet is to identify, for each single cell from a dataset, which cell population this cell is particularly likely to interact with. Potential signaling interactions between cells and anchors are scored based on the mutual expression level of ligands and their cognate receptors. We can retrieve the underlying receptor-ligand lists using `getLigandsReceptors`.
```{r, echo = T, message=F,warning=F}
require(RNAMagnet)
require(ggplot2)
ligrec <- getLigandsReceptors("1.0.0",cellularCompartment = c("Secreted","Both"),manualAnnotation = "Correct")
head(ligrec)
```
## The data at hand
Let's familiarize ourselves with the dataset at hand: Our dataset contains 7497 cells from 32 populations and is stored as an object of class **seurat**.
```{r, echo = F}
NicheDataColors <-
c(Erythroblasts = "#bc7c7c", Chondrocytes = "#a6c7f7", Osteoblasts = "#0061ff",
`Fibro/Chondro p.` = "#70a5f9", `pro-B` = "#7b9696", `Arteriolar ECs` = "#b5a800",
`B cell` = "#000000", `large pre-B.` = "#495959", `Sinusoidal ECs` = "#ffee00",
Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "#567fba",
`Stromal fibro.` = "#465f82", `small pre-B.` = "#323d3d", `Adipo-CAR` = "#ffb556",
`Ng2+ MSCs` = "#ab51ff", Neutrophils = "#1f7700", `T cells` = "#915400",
`NK cells` = "#846232", `Schwann cells` = "#ff00fa", `Osteo-CAR` = "#ff0000",
`Dendritic cells` = "#44593c", Myofibroblasts = "#dddddd", Monocytes = "#8fff68",
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPCs = "#c6f9a7")
```
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=5}
qplot(x = NicheData10x@dr$tsne@cell.embeddings[,1], y = NicheData10x@dr$tsne@cell.embeddings[,2], color =NicheData10x@ident) + scale_color_manual(values = NicheDataColors) + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
```
## Running RNAMagnet for signaling interactions
Simply run `RNAMagnetSignanling`:
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6}
result <- RNAMagnetSignaling(NicheData10x, .version = "1.0.0")
```
The result is an object of class `rnamagnet`. The `specificty` slot of this object contains a numerical value for each single cell describing the propensity of that cell to receive signals from the 32 different cell types; see `?RNAMagnetBase` for a description of the underlying algorithm. We can plot these data to visualize e.g. the ability of different cells to receive signals from Adipo-CAR cells:
```{r, echo=TRUE, message =F, warning=F, fig.width=6, fig.height=4.5}
qplot(x =NicheData10x@dr$tsne@cell.embeddings[,1], y=NicheData10x@dr$tsne@cell.embeddings[,2], color = result@specificity[,"Adipo-CAR"] ,size=I(0.75)) + scale_color_gradientn(name = "Strength of signal\nfrom Adipo-CAR",colours = c("black","blue","red")) + theme_bw() + theme(panel.grid = element_blank(), axis.text = element_blank(), axis.title = element_blank())
```
...or we can summarise these scores at the level of cell types, and draw a network representation.
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6}
PlotSignalingNetwork(result, threshold = 0.01)
```
To have a closer look at the molecules mediating the interactions, we can use the function `getRNAMagnetGenes`.
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6}
getRNAMagnetGenes(result, "Osteo-CAR", "pro-B")
```
This diff is collapsed.
......@@ -4,7 +4,7 @@ author: "Vignette Author"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Vignette Title}
%\VignetteIndexEntry{CIBERSORT}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
......@@ -54,7 +54,7 @@ remove <- colnames(NicheDataLCM)[outliers]
Next, we used [!CIBERSORT](https://www.nature.com/articles/nmeth.3337) to decompose the "bulk" RNA-seq profiles from LCM-seq into the cell populations identified by single cell RNA sequencing. CIBERSORT is an algorithm for estimating the cell type composition of a bulk sample, given a gene expression profile of the sample and a known gene expression profile for each cell type potentially contributing to the sample. Mathematically, the expected expression level $x_j$ of gene $j$ in a bulk sample is the sum of cell type averages, $s_{ij}$, weighted by cell type fractions ai:
$$ x_j=\sum_i{a_i s_{ij}} $$
CIBERSORT uses support vector regression to robustly solve that well-defined system of linear equations. In our manuscript (supplementary note), we demonstrate that CIBERSORT excels at comparing relative cell type abundancies between niches (i.e. cell type X localizes to niche A over niche B and niche C), but performs only moderately at estimating cell type proportions within a single niche (i.e. it cannot draw statements like niche A consists to 70% of cell type X and 30% of cell type Y). It is therefore important to focus on analyses of the first type.
CIBERSORT uses support vector regression to robustly solve that well-defined system of linear equations. In our manuscript (supplementary note), we demonstrate that CIBERSORT excels at comparing relative cell type abundancies between niches (i.e. ???cell type X localizes to niche A over niche B and niche C???), but performs only moderately at estimating cell type proportions within a single niche (i.e. it cannot draw statements like ???niche A consists to 70% of cell type X and 30% of cell type Y???). It is therefore important to focus on analyses of the first type.
To set up CIBERSORT, we first comoute the population-wise mean expression of all marker genes. Since the different HSPC subpopulations are too similar to be reasonably distinguished by CIBERSORT, we merge them to one.
......
......@@ -40,7 +40,7 @@ Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPCs = "#c6f9a7")
HSPC = "#c6f9a7")
```
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=6}
......
......@@ -38,7 +38,7 @@ Fibroblasts = "#70a5f9", `Endosteal fibro.` = "#264570", `Arteriolar fibro.` = "
`Smooth muscle` = "#ff2068", `Ery prog.` = "#f9a7a7", `Mk prog.` = "#f9e0a7",
`Ery/Mk prog.` = "#f9cda7", `Gran/Mono prog.` = "#e0f9a7", `Neutro prog.` = "#c6f9a7",
`Mono prog.` = "#f4f9a7", LMPPs = "#a7f9e9", `Eo/Baso prog.` = "#a7b7f9",
HSPCs = "#c6f9a7")
HSPC = "#c6f9a7")
```
```{r, echo=TRUE, message =F, warning=F, fig.width=8, fig.height=5}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment