Exploratory plots
After QC
Katia de Paiva Lopes
Raj Lab
Department of Neuroscience
Icahn School of Medicine at Mount Sinai
NYC, New York
Raj Lab
Department of Neuroscience
Icahn School of Medicine at Mount Sinai
NYC, New York
2020-06-30
255 samples | 4 brain regions | Multi disease cohort.
work_dir = "~/pd-omics/katia/Microglia/mic_255s/"
expression_dir = "~/ad-omics_hydra/microglia_omics/expression_tables/added_pilot_314s/expr_4brain_regions/"
metadata_path = "~/pd-omics/katia/Microglia/mic_255s/metadata_files/"Metadata
load(paste0(expression_dir, "Expression_filt_255s.Rdata"))
# dim(genes_counts_exp_3rd) # 19376 255
load(paste0(metadata_path, "metadata_255filt_eng_29jun2020.Rdata"))
# str(metadata3rd_pass)
metadata <- metadata3rd_pass[, ! colnames(metadata3rd_pass) %in% c("C5", "C6", "C7", "C8", "C9", "C10")]
rownames(metadata) = metadata$donor_tissue
createDT(metadata)Brain regions
numb_tissues = as.data.frame(table(metadata$tissue))
colnames(numb_tissues) = c("Tissue", ("Number of donors"))
createDT(numb_tissues)ggplot(numb_tissues, aes(x=Tissue, y=`Number of donors`, fill=Tissue)) +
geom_bar(stat = "identity", width=0.5, color="black") +
scale_fill_futurama() +
theme_classic()
Demographics
Age range
Dashed bars for mean of age. Red = female | Blue = male.
ageByDonor = unique(metadata[,c("donor_id", "age", "sex")])
#createDT(ageByDonor)
max(ageByDonor$age, na.rm = T)[1] 103
[1] 21
mean_f = mean(ageByDonor[ageByDonor$sex == "f", "age"], na.rm = T)
mean_m = mean(ageByDonor[ageByDonor$sex == "m", "age"], na.rm = T)
ggplot(ageByDonor, aes(x=age, fill=sex)) +
geom_histogram(bins = 25, colour='black', position = "stack") +
labs(x="Age", y="Donors") +
scale_y_continuous(breaks = (1:20)) +
scale_x_continuous(breaks=seq(20,120,10)) +
geom_vline(xintercept=mean_f, color = "red", linetype="dashed") +
geom_vline(xintercept=mean_m, color = "blue", linetype="dashed") +
theme_classic()
ggplot(ageByDonor, aes(x = sex, y = age, fill = sex)) +
geom_boxplot(notch = T, na.rm = T) +
theme_classic()
Main diagnosis by donor
Main_diagnosisByDonnor = unique(metadata[,c("donor_id", "main_diagnosis")])
as.data.frame(t(as.matrix(unclass( table(Main_diagnosisByDonnor$main_diagnosis, useNA = "ifany") )))) %>%
kable(row.names = F) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))| Control | Dementia | Encephalitis | Epilepsy | Fahrs syndrome | Multiple sclerosis | Parkinson | PSP | Psychiatric diagnosis |
|---|---|---|---|---|---|---|---|---|
| 38 | 9 | 1 | 1 | 1 | 1 | 12 | 1 | 36 |
pie_table = table(Main_diagnosisByDonnor$main_diagnosis)
myPalette <- brewer.pal(10, "Set3")
pie(pie_table, border = "white", col = myPalette) +
coord_polar("y", start = 0) NULL 
Main diagnosis by sample (n = 255)
as.data.frame(table(metadata$main_diagnosis), useNA = "ifany" ) %>%
kable(row.names = F) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))| Var1 | Freq |
|---|---|
| Control | 96 |
| Dementia | 15 |
| Encephalitis | 3 |
| Epilepsy | 2 |
| Fahrs syndrome | 1 |
| Multiple sclerosis | 4 |
| Parkinson | 18 |
| PSP | 1 |
| Psychiatric diagnosis | 115 |
df = as.data.frame(table(metadata$main_diagnosis))
colnames(df) <- c("Diagnosis", "Frequency")
ggplot(data = df, aes(x=Diagnosis, y=Frequency)) +
geom_text(aes(label=Frequency), vjust=-0.5, size=3.5) +
geom_bar(stat = "identity", width=0.5, color="blue", fill="white") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Samples by Main diagnosis and Tissue (n = 255)
as.data.frame(table(metadata[,c("main_diagnosis", "tissue")]), useNA = "ifany" ) %>% tidyr::spread(tissue, Freq) %>%
kable(row.names = F) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))| main_diagnosis | MFG | STG | SVZ | THA |
|---|---|---|---|---|
| Control | 34 | 28 | 15 | 19 |
| Dementia | 5 | 2 | 5 | 3 |
| Encephalitis | 1 | 1 | 1 | 0 |
| Epilepsy | 1 | 1 | 0 | 0 |
| Fahrs syndrome | 0 | 0 | 0 | 1 |
| Multiple sclerosis | 1 | 1 | 1 | 1 |
| Parkinson | 7 | 2 | 5 | 4 |
| PSP | 1 | 0 | 0 | 0 |
| Psychiatric diagnosis | 27 | 28 | 28 | 32 |
Upset plot
# table(metadata$tissue) # To check
# 7 brain regions
gfm_list = unique(metadata$donor_id[which(metadata$tissue == "MFG")])
gts_list = unique(metadata$donor_id[which(metadata$tissue == "STG")])
svz_list = unique(metadata$donor_id[which(metadata$tissue == "SVZ")])
tha_list = unique(metadata$donor_id[which(metadata$tissue == "THA")])
gene_overlap = list(
GFM = gfm_list,
GTS = gts_list,
SVZ = svz_list,
THA = tha_list)
upset(fromList(gene_overlap), empty.intersections = NULL, order.by = "freq",nsets = 7, sets.bar.color = "#56B4E9")
Cause of death (n = 100)
DonorByDeath = unique(metadata[,c("donor_id", "cause_of_death_categories")])
#createDT(DonorByDeath)
as.data.frame(t(as.matrix(unclass( table(DonorByDeath$cause_of_death_categories, useNA = "ifany") )))) %>%
kable(row.names = F) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))| Cachexia_dehydration | Cancer | Cardiorespiratory | Euthanasia | Infection | Other | Suicide | NA |
|---|---|---|---|---|---|---|---|
| 4 | 6 | 19 | 35 | 21 | 5 | 3 | 7 |
df = as.data.frame(table(DonorByDeath$cause_of_death_categories, useNA = "ifany"))
colnames(df) <- c("Cause_of_death", "Frequency")
ggplot(data=df, aes(x=Cause_of_death, y=Frequency)) +
geom_bar(stat="identity", fill="#FA8072")+
geom_text(aes(label=Frequency), vjust=0.5, hjust=1.6, color="white", size=3.5)+
coord_flip() +
theme_classic()
R version 3.6.2 (2019-12-12) Platform: x86_64-apple-darwin15.6.0 (64-bit) Running under: macOS Catalina 10.15.5
Matrix products: default BLAS: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib
locale: [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages: [1] grid stats graphics grDevices utils datasets methods
[8] base
other attached packages: [1] factoextra_1.0.6 ggsci_2.9 ggfortify_0.4.10 gridExtra_2.3
[5] UpSetR_1.4.0 RColorBrewer_1.1-2 ggplot2_3.3.2 kableExtra_1.1.0
[9] dplyr_1.0.0 knitr_1.26 readxl_1.3.1
loaded via a namespace (and not attached): [1] tidyselect_1.1.0 xfun_0.11 purrr_0.3.4 colorspace_1.4-1 [5] vctrs_0.3.1 generics_0.0.2 htmltools_0.4.0 viridisLite_0.3.0 [9] yaml_2.2.0 rlang_0.4.6 pillar_1.4.4 later_1.0.0
[13] glue_1.4.1 withr_2.2.0 lifecycle_0.2.0 plyr_1.8.6
[17] stringr_1.4.0 munsell_0.5.0 gtable_0.3.0 cellranger_1.1.0 [21] rvest_0.3.5 htmlwidgets_1.5.1 evaluate_0.14 labeling_0.3
[25] fastmap_1.0.1 httpuv_1.5.2 crosstalk_1.0.0 highr_0.8
[29] Rcpp_1.0.4.6 xtable_1.8-4 readr_1.3.1 promises_1.1.0
[33] scales_1.1.1 DT_0.13 jsonlite_1.6.1 webshot_0.5.2
[37] farver_2.0.3 mime_0.8 hms_0.5.3 digest_0.6.25
[41] stringi_1.4.6 ggrepel_0.8.2 shiny_1.4.0 tools_3.6.2
[45] magrittr_1.5 tibble_3.0.1 crayon_1.3.4 tidyr_1.1.0
[49] pkgconfig_2.0.3 ellipsis_0.3.1 xml2_1.2.2 rmarkdown_2.0
[53] httr_1.4.1 rstudioapi_0.11 R6_2.4.1 compiler_3.6.2