Making comparisons for differential abundance using contrasts
library(miloR)
library(SingleCellExperiment)
library(scater)
library(scran)
library(dplyr)
library(patchwork)
library(MouseThymusAgeing)
library(scuttle)Introduction
We have seen how Milo uses graph neighbourhoods to model cell state
abundance differences in an experiment, when comparing 2 groups.
However, we are often interested in testing between 2 specific groups in
our analysis when our experiment has collected data from > 2 groups. We can focus our analysis to a
2 group comparison and still make use of all of the data for things like
dispersion estimation, by using contrasts. For an in-depth use
of contrasts we recommend users refer to the limma and
edgeR Biostars and Bioconductor community forum threads on
the subject. Here I will give an overview of how to use contrasts in the
context of a Milo analysis.
Load data
We will use the MouseThymusAgeing data package as there
are multiple groups that we can compare.
## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## Warning: download failed
## web resource path: 'https://experimenthub.bioconductor.org/fetch/4640'
## local file path: '/github/home/.cache/R/ExperimentHub/273741e8e5db_4640'
## reason: Internal Server Error (HTTP 500).## Warning: bfcadd() failed; resource removed
## rid: BFC3
## fpath: 'https://experimenthub.bioconductor.org/fetch/4640'
## reason: download failed## Warning: download failed
## hub path: 'https://experimenthub.bioconductor.org/fetch/4640'
## cache resource: 'EH4597 : 4640'
## reason: bfcadd() failed; see warnings()## Error loading resource.
## attempting to re-download## downloading 1 resources## retrieving 1 resource## loading from cache## field not found in version - adding## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## see ?MouseThymusAgeing and browseVignettes('MouseThymusAgeing') for documentation## downloading 1 resources## retrieving 1 resource## loading from cache## class: SingleCellExperiment
## dim: 48801 2327
## metadata(0):
## assays(2): counts logcounts
## rownames(48801): ERCC-00002 ERCC-00003 ... ENSMUSG00000064371
## ENSMUSG00000064372
## rowData names(6): Geneid Chr ... Strand Length
## colnames(2327): B13.B002229.1_52.1.32.1_S109
## B13.B002297.1_32.4.52.1_S73 ... P9.B002345.5_52.1.32.1_S93
## P9.B002450.5_4.52.16.1_S261
## colData names(11): CellID ClusterID ... SubType sizeFactor
## reducedDimNames(1): PCA
## mainExpName: NULL
## altExpNames(0):Define cell neighbourhoods
thy.sce <- runUMAP(thy.sce) # add a UMAP for plotting results later
thy.milo <- Milo(thy.sce) # from the SCE object
reducedDim(thy.milo, "UMAP") <- reducedDim(thy.sce, "UMAP")
plotUMAP(thy.milo, colour_by="SubType") + plotUMAP(thy.milo, colour_by="Age")
These UMAPs shows how the different thymic epithelial cell subtypes and cells from different aged mice are distributed across our single-cell data set. Next we build the KNN graph and define neighbourhoods to quantify cell abundance across our experimental samples.
## Constructing kNN graph with k:11thy.milo <- makeNhoods(thy.milo, prop = 0.2, k = 11, d=40, refined = TRUE, refinement_scheme="graph") # make nhoods using graph-only as this is faster## Checking valid object## Running refined sampling with graphcolData(thy.milo)$Sample <- paste(colData(thy.milo)$SortDay, colData(thy.milo)$Age, sep="_")
thy.milo <- countCells(thy.milo, meta.data = data.frame(colData(thy.milo)), samples="Sample") # make the nhood X sample counts matrix## Checking meta.data validity## Counting cells in neighbourhoods
Differential abundance testing with contrasts
Now we have the pieces in place for DA testing to demonstrate how to use contrasts. We will use these contrasts to explicitly define which groups will be compared to each other.
thy.design <- data.frame(colData(thy.milo))[,c("Sample", "SortDay", "Age")]
thy.design <- distinct(thy.design)
rownames(thy.design) <- thy.design$Sample
## Reorder rownames to match columns of nhoodCounts(milo)
thy.design <- thy.design[colnames(nhoodCounts(thy.milo)), , drop=FALSE]
table(thy.design$Age)##
## 16wk 1wk 32wk 4wk 52wk
## 5 5 5 5 5To demonstrate the use of contrasts we will fit the whole model to the whole data set, but we will compare sequential pairs of time points. I’ll start with week 1 vs. week 4 to illustrate the syntax.
rownames(thy.design) <- thy.design$Sample
contrast.1 <- c("Age1wk - Age4wk") # the syntax is <VariableName><ConditionLevel> - <VariableName><ControlLevel>
# we need to use the ~ 0 + Variable expression here so that we have all of the levels of our variable as separate columns in our model matrix
da_results <- testNhoods(thy.milo, design = ~ 0 + Age, design.df = thy.design, model.contrasts = contrast.1,
fdr.weighting="graph-overlap", norm.method="TMM")## Using TMM normalisation## Running with model contrasts## Performing spatial FDR correction with graph-overlap weighting##
## FALSE TRUE
## 354 10This calculates a Fold-change and corrected P-value for each neighbourhood, which indicates whether there is significant differential abundance between conditions for 10 neighbourhoods.
You will notice that the syntax for the contrasts is quite specific.
It starts with the name of the column variable that contains the
different group levels; in this case it is the Age
variable. We then define the comparison levels as
level1 - level2. To understand this syntax we need to
consider what we are concretely comparing. In this case we are asking
what is the ratio of the average cell count at week1 compared to the
average cell count at week 4, where the averaging is across the
replicates. The reason we express this as a difference rather than a
ratio is because we are dealing with the log fold change.
We can also pass multiple comparisons at the same time, for instance if we wished to compare each sequential pair of time points. This will give us a better intuition behind how to use contrasts to compare multiple groups.
contrast.all <- c("Age1wk - Age4wk", "Age4wk - Age16wk", "Age16wk - Age32wk", "Age32wk - Age52wk")
# contrast.all <- c("Age1wk - Age4wk", "Age16wk - Age32wk")
# this is the edgeR code called by `testNhoods`
model <- model.matrix(~ 0 + Age, data=thy.design)
mod.constrast <- makeContrasts(contrasts=contrast.all, levels=model)
mod.constrast## Contrasts
## Levels Age1wk - Age4wk Age4wk - Age16wk Age16wk - Age32wk Age32wk - Age52wk
## Age16wk 0 -1 1 0
## Age1wk 1 0 0 0
## Age32wk 0 0 -1 1
## Age4wk -1 1 0 0
## Age52wk 0 0 0 -1This shows the contrast matrix. If we want to test each of these
comparisons then we need to pass them sequentially to
testNhoods, then apply an additional multiple testing
correction to the spatial FDR values.
contrast1.res <- testNhoods(thy.milo, design=~0+ Age, design.df=thy.design, fdr.weighting="graph-overlap", model.contrasts = contrast.all)## Using TMM normalisation## Running with model contrasts## Performing spatial FDR correction with graph-overlap weighting## logFC.Age1wk...Age4wk logFC.Age4wk...Age16wk logFC.Age16wk...Age32wk
## 1 0.00000000 -1.4495557 -2.7097440
## 2 0.00000000 0.0000000 -2.6745793
## 3 0.99576304 -1.0735044 1.5084445
## 4 0.09897355 -0.6448613 -0.7990751
## 5 0.40640436 3.6217863 -1.4998322
## 6 -0.74620510 0.6645686 0.7111930
## logFC.Age32wk...Age52wk logCPM F PValue FDR Nhood
## 1 0.6035095 13.50538 4.6007121 0.0010389305 0.005042276 1
## 2 -1.5428380 13.42443 5.2310274 0.0003319169 0.002368975 2
## 3 -1.4713281 13.45293 0.5280459 0.7151373477 0.765617631 3
## 4 -0.3377343 13.53871 0.9203542 0.4508966051 0.550759612 4
## 5 0.1634744 13.53335 3.3845397 0.0089664976 0.027274921 5
## 6 0.8741085 13.51163 0.8557073 0.4897605865 0.584028207 6
## SpatialFDR
## 1 0.005856469
## 2 0.002644630
## 3 0.763368478
## 4 0.541981683
## 5 0.030864802
## 6 0.570331056This matrix of contrasts will perform a quasi-likelihood F-test over
all 5 contrasts, hence a single p-value and spatial FDR are returned.
Log fold changes are returned for each contrast of the Age
variable, which gives 1 log-fold change column for each - this is the
default behaviour of glmQLFTest in the edgeR
package which is what Milo uses for hypothesis testing. In general, and
to avoid confusion, we recommend testing each pair of contrasts
separately if these are the comparisons of interest, as shown below.
# compare weeks 4 and 16, with week 4 as the reference.
cont.4vs16.res <- testNhoods(thy.milo, design=~0+ Age, design.df=thy.design, fdr.weighting="graph-overlap", model.contrasts = c("Age4wk - Age16wk"))## Using TMM normalisation## Running with model contrasts## Performing spatial FDR correction with graph-overlap weighting## logFC logCPM F PValue FDR Nhood SpatialFDR
## 1 -1.4495557 13.50538 1.6035169 0.205446049 0.5581850 1 0.4556047
## 2 0.0000000 13.42443 0.0000000 1.000000000 1.0000000 2 1.0000000
## 3 -1.0735044 13.45293 0.7273104 0.393784438 0.7239269 3 0.6567470
## 4 -0.6448613 13.53871 0.2890827 0.590825362 0.8691717 4 0.8388794
## 5 3.6217863 13.53335 6.9077981 0.008600078 0.2542107 5 0.1563513
## 6 0.6645686 13.51163 0.3358534 0.562250501 0.8562556 6 0.8163153Now we have a single logFC which compares nhood abundance between week 4 and week 16 - as we can see the LFC estimates should be the same, but the SpatialFDR will be different.
par(mfrow=c(1, 2))
plot(contrast1.res$logFC.Age4wk...Age16wk, cont.4vs16.res$logFC,
xlab="4wk vs. 16wk LFC\nsingle contrast", ylab="4wk vs. 16wk LFC\nmultiple contrast")
plot(contrast1.res$SpatialFDR, cont.4vs16.res$SpatialFDR,
xlab="Spatial FDR\nsingle contrast", ylab="Spatial FDR\nmultiple contrast")
Contrasts are not limited to these simple pair-wise comparisons, we can also group levels together for comparisons. For instance, imagine we want to know what the effect of the cell counts in the week 1 mice is compared to all other time points.
model <- model.matrix(~ 0 + Age, data=thy.design)
ave.contrast <- c("Age1wk - (Age4wk + Age16wk + Age32wk + Age52wk)/4")
mod.constrast <- makeContrasts(contrasts=ave.contrast, levels=model)
mod.constrast## Contrasts
## Levels Age1wk - (Age4wk + Age16wk + Age32wk + Age52wk)/4
## Age16wk -0.25
## Age1wk 1.00
## Age32wk -0.25
## Age4wk -0.25
## Age52wk -0.25In this contrasts matrix we can see that we have taken the average
effect over the other time points. Now running this using
testNhoods
da_results <- testNhoods(thy.milo, design = ~ 0 + Age, design.df = thy.design, model.contrasts = ave.contrast, fdr.weighting="graph-overlap")## Using TMM normalisation## Running with model contrasts## Performing spatial FDR correction with graph-overlap weighting##
## FALSE TRUE
## 253 111## logFC logCPM F PValue FDR Nhood SpatialFDR
## 1 -2.2911614 13.50538 3.479429e-07 0.999566905 0.99970000 1 0.99970000
## 2 -1.7229991 13.42443 5.307672e-07 0.999633039 0.99970000 2 0.99970000
## 3 0.5770250 13.45293 3.961271e-01 0.529115938 0.77039281 3 0.88293777
## 4 -0.8686435 13.53871 6.752065e-01 0.411269160 0.64526713 4 0.73303278
## 5 2.4136966 13.53335 9.060474e+00 0.002620894 0.02650015 5 0.02310505
## 6 0.3263449 13.51163 1.527828e-01 0.695901501 0.94871965 6 0.99970000The results table In this comparison there are 111 DA nhoods - which we can visualise on a superimposed single-cell UMAP.
thy.milo <- buildNhoodGraph(thy.milo)
plotUMAP(thy.milo, colour_by="SubType") + plotNhoodGraphDA(thy.milo, da_results, alpha=0.1) +
plot_layout(guides="auto" )## Adding nhood effect sizes to neighbourhood graph attributes
In these side-by-side UMAPs we can see that there is an enrichment of the Perinatal cTEC and Proliferating TEC populations in the 1 week old compared to the other time points.
For a more extensive description of the uses of contrasts please take a look at the edgeR documentation .
Session Info
## R version 4.4.1 (2024-06-14)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 24.04.1 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so; LAPACK version 3.12.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 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
##
## time zone: Etc/UTC
## tzcode source: system (glibc)
##
## attached base packages:
## [1] stats4 stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] MouseThymusAgeing_1.13.0 patchwork_1.3.0
## [3] dplyr_1.1.4 scran_1.33.2
## [5] scater_1.33.4 ggplot2_3.5.1
## [7] scuttle_1.15.5 SingleCellExperiment_1.27.2
## [9] SummarizedExperiment_1.35.5 Biobase_2.67.0
## [11] GenomicRanges_1.57.2 GenomeInfoDb_1.41.2
## [13] IRanges_2.39.2 S4Vectors_0.43.2
## [15] BiocGenerics_0.53.0 MatrixGenerics_1.17.1
## [17] matrixStats_1.4.1 miloR_2.3.0
## [19] edgeR_4.3.21 limma_3.61.12
## [21] BiocStyle_2.35.0
##
## loaded via a namespace (and not attached):
## [1] RColorBrewer_1.1-3 sys_3.4.3 jsonlite_1.8.9
## [4] magrittr_2.0.3 ggbeeswarm_0.7.2 farver_2.1.2
## [7] rmarkdown_2.28 zlibbioc_1.51.2 vctrs_0.6.5
## [10] memoise_2.0.1 htmltools_0.5.8.1 S4Arrays_1.5.11
## [13] AnnotationHub_3.15.0 curl_5.2.3 BiocNeighbors_2.1.0
## [16] SparseArray_1.5.45 sass_0.4.9 pracma_2.4.4
## [19] bslib_0.8.0 cachem_1.1.0 buildtools_1.0.0
## [22] igraph_2.1.1 mime_0.12 lifecycle_1.0.4
## [25] pkgconfig_2.0.3 rsvd_1.0.5 Matrix_1.7-1
## [28] R6_2.5.1 fastmap_1.2.0 GenomeInfoDbData_1.2.13
## [31] digest_0.6.37 numDeriv_2016.8-1.1 colorspace_2.1-1
## [34] AnnotationDbi_1.69.0 dqrng_0.4.1 irlba_2.3.5.1
## [37] ExperimentHub_2.13.1 RSQLite_2.3.7 beachmat_2.23.0
## [40] labeling_0.4.3 filelock_1.0.3 fansi_1.0.6
## [43] httr_1.4.7 polyclip_1.10-7 abind_1.4-8
## [46] compiler_4.4.1 bit64_4.5.2 withr_3.0.2
## [49] BiocParallel_1.41.0 viridis_0.6.5 DBI_1.2.3
## [52] highr_0.11 ggforce_0.4.2 MASS_7.3-61
## [55] rappdirs_0.3.3 DelayedArray_0.33.1 bluster_1.17.0
## [58] gtools_3.9.5 tools_4.4.1 vipor_0.4.7
## [61] beeswarm_0.4.0 glue_1.8.0 grid_4.4.1
## [64] cluster_2.1.6 generics_0.1.3 gtable_0.3.6
## [67] tidyr_1.3.1 BiocSingular_1.23.0 tidygraph_1.3.1
## [70] ScaledMatrix_1.13.0 metapod_1.13.0 utf8_1.2.4
## [73] XVector_0.45.0 ggrepel_0.9.6 BiocVersion_3.21.1
## [76] pillar_1.9.0 stringr_1.5.1 splines_4.4.1
## [79] tweenr_2.0.3 BiocFileCache_2.15.0 lattice_0.22-6
## [82] FNN_1.1.4.1 bit_4.5.0 tidyselect_1.2.1
## [85] locfit_1.5-9.10 maketools_1.3.1 Biostrings_2.75.0
## [88] knitr_1.48 gridExtra_2.3 xfun_0.48
## [91] graphlayouts_1.2.0 statmod_1.5.0 stringi_1.8.4
## [94] UCSC.utils_1.1.0 yaml_2.3.10 evaluate_1.0.1
## [97] codetools_0.2-20 ggraph_2.2.1 tibble_3.2.1
## [100] BiocManager_1.30.25 cli_3.6.3 uwot_0.2.2
## [103] munsell_0.5.1 jquerylib_0.1.4 Rcpp_1.0.13
## [106] dbplyr_2.5.0 png_0.1-8 parallel_4.4.1
## [109] blob_1.2.4 viridisLite_0.4.2 scales_1.3.0
## [112] purrr_1.0.2 crayon_1.5.3 rlang_1.1.4
## [115] cowplot_1.1.3 KEGGREST_1.45.1