Initial pre-processing

Generating a synthetic dataset

We will use a synthetic dataset to illustrate the functionalities of the condiments package. We start directly with a dataset where the following steps are assumed to have been run:

  • Obtaining count matrices for each setting (i.e. each condition).
  • Integration and normalization between the conditions.
  • Reduced Dimension Estimations
  • (Clustering)
# For analysis
library(condiments)
library(slingshot)
# For data manipulation
library(dplyr)
library(tidyr)
# For visualization
library(ggplot2)
library(RColorBrewer)
library(viridis)
set.seed(2071)
theme_set(theme_classic())
data("toy_dataset", package = "condiments")
df <- toy_dataset$sd

As such, we start with a matrix df of metadata for the cells: coordinates in a reduced dimension space (Dim1, Dim2), a vector of conditions assignments conditions (A or B) and a lineage assignment.

Vizualisation

We can first plot the cells on the reduced dimensions

p <- ggplot(df, aes(x = Dim1, y = Dim2, col = conditions)) +
  geom_point() +
  scale_color_brewer(type = "qual")
p

We can also visualize the underlying skeleton structure of the two conditions.

p <- ggplot(df, aes(x = Dim1, y = Dim2, col = conditions)) +
  geom_point(alpha = .5) +
  geom_point(data = toy_dataset$mst, size = 2) +
  geom_path(data = toy_dataset$mst, aes(group = lineages), size = 1.5) +
  scale_color_brewer(type = "qual") + 
  facet_wrap(~conditions) +
  guides(col = FALSE)
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
p

Differential Topology

Exploratory analysis

We can then compute the imbalance score of each cell using the imbalance_score function.

scores <- imbalance_score(Object = df %>% select(Dim1, Dim2) %>% as.matrix(),
                          conditions = df$conditions)
df$scores <- scores$scores
df$scaled_scores <- scores$scaled_scores

There are two types of scores. The raw score is computed on each cell and looks at the condition distribution of its neighbors compared the the overall distribution. The size of the neighborhood can be set using the k argument, which specify the number of neighbors to consider. Higher values means more local imbalance.

ggplot(df, aes(x = Dim1, y = Dim2, col = scores)) +
  geom_point() +
  scale_color_viridis_c(option = "C")

The local scores are quite noisy so we can then use local smoothers to smooth the scores of individual cells. The smoothness is dictated by the smooth argument. Those smoothed scores were also computed using the imbalance_score function.

ggplot(df, aes(x = Dim1, y = Dim2, col = scaled_scores)) +
  geom_point() +
  scale_color_viridis_c(option = "C")

As could be guessed from the original plot, the bottom lineage shows a lot of imbalance while the top one does not. The imbalance score can be used to check: + If the integration has been successful. In general, some regions should be balanced + To identify the regions of imbalance for further analyses.

Trajectory Inference

The first step of our workflow is to decide whether or not to infer the trajectories separately or not. On average, it is better to infer a common trajectory, since a) this allow for a wider range of downstream analyses, and b) more cells are used to estimate the trajectory. However, the condition effect might be strong enough to massively disrupt the differentiation process, which would require fitting separate trajectories.

slingshot(Street et al. 2018) relies on a reduced dimensionality reduction representation of the data, as well as on cluster labels. We can visualize those below:

ggplot(df, aes(x = Dim1, y = Dim2, col = cl)) +
  geom_point()

The topologyTest assess the quality of the common trajectory inference done by slingshot and test whether we should fit a common or separate trajectory. This test relies on repeated permutations of the conditions followed by trajectory inference so it can take a few seconds.

rd <- as.matrix(df[, c("Dim1", "Dim2")])
sds <- slingshot(rd, df$cl)
## Takes ~1m30s to run
top_res <- topologyTest(sds = sds, conditions = df$conditions)
## Generating permuted trajectories
## Running KS-mean test
knitr::kable(top_res)
method thresh statistic p.value
KS_mean 0.01 0 1

The test clearly fails to reject the null that we can fit a common trajectory so we can continue with the sds object. This will facilitate downstream analysis. For an example of how to proceed if the topologyTest reject the null, we invite the user to refer to relevant case study used in our paper.

We can thus visualize the trajectory

ggplot(df, aes(x = Dim1, y = Dim2, col = cl)) +
  geom_point() +
  geom_path(data =  slingCurves(sds, as.df = TRUE) %>% arrange(Order),
            aes(group = Lineage), col = "black", size = 2)

Differential Progression

Even though we can fit a common trajectory, it does not mean that the cells will differentiate similarly between the conditions. The first question we can ask is: for a given lineage, are cells equally represented along pseudotime between conditions?

psts <- slingPseudotime(sds) %>%
  as.data.frame() %>%
  mutate(cells = rownames(.),
         conditions = df$conditions) %>%
  pivot_longer(starts_with("Lineage"), values_to = "pseudotime", names_to = "lineages")

Visualization

ggplot(psts, aes(x = pseudotime, fill = conditions)) +
  geom_density(alpha = .5) +
  scale_fill_brewer(type = "qual") +
  facet_wrap(~lineages) +
  theme(legend.position = "bottom")

The pseudotime distributions are identical across conditions for the first lineage but there are clear differences between the two conditions in the second lineage.

Testing for differential progression

To test for differential progression, we use the progressionTest. The test can be run with global = TRUE to test when pooling all lineages, or lineages = TRUE to test every lineage independently, or both. Several tests are implemented in the progressionTest. function. Here, we will use the default, the custom KS test (Smirnov 1939).

prog_res <- progressionTest(sds, conditions = df$conditions, global = TRUE, lineages = TRUE)
knitr::kable(prog_res)
lineage statistic p.value
All 5.5063660 0.0000000
1 0.0343831 0.9940762
2 0.4699371 0.0000000

As expected, there is a global difference over all lineages, which is driven by differences of distribution across lineage 2 (i.e. the bottom one).

Differential fate selection

Even though we can fit a common trajectory, it does not mean that the cells will differentiate similarly between the conditions. The first question we can ask is: for a given lineage, are cells equally between the two lineages for the two conditions?

Vizualisation

Visualizing differences 2D distributions can be somewhat tricky. However, it is important to note that the sum of all lineage weights should sum to 1. As such, we can only plot the weights for the first lineage.

df$weight_1 <- slingCurveWeights(sds, as.probs = TRUE)[, 1]
ggplot(df, aes(x = weight_1, fill = conditions)) +
  geom_density(alpha = .5) +
  scale_fill_brewer(type = "qual") +
  labs(x = "Curve weight for the first lineage")

The distribution has tri modes, which is very often the case for two lineages: + A weight around 0 represent a cell that is mostly assigned to the other lineage (i.e. lineage 2 here) + A weight around .5 represent a cell that is equally assigned to both lineages, i.e. before the bifurcation. + A weight around 1 represent a cell that is mostly assigned to this lineage (i.e. lineage 1 here)

In condition A, we have many more cells with a weight of 0 and, since those are density plots, fewer cells with weights around .5 and 1. Visually, we can guess that cells in condition B differentiate preferentially along lineage 1.

Testing for differential fate selection

To test for differential fate selection, we use the fateSelectionTest. The test can be run with global = TRUE to test when pooling all pairs of lineages, or pairwise = TRUE to test every pair independently, or both. Here, there is only one pair so the options are equivalent. Several tests are implemented in the fateSelectionTest. function. Here, we will use the default, the classifier test(Lopez-Paz and Oquab 2016).

set.seed(12)
dif_res <- fateSelectionTest(sds, conditions = df$conditions, global = FALSE, pairwise = TRUE)
## note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
## Loading required package: lattice
## note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
knitr::kable(dif_res)
pair statistic p.value
1vs2 0.6476577 5.6e-06

As could be guessed from the plot, we have clear differential fate selection.

Differential Expression

The workflow above focus on global differences, looking at broad patterns of differentiation. While this is a necessary first step, gene-level information is also quite meaningful.

To do so requires tradeSeq(Van den Berge et al. 2020) > 1.3.0. Considering that we have a count matrix counts, the basic workflow is:s

library(tradeSeq)
sce <- fitGAM(counts = counts, sds = sds, conditions = df$conditions)
cond_genes <- conditionTest(sds)

For more details on fitting the smoothers, we refer users to the tradeSeq website and to the accompanying Bioconductor workshop.

Conclusion

For both of the above procedures, it is important to note that we are making multiple comparisons (in this case, 5). The p-values we obtain from these tests should be corrected for multiple testing, especially for trajectories with a large number of lineages.

That said, trajectory inference is often one of the last computational methods in a very long analysis pipeline (generally including gene-level quantification, gene filtering / feature selection, and dimensionality reduction). Hence, we strongly discourage the reader from putting too much faith in any p-value that comes out of this analysis. Such values may be useful suggestions, indicating particular features or cells for follow-up study, but should generally not be treated as meaningful statistical quantities.

Session Info

sessionInfo()
## R version 4.2.0 RC (2022-04-19 r82224)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.4 LTS
## 
## Matrix products: default
## BLAS:   /home/biocbuild/bbs-3.15-bioc/R/lib/libRblas.so
## LAPACK: /home/biocbuild/bbs-3.15-bioc/R/lib/libRlapack.so
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_GB              LC_COLLATE=C              
##  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats4    stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] caret_6.0-92                lattice_0.20-45            
##  [3] viridis_0.6.2               viridisLite_0.4.0          
##  [5] RColorBrewer_1.1-3          ggplot2_3.3.5              
##  [7] tidyr_1.2.0                 dplyr_1.0.8                
##  [9] slingshot_2.3.1             TrajectoryUtils_1.3.0      
## [11] SingleCellExperiment_1.17.2 SummarizedExperiment_1.25.3
## [13] Biobase_2.55.2              GenomicRanges_1.47.6       
## [15] GenomeInfoDb_1.31.10        IRanges_2.29.1             
## [17] S4Vectors_0.33.17           BiocGenerics_0.41.2        
## [19] MatrixGenerics_1.7.0        matrixStats_0.62.0         
## [21] princurve_2.1.6             condiments_1.3.1           
## [23] knitr_1.38                 
## 
## loaded via a namespace (and not attached):
##   [1] plyr_1.8.7                igraph_1.3.1             
##   [3] splines_4.2.0             BiocParallel_1.29.21     
##   [5] listenv_0.8.0             scater_1.23.6            
##   [7] digest_0.6.29             foreach_1.5.2            
##   [9] htmltools_0.5.2           fansi_1.0.3              
##  [11] magrittr_2.0.3            ScaledMatrix_1.3.0       
##  [13] tensor_1.5                doParallel_1.0.17        
##  [15] limma_3.51.8              recipes_0.2.0            
##  [17] globals_0.14.0            gower_1.0.0              
##  [19] hardhat_0.2.0             spatstat.sparse_2.1-1    
##  [21] colorspace_2.0-3          ggrepel_0.9.1            
##  [23] xfun_0.30                 crayon_1.5.1             
##  [25] RCurl_1.98-1.6            jsonlite_1.8.0           
##  [27] distinct_1.7.1            spatstat_2.3-4           
##  [29] spatstat.data_2.2-0       survival_3.3-1           
##  [31] iterators_1.0.14          glue_1.6.2               
##  [33] polyclip_1.10-0           gtable_0.3.0             
##  [35] ipred_0.9-12              zlibbioc_1.41.0          
##  [37] XVector_0.35.0            DelayedArray_0.21.2      
##  [39] Ecume_0.9.1               BiocSingular_1.11.0      
##  [41] kernlab_0.9-30            future.apply_1.8.1       
##  [43] abind_1.4-5               scales_1.2.0             
##  [45] DBI_1.1.2                 rngtools_1.5.2           
##  [47] spatstat.random_2.2-0     Rcpp_1.0.8.3             
##  [49] spatstat.core_2.4-2       rsvd_1.0.5               
##  [51] proxy_0.4-26              lava_1.6.10              
##  [53] prodlim_2019.11.13        ellipsis_0.3.2           
##  [55] farver_2.1.0              pkgconfig_2.0.3          
##  [57] scuttle_1.5.2             nnet_7.3-17              
##  [59] sass_0.4.1                deldir_1.0-6             
##  [61] utf8_1.2.2                labeling_0.4.2           
##  [63] tidyselect_1.1.2          rlang_1.0.2              
##  [65] reshape2_1.4.4            munsell_0.5.0            
##  [67] tools_4.2.0               cli_3.2.0                
##  [69] generics_0.1.2            evaluate_0.15            
##  [71] stringr_1.4.0             fastmap_1.1.0            
##  [73] yaml_2.3.5                goftest_1.2-3            
##  [75] ModelMetrics_1.2.2.2      transport_0.12-2         
##  [77] randomForest_4.7-1        purrr_0.3.4              
##  [79] RANN_2.6.1                pbapply_1.5-0            
##  [81] future_1.24.0             nlme_3.1-157             
##  [83] doRNG_1.8.2               sparseMatrixStats_1.7.0  
##  [85] compiler_4.2.0            beeswarm_0.4.0           
##  [87] e1071_1.7-9               spatstat.utils_2.3-0     
##  [89] spatstat.linnet_2.3-2     tibble_3.1.6             
##  [91] bslib_0.3.1               stringi_1.7.6            
##  [93] highr_0.9                 Matrix_1.4-1             
##  [95] vctrs_0.4.1               pillar_1.7.0             
##  [97] lifecycle_1.0.1           spatstat.geom_2.4-0      
##  [99] jquerylib_0.1.4           BiocNeighbors_1.13.0     
## [101] irlba_2.3.5               data.table_1.14.2        
## [103] bitops_1.0-7              R6_2.5.1                 
## [105] gridExtra_2.3             vipor_0.4.5              
## [107] parallelly_1.31.0         codetools_0.2-18         
## [109] MASS_7.3-56               assertthat_0.2.1         
## [111] withr_2.5.0               GenomeInfoDbData_1.2.8   
## [113] mgcv_1.8-40               parallel_4.2.0           
## [115] grid_4.2.0                rpart_4.1.16             
## [117] beachmat_2.11.0           timeDate_3043.102        
## [119] class_7.3-20              rmarkdown_2.13           
## [121] DelayedMatrixStats_1.17.0 pROC_1.18.0              
## [123] lubridate_1.8.0           ggbeeswarm_0.6.0

References

Lopez-Paz, David, and Maxime Oquab. 2016. “Revisiting Classifier Two-Sample Tests.” Arxiv, October, 1–15. http://arxiv.org/abs/1610.06545.

Smirnov, Nikolai V. 1939. “On the Estimation of the Discrepancy Between Empirical Curves of Distribution for Two Independent Samples.” Bull. Math. Univ. Moscou 2 (2): 3–14.

Street, Kelly, Davide Risso, Russell B. Fletcher, Diya Das, John Ngai, Nir Yosef, Elizabeth Purdom, and Sandrine Dudoit. 2018. “Slingshot: cell lineage and pseudotime inference for single-cell transcriptomics.” BMC Genomics 19 (1): 477. https://doi.org/10.1186/s12864-018-4772-0.

Van den Berge, Koen, Hector Roux de Bézieux, Kelly Street, Wouter Saelens, Robrecht Cannoodt, Yvan Saeys, Sandrine Dudoit, and Lieven Clement. 2020. “Trajectory-based differential expression analysis for single-cell sequencing data.” Nature Communications 11 (1): 1201. https://doi.org/10.1038/s41467-020-14766-3.