library(Seurat)
library(princurve)
library(Matrix)
library(dplyr)
library(RColorBrewer)
library(ggplot2)
library(ggExtra)
library(cowplot)
library(wesanderson)
#Set ggplot theme as classic
theme_set(theme_classic())
<- readRDS("../QC.filtered.clustered.cells.RDS") Hem.data
DimPlot(object = Hem.data,
group.by = "Cell_ident",
reduction = "spring",
cols = c("#ebcb2e", #"ChP"
"#9ec22f", #"ChP_progenitors"
"#e7823a", # CR
"#cc3a1b", #"Dorso-Medial_pallium"
"#d14c8d", #"Hem"
"#4cabdc", #"Medial_pallium"
"#046c9a", # Pallial
"#4990c9" #"Thalamic_eminence"
) )
<- subset(Hem.data, idents = c("ChP"))
ChP.data
DimPlot(ChP.data,
reduction = "spring",
pt.size = 1,
cols = c("#83c3b8", "#009fda")) + NoAxes()
<- ChP.data@meta.data %>%
Trajectory.ChP select("Barcodes", "Spring_1", "Spring_2", "Cell_ident")
<- principal_curve(as.matrix(Trajectory.ChP[,c("Spring_1", "Spring_2")]),
fit smoother='lowess',
trace=TRUE,
f = .7,
stretch=0)
## Starting curve---distance^2: 2305169233
## Iteration 1---distance^2: 1449991
## Iteration 2---distance^2: 1424111
## Iteration 3---distance^2: 1422674
## Iteration 4---distance^2: 1422096
#Pseudotime score
$Pseudotime <- fit$lambda/max(fit$lambda) Trajectory.ChP
<- brewer.pal(n =11, name = "Spectral")
cols
ggplot(Trajectory.ChP, aes(Spring_1, Spring_2)) +
geom_point(aes(color=Pseudotime), size=2, shape=16) +
scale_color_gradientn(colours=rev(cols), name='Pseudotime score')
$Cell.state <- cut(Trajectory.ChP$Pseudotime,
Trajectory.ChP3,
include.lowest = T,
labels=c("Early","Mid","Late"))
$Cell.state <- paste0(Trajectory.ChP$Cell_ident, "_", Trajectory.ChP$Cell.state)
Trajectory.ChP
ggplot(Trajectory.ChP, aes(Spring_1, Spring_2)) +
geom_point(aes(color= Cell.state), size=0.5) +
scale_color_manual(values= c("#68b041", "#e3c148", "#b7d174"))
<- subset(Hem.data, idents = c("Cajal-Retzius_neurons", "Pallial_neurons"))
Neurons.data
DimPlot(Neurons.data ,
reduction = "spring",
pt.size = 1,
cols = c("#cc391b","#026c9a")
+ NoAxes() )
## Cajal-Retzius cells
<- Neurons.data@meta.data %>%
Trajectories.Hem select("Barcodes", "Spring_1", "Spring_2", "Cell_ident") %>%
filter(Cell_ident == "Cajal-Retzius_neurons")
<- principal_curve(as.matrix(Trajectories.Hem[,c("Spring_1", "Spring_2")]),
fit smoother='lowess',
trace=TRUE,
f = .7,
stretch=0)
## Starting curve---distance^2: 45804778678
## Iteration 1---distance^2: 27732113
## Iteration 2---distance^2: 27728318
#Pseudotime score
$Pseudotime <- fit$lambda/max(fit$lambda) Trajectories.Hem
if (cor(Trajectories.Hem$Pseudotime, Neurons.data@assays$SCT@data['Hmga2', Trajectories.Hem$Barcodes]) > 0) {
$Pseudotime <- -(Trajectories.Hem$Pseudotime - max(Trajectories.Hem$Pseudotime))
Trajectories.Hem }
<- Neurons.data@meta.data %>%
Trajectories.Pallial select("Barcodes", "Spring_1", "Spring_2", "Cell_ident") %>%
filter(Cell_ident == "Pallial_neurons")
<- principal_curve(as.matrix(Trajectories.Pallial[,c("Spring_1", "Spring_2")]),
fit smoother='lowess',
trace=TRUE,
f = .7,
stretch=0)
## Starting curve---distance^2: 26984853690
## Iteration 1---distance^2: 22153700
## Iteration 2---distance^2: 22179462
## Iteration 3---distance^2: 22180297
#Pseudotime score
$Pseudotime <- fit$lambda/max(fit$lambda) Trajectories.Pallial
if (cor(Trajectories.Pallial$Pseudotime, Neurons.data@assays$SCT@data['Hmga2', Trajectories.Pallial$Barcodes]) > 0) {
$Pseudotime <- -(Trajectories.Pallial$Pseudotime - max(Trajectories.Pallial$Pseudotime))
Trajectories.Pallial }
<- rbind(Trajectories.Pallial, Trajectories.Hem) Trajectories.neurons
ggplot(Trajectories.neurons, aes(Spring_1, Spring_2)) +
geom_point(aes(color=Pseudotime), size=2, shape=16) +
scale_color_gradientn(colours=rev(cols), name='Pseudotime score')
hist(Trajectories.neurons$Pseudotime, breaks = 100)
abline(v=c(0.4,0.68), col ="blue")
$Cell.state <- cut(Trajectories.neurons$Pseudotime,
Trajectories.neuronsc(0,0.4,0.68,1),
include.lowest = T,
labels=c("BP","EN","LN"))
ggplot(Trajectories.neurons, aes(Spring_1, Spring_2)) +
geom_point(aes(color= Cell.state), size=0.5) +
scale_color_manual(values= c("#68b041", "#e3c148", "#b7d174"))
$Cell.state <- paste0(Trajectories.neurons$Cell_ident, "_", Trajectories.neurons$Cell.state) Trajectories.neurons
<- rbind(Trajectory.ChP,Trajectories.neurons) New.labels
$Cell.state <- sapply(Hem.data$Barcodes,
Hem.dataFUN = function(x) {
if (x %in% New.labels$Barcodes) {
= New.labels[x, "Cell.state"]
x else {
} = Hem.data@meta.data[x, "Cell_ident"]
x
} })
DimPlot(object = Hem.data,
group.by = "Cell.state",
reduction = "spring",
cols = c("#7293c8", "#b79f0b", "#3ca73f","#31b6bd",
"#ebcb2e", "#9ec22f", "#a9961b", "#cc3a1b", "#d14c8d", "#4cabdc", "#5ab793", "#e7823a", "#046c9a", "#4990c9"))
saveRDS(Hem.data, "../QC.filtered.clustered.cells.RDS")
#date
format(Sys.time(), "%d %B, %Y, %H,%M")
## [1] "26 avril, 2022, 11,57"
#Packages used
sessionInfo()
## R version 4.1.3 (2022-03-10)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.4 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
##
## locale:
## [1] LC_CTYPE=fr_FR.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=fr_FR.UTF-8 LC_COLLATE=fr_FR.UTF-8
## [5] LC_MONETARY=fr_FR.UTF-8 LC_MESSAGES=fr_FR.UTF-8
## [7] LC_PAPER=fr_FR.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=fr_FR.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] wesanderson_0.3.6 cowplot_1.1.1 ggExtra_0.9 ggplot2_3.3.5
## [5] RColorBrewer_1.1-2 dplyr_1.0.7 Matrix_1.4-1 princurve_2.1.6
## [9] SeuratObject_4.0.4 Seurat_4.0.5
##
## loaded via a namespace (and not attached):
## [1] Rtsne_0.15 colorspace_2.0-2 deldir_1.0-6
## [4] ellipsis_0.3.2 ggridges_0.5.3 spatstat.data_2.1-0
## [7] farver_2.1.0 leiden_0.3.9 listenv_0.8.0
## [10] ggrepel_0.9.1 fansi_0.5.0 codetools_0.2-18
## [13] splines_4.1.3 knitr_1.36 polyclip_1.10-0
## [16] jsonlite_1.7.2 ica_1.0-2 cluster_2.1.3
## [19] png_0.1-7 uwot_0.1.10 shiny_1.7.1
## [22] sctransform_0.3.2 spatstat.sparse_2.0-0 compiler_4.1.3
## [25] httr_1.4.2 assertthat_0.2.1 fastmap_1.1.0
## [28] lazyeval_0.2.2 later_1.3.0 htmltools_0.5.2
## [31] tools_4.1.3 igraph_1.2.11 gtable_0.3.0
## [34] glue_1.5.1 RANN_2.6.1 reshape2_1.4.4
## [37] Rcpp_1.0.8 scattermore_0.7 jquerylib_0.1.4
## [40] vctrs_0.3.8 nlme_3.1-153 lmtest_0.9-39
## [43] xfun_0.28 stringr_1.4.0 globals_0.14.0
## [46] mime_0.12 miniUI_0.1.1.1 lifecycle_1.0.1
## [49] irlba_2.3.3 goftest_1.2-3 future_1.23.0
## [52] MASS_7.3-56 zoo_1.8-9 scales_1.1.1
## [55] spatstat.core_2.3-1 promises_1.2.0.1 spatstat.utils_2.2-0
## [58] parallel_4.1.3 yaml_2.2.1 reticulate_1.22
## [61] pbapply_1.5-0 gridExtra_2.3 sass_0.4.0
## [64] rpart_4.1.16 stringi_1.7.6 highr_0.9
## [67] rlang_0.4.12 pkgconfig_2.0.3 matrixStats_0.61.0
## [70] evaluate_0.14 lattice_0.20-45 ROCR_1.0-11
## [73] purrr_0.3.4 tensor_1.5 labeling_0.4.2
## [76] patchwork_1.1.1 htmlwidgets_1.5.4 tidyselect_1.1.1
## [79] parallelly_1.29.0 RcppAnnoy_0.0.19 plyr_1.8.6
## [82] magrittr_2.0.2 R6_2.5.1 generics_0.1.1
## [85] DBI_1.1.1 pillar_1.6.4 withr_2.4.3
## [88] mgcv_1.8-40 fitdistrplus_1.1-6 survival_3.2-13
## [91] abind_1.4-5 tibble_3.1.6 future.apply_1.8.1
## [94] crayon_1.4.2 KernSmooth_2.23-20 utf8_1.2.2
## [97] spatstat.geom_2.3-0 plotly_4.10.0 rmarkdown_2.11
## [100] grid_4.1.3 data.table_1.14.2 digest_0.6.29
## [103] xtable_1.8-4 tidyr_1.1.4 httpuv_1.6.3
## [106] munsell_0.5.0 viridisLite_0.4.0 bslib_0.3.1
Institute of Psychiatry and Neuroscience of Paris, INSERM U1266, 75014, Paris, France, matthieu.moreau@inserm.fr↩︎