## Options for Rmarkdown compilation knitr::opts_chunk$set( fig.width = 7, fig.height = 5, fig.align = "center", collapse = TRUE, crop = NULL ) ## Time the compilation timeStart <- Sys.time()
In this vignette, we will analyse the schoof2021
dataset using the
scplainer approach. The
data were acquired using the SCoPE2-derived acquisition protocol
(Schoof et al. 2021).
Single cells were labelled with TMT-16 and
MS data were acquired in DDA mode. The objective of the study was to
show that mass spectrometry-based single-cell proteomics can
effectively characterised the hierarchy of cellular differentiation in
an accute myleoid leukemia model (AML).
We rely on several packages to compile this vignette.
## Core packages library("scp") library("scpdata") library("SingleCellExperiment") ## Utility packages library("ggplot2") library("patchwork") library("dplyr") library("ensembldb") library("EnsDb.Hsapiens.v86") library("destiny") library("scater") library("plotly")
The data set is available from the scpdata
package.
schoof <- schoof2021()
The data set consists of four cell types as identied by upstream flow cytometry: leukemic stem cells (LSC), progenitor cells (PROG), CD38 positive blast cells (BLAST CD38+) and CD38 negative blast cells (BLAST CD38-).
table(schoof$Population)
The dataset contains booster samples (also called carrier samples), empty wells, negative control samples, normalisation samples and single cells.
table(schoof$SampleType)
The data were acquired using TMT-16 labelling.
table(schoof$Channel)
The data were acquired as part of 192 MS acquisition batches.
length(levels(schoof$File.ID))
Finally, samples were prepared through 8 sample preparation batches performed in 384-well plates.
table(schoof$Plate)
The minimal data processing workflow in scplainer consists of 5 main steps:
We remove the protein assays that were processed by the authors. The vignette only uses the PTM data generated by Proteome Discoverer.
schoof <- removeAssay(schoof, c("proteins", "logNormProteins"))
We remove feature annotations that won't be used in the remainder of the vignette. This is to avoid overcrowding of the annotation tables later in the vignette.
requiredRowData <- c( "Annotated.Sequence", "isContaminant", "Master.Protein.Accessions", "Isolation.Interference.in.Percent", "Percolator.q.Value" ) schoof <- selectRowData(schoof, requiredRowData)
We replace zeros by missing values. A zero may be a true (the feature
is not present in the sample) or because of technical limitations (due
to the technology or the computational pre-processing). Because we are
not able to distinguish between the two, zeros should be replaced with
NA
.
schoof <- zeroIsNA(schoof, i = names(schoof))
We remove low-quality PSMs that may propagate technical artefacts and bias data modelling. The quality control criteria are:
All the criteria were readily computed except for the
sample-to-carrier ratio. We compute this using computeSCR()
.
The results are stored in the rowData
.
schoof <- computeSCR( schoof, names(schoof), colvar = "SampleType", samplePattern = "sc", carrierPattern = "^boost", sampleFUN = "mean", rowDataName = "MeanSCR" )
Here is an overview of the distributions of each criteria
df <- data.frame(rbindRowData(schoof, names(schoof))) ggplot(df) + aes(x = isContaminant) + geom_bar() + ## PIF plot ggplot(df) + aes(x = Isolation.Interference.in.Percent) + geom_histogram() + ## q-value plot ggplot(df) + aes(x = log10(Percolator.q.Value)) + geom_histogram() + ## mean SCR plot ggplot(df) + aes(x = log10(MeanSCR)) + geom_histogram()
We filter and keep the features that pass the quality control criteria.
schoof <- filterFeatures( schoof, ~ Percolator.q.Value < 0.01 & !isContaminant & Master.Protein.Accessions != "" & Isolation.Interference.in.Percent < 30 & !is.na(MeanSCR) & MeanSCR < 0.2 )
Similarly to the features, we also remove low-quality cells. The quality control criteria are:
schoof <- countUniqueFeatures( schoof, i = names(schoof), groupBy = "Annotated.Sequence", colDataName = "NumberPeptides" )
MedianIntensity <- lapply(experiments(schoof), function(x) { out <- colMedians(log(assay(x)), na.rm = TRUE) names(out) <- colnames(x) out }) names(MedianIntensity) <- NULL MedianIntensity <- unlist(MedianIntensity) colData(schoof)[names(MedianIntensity), "MedianIntensity"] <- MedianIntensity
schoof <- medianCVperCell( schoof, i = names(schoof), groupBy = "Master.Protein.Accessions", nobs = 3, na.rm = TRUE, colDataName = "MedianCV", norm = "SCoPE2" )
We plot the metrics used to perform sample quality control.
ggplot(data.frame(colData(schoof))) + aes( y = MedianIntensity, x = NumberPeptides, color = MedianCV, shape = SampleType ) + geom_point(size = 2) + scale_color_continuous(type = "viridis")
We apply the filter and keep only single cells that pass the quality control.
passQC <- !is.na(schoof$MedianCV) & schoof$MedianCV < 0.4 & schoof$MedianIntensity < 3 & schoof$NumberPeptides > 1200 & schoof$SampleType == "sc" schoof <- subsetByColData(schoof, passQC) schoof <- dropEmptyAssays(schoof)
For now, each MS acquisition run is stored separately in an assay. We here combine these assays in one. The issue is that PSMs are specific to each run. We therefore aggregate the PSMs into peptides.
peptideAssays <- paste0("peptides_", names(schoof)) schoof <- aggregateFeatures( schoof, i = names(schoof), fcol = "Annotated.Sequence", name = peptideAssays, fun = colMedians, na.rm = TRUE )
The data can now be joined.
schoof <- joinAssays(schoof, i = peptideAssays, name = "peptides")
Finally, we also convert Uniprot protein identifiers to gene symbols.
proteinIds <- rowData(schoof)[["peptides"]][, "Master.Protein.Accessions"] ## Unlist protein groups proteinIds <- unlist(sapply(proteinIds, function(x) { strsplit(x, "; ")[[1]] }, USE.NAMES = FALSE)) ## Rename splice isoform number to canonical protein proteinIds <- unique(sub("[-]\\d*$", "", proteinIds)) ## Convert uniprot IDs to gene names convert <- transcripts( EnsDb.Hsapiens.v86, columns = "gene_name", return.type = "data.frame", filter = UniprotFilter(proteinIds) ) ## Convert the protein groups into gene group geneNames <- sapply(rowData(schoof)[["peptides"]]$Master.Protein.Accessions, function(x) { out <- strsplit(x, "; ")[[1]] out <- sapply(out, function(xx) { gene <- convert$gene_name[convert$uniprot_id == sub("[-]\\d*$", "", xx)] if (!length(gene)) return(NA) unique(gene) }) paste(out, collapse = "; ") }) rowData(schoof)[["peptides"]]$Gene <- unname(geneNames) head(rowData(schoof)[["peptides"]][, "Master.Protein.Accessions"]) head(rowData(schoof)[["peptides"]][, "Gene"])
We log2-transform the quantification data.
schoof <- logTransform(schoof, i = "peptides", name = "peptides_log")
Here is an overview of the data processing:
plot(schoof)
Model the data using scplainer, the linear regression model implemented in scp
.
scplainer is applied on a SingleCellExperiment
so we extract it from
the processed data set along with the colData
sce <- getWithColData(schoof, "peptides_log")
First, we must specify which variables to include in the model. We here include 4 variables:
MedianIntensity
: this is the normalisation factor used to correct
for cell-specific technical differences.Channel
: this is used to correct for TMT effects.File.ID
: this is used to perform batch correction. We consider each
acquisition run to be a batch. Population
: this is the biological variable of interest. It
captures the difference between the different AML populationsscpModelWorkflow()
fits linear regression models to the data, where the
model is adapted for each peptide depending on its pattern of missing
values.
sce <- scpModelWorkflow( sce, formula = ~ 1 + ## intercept ## normalisation MedianIntensity + ## batch effects Channel + File.ID + ## biological variability Population )
Once the models are fit, we can explore the distribution of the n/p ratios.
scpModelFilterThreshold(sce) <- 3 scpModelFilterPlot(sce)
Many peptides do not have sufficient observations to estimate the model. We have chosen to continue the analysis with peptides that have $n/p >= 3$. You could consider $n/p$ a rough average of the number of replicates per parameter to fit (for categorical variables, the number of replicates per group). We recommend moving the threshold away from 1 to increase statistical power and remove noisy peptides. This comes of course at the cost of less peptides included in the analysis.
The model analysis consists of three steps:
The analysis of variance explores the proportion of data captures by each variable in the model.
(vaRes <- scpVarianceAnalysis(sce)) vaRes[[1]]
The results are a list of tables, one table for each variable. Each
table reports for each peptide the variance captures (SS
), the
residual degrees of freedom for estimating the variance (df
) and the
percentage of total variance explained (percentExplainedVar
). To
better explore the results, we add the annotations available in the
rowData
.
vaRes <- scpAnnotateResults( vaRes, rowData(sce), by = "feature", by2 = "Annotated.Sequence" )
By default, we explore the variance for all peptides combined:
scpVariancePlot(vaRes)
We explore the top 20 peptides that are have the highest percentage of variance explained by the biological variable (top) or by the batch variable (bottom).
scpVariancePlot( vaRes, top = 20, by = "percentExplainedVar", effect = "Population", decreasing = TRUE, combined = FALSE ) + scpVariancePlot( vaRes, top = 20, by = "percentExplainedVar", effect = "File.ID", decreasing = TRUE, combined = FALSE ) + plot_layout(ncol = 1, guides = "collect")
We can also group these peptide according to their protein. We simply
need to provide the fcol
argument.
scpVariancePlot( vaRes, top = 20, by = "percentExplainedVar", effect = "Population", decreasing = TRUE, combined = FALSE, fcol = "Gene" ) + scpVariancePlot( vaRes, top = 20, by = "percentExplainedVar", effect = "File.ID", decreasing = TRUE, combined = FALSE, fcol = "Gene" ) + plot_layout(ncol = 1, guides = "collect")
Next, we explore the model output to understand the differences
between melanoma cells and monocytes. The difference of interest is
specified using the contrast
argument. The first element points to
the variable to test and the two following element are the groups of
interest to compare. You can provide multiple contrast in a list.
(daRes <- scpDifferentialAnalysis( sce, contrast = list( c("Population", "BLAST CD38-", "LSC"), c("Population", "BLAST CD38-", "PROG"), c("Population", "BLAST CD38-", "BLAST CD38+") ) )) daRes[[1]]
Similarly to analysis of variance, the results are a list of tables, one
table for each contrast. Each table reports for each peptide the
estimated difference between the two groups, the standard error
associated to the estimation, the degrees of freedom, the
t-statistics, the associated p-value and the p-value FDR-adjusted for
multiple testing across all peptides. Again, to better explore the
results, we add the annotations available in the rowData
.
daRes <- scpAnnotateResults( daRes, rowData(sce), by = "feature", by2 = "Annotated.Sequence" )
We then visualize the results using a volcano plot. The function below return a volcano plot for each contrast.
wrap_plots(scpVolcanoPlot(daRes))
To help interpretation of the results, we will label the peptides with their gene name. Also we increase the number of labels shown on the plot. Finally, we can add colors to the plot. For instance, let's explore the impact of the number of observations using the $n/p$ ratio. We create a new annotation table, add it to the results and redraw the plot. The $n/p$ ratio is retrieved using scpModelFilterNPRatio
np <- scpModelFilterNPRatio(sce) daRes <- scpAnnotateResults( daRes, data.frame(feature = names(np), npRatio = np), by = "feature" ) wrap_plots(scpVolcanoPlot( daRes, top = 30, textBy = "Gene", pointParams = list(aes(colour = npRatio)) ))
As expected, higher number of observations (higher $n/p$) lead to increased statistical power and hence to more significant results.
Finally, we offer functionality to report results at the protein level.
scpDifferentialAggregate(daRes, fcol = "Gene") |> scpVolcanoPlot(top = 30) |> wrap_plots()
Finally, we perform component analysis to link the modelled effects to the cellular heterogeneity. We here run an APCA+ (extended ANOVA-simultaneous principal component analysis) for the sample type effect. In other words, we perform a PCA on the data that is capture by the sample type variable along with the residuals (unmodelled data).
(caRes <- scpComponentAnalysis( sce, ncomp = 2, method = "APCA", effect = "Population" ))
The results are contained in a list with 2 elements. bySample
contains the PC scores, that is the component results in sample space.
byFeature
contains the eigenvectors, that is the component results
in feature space.
caRes$bySample
Each of the two elements contains components results
for the data before modelling (unmodelled
), for the residuals or for
the APCA on the sample type variable (APCA_Population
).
caRes$bySample[[1]]
Each elements is a table with the computed componoents. Let's explore the component analysis results in cell space. Similarly to the previous explorations, we annotate the results.
caResCells <- caRes$bySample sce$cell <- colnames(sce) caResCells <- scpAnnotateResults(caResCells, colData(sce), by = "cell")
We then generate the component plot, colouring by Population
.
scpComponentPlot( caResCells, pointParams = list(aes(colour = Population), alpha = 0.5) ) |> wrap_plots() + plot_layout(guides = "collect")
To assess the impact of batch effects, we shape the points according to the plate batch (cf intro) as well.
scpComponentPlot( caResCells, pointParams = list(aes(colour = as.numeric(File.ID)), alpha = 0.5) ) |> wrap_plots() + plot_layout(guides = "collect") & scale_color_continuous(type = "viridis")
While the data before modelling is driven by batch effects with little biological effects, the APCA shows better separation of the four cell populations, with LSC progressively transitioning to PROG and then BLAST following the PC1 axis. However, strong residuals blurs the differences between populations, indicating that discretising the AML cell population into 4 populations may not be the most relevant approach for these data. We will explore this later during downstream analysis.
We use the same approach to explore the component results in feature space.
caResPeps <- caRes$byFeature caResPeps <- scpAnnotateResults( caResPeps, rowData(sce), by = "feature", by2 = "Annotated.Sequence" )
We plot the compenents in peptide-space.
plCApeps <- scpComponentPlot( caResPeps, pointParams = list(size = 0.8, alpha = 0.4) ) wrap_plots(plCApeps)
We can also combine the exploration of the components in cell and peptide space. This is possible thanks to biplots.
biplots <- scpComponentBiplot( caResCells, caResPeps, pointParams = list(aes(colour = Population)), labelParams = list(size = 1.5, max.overlaps = 20), textBy = "Gene", top = 20 ) wrap_plots(biplots, guides = "collect")
Finally, we offer functionality to aggregate the results at the protein level instead of the peptide level.
caResProts <- scpComponentAggregate(caResPeps, fcol = "Gene") biplots <- scpComponentBiplot( caResCells, caResProts, pointParams = list(aes(colour = Population)), labelParams = list(size = 1.5, max.overlaps = 20), textBy = "Gene", top = 20 ) wrap_plots(biplots, guides = "collect")
You can manually explore the data through an interactive interface
thanks to iSEE
:
library("iSEE") iSEE(sce)
The final step in this analyses in the exploration of the differentiation trajectories of the AML model. To achieve this, we perform an APCA+ with more components to capture more of the variability. The APCA+ results are used to compute diffusion components that are used for diffusion pseudotime ordering.
We compute the 20 first APCA+ components on the sample type. We limit the PCA algorithm to 50 iterations to avoid an overly long run and will not compute the PCA for the unmodelled data and the residuals because we won't use it during the downstream analysis.
apcaPopulation <- scpComponentAnalysis( sce, ncomp = 20, method = "APCA", effect = "Population", residuals = FALSE, unmodelled = FALSE, maxiter = 50 ) pca <- apcaPopulation$bySample$APCA_Population
The resulting components are stored in the SingleCellExperiment
object.
pca <- as.matrix(pca[, grep("^PC", colnames(pca))]) reducedDim(sce, "APCA") <- pca
We compute the diffusion map from the PCA results.
dm <- DiffusionMap(pca) reducedDim(sce, "DiffusionMap") <- eigenvectors(dm)
Finally, we plot the three first diffusion components.
plot_ly(x = reducedDim(sce, "DiffusionMap")[, 1], y = reducedDim(sce, "DiffusionMap")[, 2], z = reducedDim(sce, "DiffusionMap")[, 3], color = sce$Population, type = "scatter3d", mode = "markers")
The diffusion map confirms the progressive transition from LSC to BLAST cells. However, we see an alternative differentiation track characterised by low scores for the second diffusion component.
knitr::opts_chunk$set( collapse = TRUE, comment = "", crop = NULL )
sessionInfo()
citation("scp")
This vignette is distributed under a CC BY-SA license license.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.