Single-cell transcriptomic analysis of human implantation
JD
2020-08-02
Zhou, F., Wang, R., Yuan, P., Ren, Y., Mao, Y., Li, R., Lian, Y., Li, J., Wen, L., Yan, L., et al. (2019). Reconstituting the transcriptome and DNA methylome landscapes of human implantation. Nature 572, 660–664.
- BioProject Accession: PRJNA431392
- GEO Accession: GSE109555
Load required packages.
library(tidyverse)
library(magrittr)
library(Matrix)
library(Seurat)
library(extrafont)
library(patchwork)
# library(tidylog)Sys.time()## [1] "2020-08-02 14:44:50 CDT"Data preparation
Functions loading
source(
file = file.path(
SCRIPT_DIR,
"utilities.R"
)
)Data loading
cell_metadata <- read_csv(
file = "../Supplementary_Table_2_Sample_Information.csv"
) %>%
select(
Sample,
Day,
IVC,
Embryo,
Ori_Day,
Ori_Day_Emb,
Sex,
CNV,
Lineage
) %>%
rename_all(tolower)## Parsed with column specification:
## cols(
## Sample = col_character(),
## Day = col_character(),
## IVC = col_character(),
## Embryo = col_character(),
## chrM_Ratio = col_double(),
## ERCC_Ratio = col_double(),
## GeneNum = col_double(),
## Ori_Day = col_character(),
## Ori_Day_Emb = col_character(),
## Sex = col_character(),
## Pseudotime = col_double(),
## CNV = col_character(),
## Lineage = col_character()
## )Prepare metadata for single cells.
# Supplementary Tables 1
embedding_5911 <- read_csv(
file = "5911/embedding_ncomponents7_seed20200317.csv"
) %>%
left_join(
cell_metadata,
by = c("cell" = "sample")
) %>%
mutate(
developmental_stage = str_replace(
string = day,
pattern = "D",
replacement = "E"
),
developmental_stage = factor(
developmental_stage,
levels = c(str_sort(unique(developmental_stage), numeric = TRUE))
),
#
lineage = ifelse(lineage == "MIX", "ysTE", lineage),
lineage = factor(lineage, levels = c("EPI", "PE", "TE", "ysTE"))
)## Parsed with column specification:
## cols(
## cell = col_character(),
## batch = col_character(),
## louvain = col_double(),
## x_tsne = col_double(),
## y_tsne = col_double(),
## x_umap = col_double(),
## y_umap = col_double(),
## x_fitsne = col_double(),
## y_fitsne = col_double(),
## x_phate = col_double(),
## y_phate = col_double(),
## `x_min_dist=0.1` = col_double(),
## `y_min_dist=0.1` = col_double(),
## x_multicoretsne = col_double(),
## y_multicoretsne = col_double()
## )reticulate::py_discover_config()## python: /Users/jialei/.pyenv/shims/python
## libpython: /Users/jialei/.pyenv/versions/3.8.2/lib/libpython3.8.dylib
## pythonhome: /Users/jialei/.pyenv/versions/3.8.2:/Users/jialei/.pyenv/versions/3.8.2
## version: 3.8.2 (default, May 23 2020, 03:35:41) [Clang 11.0.3 (clang-1103.0.32.62)]
## numpy: /Users/jialei/.pyenv/versions/3.8.2/lib/python3.8/site-packages/numpy
## numpy_version: 1.19.0
##
## NOTE: Python version was forced by RETICULATE_PYTHONnp <- reticulate::import("numpy", convert = TRUE)
scipy.sparse <- reticulate::import(module = "scipy.sparse", convert = TRUE)
matrix_readcount_use <- scipy.sparse$load_npz("../matrix_readcount.npz")
matrix_readcount_use_features <- np$load("../matrix_readcount_features.npy")
matrix_readcount_use_barcodes <- np$load("../matrix_readcount_barcodes.npy")
colnames(matrix_readcount_use) <- matrix_readcount_use_barcodes
rownames(matrix_readcount_use) <- matrix_readcount_use_features
matrix_readcount_use <- matrix_readcount_use[, embedding_5911$cell]
# calculate CPM
matrix_cpm_use <- calc_cpm(matrix_readcount_use)
stopifnot(
dim(matrix_readcount_use) == dim(matrix_cpm_use)
)
print(dim(matrix_readcount_use))## [1] 33538 5911walk(list(embedding_5911, matrix_readcount_use, matrix_cpm_use), function(x) {
print(object.size(x), units = "auto", standard = "SI")
})## 2.1 MB
## 551.5 MB
## 551.5 MBProfiling of human post-implantation
Clustering of 5911 single cells
Lineage and sex identification
p_embedding_5911_cluster <- plot_embedding(
embedding = embedding_5911[, c("x_tsne", "y_tsne")],
color_values = embedding_5911$louvain %>% as.factor(),
label = "t-SNE; Cluster",
# label_position = c(label_x, label_y),
show_color_value_labels = TRUE,
show_color_legend = FALSE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = gg_color_hue(n = length(unique(embedding_5911$louvain)))
)
# Extended Data Fig. 1i
p_embedding_5911_developmental_stage <- plot_embedding(
embedding = embedding_5911[, c("x_tsne", "y_tsne")],
color_values = embedding_5911$developmental_stage,
label = "t-SNE; Developmental stage",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 20")(
length(levels(embedding_5911$developmental_stage))
)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme()
# Extended Data Fig. 1j
p_embedding_5911_lineage <- plot_embedding(
embedding = embedding_5911[, c("x_tsne", "y_tsne")],
color_values = embedding_5911$lineage,
label = "t-SNE; Lineage",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 10")(
length(levels(embedding_5911$lineage))
)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme()
p_embedding_5911_cnv <- plot_embedding(
embedding = embedding_5911[, c("x_tsne", "y_tsne")],
color_values = embedding_5911$cnv,
label = "t-SNE; CNV",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 10")(8) %>% rev(.)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme()
p_embedding_5911_sex <- plot_embedding(
embedding = embedding_5911[, c("x_tsne", "y_tsne")],
color_values = embedding_5911$sex,
label = "t-SNE; Sex",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 10")(6) %>% rev(.)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme()Summarize sequencing depth.
embedding_5911 %>%
mutate(
num_umis = colSums(matrix_readcount_use[, cell]),
num_genes = colSums(matrix_readcount_use[, cell] > 0)
) %>%
group_by(louvain) %>%
summarise(
num_cell = n(),
median_umis = median(num_umis),
median_genes = median(num_genes)
) %>%
# xtable::xtable()
gt::gt() %>%
gt::tab_options(table.font.size = "median")## `summarise()` ungrouping output (override with `.groups` argument)| louvain | num_cell | median_umis | median_genes |
|---|---|---|---|
| 0 | 727 | 216913.0 | 9609.0 |
| 1 | 624 | 222450.5 | 10128.0 |
| 2 | 584 | 12578.5 | 3589.5 |
| 3 | 528 | 111037.5 | 8532.0 |
| 4 | 524 | 190187.5 | 8982.0 |
| 5 | 521 | 31544.0 | 4972.0 |
| 6 | 501 | 160813.0 | 8174.0 |
| 7 | 447 | 111279.0 | 7990.0 |
| 8 | 363 | 130704.0 | 8093.0 |
| 9 | 321 | 19209.0 | 4039.0 |
| 10 | 275 | 143497.0 | 8970.0 |
| 11 | 215 | 121296.0 | 7331.0 |
| 12 | 184 | 117697.0 | 8155.0 |
| 13 | 97 | 213967.0 | 10233.0 |
Summarize development stage info.
embedding_5911 %>%
dplyr::count(developmental_stage) %>%
gt::gt() %>%
gt::cols_label(n = "num_cell") %>%
gt::tab_options(table.font.size = "median")| developmental_stage | num_cell |
|---|---|
| E6 | 733 |
| E8 | 2077 |
| E10 | 1710 |
| E12 | 854 |
| E14 | 537 |
Summarize lineage info.
embedding_5911 %>%
dplyr::count(lineage) %>%
gt::gt() %>%
gt::cols_label(n = "num_cell") %>%
gt::tab_options(table.font.size = "median")| lineage | num_cell |
|---|---|
| EPI | 330 |
| PE | 179 |
| TE | 5363 |
| ysTE | 39 |
Summarize CNV info.
embedding_5911 %>%
dplyr::count(cnv) %>%
gt::gt() %>%
gt::cols_label(n = "num_cell") %>%
gt::tab_options(table.font.size = "median")| cnv | num_cell |
|---|---|
| Abnormal | 1955 |
| Normal | 3956 |
Summarize Sex info.
embedding_5911 %>%
dplyr::count(sex) %>%
gt::gt() %>%
gt::cols_label(n = "num_cell") %>%
gt::tab_options(table.font.size = "median")| sex | num_cell |
|---|---|
| Female | 2718 |
| Male | 3193 |
Select cells analyzed in Fig. 1a.
# Supplementary Tables 1
EMBRYOS_SELECTED <- c(
"ha_D6_E2",
"hm_D6_E1",
"hm_D6_E2",
"hm_D8_E2",
"hm_D8_E3",
"hm_D8_E5",
"ha_D8_E1",
"hm_D8_E1",
"hv_D8_E1",
"hv_D8_E2",
"hv_D8_E3",
"hv_D10_E6",
"ha_D10_E1",
"ha_D10_E2",
"hm_D10_E4",
"hm_D10_E9",
"hv_D10_E7",
"hv_D10_E8",
"ha_D12_E1",
"hv_D12_E1",
"hv_D12_E2"
)embedding_5911 %<>%
mutate(
selected = ifelse(ori_day_emb %in% EMBRYOS_SELECTED, 1, 0)
)
embedding_5911 %>%
mutate(
num_umis = colSums(matrix_readcount_use[, cell]),
num_genes = colSums(matrix_readcount_use[, cell] > 0)
) %>%
group_by(selected) %>%
summarise(
num_cell = n(),
median_umis = median(num_umis),
median_genes = median(num_genes)
) %>%
gt::gt() %>%
gt::tab_options(table.font.size = "median")## `summarise()` ungrouping output (override with `.groups` argument)
| selected | num_cell | median_umis | median_genes |
|---|---|---|---|
| 0 | 2727 | 123761.0 | 8348.0 |
| 1 | 3184 | 124979.5 | 8154.5 |
p_embedding_5911_selected <- plot_embedding(
embedding = embedding_5911[, c("x_tsne", "y_tsne")],
color_values = embedding_5911$selected %>% as.factor(),
label = "t-SNE; 3184 in Fig. 1c",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = c("grey", "salmon")
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme()purrr::reduce(list(
p_embedding_5911_cluster,
p_embedding_5911_developmental_stage,
p_embedding_5911_lineage,
p_embedding_5911_cnv,
p_embedding_5911_sex,
p_embedding_5911_selected
), `+`) +
plot_layout(ncol = 3) +
plot_annotation(
theme = theme(plot.margin = margin())
)
Expression
t-SNE
Extended Data Fig. 2abc
FEATURES_SELECTED <- c(
"POU5F1",
"NANOG",
"SOX2",
"GATA4",
"PDGFRA",
"FOXA2",
"GATA3",
"DAB2",
"TFAP2C"
)
FEATURES_SELECTED <- rownames(matrix_readcount_use)[
gene_symbo_info$X2 %in% FEATURES_SELECTED
]map(FEATURES_SELECTED, function(x) {
plot_embedding_value(
embedding = embedding_5911[, c("x_tsne", "y_tsne")],
color_values = matrix_cpm_use[x, embedding_5911$cell],
colorbar_position = c(0.86, 0.28),
label = str_c("t-SNE; ", x),
label_position = NULL,
# label_position = c(label_x, label_y),
geom_point_size = 1,
sort_values = TRUE,
FUN = NULL
)
}) %>%
purrr::reduce(`+`) +
plot_layout(nrow = 3, byrow = TRUE) +
plot_annotation(theme = theme(plot.margin = margin()))
Clustering of 3184 single cells
Prepare metadata for single cells.
embedding_3184 <- read_csv(
file = "embedding_ncomponents8_seed20200317.csv"
) %>%
select(cell, batch, louvain, x_tsne, y_tsne) %>%
left_join(
embedding_5911 %>%
select(cell, day:last_col()),
by = "cell"
)## Parsed with column specification:
## cols(
## cell = col_character(),
## batch = col_character(),
## louvain = col_double(),
## x_tsne = col_double(),
## y_tsne = col_double(),
## x_umap = col_double(),
## y_umap = col_double(),
## x_fitsne = col_double(),
## y_fitsne = col_double(),
## x_phate = col_double(),
## y_phate = col_double(),
## `x_min_dist=0.1` = col_double(),
## `y_min_dist=0.1` = col_double(),
## x_multicoretsne = col_double(),
## y_multicoretsne = col_double()
## )Lineage and sex identification
Fig. 1cd
p_embedding_3184_cluster <- plot_embedding(
embedding = embedding_3184[, c("x_tsne", "y_tsne")],
color_values = embedding_3184$louvain %>% as.factor(),
label = "t-SNE; Cluster",
# label_position = c(label_x, label_y),
show_color_value_labels = TRUE,
show_color_legend = FALSE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = gg_color_hue(n = length(unique(embedding_3184$louvain)))
)
p_embedding_3184_developmental_stage <- plot_embedding(
embedding = embedding_3184[, c("x_tsne", "y_tsne")],
color_values = embedding_3184$developmental_stage,
label = "t-SNE; Developmental stage",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 20")(
length(levels(embedding_3184$developmental_stage))
)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme(x = 0.75, y = 0.995)
p_embedding_3184_lineage <- plot_embedding(
embedding = embedding_3184[, c("x_tsne", "y_tsne")],
color_values = embedding_3184$lineage,
label = "t-SNE; Lineage",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 10")(
length(levels(embedding_3184$lineage))
)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme(x = 0.75, y = 0.995)
p_embedding_3184_cnv <- plot_embedding(
embedding = embedding_3184[, c("x_tsne", "y_tsne")],
color_values = embedding_3184$cnv,
label = "t-SNE; CNV",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 10")(
8
) %>% rev(.)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme(x = 0.75, y = 0.995)
p_embedding_3184_sex <- plot_embedding(
embedding = embedding_3184[, c("x_tsne", "y_tsne")],
color_values = embedding_3184$sex,
label = "t-SNE; Sex",
# label_position = c(label_x, label_y),
show_color_value_labels = FALSE,
show_color_legend = TRUE,
geom_point_size = 1,
sort_values = FALSE
) +
scale_color_manual(
values = ggthemes::tableau_color_pal("Tableau 10")(
6
) %>% rev(.)
) +
labs(color = NULL) +
guides(
colour = guide_legend(override.aes = list(size = 3))
) +
customized_theme(x = 0.75, y = 0.995)
p_embedding_3184_umi <- plot_embedding_value(
embedding = embedding_3184[, c("x_tsne", "y_tsne")],
color_values = matrix_readcount_use[, embedding_3184$cell] %>%
colSums(),
colorbar_position = c(0.85, 0.95),
label = "UMI distribution",
label_position = NULL,
# label_position = c(label_x, label_y),
geom_point_size = 1,
sort_values = FALSE,
FUN = function(x) log10(x)
)purrr::reduce(list(
p_embedding_3184_cluster,
p_embedding_3184_umi,
p_embedding_3184_developmental_stage,
p_embedding_3184_lineage,
p_embedding_3184_cnv,
p_embedding_3184_sex
), `+`) +
plot_layout(ncol = 3) +
plot_annotation(
theme = theme(plot.margin = margin())
)
Expression
t-SNE
FEATURES_SELECTED## [1] "ENSG00000181449_SOX2" "ENSG00000134853_PDGFRA" "ENSG00000153071_DAB2"
## [4] "ENSG00000204531_POU5F1" "ENSG00000136574_GATA4" "ENSG00000107485_GATA3"
## [7] "ENSG00000111704_NANOG" "ENSG00000125798_FOXA2" "ENSG00000087510_TFAP2C"map(FEATURES_SELECTED, function(x) {
plot_embedding_value(
embedding = embedding_3184[, c("x_tsne", "y_tsne")],
color_values = matrix_cpm_use[x, embedding_3184$cell],
colorbar_position = c(0.85, 0.95),
label = str_c("t-SNE; ", x),
label_position = NULL,
# label_position = c(label_x, label_y),
geom_point_size = 1,
sort_values = TRUE,
FUN = NULL
)
}) %>%
purrr::reduce(`+`) +
plot_layout(nrow = 3, byrow = TRUE) +
plot_annotation(theme = theme(plot.margin = margin()))
Heatmap
Lineages
Fig. 2a
SUPPLEMENTARY_INFORMATION_DIR <- "../../../../docs/Reconstituting_the_transcriptome_and_DNA_methylome_landscapes_of_human_implantation/41586_2019_1500_MOESM3_ESM"Supplementary Table 3, sheet 1
file_name <- "Supplementary Table 3 Lineage_Markers.xlsx"
table_s3_sheet1 <- readxl::read_excel(
path = file.path(SUPPLEMENTARY_INFORMATION_DIR, file_name),
sheet = "Sheet1"
)
table_s3_sheet1FEATURES_SELECTED <- rownames(matrix_readcount_use)[
gene_symbo_info$X2 %in% table_s3_sheet1$gene
]
FEATURES_SELECTED %>% length()## [1] 817matrix_heatmap <- calc_cpm(
m = matrix_readcount_use
)[rownames(matrix_readcount_use) %in% FEATURES_SELECTED, embedding_3184$cell]
matrix_heatmap <- matrix_heatmap[rowSums(matrix_heatmap) != 0, ]
matrix_heatmap <- log10(matrix_heatmap + 1)
matrix_heatmap <- t(scale(t(matrix_heatmap)))
(heatmap_limits <- quantile(matrix_heatmap, c(0.05, 0.95)))## 5% 95%
## -1.141820 1.928569matrix_heatmap[matrix_heatmap < heatmap_limits[1]] <- heatmap_limits[1]
matrix_heatmap[matrix_heatmap > heatmap_limits[2]] <- heatmap_limits[2]# order cells
cells_heatmap <- map(levels(embedding_3184$lineage), function(x) {
cells_in_group <- embedding_3184 %>%
filter(lineage == x) %>%
pull(cell)
cells_in_group[
pvclust::pvclust(
matrix_heatmap[, cells_in_group],
nboot = 100,
parallel = parallel::detectCores() - 2L
)$hclust$order
]
}) %>%
unlist()## Creating a temporary cluster...done:
## socket cluster with 6 nodes on host 'localhost'
## Multiscale bootstrap... Done.
## Creating a temporary cluster...done:
## socket cluster with 6 nodes on host 'localhost'
## Multiscale bootstrap... Done.
## Creating a temporary cluster...done:
## socket cluster with 6 nodes on host 'localhost'
## Multiscale bootstrap... Done.
## Creating a temporary cluster...done:
## socket cluster with 6 nodes on host 'localhost'
## Multiscale bootstrap... Done.# order features, index
features_heatmap <- pvclust::pvclust(
t(matrix_heatmap[, cells_heatmap]),
nboot = 100,
parallel = parallel::detectCores() - 2L
)$hclust$order## Creating a temporary cluster...done:
## socket cluster with 6 nodes on host 'localhost'
## Multiscale bootstrap... Done.matrix_heatmap <- matrix_heatmap[features_heatmap, cells_heatmap]ha_columns <- ComplexHeatmap::HeatmapAnnotation(
lineage = ComplexHeatmap::anno_simple(
embedding_3184[match(
x = colnames(matrix_heatmap),
table = embedding_3184$cell
), "lineage"],
# pch = anno_labels_cluster,
col = setNames(
object = ggthemes::tableau_color_pal("Tableau 10")(
length(unique(embedding_3184$lineage))
),
nm = levels(embedding_3184$lineage)
),
which = "column",
pt_size = unit(2, "mm"),
pt_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 5
),
simple_anno_size = unit(3, "mm")
),
#
developmental_stage = ComplexHeatmap::anno_simple(
embedding_3184[match(
x = colnames(matrix_heatmap),
table = embedding_3184$cell
), "developmental_stage"],
# pch = anno_labels_lineage,
col = setNames(
object = ggthemes::tableau_color_pal("Tableau 20")(
embedding_3184$developmental_stage %>%
droplevels() %>%
levels() %>%
length()
),
nm = embedding_3184$developmental_stage %>%
droplevels() %>%
levels()
),
which = "column",
# pt_size = unit(2, "mm"),
pt_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 5
),
simple_anno_size = unit(3, "mm")
),
show_annotation_name = TRUE,
annotation_label = c(
"Lineage",
"Developmental stage"
),
annotation_name_gp = grid::gpar(fontfamily = "Arial", fontsize = 6),
annotation_name_side = "left"
)# genes highlighted in Fig. 2a
features_to_mark_left <- rownames(matrix_readcount_use)[
str_remove(
string = rownames(matrix_readcount_use),
pattern = "^E.+_"
) %in% c(
"DPPA5",
"KHDC3L",
"TDGF1",
"NANOG",
"SOX2",
"CXCL12",
"PRDM14",
"THY1",
#
"PDGFRA",
"GATA4",
"CDH2",
#
"FOXA2",
"FLRT3",
"SOX17",
"APOA4",
#
"CD44",
"SOX21",
"DLX3",
"HSD3B1",
"TFAP2A",
"ACKR2"
)
]
ha_left <- ComplexHeatmap::rowAnnotation(
foo = ComplexHeatmap::anno_mark(
at = which(rownames(matrix_heatmap) %in% features_to_mark_left),
labels = str_remove(
rownames(matrix_heatmap)[rownames(matrix_heatmap)
%in% features_to_mark_left], "^.+_"
),
which = "row",
side = "left",
lines_gp = grid::gpar(col = "grey50"),
labels_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 5
)
)
)lgd_lineage <- ComplexHeatmap::Legend(
title = "Lineage",
labels = sort(unique(embedding_3184$lineage)),
legend_gp = grid::gpar(fill = ggthemes::tableau_color_pal("Tableau 10")(
length(unique(embedding_3184$lineage))
)),
labels_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 6
),
title_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 6
)
)
lgd_developmental_stage <- ComplexHeatmap::Legend(
title = "Develpmental stage",
labels = levels(embedding_3184$developmental_stage),
legend_gp = grid::gpar(fill = ggthemes::tableau_color_pal("Tableau 20")(
length(levels(embedding_3184$developmental_stage))
)),
labels_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 6
),
title_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 6
)
)ht <- ComplexHeatmap::Heatmap(
matrix = matrix_heatmap,
# col = viridis::plasma(n = 10),
col = wesanderson::wes_palette("Zissou1", 50, type = "continuous"),
#
cluster_rows = FALSE,
cluster_columns = FALSE,
#
show_row_names = FALSE,
show_column_names = FALSE,
#
show_row_dend = FALSE,
show_column_dend = FALSE,
#
show_heatmap_legend = TRUE,
top_annotation = ha_columns,
left_annotation = ha_left,
#
heatmap_legend_param = list(
title = "Z score",
title_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 6
),
legend_direction = "vertical",
labels_gp = grid::gpar(
fontfamily = "Arial",
fontsize = 6
),
legend_height = unit(25, "mm"),
legend_width = unit(10, "mm")
),
#
use_raster = TRUE
)pd <- ComplexHeatmap::packLegend(
lgd_lineage,
lgd_developmental_stage,
# gap = unit(8, "mm"),
direction = "vertical"
)
Cells: 3184 used in Fig. 1a; Genes are from Supplementary Table 3
ComplexHeatmap::draw(
ht,
heatmap_legend_list = list(pd)
)