The vignette depends on CIARA packages.
library(SCOPRO)
required <- c("CIARA")
if (!all(unlist(lapply(required, function(pkg) requireNamespace(pkg, quietly = TRUE)))))
knitr::opts_chunk$set(eval = FALSE)In this vignette it is shown the projection performed between single cell RNA seq mouse data from Iturbe et al., 2021 and in vivo mouse datasets from Deng et al. , 2014 and Mohammed et al. , 2017.
The single cell RNA seq dataset includes 1285 mouse embryonic stem cells, including a small cluster of 2-cell-like cells (2CLC) (cluster 2, 31 cells).
The in vivo mouse dataset from Deng et al. , 2014 includes stages from from early 2 cells-stage to late blastocyst while the in vivo mouse dataset from Mohammed et al. , 2017 includes stages from from E4.5 to E6.5.
We load the raw count matrix provided in the original paper and create norm counts and run cluster analysis with CIARA function cluster_analysis_integrate_rare
Raw count matrix can be downloaded here
The seurat object seurat_genes_published_mouse.Rda already includes the raw and normalized count matrix obtained combining the two in vivo datasets ( Deng et al., 014 and Mohammed et al. , 2017 ). Normalization was done with Seurat function NormalizeData (default parameters). Seurat object can be downloaded here
DefaultAssay(seurat_genes_published_mouse) <- "RNA"
cluster_mouse_published <- as.vector(seurat_genes_published_mouse$stim)
relevant_stages <- c("Late_2_cell", "epiblast_4.5", "epiblast_5.5", "epiblast_6.5")
DefaultAssay(seurat_genes_published_mouse) <- "RNA"
markers_first_ESC_small <- CIARA::markers_cluster_seurat(seurat_genes_published_mouse[,cluster_mouse_published%in%relevant_stages],cluster_mouse_published[cluster_mouse_published%in%relevant_stages],names(seurat_genes_published_mouse$RNA_snn_res.0.2)[cluster_mouse_published%in%relevant_stages],10)
markers_mouse <- as.vector(markers_first_ESC_small[[3]])
stages_markers <- names(markers_first_ESC_small[[3]])
## Keeping only the genes in common between in vitro and in vivo datasets
stages_markers <- stages_markers[markers_mouse %in% row.names(norm_es_vitro)]
markers_small <- markers_mouse[markers_mouse %in% row.names(norm_es_vitro)]
names(markers_small) <- stages_markersFor each in vivo stage, we select only the markers for which the median is above 0.1 and is below 0.1 in all the other stages.
We run SCOPRO between the cluster of the mouse ESCs dataset and the in vivo stage “Late 2-cells”.
The function SCOPRO first computes the mean expression profile of genes for each cluster in the in vivo and in vitro dataset. For a given cluster, a connectivity matrix is computed with number of rows and number of columns equal to the length of . Each entry (i,j) in the matrix can be 1 if the fold_change between gene i and gene j is above . Otherwise is 0. Finally the connectivity matrix of Late 2-cells stage and all the clusters in the in vitro dataset are compared. A gene i is considered to be conserved between Late 2-cells stage and an in vitro cluster if the jaccard index of the links of gene i is above .
There are 25 markers of the Late 2-cells stage that are also expressed in the mouse ESC datasets. More than 75% of these 25 markers are conserved in the cluster number 2. This result is expected since cluster 2 is made up by 2CLC, a rare population of cells known to be transcriptionally similar to the late 2 cells-stage in the mouse embryo development (typical markers of 2CLC are the Zscan4 genes, also highly expressed in the late 2 cells-stage).
marker_stages_filter <- filter_in_vitro(norm_es_vitro,cluster_es_vitro ,marker_all, fraction = 0.10, threshold = 0)
analysis_2cell <- SCOPRO(norm_es_vitro,norm_vivo,cluster_es_vitro,cluster_mouse_published,"Late_2_cell",marker_stages_filter, threshold = 0.1, number_link = 1, fold_change = 3, threshold_fold_change = 0.1 ,marker_stages, relevant_stages)
#png("/Users/gabriele.lubatti/Downloads/SCOPRO_1.png")
plot_score(analysis_2cell, marker_stages, marker_stages_filter, relevant_stages, "Late_2_cell", "Final score", "Cluster", "Late_2_cell")
#dev.off()We can visualize which are the markers of the late 2 cells stage that are conserved/ not conserved in cluster 2. As expected the Zscan4 family genes are conserved.
common_genes <- select_common_genes(analysis_2cell, marker_stages, relevant_stages, "Late_2_cell", cluster_es_vitro, "2")
no_common_genes <- select_no_common_genes(analysis_2cell, marker_stages, relevant_stages, "Late_2_cell", cluster_es_vitro, "2")
all_genes <- c(no_common_genes[1:4], common_genes[1:10])
all_genes_label <- c(paste0(no_common_genes[1:4], "-no_conserved"), paste0(common_genes[1:10], "-conserved"))
rabbit_plot <- plot_score_genes(all_genes, "Mouse ESC", "Mouse vitro", norm_es_vitro,norm_vivo[ , cluster_mouse_published=="Late_2_cell"],cluster_es_vitro, cluster_mouse_published[cluster_mouse_published == "Late_2_cell"], all_genes_label, 7, 10, "Late_2_cell")
#png("/Users/gabriele.lubatti/Downloads/SCOPRO_2.png")
rabbit_plot
#dev.off()utils::sessionInfo()
#> R version 4.4.2 (2024-10-31)
#> 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] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] SCOPRO_0.1.0 rmarkdown_2.29
#>
#> loaded via a namespace (and not attached):
#> [1] viridis_0.6.5 sass_0.4.9 utf8_1.2.4 generics_0.1.3
#> [5] tidyr_1.3.1 digest_0.6.37 magrittr_2.0.3 evaluate_1.0.1
#> [9] grid_4.4.2 CIARA_0.1.0 fastmap_1.2.0 jsonlite_1.8.9
#> [13] ggrepel_0.9.6 gridExtra_2.3 purrr_1.0.2 fansi_1.0.6
#> [17] viridisLite_0.4.2 scales_1.3.0 tweenr_2.0.3 jquerylib_0.1.4
#> [21] cli_3.6.3 rlang_1.1.4 graphlayouts_1.2.0 polyclip_1.10-7
#> [25] tidygraph_1.3.1 munsell_0.5.1 withr_3.0.2 cachem_1.1.0
#> [29] yaml_2.3.10 parallel_4.4.2 tools_4.4.2 memoise_2.0.1
#> [33] dplyr_1.1.4 colorspace_2.1-1 ggplot2_3.5.1 buildtools_1.0.0
#> [37] vctrs_0.6.5 R6_2.5.1 lifecycle_1.0.4 MASS_7.3-61
#> [41] ggraph_2.2.1 pkgconfig_2.0.3 pillar_1.9.0 bslib_0.8.0
#> [45] gtable_0.3.6 glue_1.8.0 Rcpp_1.0.13-1 ggforce_0.4.2
#> [49] xfun_0.49 tibble_3.2.1 tidyselect_1.2.1 sys_3.4.3
#> [53] knitr_1.48 farver_2.1.2 htmltools_0.5.8.1 igraph_2.1.1
#> [57] maketools_1.3.1 compiler_4.4.2