diff --git a/code/analysis/01_build_spe/03_add_deconvolution.R b/code/analysis/01_build_spe/03_add_deconvolution.R index 3bb2f605..cb51c129 100644 --- a/code/analysis/01_build_spe/03_add_deconvolution.R +++ b/code/analysis/01_build_spe/03_add_deconvolution.R @@ -151,19 +151,19 @@ for (sample_id in anno_samples) { "\\{sample_id\\}", sample_id, anno_wrinkle_path ) this_anno_layers_path <- sub("\\{sample_id\\}", sample_id, anno_layers_path) - + # Read in wrinkle annotation and use unique and informative colnames anno_wrinkle <- this_anno_wrinkle_path |> read.csv() |> as_tibble() |> rename(wrinkle_type = ManualAnnotation, barcode = spot_name) - + # Read in layer annotation and use unique and informative colnames anno_layers <- this_anno_layers_path |> read.csv() |> as_tibble() |> rename(manual_layer_label = ManualAnnotation, barcode = spot_name) - + anno_list[[sample_id]] <- anno_layers |> full_join(anno_wrinkle, by = c("sample_id", "barcode")) } @@ -191,11 +191,11 @@ colData(spe) <- colData(spe)[, sort(colnames(colData(spe)))] # Interactively double-check that the annotations merged as expected # table(is.na(spe$manual_layer_label)) -# FALSE TRUE +# FALSE TRUE # 11991 101936 # table(is.na(spe$wrinkle_type)) -# FALSE TRUE +# FALSE TRUE # 2094 111833 # vis_clus(spe, sampleid = anno_samples[1], clustervar = "wrinkle_type") + @@ -271,7 +271,7 @@ session_info() # tz US/Eastern # date 2023-02-09 # pandoc 2.19.2 @ /jhpce/shared/jhpce/core/conda/miniconda3-4.11.0/envs/svnR-4.2.x/bin/pandoc -# +# # ─ Packages ─────────────────────────────────────────────────────────────────────────────────────────────────── # package * version date (UTC) lib source # AnnotationDbi 1.60.0 2022-11-01 [2] Bioconductor diff --git a/code/analysis/01_build_spe/my_functions/vis_gene_300.R b/code/analysis/01_build_spe/my_functions/vis_gene_300.R index 5d11cbe7..8b180fc4 100644 --- a/code/analysis/01_build_spe/my_functions/vis_gene_300.R +++ b/code/analysis/01_build_spe/my_functions/vis_gene_300.R @@ -1,17 +1,16 @@ vis_gene_300 <- - function( - spe, - sampleid, - geneid = "SCGB2A2; ENSG00000110484", - spatial = TRUE, - assayname = "logcounts", - minCount = 0, - viridis = TRUE, - image_id = "lowres", - alpha = 1, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - point_size = 1.25, - ...) { + function(spe, + sampleid, + geneid = "SCGB2A2; ENSG00000110484", + spatial = TRUE, + assayname = "logcounts", + minCount = 0, + viridis = TRUE, + image_id = "lowres", + alpha = 1, + cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), + point_size = 1.25, + ...) { spe_sub <- spe[, spe$sample_id == sampleid] d <- as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), optional = TRUE) diff --git a/code/analysis/01_build_spe/my_functions/vis_gene_p_300.R b/code/analysis/01_build_spe/my_functions/vis_gene_p_300.R index 0fdf9d60..74b5e9ff 100644 --- a/code/analysis/01_build_spe/my_functions/vis_gene_p_300.R +++ b/code/analysis/01_build_spe/my_functions/vis_gene_p_300.R @@ -1,15 +1,14 @@ vis_gene_p_300 <- - function( - spe, - d, - sampleid, - spatial, - title, - viridis = TRUE, - image_id = "lowres", - alpha = 1, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - point_size = 1.25) { + function(spe, + d, + sampleid, + spatial, + title, + viridis = TRUE, + image_id = "lowres", + alpha = 1, + cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), + point_size = 1.25) { ## Some variables pxl_row_in_fullres <- pxl_col_in_fullres <- key <- COUNT <- NULL # stopifnot(all(c("pxl_col_in_fullres", "pxl_row_in_fullres", "COUNT", "key") %in% colnames(d))) diff --git a/code/analysis/01_build_spe/my_functions/vis_grid_gene_300.R b/code/analysis/01_build_spe/my_functions/vis_grid_gene_300.R index 271517c5..846d0656 100644 --- a/code/analysis/01_build_spe/my_functions/vis_grid_gene_300.R +++ b/code/analysis/01_build_spe/my_functions/vis_grid_gene_300.R @@ -1,21 +1,20 @@ vis_grid_gene_300 <- - function( - spe, - geneid = "SCGB2A2; ENSG00000110484", - pdf_file, - assayname = "logcounts", - minCount = 0, - return_plots = FALSE, - spatial = TRUE, - viridis = TRUE, - height = 24, - width = 36, - image_id = "lowres", - alpha = 1, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - sample_order = unique(spe$sample_id), - point_size = 1.25, - ...) { + function(spe, + geneid = "SCGB2A2; ENSG00000110484", + pdf_file, + assayname = "logcounts", + minCount = 0, + return_plots = FALSE, + spatial = TRUE, + viridis = TRUE, + height = 24, + width = 36, + image_id = "lowres", + alpha = 1, + cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), + sample_order = unique(spe$sample_id), + point_size = 1.25, + ...) { stopifnot(all(sample_order %in% unique(spe$sample_id))) plots <- lapply(sample_order, function(sampleid) { diff --git a/code/analysis/07_layer_differential_expression/custom_plotExpression.R b/code/analysis/07_layer_differential_expression/custom_plotExpression.R index e51e32b5..43087386 100644 --- a/code/analysis/07_layer_differential_expression/custom_plotExpression.R +++ b/code/analysis/07_layer_differential_expression/custom_plotExpression.R @@ -16,14 +16,15 @@ #' cat = "Mutation_Status", #' fill_colors = c(negative = "green", positive = "pink") #' ) -custom_plotExpression <- function(sce, - genes, - assay = "logcounts", - cat, - highlight_sample = "None", - line = FALSE, - fill_colors = NULL, - title = NULL) { +custom_plotExpression <- function( + sce, + genes, + assay = "logcounts", + cat, + highlight_sample = "None", + line = FALSE, + fill_colors = NULL, + title = NULL) { cat_df <- as.data.frame(colData(sce))[, c("sample_id", cat), drop = FALSE] expression_long <- reshape2::melt(as.matrix(assays(sce)[[assay]][genes, , drop = FALSE])) diff --git a/code/analysis/08_spatial_registration/deprecated/03_custom_spatial_registration_plots.R b/code/analysis/08_spatial_registration/deprecated/03_custom_spatial_registration_plots.R index 7ad3318a..a5a62324 100644 --- a/code/analysis/08_spatial_registration/deprecated/03_custom_spatial_registration_plots.R +++ b/code/analysis/08_spatial_registration/deprecated/03_custom_spatial_registration_plots.R @@ -18,20 +18,19 @@ cor_stats_layer <- layer_stat_cor( ) layer_matrix_plot_AS <- - function( - matrix_values, - matrix_labels = NULL, - xlabs = NULL, - layerHeights = NULL, - mypal = c( - "white", - grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) - ), - breaks = NULL, - axis.args = NULL, - srt = 0, - mar = c(8, 4 + (max(nchar(rownames(matrix_values))) %/% 3) * 0.5, 4, 2) + 0.1, - cex = 1.2) { + function(matrix_values, + matrix_labels = NULL, + xlabs = NULL, + layerHeights = NULL, + mypal = c( + "white", + grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) + ), + breaks = NULL, + axis.args = NULL, + srt = 0, + mar = c(8, 4 + (max(nchar(rownames(matrix_values))) %/% 3) * 0.5, 4, 2) + 0.1, + cex = 1.2) { ## Create some default values in case the user didn't specify them if (is.null(xlabs)) { if (is.null(colnames(matrix_values))) { @@ -111,12 +110,11 @@ layer_matrix_plot_AS <- } layer_stat_cor_plot_AS <- - function( - cor_stats_layer, - max = 0.81, - min = -max, - layerHeights = NULL, - cex = 1.2) { + function(cor_stats_layer, + max = 0.81, + min = -max, + layerHeights = NULL, + cex = 1.2) { ## From https://github.com/LieberInstitute/HumanPilot/blob/master/Analysis/Layer_Guesses/dlpfc_snRNAseq_annotation.R theSeq <- seq(min, max, by = 0.01) my.col <- grDevices::colorRampPalette(RColorBrewer::brewer.pal(7, "PRGn"))(length(theSeq)) diff --git a/code/analysis/08_spatial_registration/deprecated/layer_matrix_plot_AS.R b/code/analysis/08_spatial_registration/deprecated/layer_matrix_plot_AS.R index 9bca38b6..cd412aac 100644 --- a/code/analysis/08_spatial_registration/deprecated/layer_matrix_plot_AS.R +++ b/code/analysis/08_spatial_registration/deprecated/layer_matrix_plot_AS.R @@ -55,20 +55,19 @@ #' cex = 2 #' ) layer_matrix_plot_AS <- - function( - matrix_values, - matrix_labels = NULL, - xlabs = NULL, - layerHeights = NULL, - mypal = c( - "white", - grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) - ), - breaks = NULL, - axis.args = NULL, - srt = 45, - mar = c(8, 4 + (max(nchar(rownames(matrix_values))) %/% 3) * 0.5, 4, 2) + 0.1, - cex = 1.2) { + function(matrix_values, + matrix_labels = NULL, + xlabs = NULL, + layerHeights = NULL, + mypal = c( + "white", + grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) + ), + breaks = NULL, + axis.args = NULL, + srt = 45, + mar = c(8, 4 + (max(nchar(rownames(matrix_values))) %/% 3) * 0.5, 4, 2) + 0.1, + cex = 1.2) { ## Create some default values in case the user didn't specify them if (is.null(xlabs)) { if (is.null(colnames(matrix_values))) { diff --git a/code/analysis/08_spatial_registration/deprecated/layer_stat_cor_plot_AS.R b/code/analysis/08_spatial_registration/deprecated/layer_stat_cor_plot_AS.R index 233cef1b..adae4b1c 100644 --- a/code/analysis/08_spatial_registration/deprecated/layer_stat_cor_plot_AS.R +++ b/code/analysis/08_spatial_registration/deprecated/layer_stat_cor_plot_AS.R @@ -64,12 +64,11 @@ #' top_n = 10 #' ), max = 0.3) layer_stat_cor_plot_AS <- - function( - cor_stats_layer, - max = 0.81, - min = -max, - layerHeights = NULL, - cex = 1.2) { + function(cor_stats_layer, + max = 0.81, + min = -max, + layerHeights = NULL, + cex = 1.2) { ## From https://github.com/LieberInstitute/HumanPilot/blob/master/Analysis/Layer_Guesses/dlpfc_snRNAseq_annotation.R theSeq <- seq(min, max, by = 0.01) my.col <- grDevices::colorRampPalette(RColorBrewer::brewer.pal(7, "PRGn"))(length(theSeq)) diff --git a/code/analysis/09_position_differential_expression/02_summarize.R b/code/analysis/09_position_differential_expression/02_summarize.R index 615c49ed..20738dbd 100644 --- a/code/analysis/09_position_differential_expression/02_summarize.R +++ b/code/analysis/09_position_differential_expression/02_summarize.R @@ -6,8 +6,10 @@ library("ggplot2") library("Polychrome") ## Plot directory -dir_plots <- here::here("plots", - "09_position_differential_expression") +dir_plots <- here::here( + "plots", + "09_position_differential_expression" +) dir.create(dir_plots, showWarnings = FALSE, recursive = TRUE) stopifnot(file.exists(dir_plots)) @@ -24,17 +26,20 @@ sce_pseudo <- ) ## Define variables to use -vars <- c("age", +vars <- c( + "age", "sample_id", "BayesSpace", "subject", "sex", - "position") + "position" +) ## Obtain percent of variance explained at the gene level ## using scater::getVarianceExplained() vars <- getVarianceExplained(sce_pseudo, - variables = vars) + variables = vars +) ## Now visualize the percent of variance explained across all genes pdf( @@ -49,13 +54,15 @@ dev.off() ## Load Sp09 DE results load(here("code", "deploy_app_k09", "sig_genes_subset_k09.Rdata"), - verbose = TRUE) + verbose = TRUE +) sig_domain <- sig_genes rm(sig_genes) ## Load Sp16 DE results load(here("code", "deploy_app_k16", "sig_genes_subset_k16.Rdata"), - verbose = TRUE) + verbose = TRUE +) sig_domain_16 <- sig_genes rm(sig_genes) @@ -92,7 +99,7 @@ pdf( ## Plot densities of t-statistics ggplot(enriched, aes(x = stat, fill = test)) + geom_density() + - facet_grid( ~ Analysis + test, margins = "test") + + facet_grid(~ Analysis + test, margins = "test") + xlab("Enrichment t-statistic") + scale_color_manual(values = colors, name = "Test") + scale_fill_manual(values = colors, name = "Test") + @@ -103,7 +110,7 @@ ggplot(enriched, aes(x = stat, fill = test)) + ## Plot histogram of t-statistics with FDR < 5% ggplot(subset(enriched, fdr < 0.05), aes(x = stat, fill = test)) + geom_histogram() + - facet_grid( ~ Analysis + test, margins = "test") + + facet_grid(~ Analysis + test, margins = "test") + xlab("Enrichment t-statistic (FDR <5%)") + scale_color_manual(values = colors, name = "Test") + scale_fill_manual(values = colors, name = "Test") + diff --git a/code/analysis/09_position_differential_expression/03_export_csvs.R b/code/analysis/09_position_differential_expression/03_export_csvs.R index 57afa4bd..ea728987 100644 --- a/code/analysis/09_position_differential_expression/03_export_csvs.R +++ b/code/analysis/09_position_differential_expression/03_export_csvs.R @@ -1,19 +1,23 @@ library("here") library("sessioninfo") -dir_rdata <- here::here("processed-data", "rdata", "spe", - "09_position_differential_expression") +dir_rdata <- here::here( + "processed-data", "rdata", "spe", + "09_position_differential_expression" +) stopifnot(file.exists(dir_rdata)) ## Load Sp09 DE results load(here("code", "deploy_app_k09", "sig_genes_subset_k09.Rdata"), - verbose = TRUE) + verbose = TRUE +) sig_domain_09 <- sig_genes rm(sig_genes) ## Load Sp16 DE results load(here("code", "deploy_app_k16", "sig_genes_subset_k16.Rdata"), - verbose = TRUE) + verbose = TRUE +) sig_domain_16 <- sig_genes rm(sig_genes) diff --git a/code/analysis/10_clinical_gene_set_enrichment/05_enrichment_PTSD.R b/code/analysis/10_clinical_gene_set_enrichment/05_enrichment_PTSD.R index d7957ff8..e7a20184 100644 --- a/code/analysis/10_clinical_gene_set_enrichment/05_enrichment_PTSD.R +++ b/code/analysis/10_clinical_gene_set_enrichment/05_enrichment_PTSD.R @@ -7,27 +7,27 @@ library("sessioninfo") ## Input dir dir_input <- here::here( - "processed-data", - "rdata", - "spe", - "07_layer_differential_expression" + "processed-data", + "rdata", + "spe", + "07_layer_differential_expression" ) ## Output directories dir_rdata <- here::here( - "processed-data", - "rdata", - "spe", - "10_clinical_gene_set_enrichment", - "PTSD" + "processed-data", + "rdata", + "spe", + "10_clinical_gene_set_enrichment", + "PTSD" ) dir.create(dir_rdata, showWarnings = FALSE, recursive = TRUE) stopifnot(file.exists(dir_rdata)) ## Check that it was created successfully dir_plots <- here::here( - "plots", - "10_clinical_gene_set_enrichment", - "05_enrichment_PTSD" + "plots", + "10_clinical_gene_set_enrichment", + "05_enrichment_PTSD" ) dir.create(dir_plots, showWarnings = FALSE, recursive = TRUE) stopifnot(file.exists(dir_plots)) @@ -39,18 +39,18 @@ de_protein <- mget(load(here(dir_rdata, "proteins.rda"), verbose = TRUE)) names(de_gene) names(de_protein) -split_region <- function(list){ - n <- stringr::str_split(names(list),"_") - n <- map_chr(n, ~tail(.x, 1)) - list2 <- map(splitit(n),~list[.x]) - return(list2) +split_region <- function(list) { + n <- stringr::str_split(names(list), "_") + n <- map_chr(n, ~ tail(.x, 1)) + list2 <- map(splitit(n), ~ list[.x]) + return(list2) } de_gene2 <- split_region(flatten(de_gene)) -names(de_gene2) <- paste0("gene_",names(de_gene2)) +names(de_gene2) <- paste0("gene_", names(de_gene2)) de_protein2 <- split_region(flatten(de_protein)) -names(de_protein2) <- paste0("protein_",names(de_protein2)) +names(de_protein2) <- paste0("protein_", names(de_protein2)) ptsd_genes <- c(de_gene2, de_protein2) names(ptsd_gene_list) @@ -58,28 +58,28 @@ names(ptsd_gene_list) ## convert to list and filter min_gene <- 10 -ptsd_gene_list <- map_depth(ptsd_genes, 2, ~.$gene) -ptsd_gene_list <- map(ptsd_gene_list, ~.x[map_int(.x,length) >20]) -ptsd_gene_list <- map_depth(ptsd_gene_list,2, ~ss(.x,"\\.")) -map(ptsd_gene_list,~map_int(.x,length)) +ptsd_gene_list <- map_depth(ptsd_genes, 2, ~ .$gene) +ptsd_gene_list <- map(ptsd_gene_list, ~ .x[map_int(.x, length) > 20]) +ptsd_gene_list <- map_depth(ptsd_gene_list, 2, ~ ss(.x, "\\.")) +map(ptsd_gene_list, ~ map_int(.x, length)) # $gene_DLPFC -# MDD_DLPFC PTSD_MDD_DLPFC MDD_Male_DLPFC PTSD_MDD_Male_DLPFC -# 315 414 34 22 -# +# MDD_DLPFC PTSD_MDD_DLPFC MDD_Male_DLPFC PTSD_MDD_Male_DLPFC +# 315 414 34 22 +# # $gene_mPFC -# MDD_mPFC PTSD_mPFC PTSD_MDD_mPFC MDD_ChildTrauma_mPFC -# 1264 1498 2322 1070 -# PTSD_ChildTrauma_mPFC PTSD_MDD_ChildTrauma_mPFC PTSD_Female_mPFC PTSD_MDD_Female_mPFC -# 408 726 211 105 -# MDD_Male_mPFC PTSD_MDD_Male_mPFC MDD_suicide_mPFC -# 410 226 681 -# +# MDD_mPFC PTSD_mPFC PTSD_MDD_mPFC MDD_ChildTrauma_mPFC +# 1264 1498 2322 1070 +# PTSD_ChildTrauma_mPFC PTSD_MDD_ChildTrauma_mPFC PTSD_Female_mPFC PTSD_MDD_Female_mPFC +# 408 726 211 105 +# MDD_Male_mPFC PTSD_MDD_Male_mPFC MDD_suicide_mPFC +# 410 226 681 +# # $protein_mPFC -# MDD_mPFC PTSD_mPFC PTSD_MDD_mPFC MDD_ChildTrauma_mPFC -# 56 46 100 78 -# PTSD_MDD_ChildTrauma_mPFC MDD_Female_mPFC PTSD_Female_mPFC MDD_Male_mPFC -# 46 36 39 23 +# MDD_mPFC PTSD_mPFC PTSD_MDD_mPFC MDD_ChildTrauma_mPFC +# 56 46 100 78 +# PTSD_MDD_ChildTrauma_mPFC MDD_Female_mPFC PTSD_Female_mPFC MDD_Male_mPFC +# 46 36 39 23 ## Specify what k's we want to look at k_list <- c(2, 7, 9, 16, 28) @@ -87,52 +87,52 @@ names(k_list) <- paste0("k", sprintf("%02d", k_list)) ## Load the modeling results from the BayesSpace models bayesSpace_registration_fn <- - map(k_list, ~ here( - dir_input, - paste0( - "modeling_results_BayesSpace_k", - sprintf("%02d", .x), - ".Rdata" - ) - )) + map(k_list, ~ here( + dir_input, + paste0( + "modeling_results_BayesSpace_k", + sprintf("%02d", .x), + ".Rdata" + ) + )) bayesSpace_registration <- - lapply(bayesSpace_registration_fn, function(x) { - get(load(x)) - }) + lapply(bayesSpace_registration_fn, function(x) { + get(load(x)) + }) ## Read in the spatial registration labels bayes_anno <- - read.csv( - file = here( - "processed-data", - "rdata", - "spe", - "08_spatial_registration", - "bayesSpace_layer_annotations.csv" + read.csv( + file = here( + "processed-data", + "rdata", + "spe", + "08_spatial_registration", + "bayesSpace_layer_annotations.csv" + ) + ) |> + select(layer_combo, + test = cluster, + Annotation = bayesSpace ) - ) |> - select(layer_combo, - test = cluster, - Annotation = bayesSpace - ) ## Takes 2-3 min to run enriched <- - map(ptsd_gene_list, function(gl) { - map( - bayesSpace_registration, - ~ gene_set_enrichment( - gene_list = gl, - modeling_results = .x, - model_type = "enrichment" - ) |> - left_join(bayes_anno, by = "test") |> - mutate( - test = factor(layer_combo, levels = bayes_anno$layer_combo[bayes_anno$layer_combo %in% layer_combo]) - ) |> - select(-c(layer_combo, Annotation, fdr_cut, model_type)) - ) - }) + map(ptsd_gene_list, function(gl) { + map( + bayesSpace_registration, + ~ gene_set_enrichment( + gene_list = gl, + modeling_results = .x, + model_type = "enrichment" + ) |> + left_join(bayes_anno, by = "test") |> + mutate( + test = factor(layer_combo, levels = bayes_anno$layer_combo[bayes_anno$layer_combo %in% layer_combo]) + ) |> + select(-c(layer_combo, Annotation, fdr_cut, model_type)) + ) + }) enriched$gene_DLPFC$k09 @@ -145,11 +145,11 @@ source(here("code", "analysis", "10_clinical_gene_set_enrichment", "gene_set_enr ## how many genes for each domain or DE set, gene_enrichment_count <- map(bayesSpace_registration, function(r) { - en_count <- get_gene_enrichment_count(r) - ## reorder to match layer_combo - rownames(en_count) <- bayes_anno$layer_combo[match(rownames(en_count), bayes_anno$test)] - layer_order <- bayes_anno$layer_combo[bayes_anno$layer_combo %in% rownames(en_count)] - return(en_count[layer_order, , drop = FALSE]) + en_count <- get_gene_enrichment_count(r) + ## reorder to match layer_combo + rownames(en_count) <- bayes_anno$layer_combo[match(rownames(en_count), bayes_anno$test)] + layer_order <- bayes_anno$layer_combo[bayes_anno$layer_combo %in% rownames(en_count)] + return(en_count[layer_order, , drop = FALSE]) }) gene_list_count <- map(ptsd_gene_list, get_gene_list_count) @@ -158,63 +158,70 @@ gene_list_count <- map(ptsd_gene_list, get_gene_list_count) #### Plot Enrichments #### pdf(here(dir_plots, "Enrich_PTSD_DLPFC_genes_k09.pdf"), height = 8, width = 10) gene_set_enrichment_plot_complex(enriched$gene_DLPFC$k09, - gene_count_col = gene_list_count[["gene_DLPFC"]], - gene_count_row = gene_enrichment_count[["k09"]], - anno_title_col = "n DE Genes", - anno_title_row = "n Domain\nGenes" + gene_count_col = gene_list_count[["gene_DLPFC"]], + gene_count_row = gene_enrichment_count[["k09"]], + anno_title_col = "n DE Genes", + anno_title_row = "n Domain\nGenes" ) dev.off() walk2(enriched, names(enriched), function(enriched, ds_name) { - pdf(here(dir_plots, paste0("Enrich_PTSD_", ds_name, ".pdf")), height = 8, width = 9) - map2(enriched, names(enriched), function(x, k) { - message(ds_name, " - ", k) - - print(gene_set_enrichment_plot_complex(x, - gene_count_col = gene_list_count[[ds_name]], - gene_count_row = gene_enrichment_count[[k]], - anno_title_col = "n DE Genes", - anno_title_row = "n Domain\nGenes" - )) - }) - dev.off() + pdf(here(dir_plots, paste0("Enrich_PTSD_", ds_name, ".pdf")), height = 8, width = 9) + map2(enriched, names(enriched), function(x, k) { + message(ds_name, " - ", k) + + print(gene_set_enrichment_plot_complex(x, + gene_count_col = gene_list_count[[ds_name]], + gene_count_row = gene_enrichment_count[[k]], + anno_title_col = "n DE Genes", + anno_title_row = "n Domain\nGenes" + )) + }) + dev.off() }) ## Select gene set plot @ k09 -enriched_select <- rbind(enriched$gene_DLPFC$k09 |> filter(ID %in% c("MDD_DLPFC","PTSD_MDD_DLPFC")), - enriched$gene_mPFC$k09 |> filter(ID %in% c("MDD_mPFC","PTSD_MDD_mPFC"))) +enriched_select <- rbind( + enriched$gene_DLPFC$k09 |> filter(ID %in% c("MDD_DLPFC", "PTSD_MDD_DLPFC")), + enriched$gene_mPFC$k09 |> filter(ID %in% c("MDD_mPFC", "PTSD_MDD_mPFC")) +) -gene_list_count_select <- rbind(gene_list_count$gene_DLPFC[c("MDD_DLPFC","PTSD_MDD_DLPFC"),,drop=FALSE], - gene_list_count$gene_mPFC[c("MDD_mPFC","PTSD_MDD_mPFC"),,drop=FALSE]) +gene_list_count_select <- rbind( + gene_list_count$gene_DLPFC[c("MDD_DLPFC", "PTSD_MDD_DLPFC"), , drop = FALSE], + gene_list_count$gene_mPFC[c("MDD_mPFC", "PTSD_MDD_mPFC"), , drop = FALSE] +) pdf(here(dir_plots, "Enrich_PTSD_select_k09.pdf"), height = 8, width = 5) gene_set_enrichment_plot_complex(enriched_select, - gene_count_col = gene_list_count_select, - gene_count_row = gene_enrichment_count[["k09"]], - anno_title_col = "n DE Genes", - anno_title_row = "n Domain\nGenes" + gene_count_col = gene_list_count_select, + gene_count_row = gene_enrichment_count[["k09"]], + anno_title_col = "n DE Genes", + anno_title_row = "n Domain\nGenes" ) dev.off() ## select gene sets for PTSD team -# Sp09 resolution, RNA and Protein for mPFC for the MDD, PTSD, PTSD_MDD +# Sp09 resolution, RNA and Protein for mPFC for the MDD, PTSD, PTSD_MDD -enriched_select_ptsd <- list(gene = enriched$gene_mPFC$k09 |> filter(ID %in% c("MDD_mPFC","PTSD_mPFC","PTSD_MDD_mPFC")), - protein = enriched$protein_mPFC$k09 |> filter(ID %in% c("MDD_mPFC","PTSD_mPFC","PTSD_MDD_mPFC"))) +enriched_select_ptsd <- list( + gene = enriched$gene_mPFC$k09 |> filter(ID %in% c("MDD_mPFC", "PTSD_mPFC", "PTSD_MDD_mPFC")), + protein = enriched$protein_mPFC$k09 |> filter(ID %in% c("MDD_mPFC", "PTSD_mPFC", "PTSD_MDD_mPFC")) +) -gene_list_count_select_ptsd <- list(gene = gene_list_count$gene_mPFC[c("MDD_mPFC","PTSD_mPFC","PTSD_MDD_mPFC"),,drop=FALSE], - protein = gene_list_count$protein_mPFC[c("MDD_mPFC","PTSD_mPFC","PTSD_MDD_mPFC"),,drop=FALSE]) +gene_list_count_select_ptsd <- list( + gene = gene_list_count$gene_mPFC[c("MDD_mPFC", "PTSD_mPFC", "PTSD_MDD_mPFC"), , drop = FALSE], + protein = gene_list_count$protein_mPFC[c("MDD_mPFC", "PTSD_mPFC", "PTSD_MDD_mPFC"), , drop = FALSE] +) pdf(here(dir_plots, "Enrich_PTSD_select_mPFC_k09.pdf"), height = 8, width = 5) map2(enriched_select_ptsd, gene_list_count_select_ptsd -~gene_set_enrichment_plot_complex(.x, - gene_count_col = .y, - gene_count_row = gene_enrichment_count[["k09"]], - anno_title_col = "n DE Genes", - anno_title_row = "n Domain\nGenes" -) -) +~ gene_set_enrichment_plot_complex(.x, + gene_count_col = .y, + gene_count_row = gene_enrichment_count[["k09"]], + anno_title_col = "n DE Genes", + anno_title_row = "n Domain\nGenes" + )) dev.off() @@ -223,12 +230,12 @@ dev.off() # "white", # grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(5) # ) -# +# # lgd2 = Legend(col_fun = circlize::colorRamp2(seq(0, 15, by = 1.6), # c("white", RColorBrewer::brewer.pal(9, "YlOrRd"))), # title = "-log10(p-val)", # direction = "horizontal") -# +# # pdf("enrich_legend.pdf", height = 1, width = 2) # draw(lgd2) # dev.off() @@ -238,31 +245,31 @@ dev.off() colnames(bayesSpace_registration$k09$enrichment) gene_check_Sp09D01 <- bayesSpace_registration$k09$enrichment |> - select(ends_with("Sp09D01"), ensembl, gene) |> - # filter(fdr_Sp09D01 < 0.05) |> - mutate(MDD_DLPFC = ensembl %in% ptsd_gene_list$gene_DLPFC$MDD_DLPFC) |> - dplyr::count(fdr_Sp09D01 < 0.05, MDD_DLPFC) - - -enrichment_check <- function(domain = "Sp09D01", - gene_list = ptsd_gene_list$gene_DLPFC$MDD_DLPFC, - enrichment = bayesSpace_registration$k09$enrichment){ - - - enrichment2 <- enrichment |> - select(ends_with(domain), ensembl, gene) |> - rename_all(~stringr::str_replace(.,paste0("_", domain),"")) |> - mutate(sig = fdr < 0.1 & t_stat > 0, - deg = ensembl %in% gene_list) - - gene_list <- enrichment2 |> - filter(deg, sig) |> - pull(gene) - - gene_tab <- addmargins(table(enrichment2$deg, enrichment2$sig)) - - - return(list(gl = gene_list, tab = gene_tab)) + select(ends_with("Sp09D01"), ensembl, gene) |> + # filter(fdr_Sp09D01 < 0.05) |> + mutate(MDD_DLPFC = ensembl %in% ptsd_gene_list$gene_DLPFC$MDD_DLPFC) |> + dplyr::count(fdr_Sp09D01 < 0.05, MDD_DLPFC) + + +enrichment_check <- function(domain = "Sp09D01", + gene_list = ptsd_gene_list$gene_DLPFC$MDD_DLPFC, + enrichment = bayesSpace_registration$k09$enrichment) { + enrichment2 <- enrichment |> + select(ends_with(domain), ensembl, gene) |> + rename_all(~ stringr::str_replace(., paste0("_", domain), "")) |> + mutate( + sig = fdr < 0.1 & t_stat > 0, + deg = ensembl %in% gene_list + ) + + gene_list <- enrichment2 |> + filter(deg, sig) |> + pull(gene) + + gene_tab <- addmargins(table(enrichment2$deg, enrichment2$sig)) + + + return(list(gl = gene_list, tab = gene_tab)) } enriched$gene_DLPFC$k09 @@ -273,63 +280,65 @@ enriched$gene_DLPFC$k09 enriched$gene_DLPFC$k09 |> filter(test == "Sp09D01 ~ L1") enriched$gene_DLPFC$k09 |> filter(ID == "MDD_DLPFC") -enrichment_check(domain = "Sp09D01", - gene_list = ptsd_gene_list$gene_DLPFC$MDD_DLPFC, - enrichment = bayesSpace_registration$k09$enrichment) +enrichment_check( + domain = "Sp09D01", + gene_list = ptsd_gene_list$gene_DLPFC$MDD_DLPFC, + enrichment = bayesSpace_registration$k09$enrichment +) enrichment_check(domain = "Sp09D01", gene_list = ptsd_gene_list$gene_DLPFC$MDD_DLPFC) # $gl -# [1] "TIE1" "GBP4" "RHOC" "TXNIP" "S100A6" "RPS27" "FCGR2A" "SEMA3G" "ABCG2" "CARMN" -# [11] "CDKN1A" "RPS12" "UTRN" "GIMAP6" "ADGRA2" "RPS6" "IFITM2" "RPL27A" "RERGL" "PTPRB" -# [21] "LRP10" "CRISPLD2" "GADD45B" "ISYNA1" "LSR" "RPS19" "HSPA12B" "EDN3" "JAM2" "TIMP1" -# [31] "MSN" "RPL10" -# +# [1] "TIE1" "GBP4" "RHOC" "TXNIP" "S100A6" "RPS27" "FCGR2A" "SEMA3G" "ABCG2" "CARMN" +# [11] "CDKN1A" "RPS12" "UTRN" "GIMAP6" "ADGRA2" "RPS6" "IFITM2" "RPL27A" "RERGL" "PTPRB" +# [21] "LRP10" "CRISPLD2" "GADD45B" "ISYNA1" "LSR" "RPS19" "HSPA12B" "EDN3" "JAM2" "TIMP1" +# [31] "MSN" "RPL10" +# # $tab -# +# # FALSE TRUE Sum # FALSE 11393 626 12019 # TRUE 174 32 206 # Sum 11567 658 12225 enrichment_check(domain = "Sp09D02", gene_list = ptsd_gene_list$gene_DLPFC$MDD_DLPFC) # $gl -# [1] "HMGN2" "TGFBR3" "RHOC" "RPS27" "GAS5" "RGS8" "DOCK10" "PROS1" -# [9] "ALDH1L1" "EPHB1" "RGS12" "TRPC3" "PCDH18" "HMGB2" "RHOBTB3" "ALDH7A1" -# [17] "RPS12" "SLC29A4" "DLX6-AS1" "TMEM176A" "CLU" "CRH" "RPS6" "RPL7A" -# [25] "FZD8" "BAG3" "IFITM2" "CD81" "RPL27A" "GIHCG" "LRP10" "RPL4" -# [33] "RLBP1" "MT1X" "KCNJ16" "DLGAP1-AS1" "NCAN" "RPS19" "FTL" "MSN" -# [41] "AFF2" "RPL10" -# +# [1] "HMGN2" "TGFBR3" "RHOC" "RPS27" "GAS5" "RGS8" "DOCK10" "PROS1" +# [9] "ALDH1L1" "EPHB1" "RGS12" "TRPC3" "PCDH18" "HMGB2" "RHOBTB3" "ALDH7A1" +# [17] "RPS12" "SLC29A4" "DLX6-AS1" "TMEM176A" "CLU" "CRH" "RPS6" "RPL7A" +# [25] "FZD8" "BAG3" "IFITM2" "CD81" "RPL27A" "GIHCG" "LRP10" "RPL4" +# [33] "RLBP1" "MT1X" "KCNJ16" "DLGAP1-AS1" "NCAN" "RPS19" "FTL" "MSN" +# [41] "AFF2" "RPL10" +# # $tab -# +# # FALSE TRUE Sum # FALSE 10858 1161 12019 # TRUE 164 42 206 # Sum 11022 1203 12225 enrichment_check(domain = "Sp09D01", gene_list = ptsd_gene_list$gene_DLPFC$PTSD_MDD_DLPFC) # $gl -# [1] "TNFRSF1B" "TIE1" "GBP4" "RHOC" "TXNIP" "S100A6" "SEMA3G" "TNFSF10" "ABCG2" "FKBP5" +# [1] "TNFRSF1B" "TIE1" "GBP4" "RHOC" "TXNIP" "S100A6" "SEMA3G" "TNFSF10" "ABCG2" "FKBP5" # [11] "CDKN1A" "PNRC1" "UTRN" "GIMAP7" "GIMAP6" "ADGRA2" "RPS6" "MARVELD1" "IFITM2" "TNFRSF1A" -# [21] "A2M" "RERGL" "PTPRB" "LRP10" "MT2A" "CRISPLD2" "RAB34" "STAT3" "TUBB6" "LSR" -# [31] "EMP3" "HSPA12B" "EDN3" "JAM2" "TIMP1" "MSN" -# +# [21] "A2M" "RERGL" "PTPRB" "LRP10" "MT2A" "CRISPLD2" "RAB34" "STAT3" "TUBB6" "LSR" +# [31] "EMP3" "HSPA12B" "EDN3" "JAM2" "TIMP1" "MSN" +# # $tab -# +# # FALSE TRUE Sum # FALSE 11333 622 11955 # TRUE 234 36 270 # Sum 11567 658 12225 enrichment_check(domain = "Sp09D02", gene_list = ptsd_gene_list$gene_DLPFC$PTSD_MDD_DLPFC) # $gl -# [1] "CAMK2N1" "HMGN2" "TGFBR3" "RHOC" "GAS5" "RGS8" "DOCK10" "SLC6A11" -# [9] "PROS1" "ALDH1L1" "EPHB1" "RGS12" "KIT" "PPM1K" "TRPC3" "SMAD1" -# [17] "HMGB2" "MYO10" "RHOBTB3" "ALDH7A1" "DDR1" "PNRC1" "TNS3" "DLX6-AS1" -# [25] "GAL3ST4" "TMEM176B" "TMEM176A" "CLU" "CRH" "RPS6" "RPL7A" "FZD8" -# [33] "BAG3" "IFITM2" "CD81" "GSTP1" "TNFRSF1A" "GIHCG" "ACSS3" "LRP10" -# [41] "ALDH6A1" "RPL4" "RLBP1" "CHD2" "IQCK" "MT2A" "MT1M" "MT1X" -# [49] "TPPP3" "RAB34" "STAT3" "KCNJ16" "DLGAP1-AS1" "FTL" "MSN" -# +# [1] "CAMK2N1" "HMGN2" "TGFBR3" "RHOC" "GAS5" "RGS8" "DOCK10" "SLC6A11" +# [9] "PROS1" "ALDH1L1" "EPHB1" "RGS12" "KIT" "PPM1K" "TRPC3" "SMAD1" +# [17] "HMGB2" "MYO10" "RHOBTB3" "ALDH7A1" "DDR1" "PNRC1" "TNS3" "DLX6-AS1" +# [25] "GAL3ST4" "TMEM176B" "TMEM176A" "CLU" "CRH" "RPS6" "RPL7A" "FZD8" +# [33] "BAG3" "IFITM2" "CD81" "GSTP1" "TNFRSF1A" "GIHCG" "ACSS3" "LRP10" +# [41] "ALDH6A1" "RPL4" "RLBP1" "CHD2" "IQCK" "MT2A" "MT1M" "MT1X" +# [49] "TPPP3" "RAB34" "STAT3" "KCNJ16" "DLGAP1-AS1" "FTL" "MSN" +# # $tab -# +# # FALSE TRUE Sum # FALSE 10807 1148 11955 # TRUE 215 55 270 diff --git a/code/analysis/10_clinical_gene_set_enrichment/deprecated/01_Clinical_Gene_Set_Enrichment.R b/code/analysis/10_clinical_gene_set_enrichment/deprecated/01_Clinical_Gene_Set_Enrichment.R index 58bb1b2a..82440deb 100644 --- a/code/analysis/10_clinical_gene_set_enrichment/deprecated/01_Clinical_Gene_Set_Enrichment.R +++ b/code/analysis/10_clinical_gene_set_enrichment/deprecated/01_Clinical_Gene_Set_Enrichment.R @@ -661,11 +661,10 @@ enrichLong_ASD <- enrichLong_ASD[order(enrichLong_ASD$ID2, enrichLong_ASD$LayerF ### custom heatmap midpoint <- function(x) x[-length(x)] + diff(x) / 2 -customLayerEnrichment <- function( - enrichTab, groups, xlabs, - Pthresh = 12, ORcut = 3, enrichOnly = FALSE, - layerHeights = c(0, 40, 55, 75, 85, 110, 120, 135, 145, 155), - mypal = c("white", colorRampPalette(brewer.pal(9, "YlOrRd"))(50)), ...) { +customLayerEnrichment <- function(enrichTab, groups, xlabs, + Pthresh = 12, ORcut = 3, enrichOnly = FALSE, + layerHeights = c(0, 40, 55, 75, 85, 110, 120, 135, 145, 155), + mypal = c("white", colorRampPalette(brewer.pal(9, "YlOrRd"))(50)), ...) { wide_p <- -log10(enrichTab[groups, grep("Pval", colnames(enrichTab))]) wide_p[wide_p > Pthresh] <- Pthresh wide_p <- t(round(wide_p[ diff --git a/code/analysis/10_clinical_gene_set_enrichment/gene_set_enrichment_plot_complex.R b/code/analysis/10_clinical_gene_set_enrichment/gene_set_enrichment_plot_complex.R index 47573665..43afa5be 100644 --- a/code/analysis/10_clinical_gene_set_enrichment/gene_set_enrichment_plot_complex.R +++ b/code/analysis/10_clinical_gene_set_enrichment/gene_set_enrichment_plot_complex.R @@ -87,21 +87,20 @@ #' gene_count_row = layer_gene_count #' ) gene_set_enrichment_plot_complex <- - function( - enrichment, - PThresh = 12, - ORcut = 3, - enrichOnly = FALSE, - gene_count_col = NULL, - gene_count_row = NULL, - anno_title_col = NULL, - anno_title_row = NULL, - column_order = NULL, - anno_add = NULL, - mypal = c( - "white", - grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) - )) { + function(enrichment, + PThresh = 12, + ORcut = 3, + enrichOnly = FALSE, + gene_count_col = NULL, + gene_count_row = NULL, + anno_title_col = NULL, + anno_title_row = NULL, + column_order = NULL, + anno_add = NULL, + mypal = c( + "white", + grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) + )) { ## Re-order and shorten names if they match our data # if (all(unique(enrichment$test) %in% c("WM", paste0("Layer", seq_len(6))))) { # enrichment$test <- @@ -201,10 +200,11 @@ get_gene_list_count <- function(gene_list) { } -get_gene_enrichment_count <- function(model_results = fetch_data(type = "modeling_results"), - model_type = "enrichment", - fdr_cut = 0.1, - bayes_anno = bayes_anno) { +get_gene_enrichment_count <- function( + model_results = fetch_data(type = "modeling_results"), + model_type = "enrichment", + fdr_cut = 0.1, + bayes_anno = bayes_anno) { model_results <- model_results[[model_type]] tstats <- diff --git a/code/analysis/14_spatial_registration_PEC/07_PEC_annotation_Dx_plots.R b/code/analysis/14_spatial_registration_PEC/07_PEC_annotation_Dx_plots.R index 11d14d4b..5784606a 100644 --- a/code/analysis/14_spatial_registration_PEC/07_PEC_annotation_Dx_plots.R +++ b/code/analysis/14_spatial_registration_PEC/07_PEC_annotation_Dx_plots.R @@ -151,8 +151,10 @@ control_anno_long <- do.call("rbind", map2( mutate(Dataset = .y) |> filter(PrimaryDx == "Control") )) |> - mutate(Dataset = factor(Dataset), - psychENCODE = factor(paste0("study_", as.numeric(Dataset)))) + mutate( + Dataset = factor(Dataset), + psychENCODE = factor(paste0("study_", as.numeric(Dataset))) + ) control_anno_long |> distinct(Dataset, psychENCODE) # Dataset psychENCODE diff --git a/code/analysis/14_spatial_registration_PEC/registration_dot_plot.R b/code/analysis/14_spatial_registration_PEC/registration_dot_plot.R index a761f5ab..ec7d9077 100644 --- a/code/analysis/14_spatial_registration_PEC/registration_dot_plot.R +++ b/code/analysis/14_spatial_registration_PEC/registration_dot_plot.R @@ -38,12 +38,13 @@ #' registration_dot_plot(test_anno) #' registration_dot_plot(test_anno, ct_anno = ct_anno) #' -registration_dot_plot <- function(annotation_df, - color_by = "Dataset", - cluster_by = "cluster", - layer_by = "layer_label", - grid_fill = list(`TRUE` = "grey80", `FALSE` = "white"), - ct_anno = NULL) { +registration_dot_plot <- function( + annotation_df, + color_by = "Dataset", + cluster_by = "cluster", + layer_by = "layer_label", + grid_fill = list(`TRUE` = "grey80", `FALSE` = "white"), + ct_anno = NULL) { if (is.factor(annotation_df[[layer_by]])) { layer_lable_levels <- levels(annotation_df[[layer_by]]) } else { @@ -77,13 +78,14 @@ registration_dot_plot <- function(annotation_df, return(ex_dotplot) } -registration_dot_plot2 <- function(annotation_df, - color_by = "PrimaryDx", - cluster_by = "cell_type", - layer_by = "layer_combo", - conf_only = FALSE, - grid_fill = list(`TRUE` = "grey80", `FALSE` = "white"), - ct_anno = NULL) { +registration_dot_plot2 <- function( + annotation_df, + color_by = "PrimaryDx", + cluster_by = "cell_type", + layer_by = "layer_combo", + conf_only = FALSE, + grid_fill = list(`TRUE` = "grey80", `FALSE` = "white"), + ct_anno = NULL) { layer_df <- annotation_df |> select(any_of(c(layer_by, "Annotation"))) |> dplyr::distinct() diff --git a/code/analysis/99_spatial_plotting/vis_gene_crop.R b/code/analysis/99_spatial_plotting/vis_gene_crop.R index 4b97b13a..2d849ef5 100644 --- a/code/analysis/99_spatial_plotting/vis_gene_crop.R +++ b/code/analysis/99_spatial_plotting/vis_gene_crop.R @@ -1,18 +1,19 @@ vis_gene_crop <- - function(spe, - sampleid, - geneid = "SCGB2A2; ENSG00000110484", - spatial = TRUE, - assayname = "logcounts", - minCount = 0, - color_scale = "plasma", - frame_lim_df, - image_id = "lowres", - alpha = NA, - cont_colors = c("aquamarine4", "springgreen", "goldenrod", "red"), - point_size = 2, - legend_overlap = FALSE, - ...) { + function( + spe, + sampleid, + geneid = "SCGB2A2; ENSG00000110484", + spatial = TRUE, + assayname = "logcounts", + minCount = 0, + color_scale = "plasma", + frame_lim_df, + image_id = "lowres", + alpha = NA, + cont_colors = c("aquamarine4", "springgreen", "goldenrod", "red"), + point_size = 2, + legend_overlap = FALSE, + ...) { if (color_scale == "viridis") { cont_colors <- viridisLite::viridis(21) } else if (color_scale == "plasma") { @@ -67,19 +68,20 @@ vis_gene_crop <- } vis_gene_p_crop <- - function(spe, - d, - sampleid, - spatial, - title, - viridis = TRUE, - image_id = "lowres", - frame_lim_df, - legend_title = "Test", - alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - point_size = 2, - legend_overlap = FALSE) { + function( + spe, + d, + sampleid, + spatial, + title, + viridis = TRUE, + image_id = "lowres", + frame_lim_df, + legend_title = "Test", + alpha = NA, + cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), + point_size = 2, + legend_overlap = FALSE) { ## Some variables pxl_row_in_fullres <- pxl_col_in_fullres <- key <- COUNT <- NULL # stopifnot(all(c("pxl_col_in_fullres", "pxl_row_in_fullres", "COUNT", "key") %in% colnames(d))) diff --git a/code/qc_artifact/Compare_cellType_correlation_diff.R b/code/qc_artifact/Compare_cellType_correlation_diff.R index a9a3e0e7..c14cfb8a 100644 --- a/code/qc_artifact/Compare_cellType_correlation_diff.R +++ b/code/qc_artifact/Compare_cellType_correlation_diff.R @@ -16,263 +16,330 @@ cellTypes <- unique(cell_meta$cellType_broad_hc) map <- as.matrix(map) map_cellType <- matrix(NA, nrow = dim(spot_meta)[1], ncol = length(cellTypes)) -for(i in c(1:dim(map)[2])){ - weights_df <- data.frame(map[ ,i], cell_meta$cellType_broad_hc) - colnames(weights_df) <- c("spot_weight", "cell_type") - weights_df$cell_type <- factor(weights_df$cell_type, levels = cellTypes) - summary_df <- aggregate(weights_df$spot_weight, by=list(Category=weights_df$cell_type), FUN=sum) - map_cellType[i, ] <- summary_df$x +for (i in c(1:dim(map)[2])) { + weights_df <- data.frame(map[, i], cell_meta$cellType_broad_hc) + colnames(weights_df) <- c("spot_weight", "cell_type") + weights_df$cell_type <- factor(weights_df$cell_type, levels = cellTypes) + summary_df <- aggregate(weights_df$spot_weight, by = list(Category = weights_df$cell_type), FUN = sum) + map_cellType[i, ] <- summary_df$x } colnames(map_cellType) <- cellTypes map_cellType <- data.frame(map_cellType) -map_cellType$sumCells <- rowSums(map_cellType[ ,1:7]) +map_cellType$sumCells <- rowSums(map_cellType[, 1:7]) map_cellType$Layer <- spot_meta$LayerAnnot map_cellType$Wrinkle <- spot_meta$WrinkleAnnot map_cellType <- map_cellType[!map_cellType$Layer == "Unknown", ] -if(sample == "Br6522_ant"){ -map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c("None", "Fold_1", "Shear_1", "Shear_2", - "Shear_3", "Wrinkle_1", "Wrinkle_2", "Wrinkle_3", - "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", - "Wrinkle_8", "Wrinkle_9"))} -if(sample == "Br6522_mid"){ - map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c("None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", - "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", - "Wrinkle_6", "Wrinkle_7", - "Wrinkle_8", "Wrinkle_9", - "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) - +if (sample == "Br6522_ant") { + map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", + "Shear_3", "Wrinkle_1", "Wrinkle_2", "Wrinkle_3", + "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", + "Wrinkle_8", "Wrinkle_9" + )) } -if(sample == "Br8667_post"){ - map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c("None", "Shear_1", "Wrinkle_1", - "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", - "Wrinkle_6", "Wrinkle_7", - "Wrinkle_8", "Wrinkle_9", - "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) - +if (sample == "Br6522_mid") { + map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", + "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", + "Wrinkle_6", "Wrinkle_7", + "Wrinkle_8", "Wrinkle_9", + "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" + )) } -ggplot(map_cellType, aes(x = Layer, y = sumCells, fill = Wrinkle)) + geom_boxplot() + theme_classic() +if (sample == "Br8667_post") { + map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c( + "None", "Shear_1", "Wrinkle_1", + "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", + "Wrinkle_6", "Wrinkle_7", + "Wrinkle_8", "Wrinkle_9", + "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" + )) +} +ggplot(map_cellType, aes(x = Layer, y = sumCells, fill = Wrinkle)) + + geom_boxplot() + + theme_classic() -diff_corr <- function(none, all){ - p_value_mat <- matrix(NA, nrow = 7, ncol = 7) - for(i in c(1:7)){ - for(j in c(1:7)){ - if(i == j){ - p_value_mat[i,j] <- NA - }else{ - res <- st1(all[ ,i], all[ ,j], none[ ,i], none[ ,j]) - p_value_mat[i, j] <- res$pval - } +diff_corr <- function(none, all) { + p_value_mat <- matrix(NA, nrow = 7, ncol = 7) + for (i in c(1:7)) { + for (j in c(1:7)) { + if (i == j) { + p_value_mat[i, j] <- NA + } else { + res <- st1(all[, i], all[, j], none[, i], none[, j]) + p_value_mat[i, j] <- res$pval + } + } } - } - colnames(p_value_mat) <- colnames(none)[1:7] - rownames(p_value_mat) <- colnames(p_value_mat) - p_value_mat[lower.tri(p_value_mat)] <- NA - p_values_df <- melt(p_value_mat) - colnames(p_values_df) <- c("cell_type_1", "cell_type_2", "p_value") - p_values_df <- p_values_df[!is.na(p_values_df$p_value), ] - # sig_mat <- p_value_mat - # sig_mat[p_value_mat > 0.1] <- "n.s" - # sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" - # sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" - # sig_mat[p_value_mat < 0.01] <- "***" - # sig_mat[lower.tri(sig_mat)] <- "" - # diag(sig_mat) <- "" - # p_value_mat[lower.tri(p_value_mat)] <- NA - # pheatmap(p_value_mat, cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, - # color = colorRampPalette(rev(brewer.pal(n = 7, name ="Reds")))(100), breaks= seq(0, 1, 0.01), - # main = title, border_color = NA, na_col = "transparent") - p_values_df + colnames(p_value_mat) <- colnames(none)[1:7] + rownames(p_value_mat) <- colnames(p_value_mat) + p_value_mat[lower.tri(p_value_mat)] <- NA + p_values_df <- melt(p_value_mat) + colnames(p_values_df) <- c("cell_type_1", "cell_type_2", "p_value") + p_values_df <- p_values_df[!is.na(p_values_df$p_value), ] + # sig_mat <- p_value_mat + # sig_mat[p_value_mat > 0.1] <- "n.s" + # sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" + # sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" + # sig_mat[p_value_mat < 0.01] <- "***" + # sig_mat[lower.tri(sig_mat)] <- "" + # diag(sig_mat) <- "" + # p_value_mat[lower.tri(p_value_mat)] <- NA + # pheatmap(p_value_mat, cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, + # color = colorRampPalette(rev(brewer.pal(n = 7, name ="Reds")))(100), breaks= seq(0, 1, 0.01), + # main = title, border_color = NA, na_col = "transparent") + p_values_df } -if(!sample == "Br8667_post"){ -L1 <- map_cellType[map_cellType$Layer == "Layer 1", ] -L1_mat <- as.matrix(L1[ ,1:7]) -L1_mat <- scale(L1_mat, center = TRUE, scale = FALSE) -L1_pca <- svd(L1_mat) -L1_u <- L1_pca$u -colnames(L1_u) <- paste0("U", c(1:dim(L1_u)[2])) -L1 <- cbind(L1, L1_u) -L1$Wrinkle <- as.factor(L1$Wrinkle) -ggplot(L1, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L1, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() -L1_none <- L1[L1$Wrinkle == "None", ] -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample ,"_layer1.pdf"), width = 5, height = 5) -corrplot(cor(L1[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample ,"_layer1_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L1_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -L1_pvalue <- diff_corr(L1_none, L1) -L1_pvalue$Layers <- "Layer 1" +if (!sample == "Br8667_post") { + L1 <- map_cellType[map_cellType$Layer == "Layer 1", ] + L1_mat <- as.matrix(L1[, 1:7]) + L1_mat <- scale(L1_mat, center = TRUE, scale = FALSE) + L1_pca <- svd(L1_mat) + L1_u <- L1_pca$u + colnames(L1_u) <- paste0("U", c(1:dim(L1_u)[2])) + L1 <- cbind(L1, L1_u) + L1$Wrinkle <- as.factor(L1$Wrinkle) + ggplot(L1, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() + ggplot(L1, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() + L1_none <- L1[L1$Wrinkle == "None", ] + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1.pdf"), width = 5, height = 5) + corrplot(cor(L1[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1_excl_artifact.pdf"), width = 5, height = 5) + corrplot(cor(L1_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + L1_pvalue <- diff_corr(L1_none, L1) + L1_pvalue$Layers <- "Layer 1" } L2 <- map_cellType[map_cellType$Layer == "Layer 2", ] -L2_mat <- as.matrix(L2[ ,1:7]) +L2_mat <- as.matrix(L2[, 1:7]) L2_mat <- scale(L2_mat, center = TRUE, scale = FALSE) L2_pca <- svd(L2_mat) L2_u <- L2_pca$u colnames(L2_u) <- paste0("U", c(1:dim(L2_u)[2])) L2 <- cbind(L2, L2_u) L2$Wrinkle <- as.factor(L2$Wrinkle) -ggplot(L2, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L2, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L2, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L2, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L2_none <- L2[L2$Wrinkle == "None", ] -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample ,"_layer2.pdf"), width = 5, height = 5) -corrplot(cor(L2[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer2.pdf"), width = 5, height = 5) +corrplot(cor(L2[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer2_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L2_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L2_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L2_pvalue <- diff_corr(L2_none, L2) L2_pvalue$Layers <- "Layer 2" L3 <- map_cellType[map_cellType$Layer == "Layer 3", ] -L3_mat <- as.matrix(L3[ ,1:7]) +L3_mat <- as.matrix(L3[, 1:7]) L3_mat <- scale(L3_mat, center = TRUE, scale = FALSE) L3_pca <- svd(L3_mat) L3_u <- L3_pca$u colnames(L3_u) <- paste0("U", c(1:dim(L3_u)[2])) L3 <- cbind(L3, L3_u) L3$Wrinkle <- as.factor(L3$Wrinkle) -ggplot(L3, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L3, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L3, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L3, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L3_none <- L3[L3$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer3.pdf"), width = 5, height = 5) -corrplot(cor(L3[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L3[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer3_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L3_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L3_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L3_pvalue <- diff_corr(L3_none, L3) L3_pvalue$Layers <- "Layer 3" L4 <- map_cellType[map_cellType$Layer == "Layer 4", ] -L4_mat <- as.matrix(L4[ ,1:7]) +L4_mat <- as.matrix(L4[, 1:7]) L4_mat <- scale(L4_mat, center = TRUE, scale = FALSE) L4_pca <- svd(L4_mat) L4_u <- L4_pca$u colnames(L4_u) <- paste0("U", c(1:dim(L4_u)[2])) L4 <- cbind(L4, L4_u) L4$Wrinkle <- as.factor(L4$Wrinkle) -ggplot(L4, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L4, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L4, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L4, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L4_none <- L4[L4$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer4.pdf"), width = 5, height = 5) -corrplot(cor(L4[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L4[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer4_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L4_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L4_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L4_pvalue <- diff_corr(L4_none, L4) L4_pvalue$Layers <- "Layer 4" L5 <- map_cellType[map_cellType$Layer == "Layer 5", ] -L5_mat <- as.matrix(L5[ ,1:7]) +L5_mat <- as.matrix(L5[, 1:7]) L5_mat <- scale(L5_mat, center = TRUE, scale = FALSE) L5_pca <- svd(L5_mat) L5_u <- L5_pca$u colnames(L5_u) <- paste0("U", c(1:dim(L5_u)[2])) L5 <- cbind(L5, L5_u) L5$Wrinkle <- as.factor(L5$Wrinkle) -ggplot(L5, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L5, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L5, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L5, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L5_none <- L5[L5$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer5.pdf"), width = 5, height = 5) -corrplot(cor(L5[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L5[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer5_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L5_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L5_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L5_pvalue <- diff_corr(L5_none, L5) L5_pvalue$Layers <- "Layer 5" L6 <- map_cellType[map_cellType$Layer == "Layer 6", ] -L6_mat <- as.matrix(L6[ ,1:7]) +L6_mat <- as.matrix(L6[, 1:7]) L6_mat <- scale(L6_mat, center = TRUE, scale = FALSE) L6_pca <- svd(L6_mat) L6_u <- L6_pca$u colnames(L6_u) <- paste0("U", c(1:dim(L6_u)[2])) L6 <- cbind(L6, L6_u) L6$Wrinkle <- as.factor(L6$Wrinkle) -ggplot(L6, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L6, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L6, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L6, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L6_none <- L6[L6$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer6.pdf"), width = 5, height = 5) -corrplot(cor(L6[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L6[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer6_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L6_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L6_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L6_pvalue <- diff_corr(L6_none, L6) L6_pvalue$Layers <- "Layer 6" -if(!sample == "Br8667_post"){ -WM <- map_cellType[map_cellType$Layer == "WM", ] -WM_mat <- as.matrix(WM[ ,1:7]) -WM_mat <- scale(WM_mat, center = TRUE, scale = FALSE) -WM_pca <- svd(WM_mat) -WM_u <- WM_pca$u -colnames(WM_u) <- paste0("U", c(1:dim(WM_u)[2])) -WM <- cbind(WM, WM_u) -WM$Wrinkle <- as.factor(WM$Wrinkle) -ggplot(WM, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(WM, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() -WM_none <- WM[WM$Wrinkle == "None", ] -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM.pdf"), width = 5, height = 5) -corrplot(cor(WM[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(WM_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -WM_pvalue <- diff_corr(WM_none, WM) -WM_pvalue$Layers <- "WM"} +if (!sample == "Br8667_post") { + WM <- map_cellType[map_cellType$Layer == "WM", ] + WM_mat <- as.matrix(WM[, 1:7]) + WM_mat <- scale(WM_mat, center = TRUE, scale = FALSE) + WM_pca <- svd(WM_mat) + WM_u <- WM_pca$u + colnames(WM_u) <- paste0("U", c(1:dim(WM_u)[2])) + WM <- cbind(WM, WM_u) + WM$Wrinkle <- as.factor(WM$Wrinkle) + ggplot(WM, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() + ggplot(WM, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() + WM_none <- WM[WM$Wrinkle == "None", ] + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM.pdf"), width = 5, height = 5) + corrplot(cor(WM[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_excl_artifact.pdf"), width = 5, height = 5) + corrplot(cor(WM_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + WM_pvalue <- diff_corr(WM_none, WM) + WM_pvalue$Layers <- "WM" +} -if(!sample == "Br8667_post"){ - pvalue_df <- rbind(L1_pvalue, L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue, WM_pvalue) -}else{ - pvalue_df <- rbind(L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue) +if (!sample == "Br8667_post") { + pvalue_df <- rbind(L1_pvalue, L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue, WM_pvalue) +} else { + pvalue_df <- rbind(L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue) } pvalue_df$corr_p_values <- p.adjust(pvalue_df$p_value, method = "fdr") -plot_heatmap <- function(pvalue_df, layer){ - p_value_mat <-dcast(pvalue_df[pvalue_df$Layers == layer, c(1, 2, 5)], cell_type_1 ~ cell_type_2) - rownames(p_value_mat) <- p_value_mat$cell_type_1 - p_value_mat$cell_type_1 <- NULL - p_value_mat <- as.matrix(p_value_mat) - sig_mat <- p_value_mat - sig_mat[p_value_mat > 0.1] <- "n.s" - sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" - sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" - sig_mat[p_value_mat < 0.01] <- "***" - sig_mat[is.na(sig_mat)] <- "" - pheatmap(p_value_mat, cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, - color = colorRampPalette(rev(brewer.pal(n = 7, name ="Reds")))(100), breaks= seq(0, 1, 0.01), - main = layer, border_color = NA, na_col = "transparent", number_color = "black", fontsize = 14) +plot_heatmap <- function(pvalue_df, layer) { + p_value_mat <- dcast(pvalue_df[pvalue_df$Layers == layer, c(1, 2, 5)], cell_type_1 ~ cell_type_2) + rownames(p_value_mat) <- p_value_mat$cell_type_1 + p_value_mat$cell_type_1 <- NULL + p_value_mat <- as.matrix(p_value_mat) + sig_mat <- p_value_mat + sig_mat[p_value_mat > 0.1] <- "n.s" + sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" + sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" + sig_mat[p_value_mat < 0.01] <- "***" + sig_mat[is.na(sig_mat)] <- "" + pheatmap(p_value_mat, + cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, + color = colorRampPalette(rev(brewer.pal(n = 7, name = "Reds")))(100), breaks = seq(0, 1, 0.01), + main = layer, border_color = NA, na_col = "transparent", number_color = "black", fontsize = 14 + ) } -if(!sample == "Br8667_post"){ -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1_pval.pdf"), width = 4, height = 4) -plot_heatmap(pvalue_df, "Layer 1") -dev.off() -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_pval.pdf"), width = 4, height = 4) -plot_heatmap(pvalue_df, "WM") -dev.off()} +if (!sample == "Br8667_post") { + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1_pval.pdf"), width = 4, height = 4) + plot_heatmap(pvalue_df, "Layer 1") + dev.off() + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_pval.pdf"), width = 4, height = 4) + plot_heatmap(pvalue_df, "WM") + dev.off() +} pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer2_pval.pdf"), width = 4, height = 4) plot_heatmap(pvalue_df, "Layer 2") @@ -291,8 +358,5 @@ plot_heatmap(pvalue_df, "Layer 6") dev.off() pvalue_df$sample <- sample -pvalue_df <- pvalue_df[ ,c("sample", "Layers", "cell_type_1", "cell_type_2", "p_value", "corr_p_values")] +pvalue_df <- pvalue_df[, c("sample", "Layers", "cell_type_1", "cell_type_2", "p_value", "corr_p_values")] saveRDS(pvalue_df, paste0("/data/abattle4/prashanthi/dewrinkler/tables/", sample, "_pvalue_df.rds")) - - - \ No newline at end of file diff --git a/code/qc_artifact/Gene_based_analysis_artifact.R b/code/qc_artifact/Gene_based_analysis_artifact.R index 882ce729..051b9cd6 100644 --- a/code/qc_artifact/Gene_based_analysis_artifact.R +++ b/code/qc_artifact/Gene_based_analysis_artifact.R @@ -27,37 +27,37 @@ Br6522_mid <- readRDS(paste0(datDir, "Br6522_mid.rds")) Br8667_post <- readRDS(paste0(datDir, "Br8667_post.rds")) # Add manual metadata -manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df){ - spots <- rownames(sobj@meta.data) - layers <- c() - wrinkle <- c() - nCells <- c() - for(i in c(1:length(spots))){ - if(spots[i] %in% layers_df$spot_name){ - layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] - }else{ - layers[i] <- "Unknown" +manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df) { + spots <- rownames(sobj@meta.data) + layers <- c() + wrinkle <- c() + nCells <- c() + for (i in c(1:length(spots))) { + if (spots[i] %in% layers_df$spot_name) { + layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] + } else { + layers[i] <- "Unknown" + } + if (spots[i] %in% wrinkles_df$spot_name) { + wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] + } else { + wrinkle[i] <- "None" + } + nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] } - if(spots[i] %in% wrinkles_df$spot_name){ - wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] - }else{ - wrinkle[i] <- "None" - } - nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] - } - sobj@meta.data["Layers"] <- layers - sobj@meta.data["Wrinkles"] <- wrinkle - sobj@meta.data["nCells"] <- nCells - sobj + sobj@meta.data["Layers"] <- layers + sobj@meta.data["Wrinkles"] <- wrinkle + sobj@meta.data["nCells"] <- nCells + sobj } Br6522_ant <- manually_annotate(Br6522_ant, Br6522_ant_layers, Br6522_ant_wrinkles, Br6522_ant_spot_counts) Br6522_mid <- manually_annotate(Br6522_mid, Br6522_mid_layers, Br6522_mid_wrinkles, Br6522_mid_spot_counts) Br8667_post <- manually_annotate(Br8667_post, Br8667_post_layers, Br8667_post_wrinkles, Br8667_post_spot_counts) -Br6522_ant <- subset(Br6522_ant, Layers!="Unknown") -Br6522_mid <- subset(Br6522_mid, Layers!="Unknown") -Br8667_post <- subset(Br8667_post, Layers!="Unknown") +Br6522_ant <- subset(Br6522_ant, Layers != "Unknown") +Br6522_mid <- subset(Br6522_mid, Layers != "Unknown") +Br8667_post <- subset(Br8667_post, Layers != "Unknown") Br6522_ant$Layers <- factor(Br6522_ant$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) Br6522_mid$Layers <- factor(Br6522_mid$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) @@ -67,15 +67,21 @@ Br6522_ant$Wrinkles <- gsub("_", " ", Br6522_ant$Wrinkles) Br6522_mid$Wrinkles <- gsub("_", " ", Br6522_mid$Wrinkles) Br8667_post$Wrinkles <- gsub("_", " ", Br8667_post$Wrinkles) -Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9")) -Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) -Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c("None", "Shear 1", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) +Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9" +)) +Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) +Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c( + "None", "Shear 1", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) Br6522_ant_1 <- Br6522_ant Br6522_mid_1 <- Br6522_mid @@ -83,43 +89,53 @@ Br8667_post_1 <- Br8667_post Br6522_ant_1$Wrinkles <- as.character(Br6522_ant_1$Wrinkles) Br6522_ant_1$Wrinkles[Br6522_ant_1$Wrinkles == "None"] <- NA -Br6522_ant_1$Wrinkles <- factor(Br6522_ant_1$Wrinkles, c("Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9")) +Br6522_ant_1$Wrinkles <- factor(Br6522_ant_1$Wrinkles, c( + "Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9" +)) Br6522_mid_1$Wrinkles <- as.character(Br6522_mid_1$Wrinkles) Br6522_mid_1$Wrinkles[Br6522_mid_1$Wrinkles == "None"] <- NA -Br6522_mid_1$Wrinkles <- factor(Br6522_mid_1$Wrinkles, c("Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) +Br6522_mid_1$Wrinkles <- factor(Br6522_mid_1$Wrinkles, c( + "Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) Br8667_post_1$Wrinkles <- as.character(Br8667_post_1$Wrinkles) Br8667_post_1$Wrinkles[Br8667_post_1$Wrinkles == "None"] <- NA -Br8667_post_1$Wrinkles <- factor(Br8667_post_1$Wrinkles, c("Shear 1", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) - -layer_palette <- c("Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", - "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", - "WM" = "#1A1A1A", "NA" = "transparent") -wrinkle_palette <- c("Fold 1" = "#e6194B", "Shear 1" = "#3cb44b", - "Shear 2" = "#4363d8", "Shear 3" = "#f58231", - "Wrinkle 1" = "#911eb4", "Wrinkle 2" = "#42d4f4", - "Wrinkle 3" = "#f032e6", "Wrinkle 4" = "#bfef45", - "Wrinkle 5" = "#469990", "Wrinkle 6" = "#9A6324", - "Wrinkle 7" = "#800000", "Wrinkle 8" = "#aaffc3", - "Wrinkle 9" = "#373e02", "Wrinkle 10" = "#000075", - "Wrinkle 11" = "#ffd8b1" , "Wrinkle 12" = "#fffac8", - "Wrinkle 13" = "#ffe119", "NA" = "transparent") - -make_spatial_plots <- function(sobj, title){ - Idents(sobj) <- sobj$Layers - p1 <- SpatialDimPlot(sobj, cols = layer_palette) + theme_bw() + guides(fill=guide_legend(title="")) + xlab("") + ylab("") + - theme(axis.ticks = element_blank(), axis.text = element_blank(), plot.title = element_text(face = "bold", size = 10), legend.text = element_text(size = 7)) - Idents(sobj) <- sobj$Wrinkles - p2 <- SpatialDimPlot(sobj, cols = wrinkle_palette)+ theme_bw() + guides(fill=guide_legend(title="", ncol = 2)) + xlab("") + ylab("") + - theme(axis.ticks = element_blank(), axis.text = element_blank(), legend.text = element_text(size = 7)) - list(p1, p2) +Br8667_post_1$Wrinkles <- factor(Br8667_post_1$Wrinkles, c( + "Shear 1", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) + +layer_palette <- c( + "Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", + "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", + "WM" = "#1A1A1A", "NA" = "transparent" +) +wrinkle_palette <- c( + "Fold 1" = "#e6194B", "Shear 1" = "#3cb44b", + "Shear 2" = "#4363d8", "Shear 3" = "#f58231", + "Wrinkle 1" = "#911eb4", "Wrinkle 2" = "#42d4f4", + "Wrinkle 3" = "#f032e6", "Wrinkle 4" = "#bfef45", + "Wrinkle 5" = "#469990", "Wrinkle 6" = "#9A6324", + "Wrinkle 7" = "#800000", "Wrinkle 8" = "#aaffc3", + "Wrinkle 9" = "#373e02", "Wrinkle 10" = "#000075", + "Wrinkle 11" = "#ffd8b1", "Wrinkle 12" = "#fffac8", + "Wrinkle 13" = "#ffe119", "NA" = "transparent" +) + +make_spatial_plots <- function(sobj, title) { + Idents(sobj) <- sobj$Layers + p1 <- SpatialDimPlot(sobj, cols = layer_palette) + theme_bw() + guides(fill = guide_legend(title = "")) + xlab("") + ylab("") + + theme(axis.ticks = element_blank(), axis.text = element_blank(), plot.title = element_text(face = "bold", size = 10), legend.text = element_text(size = 7)) + Idents(sobj) <- sobj$Wrinkles + p2 <- SpatialDimPlot(sobj, cols = wrinkle_palette) + theme_bw() + guides(fill = guide_legend(title = "", ncol = 2)) + xlab("") + ylab("") + + theme(axis.ticks = element_blank(), axis.text = element_blank(), legend.text = element_text(size = 7)) + list(p1, p2) } sp_plot_1 <- make_spatial_plots(Br6522_ant_1, "Br6522 Anterior") @@ -150,100 +166,138 @@ pdf(file = "/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br8667_post_arti sp_plot_3[[2]] dev.off() -Br6522_ant$percent_reads_LG <- apply(Br6522_ant@assays$Spatial@counts, 2, max)/ apply(Br6522_ant@assays$Spatial@counts, 2, sum) -Br6522_mid$percent_reads_LG <- apply(Br6522_mid@assays$Spatial@counts, 2, max)/ apply(Br6522_mid@assays$Spatial@counts, 2, sum) -Br8667_post$percent_reads_LG <- apply(Br8667_post@assays$Spatial@counts, 2, max)/ apply(Br8667_post@assays$Spatial@counts, 2, sum) +Br6522_ant$percent_reads_LG <- apply(Br6522_ant@assays$Spatial@counts, 2, max) / apply(Br6522_ant@assays$Spatial@counts, 2, sum) +Br6522_mid$percent_reads_LG <- apply(Br6522_mid@assays$Spatial@counts, 2, max) / apply(Br6522_mid@assays$Spatial@counts, 2, sum) +Br8667_post$percent_reads_LG <- apply(Br8667_post@assays$Spatial@counts, 2, max) / apply(Br8667_post@assays$Spatial@counts, 2, sum) -Br6522_ant$percent_reads_LG <- Br6522_ant$percent_reads_LG*100 -Br6522_mid$percent_reads_LG <- Br6522_mid$percent_reads_LG*100 -Br8667_post$percent_reads_LG <- Br8667_post$percent_reads_LG*100 +Br6522_ant$percent_reads_LG <- Br6522_ant$percent_reads_LG * 100 +Br6522_mid$percent_reads_LG <- Br6522_mid$percent_reads_LG * 100 +Br8667_post$percent_reads_LG <- Br8667_post$percent_reads_LG * 100 Br6522_ant$is_wrinkle <- !Br6522_ant$Wrinkles == "None" Br6522_mid$is_wrinkle <- !Br6522_mid$Wrinkles == "None" Br8667_post$is_wrinkle <- !Br8667_post$Wrinkles == "None" -make_metadata_layers_plots <- function(sobj, title){ - Layers <- levels(sobj$Layers) - nSpots_normal <- c() - nSpots_artifacts <- c() - for(i in c(1:length(Layers))){ - if(sum(sobj$Layers == Layers[i]) == 0){ - nSpots_normal[i] <- 0 - nSpots_artifacts[i] <- 0 - }else{ - nSpots_normal[i] <- sum(!sobj$is_wrinkle[sobj$Layers == Layers[i]]) - nSpots_artifacts[i] <- sum(sobj$is_wrinkle[sobj$Layers == Layers[i]]) +make_metadata_layers_plots <- function(sobj, title) { + Layers <- levels(sobj$Layers) + nSpots_normal <- c() + nSpots_artifacts <- c() + for (i in c(1:length(Layers))) { + if (sum(sobj$Layers == Layers[i]) == 0) { + nSpots_normal[i] <- 0 + nSpots_artifacts[i] <- 0 + } else { + nSpots_normal[i] <- sum(!sobj$is_wrinkle[sobj$Layers == Layers[i]]) + nSpots_artifacts[i] <- sum(sobj$is_wrinkle[sobj$Layers == Layers[i]]) + } } - } - count_df_artifact <- data.frame("Layers" = Layers, "nSpots" = nSpots_artifacts, - "Artifact" = TRUE) - count_df_normal <- data.frame("Layers" = Layers, "nSpots" = nSpots_normal, - "Artifact" = FALSE) - count_df <- rbind(count_df_artifact, count_df_normal) - p0 <- ggplot(count_df, aes(x = Layers, y = nSpots, fill = Artifact)) + geom_bar(position="dodge", stat="identity") + theme_classic() + - ylab("Number of spots") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) - - stat.test1 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCount_Spatial ~ is_wrinkle, alternative = "less") %>% - add_significance("p") - stat.test1 <- stat.test1 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p1 <- ggplot(sobj@meta.data) + geom_boxplot( aes(x = Layers, y = nCount_Spatial, fill = is_wrinkle),outlier.size = 0.4) + theme_classic() + - ylab("Library Size") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test1, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test2 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent.mt ~ is_wrinkle, alternative = "greater") %>% - add_significance("p") - stat.test2 <- stat.test2 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p2 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent.mt , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Percentage mitochondrial reads") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test2, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test3 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nFeature_Spatial ~ is_wrinkle, alternative = "less") %>% - add_significance("p") - stat.test3 <- stat.test3 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p3 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nFeature_Spatial , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Detected genes") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test3, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test4 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCells ~ is_wrinkle, alternative = "less") %>% - add_significance("p") - stat.test4 <- stat.test4 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p4 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nCells , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Nuclei detected (DAPI)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test4, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test5 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent_reads_LG ~ is_wrinkle, alternative = "greater") %>% - add_significance("p") - stat.test5 <- stat.test5 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p5 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent_reads_LG , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Percent reads (Largest gene)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test5, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - list(p0, p1, p2, p3, p4, p5) + count_df_artifact <- data.frame( + "Layers" = Layers, "nSpots" = nSpots_artifacts, + "Artifact" = TRUE + ) + count_df_normal <- data.frame( + "Layers" = Layers, "nSpots" = nSpots_normal, + "Artifact" = FALSE + ) + count_df <- rbind(count_df_artifact, count_df_normal) + p0 <- ggplot(count_df, aes(x = Layers, y = nSpots, fill = Artifact)) + + geom_bar(position = "dodge", stat = "identity") + + theme_classic() + + ylab("Number of spots") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat.test1 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCount_Spatial ~ is_wrinkle, alternative = "less") %>% + add_significance("p") + stat.test1 <- stat.test1 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p1 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Library Size") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test1, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test2 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent.mt ~ is_wrinkle, alternative = "greater") %>% + add_significance("p") + stat.test2 <- stat.test2 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p2 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent.mt, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Percentage mitochondrial reads") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test2, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test3 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nFeature_Spatial ~ is_wrinkle, alternative = "less") %>% + add_significance("p") + stat.test3 <- stat.test3 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p3 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Detected genes") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test3, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test4 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCells ~ is_wrinkle, alternative = "less") %>% + add_significance("p") + stat.test4 <- stat.test4 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p4 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCells, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Nuclei detected (DAPI)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test4, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test5 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent_reads_LG ~ is_wrinkle, alternative = "greater") %>% + add_significance("p") + stat.test5 <- stat.test5 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p5 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent_reads_LG, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Percent reads (Largest gene)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test5, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + list(p0, p1, p2, p3, p4, p5) } md_plot_1 <- make_metadata_layers_plots(Br6522_ant, "Br6522 Anterior") @@ -257,140 +311,191 @@ md_plot_1[[4]] + md_plot_2[[4]] + md_plot_3[[4]] md_plot_1[[5]] + md_plot_2[[5]] + md_plot_3[[5]] md_plot_1[[6]] + md_plot_2[[6]] + md_plot_3[[6]] -make_metadata_wrinkles_plots <- function(sobj, title, layer){ - Wrinkles <- levels(sobj$Wrinkles) - nSpots_L1 <- c() - nSpots_L2 <- c() - nSpots_L3 <- c() - nSpots_L4 <- c() - nSpots_L5 <- c() - nSpots_L6 <- c() - nSpots_WM <- c() - for(i in c(1:length(Wrinkles))){ - nSpots_L1[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 1") - nSpots_L2[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 2") - nSpots_L3[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 3") - nSpots_L4[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 4") - nSpots_L5[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 5") - nSpots_L6[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 6") - nSpots_WM[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer WM") - } - count_df_L1 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, - "Layer" = "Layer 1") - count_df_L2 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L2, - "Layer" = "Layer 2") - count_df_L3 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L3, - "Layer" = "Layer 3") - count_df_L4 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L4, - "Layer" = "Layer 4") - count_df_L5 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L5, - "Layer" = "Layer 5") - count_df_L6 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, - "Layer" = "Layer 1") - count_df_WM <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L6, - "Layer" = "Layer 6") - - count_df <- rbind(count_df_L1, count_df_L2, count_df_L3, - count_df_L4, count_df_L5, count_df_L6, count_df_WM) - count_df <- count_df[!count_df$Wrinkles == "None", ] - p0 <- ggplot(count_df, aes(Wrinkles, nSpots, fill = Layer)) + geom_bar(position="dodge", stat="identity") + theme_classic() + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + ggtitle(title) + scale_fill_brewer(palette = "Dark2") + xlab("") - - stat.test1 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCount_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% - add_significance("p") - stat.test1 <- stat.test1 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p1 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = Wrinkles),outlier.size = 0.4) + theme_classic() + - ylab("Library Size") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test1, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test2 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent.mt ~ Wrinkles, alternative = "greater", ref.group = "None") %>% - add_significance("p") - stat.test2 <- stat.test2 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p2 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent.mt , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Percentage mitochondrial reads") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test2, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test3 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nFeature_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% - add_significance("p") - stat.test3 <- stat.test3 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p3 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nFeature_Spatial , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Detected genes") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test3, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test4 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCells ~ Wrinkles, alternative = "less", ref.group = "None") %>% - add_significance("p") - stat.test4 <- stat.test4 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p4 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nCells , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Nuclei detected (DAPI)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test4, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test5 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent_reads_LG ~ Wrinkles, alternative = "greater", ref.group = "None") %>% - add_significance("p") - stat.test5 <- stat.test5 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p5 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent_reads_LG , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Percent reads (Largest gene)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test5, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - list(p0, p1, p2, p3, p4, p5) +make_metadata_wrinkles_plots <- function(sobj, title, layer) { + Wrinkles <- levels(sobj$Wrinkles) + nSpots_L1 <- c() + nSpots_L2 <- c() + nSpots_L3 <- c() + nSpots_L4 <- c() + nSpots_L5 <- c() + nSpots_L6 <- c() + nSpots_WM <- c() + for (i in c(1:length(Wrinkles))) { + nSpots_L1[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 1") + nSpots_L2[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 2") + nSpots_L3[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 3") + nSpots_L4[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 4") + nSpots_L5[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 5") + nSpots_L6[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 6") + nSpots_WM[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer WM") + } + count_df_L1 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, + "Layer" = "Layer 1" + ) + count_df_L2 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L2, + "Layer" = "Layer 2" + ) + count_df_L3 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L3, + "Layer" = "Layer 3" + ) + count_df_L4 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L4, + "Layer" = "Layer 4" + ) + count_df_L5 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L5, + "Layer" = "Layer 5" + ) + count_df_L6 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, + "Layer" = "Layer 1" + ) + count_df_WM <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L6, + "Layer" = "Layer 6" + ) + + count_df <- rbind( + count_df_L1, count_df_L2, count_df_L3, + count_df_L4, count_df_L5, count_df_L6, count_df_WM + ) + count_df <- count_df[!count_df$Wrinkles == "None", ] + p0 <- ggplot(count_df, aes(Wrinkles, nSpots, fill = Layer)) + + geom_bar(position = "dodge", stat = "identity") + + theme_classic() + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) + + ggtitle(title) + + scale_fill_brewer(palette = "Dark2") + + xlab("") + + stat.test1 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCount_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% + add_significance("p") + stat.test1 <- stat.test1 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p1 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Library Size") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test1, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test2 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent.mt ~ Wrinkles, alternative = "greater", ref.group = "None") %>% + add_significance("p") + stat.test2 <- stat.test2 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p2 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent.mt, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Percentage mitochondrial reads") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test2, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test3 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nFeature_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% + add_significance("p") + stat.test3 <- stat.test3 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p3 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Detected genes") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test3, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test4 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCells ~ Wrinkles, alternative = "less", ref.group = "None") %>% + add_significance("p") + stat.test4 <- stat.test4 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p4 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCells, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Nuclei detected (DAPI)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test4, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test5 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent_reads_LG ~ Wrinkles, alternative = "greater", ref.group = "None") %>% + add_significance("p") + stat.test5 <- stat.test5 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p5 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent_reads_LG, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Percent reads (Largest gene)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test5, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + list(p0, p1, p2, p3, p4, p5) } mdw_plot_1 <- make_metadata_wrinkles_plots(Br6522_ant, "Br6522 Anterior") mdw_plot_2 <- make_metadata_wrinkles_plots(Br6522_mid, "Br6522 Middle") mdw_plot_3 <- make_metadata_wrinkles_plots(Br8667_post, "Br8667 Posterior") -get_legend<-function(myggplot){ - tmp <- ggplot_gtable(ggplot_build(myggplot)) - leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") - legend <- tmp$grobs[[leg]] - return(legend) +get_legend <- function(myggplot) { + tmp <- ggplot_gtable(ggplot_build(myggplot)) + leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") + legend <- tmp$grobs[[leg]] + return(legend) } mdw_legend_1 <- get_legend(mdw_plot_1[[2]]) mdw_legend_2 <- get_legend(mdw_plot_2[[2]]) mdw_legend_3 <- get_legend(mdw_plot_3[[2]]) -mdw_plot_1[[2]] <- mdw_plot_1[[2]] + theme(legend.position="none") -mdw_plot_1[[3]] <- mdw_plot_1[[3]] + theme(legend.position="none") -mdw_plot_1[[4]] <- mdw_plot_1[[4]] + theme(legend.position="none") -mdw_plot_1[[5]] <- mdw_plot_1[[5]] + theme(legend.position="none") -mdw_plot_1[[6]] <- mdw_plot_1[[6]] + theme(legend.position="none") +mdw_plot_1[[2]] <- mdw_plot_1[[2]] + theme(legend.position = "none") +mdw_plot_1[[3]] <- mdw_plot_1[[3]] + theme(legend.position = "none") +mdw_plot_1[[4]] <- mdw_plot_1[[4]] + theme(legend.position = "none") +mdw_plot_1[[5]] <- mdw_plot_1[[5]] + theme(legend.position = "none") +mdw_plot_1[[6]] <- mdw_plot_1[[6]] + theme(legend.position = "none") -mdw_plot_2[[2]] <- mdw_plot_2[[2]] + theme(legend.position="none") -mdw_plot_2[[3]] <- mdw_plot_2[[3]] + theme(legend.position="none") -mdw_plot_2[[4]] <- mdw_plot_2[[4]] + theme(legend.position="none") -mdw_plot_2[[5]] <- mdw_plot_2[[5]] + theme(legend.position="none") -mdw_plot_2[[6]] <- mdw_plot_2[[6]] + theme(legend.position="none") +mdw_plot_2[[2]] <- mdw_plot_2[[2]] + theme(legend.position = "none") +mdw_plot_2[[3]] <- mdw_plot_2[[3]] + theme(legend.position = "none") +mdw_plot_2[[4]] <- mdw_plot_2[[4]] + theme(legend.position = "none") +mdw_plot_2[[5]] <- mdw_plot_2[[5]] + theme(legend.position = "none") +mdw_plot_2[[6]] <- mdw_plot_2[[6]] + theme(legend.position = "none") -mdw_plot_3[[2]] <- mdw_plot_3[[2]] + theme(legend.position="none") -mdw_plot_3[[3]] <- mdw_plot_3[[3]] + theme(legend.position="none") -mdw_plot_3[[4]] <- mdw_plot_3[[4]] + theme(legend.position="none") -mdw_plot_3[[5]] <- mdw_plot_3[[5]] + theme(legend.position="none") -mdw_plot_3[[6]] <- mdw_plot_3[[6]] + theme(legend.position="none") +mdw_plot_3[[2]] <- mdw_plot_3[[2]] + theme(legend.position = "none") +mdw_plot_3[[3]] <- mdw_plot_3[[3]] + theme(legend.position = "none") +mdw_plot_3[[4]] <- mdw_plot_3[[4]] + theme(legend.position = "none") +mdw_plot_3[[5]] <- mdw_plot_3[[5]] + theme(legend.position = "none") +mdw_plot_3[[6]] <- mdw_plot_3[[6]] + theme(legend.position = "none") Br6522_ant$subject <- "Br6522 anterior" Br6522_mid$subject <- "Br6522 middle" @@ -399,63 +504,85 @@ Br8667_post$subject <- "Br8667 posterior" combined_metadata <- rbind(Br6522_ant@meta.data, Br6522_mid@meta.data, Br8667_post@meta.data) combined_metadata$sample <- combined_metadata$subject combined_metadata$sample[combined_metadata$is_wrinkle] <- paste(combined_metadata$sample[combined_metadata$is_wrinkle], "(artifact)") -combined_metadata$sample <- factor(combined_metadata$sample, levels = c("Br8667 posterior", "Br8667 posterior (artifact)", - "Br6522 middle", "Br6522 middle (artifact)", - "Br6522 anterior", "Br6522 anterior (artifact)")) +combined_metadata$sample <- factor(combined_metadata$sample, levels = c( + "Br8667 posterior", "Br8667 posterior (artifact)", + "Br6522 middle", "Br6522 middle (artifact)", + "Br6522 anterior", "Br6522 anterior (artifact)" +)) stat.test1 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(nCount_Spatial ~ sample, alternative = "less") %>% - add_significance("p") -stat.test1 <- stat.test1 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(nCount_Spatial ~ sample, alternative = "less") %>% + add_significance("p") +stat.test1 <- stat.test1 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test1$group_combined <- paste(stat.test1$group1, stat.test1$group2, sep = "-") stat.test1 <- stat.test1[stat.test1$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] -p1 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10))+ - ylab("Library Size") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test1, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) +p1 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("Library Size") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test1, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) stat.test2 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(nFeature_Spatial ~ sample, alternative = "less") %>% - add_significance("p") -stat.test2 <- stat.test2 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(nFeature_Spatial ~ sample, alternative = "less") %>% + add_significance("p") +stat.test2 <- stat.test2 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test2$group_combined <- paste(stat.test2$group1, stat.test2$group2, sep = "-") stat.test2 <- stat.test2[stat.test2$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] -p2 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10)) + - ylab("Number of detected genes") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test2, label = "{p.adj.signif}",tip.length = 0, hide.ns = TRUE) +p2 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("Number of detected genes") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test2, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) stat.test3 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(percent.mt ~ sample, alternative = "greater") %>% - add_significance("p") -stat.test3 <- stat.test3 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(percent.mt ~ sample, alternative = "greater") %>% + add_significance("p") +stat.test3 <- stat.test3 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test3$group_combined <- paste(stat.test3$group1, stat.test3$group2, sep = "-") stat.test3 <- stat.test3[stat.test3$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] -p3 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = percent.mt, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10)) + - ylab("Percent mito") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test3, label = "{p.adj.signif}",tip.length = 0, hide.ns = TRUE) +p3 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = percent.mt, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("Percent mito") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test3, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) stat.test4 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(nCells ~ sample, alternative = "less") %>% - add_significance("p") -stat.test4 <- stat.test4 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(nCells ~ sample, alternative = "less") %>% + add_significance("p") +stat.test4 <- stat.test4 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test4$group_combined <- paste(stat.test4$group1, stat.test4$group2, sep = "-") stat.test4 <- stat.test4[stat.test4$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] stat.test4$y.position <- stat.test4$y.position + 25 -p4 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = nCells, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10)) + - ylab("#Cells (Vistoseg)") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test4, label = "{p.adj.signif}",tip.length = 0, hide.ns = TRUE) +p4 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = nCells, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("#Cells (Vistoseg)") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test4, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) qc_legend <- get_legend(p1) @@ -475,16 +602,21 @@ pdf(file = "/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/legend_QC.pdf", plot_grid(qc_legend) dev.off() -ggplotRegression <- function (fit, x, y) { - require(ggplot2) - ggplot(fit$model, aes_string(x = names(fit$model)[2], y = names(fit$model)[1])) + - geom_point() + - stat_smooth(method = "lm", col = "red") + - labs(title = paste("Adj R2 = ",signif(summary(fit)$adj.r.squared, 5), - "Intercept =",signif(fit$coef[[1]],5 ), - " Slope =",signif(fit$coef[[2]], 5), - " P =",signif(summary(fit)$coef[2,4], 5))) + theme_classic() + - xlab(x) + ylab(y) + theme(plot.title = element_text(size = 10), axis.title = element_text(size = 10)) +ggplotRegression <- function(fit, x, y) { + require(ggplot2) + ggplot(fit$model, aes_string(x = names(fit$model)[2], y = names(fit$model)[1])) + + geom_point() + + stat_smooth(method = "lm", col = "red") + + labs(title = paste( + "Adj R2 = ", signif(summary(fit)$adj.r.squared, 5), + "Intercept =", signif(fit$coef[[1]], 5), + " Slope =", signif(fit$coef[[2]], 5), + " P =", signif(summary(fit)$coef[2, 4], 5) + )) + + theme_classic() + + xlab(x) + + ylab(y) + + theme(plot.title = element_text(size = 10), axis.title = element_text(size = 10)) } fit_wrinkle <- lm(nCount_Spatial ~ nCells, Br6522_ant@meta.data[Br6522_ant$is_wrinkle, ]) @@ -500,21 +632,30 @@ fit_normal <- lm(nCount_Spatial ~ nCells, Br8667_post@meta.data[!Br8667_post$is_ plot_grid(ggplotRegression(fit_normal, "Number of cells", "Library size"), ggplotRegression(fit_wrinkle, "Number of cells", "Library size"), nrow = 2) set.seed(100) -make_plots <- function(data){ - gene_attr <- data.frame(mean = rowMeans(data), detection_rate = rowMeans(data > 0), var = apply(data, 1, var)) - gene_attr$log_mean <- log10(gene_attr$mean) - gene_attr$log_var <- log10(gene_attr$var) - rownames(gene_attr) <- rownames(data) - cell_attr <- data.frame(n_umi = colSums(data), n_gene = colSums(data > 0)) - rownames(cell_attr) <- colnames(data) - p1 <- ggplot(gene_attr, aes(log_mean, log_var)) + geom_point(alpha = 0.3, shape = 16) + - geom_density_2d(size = 0.3) + geom_abline(intercept = 0, slope = 1, color = "red")+ theme_classic() - x = seq(from = -3, to = 2, length.out = 1000) - poisson_model <- data.frame(log_mean = x, detection_rate = 1 - dpois(0, lambda = 10^x)) - p2 <- ggplot(gene_attr, aes(log_mean, detection_rate)) + geom_point(alpha = 0.3, shape = 16) + - geom_line(data = poisson_model, color = "red") + theme_gray(base_size = 8) + theme_classic() - p3 <- ggplot(cell_attr, aes(n_umi, n_gene)) + geom_point(alpha = 0.3, shape = 16) + geom_density_2d(size = 0.3) + theme_classic() - p1 + p2 + p3 +make_plots <- function(data) { + gene_attr <- data.frame(mean = rowMeans(data), detection_rate = rowMeans(data > 0), var = apply(data, 1, var)) + gene_attr$log_mean <- log10(gene_attr$mean) + gene_attr$log_var <- log10(gene_attr$var) + rownames(gene_attr) <- rownames(data) + cell_attr <- data.frame(n_umi = colSums(data), n_gene = colSums(data > 0)) + rownames(cell_attr) <- colnames(data) + p1 <- ggplot(gene_attr, aes(log_mean, log_var)) + + geom_point(alpha = 0.3, shape = 16) + + geom_density_2d(size = 0.3) + + geom_abline(intercept = 0, slope = 1, color = "red") + + theme_classic() + x <- seq(from = -3, to = 2, length.out = 1000) + poisson_model <- data.frame(log_mean = x, detection_rate = 1 - dpois(0, lambda = 10^x)) + p2 <- ggplot(gene_attr, aes(log_mean, detection_rate)) + + geom_point(alpha = 0.3, shape = 16) + + geom_line(data = poisson_model, color = "red") + + theme_gray(base_size = 8) + + theme_classic() + p3 <- ggplot(cell_attr, aes(n_umi, n_gene)) + + geom_point(alpha = 0.3, shape = 16) + + geom_density_2d(size = 0.3) + + theme_classic() + p1 + p2 + p3 } geneData <- readRDS("/data/abattle4/prashanthi/dewrinkler/data/gene_df.rds") @@ -525,9 +666,9 @@ Br6522_ant@assays$Spatial@meta.features$geneType <- geneData$gene_type Br6522_mid@assays$Spatial@meta.features$geneType <- geneData$gene_type Br8667_post@assays$Spatial@meta.features$geneType <- geneData$gene_type -Br6522_ant@assays$Spatial@meta.features$pCells <- Br6522_ant@assays$Spatial@meta.features$nCells/dim(Br6522_ant)[2] -Br6522_mid@assays$Spatial@meta.features$pCells <- Br6522_mid@assays$Spatial@meta.features$nCells/dim(Br6522_mid)[2] -Br8667_post@assays$Spatial@meta.features$pCells <- Br8667_post@assays$Spatial@meta.features$nCells/dim(Br8667_post)[2] +Br6522_ant@assays$Spatial@meta.features$pCells <- Br6522_ant@assays$Spatial@meta.features$nCells / dim(Br6522_ant)[2] +Br6522_mid@assays$Spatial@meta.features$pCells <- Br6522_mid@assays$Spatial@meta.features$nCells / dim(Br6522_mid)[2] +Br8667_post@assays$Spatial@meta.features$pCells <- Br8667_post@assays$Spatial@meta.features$nCells / dim(Br8667_post)[2] # Apply QC filters # Gene level QC @@ -551,9 +692,9 @@ Br6522_ant_normal@assays$Spatial@meta.features$nCells <- rowSums(Br6522_ant_norm Br6522_mid_normal@assays$Spatial@meta.features$nCells <- rowSums(Br6522_mid_normal@assays$Spatial@counts > 0) Br8667_post_normal@assays$Spatial@meta.features$nCells <- rowSums(Br8667_post_normal@assays$Spatial@counts > 0) -Br6522_ant_normal@assays$Spatial@meta.features$pCells <- Br6522_ant_normal@assays$Spatial@meta.features$nCells/dim(Br6522_ant_normal)[2] -Br6522_mid_normal@assays$Spatial@meta.features$pCells <- Br6522_mid_normal@assays$Spatial@meta.features$nCells/dim(Br6522_mid_normal)[2] -Br8667_post_normal@assays$Spatial@meta.features$pCells <- Br8667_post_normal@assays$Spatial@meta.features$nCells/dim(Br8667_post_normal)[2] +Br6522_ant_normal@assays$Spatial@meta.features$pCells <- Br6522_ant_normal@assays$Spatial@meta.features$nCells / dim(Br6522_ant_normal)[2] +Br6522_mid_normal@assays$Spatial@meta.features$pCells <- Br6522_mid_normal@assays$Spatial@meta.features$nCells / dim(Br6522_mid_normal)[2] +Br8667_post_normal@assays$Spatial@meta.features$pCells <- Br8667_post_normal@assays$Spatial@meta.features$nCells / dim(Br8667_post_normal)[2] Br6522_ant_normal <- Br6522_ant_normal[Br6522_ant_normal@assays$Spatial@meta.features$pCells >= 0.05, ] Br6522_mid_normal <- Br6522_mid_normal[Br6522_mid_normal@assays$Spatial@meta.features$pCells >= 0.05, ] @@ -575,93 +716,133 @@ make_plots(Br6522_ant_normal_data) make_plots(Br6522_mid_normal_data) make_plots(Br8667_post_normal_data) -Br6522_ant_normal_vst_out <- sctransform::vst(Br6522_ant_normal_data,latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br6522_mid_normal_vst_out <- sctransform::vst(Br6522_mid_normal_data, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br8667_post_normal_vst_out <- sctransform::vst(Br8667_post_normal_data, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) +Br6522_ant_normal_vst_out <- sctransform::vst(Br6522_ant_normal_data, + latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_mid_normal_vst_out <- sctransform::vst(Br6522_mid_normal_data, + latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br8667_post_normal_vst_out <- sctransform::vst(Br8667_post_normal_data, + latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) Br6522_ant_additional_params <- data.frame(Br6522_ant$is_wrinkle) colnames(Br6522_ant_additional_params) <- "is_wrinkle" -Br6522_ant_all_vst_out <- sctransform::vst(Br6522_ant_all_data, cell_attr = Br6522_ant_additional_params,latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br6522_ant_all_vst_out_libSize_only <- sctransform::vst(Br6522_ant_all_data, cell_attr = Br6522_ant_additional_params,latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br6522_ant_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_ant_all_data, cell_attr = Br6522_ant_additional_params,latent_var = c("is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) +Br6522_ant_all_vst_out <- sctransform::vst(Br6522_ant_all_data, + cell_attr = Br6522_ant_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_ant_all_vst_out_libSize_only <- sctransform::vst(Br6522_ant_all_data, + cell_attr = Br6522_ant_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_ant_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_ant_all_data, + cell_attr = Br6522_ant_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) Br6522_mid_additional_params <- data.frame(Br6522_mid$is_wrinkle) colnames(Br6522_mid_additional_params) <- "is_wrinkle" -Br6522_mid_all_vst_out <- sctransform::vst(Br6522_mid_all_data, cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br6522_mid_all_vst_out_libSize_only <- sctransform::vst(Br6522_mid_all_data, cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br6522_mid_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_mid_all_data, cell_attr = Br6522_mid_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) +Br6522_mid_all_vst_out <- sctransform::vst(Br6522_mid_all_data, + cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_mid_all_vst_out_libSize_only <- sctransform::vst(Br6522_mid_all_data, + cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_mid_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_mid_all_data, + cell_attr = Br6522_mid_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) Br8667_post_additional_params <- data.frame(Br8667_post$is_wrinkle) colnames(Br8667_post_additional_params) <- "is_wrinkle" -Br8667_post_all_vst_out <- sctransform::vst(Br8667_post_all_data, cell_attr = Br8667_post_additional_params,latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br8667_post_all_vst_out_libSize_only <- sctransform::vst(Br8667_post_all_data, cell_attr = Br8667_post_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br8667_post_all_vst_out_wrinkle_only <- sctransform::vst(Br8667_post_all_data, cell_attr = Br8667_post_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) +Br8667_post_all_vst_out <- sctransform::vst(Br8667_post_all_data, + cell_attr = Br8667_post_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br8667_post_all_vst_out_libSize_only <- sctransform::vst(Br8667_post_all_data, + cell_attr = Br8667_post_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br8667_post_all_vst_out_wrinkle_only <- sctransform::vst(Br8667_post_all_data, + cell_attr = Br8667_post_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) sctransform::plot_model_pars(Br6522_ant_normal_vst_out, show_theta = TRUE) sctransform::plot_model_pars(Br6522_mid_normal_vst_out, show_theta = TRUE) sctransform::plot_model_pars(Br8667_post_normal_vst_out, show_theta = TRUE) -make_compare_plots <- function(vst_out, vst_out_wrinkle_only, sample_label){ - wrinkle_only_params_df <- data.frame(rbind(cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars, "Single gene estimate"), - cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars_fit, "Regularized"))) - colnames(wrinkle_only_params_df)[1] <- "gmean" - colnames(wrinkle_only_params_df)[5] <- "estimate_type" - wrinkle_only_params_df$gmean <- as.numeric(wrinkle_only_params_df$gmean) - wrinkle_only_params_df$theta <- as.numeric(wrinkle_only_params_df$theta) - wrinkle_only_params_df$X.Intercept. <- as.numeric(wrinkle_only_params_df$X.Intercept.) - wrinkle_only_params_df$is_wrinkleTRUE <- as.numeric(wrinkle_only_params_df$is_wrinkleTRUE) - wrinkle_only_params_df$estimate_type <- factor(wrinkle_only_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) - wrinkle_only_params_df$gmean <- log10(wrinkle_only_params_df$gmean) - p0 <- ggplot(wrinkle_only_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + - geom_point(alpha = 0.5, size = 0.7) + theme_classic() + - xlab("Geometric mean of gene [log10]") + ylab(expression(beta[2])) + geom_hline(yintercept = 0, lty = 2, color = "black") + - guides(colour=guide_legend(title= "Estimate type")) + theme(axis.title.x = element_text(size = 10)) - - all_params_df <- data.frame(rbind(cbind(vst_out$gene_attr$gmean, vst_out$model_pars, "Single gene estimate"), cbind(vst_out$gene_attr$gmean, vst_out$model_pars_fit, "Regularized"))) - colnames(all_params_df)[1] <- "gmean" - colnames(all_params_df)[6] <- "estimate_type" - all_params_df$gmean <- as.numeric(all_params_df$gmean) - all_params_df$theta <- as.numeric(all_params_df$theta) - all_params_df$X.Intercept. <- as.numeric(all_params_df$X.Intercept.) - all_params_df$log_umi <- as.numeric(all_params_df$log_umi) - all_params_df$is_wrinkleTRUE <- as.numeric(all_params_df$is_wrinkleTRUE) - all_params_df$estimate_type <- factor(all_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) - all_params_df$gmean <- log10(all_params_df$gmean) - p1 <- ggplot(all_params_df, aes(x = gmean, y = log_umi, colour = estimate_type)) + - geom_point(alpha = 0.5, size = 0.7) + theme_classic() + - xlab("Geometric mean of gene [log10]") + ylab(expression(beta[1])) + guides(colour=guide_legend(title= "Estimate type")) + - theme(axis.title.x = element_text(size = 10)) + geom_hline(yintercept = 0, lty = 2, color = "black") - p2 <- ggplot(all_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + - geom_point(alpha = 0.5, size = 0.7) + theme_classic() + - xlab("Geometric mean of gene [log10]") + ylab(expression(beta[2])) + guides(colour=guide_legend(title= "Estimate type")) + - theme(axis.title.x = element_text(size = 10)) + geom_hline(yintercept = 0, lty = 2, color = "black") - estimate_type_legend <- get_legend(p0) - p0 <- p0 + theme(legend.position = "none") - p1 <- p1 + theme(legend.position = "none") - p2 <- p2 + theme(legend.position = "none") - - title_model_1 <- ggdraw() + draw_label(expression("Model 1: log(E["~x[i]~"])" == ~ beta[0] ~ + ~ beta[2] ~ w), size = 12) - title_model_2 <- ggdraw() + draw_label(expression("Model 2: log(E["~x[i]~"])" == ~ beta[0] ~ + ~ beta[1] ~ m ~ + ~ beta[2] ~ w), size = 12) - sample_name <- ggdraw() + draw_label(sample_label, size = 12) - - plot_grid(sample_name, - plot_grid(title_model_1, title_model_2, p0, plot_grid(p2, p1), rel_heights = c(1, 5), rel_widths = c(1, 2)), - estimate_type_legend, rel_widths = c(1, 6, 1), nrow = 1) +make_compare_plots <- function(vst_out, vst_out_wrinkle_only, sample_label) { + wrinkle_only_params_df <- data.frame(rbind( + cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars, "Single gene estimate"), + cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars_fit, "Regularized") + )) + colnames(wrinkle_only_params_df)[1] <- "gmean" + colnames(wrinkle_only_params_df)[5] <- "estimate_type" + wrinkle_only_params_df$gmean <- as.numeric(wrinkle_only_params_df$gmean) + wrinkle_only_params_df$theta <- as.numeric(wrinkle_only_params_df$theta) + wrinkle_only_params_df$X.Intercept. <- as.numeric(wrinkle_only_params_df$X.Intercept.) + wrinkle_only_params_df$is_wrinkleTRUE <- as.numeric(wrinkle_only_params_df$is_wrinkleTRUE) + wrinkle_only_params_df$estimate_type <- factor(wrinkle_only_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) + wrinkle_only_params_df$gmean <- log10(wrinkle_only_params_df$gmean) + p0 <- ggplot(wrinkle_only_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + + geom_point(alpha = 0.5, size = 0.7) + + theme_classic() + + xlab("Geometric mean of gene [log10]") + + ylab(expression(beta[2])) + + geom_hline(yintercept = 0, lty = 2, color = "black") + + guides(colour = guide_legend(title = "Estimate type")) + + theme(axis.title.x = element_text(size = 10)) + + all_params_df <- data.frame(rbind(cbind(vst_out$gene_attr$gmean, vst_out$model_pars, "Single gene estimate"), cbind(vst_out$gene_attr$gmean, vst_out$model_pars_fit, "Regularized"))) + colnames(all_params_df)[1] <- "gmean" + colnames(all_params_df)[6] <- "estimate_type" + all_params_df$gmean <- as.numeric(all_params_df$gmean) + all_params_df$theta <- as.numeric(all_params_df$theta) + all_params_df$X.Intercept. <- as.numeric(all_params_df$X.Intercept.) + all_params_df$log_umi <- as.numeric(all_params_df$log_umi) + all_params_df$is_wrinkleTRUE <- as.numeric(all_params_df$is_wrinkleTRUE) + all_params_df$estimate_type <- factor(all_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) + all_params_df$gmean <- log10(all_params_df$gmean) + p1 <- ggplot(all_params_df, aes(x = gmean, y = log_umi, colour = estimate_type)) + + geom_point(alpha = 0.5, size = 0.7) + + theme_classic() + + xlab("Geometric mean of gene [log10]") + + ylab(expression(beta[1])) + + guides(colour = guide_legend(title = "Estimate type")) + + theme(axis.title.x = element_text(size = 10)) + + geom_hline(yintercept = 0, lty = 2, color = "black") + p2 <- ggplot(all_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + + geom_point(alpha = 0.5, size = 0.7) + + theme_classic() + + xlab("Geometric mean of gene [log10]") + + ylab(expression(beta[2])) + + guides(colour = guide_legend(title = "Estimate type")) + + theme(axis.title.x = element_text(size = 10)) + + geom_hline(yintercept = 0, lty = 2, color = "black") + estimate_type_legend <- get_legend(p0) + p0 <- p0 + theme(legend.position = "none") + p1 <- p1 + theme(legend.position = "none") + p2 <- p2 + theme(legend.position = "none") + + title_model_1 <- ggdraw() + draw_label(expression("Model 1: log(E[" ~ x[i] ~ "])" == ~ beta[0] ~ +~ beta[2] ~ w), size = 12) + title_model_2 <- ggdraw() + draw_label(expression("Model 2: log(E[" ~ x[i] ~ "])" == ~ beta[0] ~ +~ beta[1] ~ m ~ +~ beta[2] ~ w), size = 12) + sample_name <- ggdraw() + draw_label(sample_label, size = 12) + + plot_grid(sample_name, + plot_grid(title_model_1, title_model_2, p0, plot_grid(p2, p1), rel_heights = c(1, 5), rel_widths = c(1, 2)), + estimate_type_legend, + rel_widths = c(1, 6, 1), nrow = 1 + ) } p1 <- make_compare_plots(Br6522_ant_all_vst_out, Br6522_ant_all_vst_out_wrinkle_only, "Br6522 Anterior") @@ -677,41 +858,49 @@ pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br8667_post_NB_regressi p3 dev.off() -plot_params <- function(normal_vst_out, all_vst_out, title){ - common.genes <- intersect(rownames(normal_vst_out$model_pars), rownames(all_vst_out$model_pars)) - normal_params <- normal_vst_out$model_pars - normal_params_fit <- normal_vst_out$model_pars_fit - all_params <- all_vst_out$model_pars - all_params_fit <- all_vst_out$model_pars_fit - normal_params <- normal_params[match(common.genes, rownames(normal_params)), ] - normal_params_fit <- normal_params_fit[match(common.genes, rownames(normal_params_fit)), ] - all_params <- all_params[match(common.genes, rownames(all_params)), ] - all_params_fit <- all_params_fit[match(common.genes, rownames(all_params_fit)), ] - plot_df <- data.frame("Normal_intercept" = normal_params[ ,2], - "Normal_intercept_regularized" = normal_params_fit[ ,2], - "All_intercept" = all_params[ ,2], - "All_intercept_regularized" = all_params_fit[ ,2]) - - ggplot(plot_df) + geom_point(aes(x = Normal_intercept, y = All_intercept, colour = "Single gene estimate"), alpha = 0.5) + - geom_point(aes(x = Normal_intercept_regularized, y = All_intercept_regularized, colour = "Regularized"), alpha = 0.5) + geom_abline(slope = 1, intercept = 0, lty = 2) + - theme_classic() + xlab("Intercept (excl. artifacts)") + ylab("Intercept") + ggtitle(title) + - scale_colour_manual(name = "Estimate type", values = c("Regularized" = "#F8766D", "Single gene estimate" = "#00BFC4")) + - theme(plot.title = element_text(face = "bold", size = 14), axis.title = element_text(size = 12), legend.title = element_text(size = 12), - legend.text = element_text(size = 10)) +plot_params <- function(normal_vst_out, all_vst_out, title) { + common.genes <- intersect(rownames(normal_vst_out$model_pars), rownames(all_vst_out$model_pars)) + normal_params <- normal_vst_out$model_pars + normal_params_fit <- normal_vst_out$model_pars_fit + all_params <- all_vst_out$model_pars + all_params_fit <- all_vst_out$model_pars_fit + normal_params <- normal_params[match(common.genes, rownames(normal_params)), ] + normal_params_fit <- normal_params_fit[match(common.genes, rownames(normal_params_fit)), ] + all_params <- all_params[match(common.genes, rownames(all_params)), ] + all_params_fit <- all_params_fit[match(common.genes, rownames(all_params_fit)), ] + plot_df <- data.frame( + "Normal_intercept" = normal_params[, 2], + "Normal_intercept_regularized" = normal_params_fit[, 2], + "All_intercept" = all_params[, 2], + "All_intercept_regularized" = all_params_fit[, 2] + ) + + ggplot(plot_df) + + geom_point(aes(x = Normal_intercept, y = All_intercept, colour = "Single gene estimate"), alpha = 0.5) + + geom_point(aes(x = Normal_intercept_regularized, y = All_intercept_regularized, colour = "Regularized"), alpha = 0.5) + + geom_abline(slope = 1, intercept = 0, lty = 2) + + theme_classic() + + xlab("Intercept (excl. artifacts)") + + ylab("Intercept") + + ggtitle(title) + + scale_colour_manual(name = "Estimate type", values = c("Regularized" = "#F8766D", "Single gene estimate" = "#00BFC4")) + + theme( + plot.title = element_text(face = "bold", size = 14), axis.title = element_text(size = 12), legend.title = element_text(size = 12), + legend.text = element_text(size = 10) + ) } -p <- plot_params(Br6522_ant_normal_vst_out, Br6522_ant_all_vst_out_libSize_only, "Br6522 Anterior") +p <- plot_params(Br6522_ant_normal_vst_out, Br6522_ant_all_vst_out_libSize_only, "Br6522 Anterior") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br6522_ant_intercept.pdf", width = 7, height = 5) p dev.off() -p <- plot_params(Br6522_mid_normal_vst_out, Br6522_mid_all_vst_out_libSize_only, "Br6522 Middle") +p <- plot_params(Br6522_mid_normal_vst_out, Br6522_mid_all_vst_out_libSize_only, "Br6522 Middle") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br6522_mid_intercept.pdf", width = 7, height = 5) p dev.off() -p <- plot_params(Br8667_post_normal_vst_out, Br8667_post_all_vst_out_libSize_only, "Br8667 Posterior") +p <- plot_params(Br8667_post_normal_vst_out, Br8667_post_all_vst_out_libSize_only, "Br8667 Posterior") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br8667_post_intercept.pdf", width = 7, height = 5) p dev.off() - diff --git a/code/qc_artifact/Simulate_heterotypic_artifacts.R b/code/qc_artifact/Simulate_heterotypic_artifacts.R index c22ec7e3..7950de38 100644 --- a/code/qc_artifact/Simulate_heterotypic_artifacts.R +++ b/code/qc_artifact/Simulate_heterotypic_artifacts.R @@ -7,28 +7,28 @@ library(cowplot) library(DoubletFinder) set.seed(1001) -manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df){ - spots <- rownames(sobj@meta.data) - layers <- c() - wrinkle <- c() - nCells <- c() - for(i in c(1:length(spots))){ - if(spots[i] %in% layers_df$spot_name){ - layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] - }else{ - layers[i] <- "Unknown" +manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df) { + spots <- rownames(sobj@meta.data) + layers <- c() + wrinkle <- c() + nCells <- c() + for (i in c(1:length(spots))) { + if (spots[i] %in% layers_df$spot_name) { + layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] + } else { + layers[i] <- "Unknown" + } + if (spots[i] %in% wrinkles_df$spot_name) { + wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] + } else { + wrinkle[i] <- "None" + } + nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] } - if(spots[i] %in% wrinkles_df$spot_name){ - wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] - }else{ - wrinkle[i] <- "None" - } - nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] - } - sobj@meta.data["Layers"] <- layers - sobj@meta.data["Wrinkles"] <- wrinkle - sobj@meta.data["nCells"] <- nCells - sobj + sobj@meta.data["Layers"] <- layers + sobj@meta.data["Wrinkles"] <- wrinkle + sobj@meta.data["nCells"] <- nCells + sobj } # Read manual annotationss @@ -54,62 +54,69 @@ Br6522_ant <- manually_annotate(Br6522_ant, Br6522_ant_layers, Br6522_ant_wrinkl Br6522_mid <- manually_annotate(Br6522_mid, Br6522_mid_layers, Br6522_mid_wrinkles, Br6522_mid_spot_counts) Br8667_post <- manually_annotate(Br8667_post, Br8667_post_layers, Br8667_post_wrinkles, Br8667_post_spot_counts) -# Exclude points that do not have a definitive layer assignment -Br6522_ant <- Br6522_ant[ ,!Br6522_ant$Layers == "Unknown"] -Br6522_mid <- Br6522_mid[ ,!Br6522_mid$Layers == "Unknown"] -Br8667_post <- Br8667_post[ ,!Br8667_post$Layers == "Unknown"] +# Exclude points that do not have a definitive layer assignment +Br6522_ant <- Br6522_ant[, !Br6522_ant$Layers == "Unknown"] +Br6522_mid <- Br6522_mid[, !Br6522_mid$Layers == "Unknown"] +Br8667_post <- Br8667_post[, !Br8667_post$Layers == "Unknown"] # Format the metadata Br6522_ant$Layers <- factor(Br6522_ant$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) Br6522_mid$Layers <- factor(Br6522_mid$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) Br8667_post$Layers <- factor(Br8667_post$Layers, levels = c("Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6")) -Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c("None", "Fold_1", "Shear_1", "Shear_2", "Shear_3", "Wrinkle_1", "Wrinkle_2", - "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", - "Wrinkle_9")) -Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c("None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", "Wrinkle_2", - "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", - "Wrinkle_9", "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) -Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c("None", "Shear_1", "Wrinkle_1", "Wrinkle_2", - "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", - "Wrinkle_9", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) +Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", "Shear_3", "Wrinkle_1", "Wrinkle_2", + "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", + "Wrinkle_9" +)) +Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", "Wrinkle_2", + "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", + "Wrinkle_9", "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" +)) +Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c( + "None", "Shear_1", "Wrinkle_1", "Wrinkle_2", + "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", + "Wrinkle_9", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" +)) Br6522_ant$is_wrinkle <- !Br6522_ant$Wrinkles == "None" Br6522_mid$is_wrinkle <- !Br6522_mid$Wrinkles == "None" Br8667_post$is_wrinkle <- !Br8667_post$Wrinkles == "None" -simulate_doublets <- function(sobj){ -sobj <- subset(sobj, Wrinkles == "None") -nSim <- round(0.05*dim(sobj)[2]) -layer_combinations <- combn(levels(sobj$Layers), 2) -simulated_doublets <- list() -for(i in c(1:dim(layer_combinations)[2])){ - print(i) - L1 <- layer_combinations[1, i] - L2 <- layer_combinations[2, i] - L1_sobj <- subset(sobj, Layers == L1) - L2_sobj <- subset(sobj, Layers == L2) - prop <- runif(nSim, min = 0.3, max = 0.7) - #prop <- rep(0.5, nSim) - sim_Dat <- matrix(NA, nrow = dim(L1_sobj)[1], ncol = nSim) - dat1 <- L1_sobj@assays$Spatial@counts - dat2 <- L2_sobj@assays$Spatial@counts - for(j in c(1:nSim)){ - sim_Dat[ ,j] <- (prop[j]*dat1[ ,sample(c(1:dim(dat1)[2]),1)]) + ((1 - prop[j])*dat2[ ,sample(c(1:dim(dat2)[2]),1)]) - } - sim_Dat <- data.frame(t(sim_Dat)) - colnames(sim_Dat) <- rownames(sobj) - rownames(sim_Dat) <- paste(gsub(" ", "", L1), gsub(" ", "", L2), c(1:dim(sim_Dat)[1]), sep = "_") - sim_Dat$L1 <- L1 - sim_Dat$L2 <- L2 - sim_Dat$Layer <- paste(sim_Dat$L1, sim_Dat$L2, sep = "/") - sim_Dat$prop_L1 <- prop - sim_Dat$Type <- "Simulated" - simulated_doublets[[i]] <- sim_Dat - rm(sim_Dat) - rm(prop) +simulate_doublets <- function(sobj) { + sobj <- subset(sobj, Wrinkles == "None") + nSim <- round(0.05 * dim(sobj)[2]) + layer_combinations <- combn(levels(sobj$Layers), 2) + simulated_doublets <- list() + for (i in c(1:dim(layer_combinations)[2])) { + print(i) + L1 <- layer_combinations[1, i] + L2 <- layer_combinations[2, i] + L1_sobj <- subset(sobj, Layers == L1) + L2_sobj <- subset(sobj, Layers == L2) + prop <- runif(nSim, min = 0.3, max = 0.7) + # prop <- rep(0.5, nSim) + sim_Dat <- matrix(NA, nrow = dim(L1_sobj)[1], ncol = nSim) + dat1 <- L1_sobj@assays$Spatial@counts + dat2 <- L2_sobj@assays$Spatial@counts + for (j in c(1:nSim)) { + sim_Dat[, j] <- (prop[j] * dat1[, sample(c(1:dim(dat1)[2]), 1)]) + ((1 - prop[j]) * dat2[, sample(c(1:dim(dat2)[2]), 1)]) + } + sim_Dat <- data.frame(t(sim_Dat)) + colnames(sim_Dat) <- rownames(sobj) + rownames(sim_Dat) <- paste(gsub(" ", "", L1), gsub(" ", "", L2), c(1:dim(sim_Dat)[1]), sep = "_") + sim_Dat$L1 <- L1 + sim_Dat$L2 <- L2 + sim_Dat$Layer <- paste(sim_Dat$L1, sim_Dat$L2, sep = "/") + sim_Dat$prop_L1 <- prop + sim_Dat$Type <- "Simulated" + simulated_doublets[[i]] <- sim_Dat + rm(sim_Dat) + rm(prop) + } + simulated_doublets <- do.call(rbind, simulated_doublets) + simulated_doublets } -simulated_doublets <- do.call(rbind, simulated_doublets) -simulated_doublets} Br6522_ant_simulated <- simulate_doublets(Br6522_ant) Br6522_mid_simulated <- simulate_doublets(Br6522_mid) @@ -120,9 +127,9 @@ Br6522_mid$Type <- ifelse(Br6522_mid$Wrinkles == "None", "Non-artifact", "Artifa Br8667_post$Type <- ifelse(Br8667_post$Wrinkles == "None", "Non-artifact", "Artifact") -Br6522_ant_expr <- cbind(Br6522_ant@assays$Spatial@counts, t(Br6522_ant_simulated[ ,1:36601])) -Br6522_mid_expr <- cbind(Br6522_mid@assays$Spatial@counts, t(Br6522_mid_simulated[ ,1:36601])) -Br8667_post_expr <- cbind(Br8667_post@assays$Spatial@counts, t(Br8667_post_simulated[ ,1:36601])) +Br6522_ant_expr <- cbind(Br6522_ant@assays$Spatial@counts, t(Br6522_ant_simulated[, 1:36601])) +Br6522_mid_expr <- cbind(Br6522_mid@assays$Spatial@counts, t(Br6522_mid_simulated[, 1:36601])) +Br8667_post_expr <- cbind(Br8667_post@assays$Spatial@counts, t(Br8667_post_simulated[, 1:36601])) Br6522_ant_all <- CreateSeuratObject(Br6522_ant_expr, project = "Br6522 Anterior") Br6522_mid_all <- CreateSeuratObject(Br6522_mid_expr, project = "Br6522 Middle") @@ -183,66 +190,78 @@ Br8667_post_all <- Br8667_post_all[!grepl("^RP[SL]", rownames(Br8667_post_all)), Br8667_post_all <- NormalizeData(Br8667_post_all) Br6522_ant_all <- FindVariableFeatures(Br6522_ant_all, verbose = F) -Br6522_ant_all <- ScaleData(Br6522_ant_all, vars.to.regress = c("nFeature_RNA", "percent_mito"), - verbose = F) +Br6522_ant_all <- ScaleData(Br6522_ant_all, + vars.to.regress = c("nFeature_RNA", "percent_mito"), + verbose = F +) Br6522_ant_all <- RunPCA(Br6522_ant_all, verbose = FALSE) stdv <- Br6522_ant[["pca"]]@stdev sum.stdv <- sum(Br6522_ant[["pca"]]@stdev) percent.stdv <- (stdv / sum.stdv) * 100 cumulative <- cumsum(percent.stdv) co1 <- which(cumulative > 90 & percent.stdv < 5)[1] -co2 <- sort(which((percent.stdv[1:length(percent.stdv) - 1] - - percent.stdv[2:length(percent.stdv)]) > 0.1), - decreasing = T)[1] + 1 +co2 <- sort( + which((percent.stdv[1:length(percent.stdv) - 1] - + percent.stdv[2:length(percent.stdv)]) > 0.1), + decreasing = T +)[1] + 1 min.pc <- min(co1, co2) Br6522_ant_all <- FindNeighbors(Br6522_ant_all, reduction = "pca", dims = 1:8, return.neighbor = TRUE) Br6522_mid_all <- FindVariableFeatures(Br6522_mid_all, verbose = F) -Br6522_mid_all <- ScaleData(Br6522_mid_all, vars.to.regress = c("nFeature_RNA", "percent_mito"), - verbose = F) +Br6522_mid_all <- ScaleData(Br6522_mid_all, + vars.to.regress = c("nFeature_RNA", "percent_mito"), + verbose = F +) Br6522_mid_all <- RunPCA(Br6522_mid_all, verbose = FALSE) stdv <- Br6522_mid[["pca"]]@stdev sum.stdv <- sum(Br6522_mid[["pca"]]@stdev) percent.stdv <- (stdv / sum.stdv) * 100 cumulative <- cumsum(percent.stdv) co1 <- which(cumulative > 90 & percent.stdv < 5)[1] -co2 <- sort(which((percent.stdv[1:length(percent.stdv) - 1] - - percent.stdv[2:length(percent.stdv)]) > 0.1), - decreasing = T)[1] + 1 +co2 <- sort( + which((percent.stdv[1:length(percent.stdv) - 1] - + percent.stdv[2:length(percent.stdv)]) > 0.1), + decreasing = T +)[1] + 1 min.pc <- min(co1, co2) Br6522_mid_all <- FindNeighbors(Br6522_mid_all, reduction = "pca", dims = 1:8, return.neighbor = TRUE) Br8667_post_all <- FindVariableFeatures(Br8667_post_all, verbose = F) -Br8667_post_all <- ScaleData(Br8667_post_all, vars.to.regress = c("nFeature_RNA", "percent_mito"), - verbose = F) +Br8667_post_all <- ScaleData(Br8667_post_all, + vars.to.regress = c("nFeature_RNA", "percent_mito"), + verbose = F +) Br8667_post_all <- RunPCA(Br8667_post_all, verbose = FALSE) stdv <- Br8667_post[["pca"]]@stdev sum.stdv <- sum(Br8667_post[["pca"]]@stdev) percent.stdv <- (stdv / sum.stdv) * 100 cumulative <- cumsum(percent.stdv) co1 <- which(cumulative > 90 & percent.stdv < 5)[1] -co2 <- sort(which((percent.stdv[1:length(percent.stdv) - 1] - - percent.stdv[2:length(percent.stdv)]) > 0.1), - decreasing = T)[1] + 1 +co2 <- sort( + which((percent.stdv[1:length(percent.stdv) - 1] - + percent.stdv[2:length(percent.stdv)]) > 0.1), + decreasing = T +)[1] + 1 min.pc <- min(co1, co2) Br8667_post_all <- FindNeighbors(Br8667_post_all, reduction = "pca", dims = 1:8, return.neighbor = TRUE) -add_info_neighbors <- function(sobj){ - frac_layers <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Layers))) - for(i in c(1:dim(sobj)[2])){ - layers <- sobj$Layers[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] - frac_layers[i, ] <- table(layers) - } - colnames(frac_layers) <- levels(sobj$Layers) - sobj@meta.data <- cbind(sobj@meta.data, frac_layers) - frac_type <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Type))) - for(i in c(1:dim(sobj)[2])){ - type <- sobj$Type[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] - frac_type[i, ] <- table(type) - } - colnames(frac_type) <- levels(sobj$Type) - sobj@meta.data <- cbind(sobj@meta.data, frac_type) - sobj +add_info_neighbors <- function(sobj) { + frac_layers <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Layers))) + for (i in c(1:dim(sobj)[2])) { + layers <- sobj$Layers[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] + frac_layers[i, ] <- table(layers) + } + colnames(frac_layers) <- levels(sobj$Layers) + sobj@meta.data <- cbind(sobj@meta.data, frac_layers) + frac_type <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Type))) + for (i in c(1:dim(sobj)[2])) { + type <- sobj$Type[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] + frac_type[i, ] <- table(type) + } + colnames(frac_type) <- levels(sobj$Type) + sobj@meta.data <- cbind(sobj@meta.data, frac_type) + sobj } Br6522_ant_all <- add_info_neighbors(Br6522_ant_all) @@ -252,87 +271,117 @@ Br8667_post_all <- add_info_neighbors(Br8667_post_all) df <- Br6522_ant_all@meta.data df <- df[!df$Type == "Simulated doublet", ] df$Layer_Wrinkle <- paste(df$Layers, as.numeric(!df$Wrinkles == "None"), sep = "-") -df2 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(), mean), - .groups = 'drop') %>% - as.data.frame() -df3 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(),sd), - .groups = 'drop') %>% - as.data.frame() +df2 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), mean), + .groups = "drop" + ) %>% + as.data.frame() +df3 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), sd), + .groups = "drop" + ) %>% + as.data.frame() df2 <- reshape2::melt(df2) df3 <- reshape2::melt(df3) df2$sd <- df3$value df2$Wrinkles <- gsub("_", " ", df2$Wrinkles) -df2$Wrinkles <- factor(df2$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", - "Shear 3", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", - "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9")) +df2$Wrinkles <- factor(df2$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", + "Shear 3", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", + "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9" +)) df2$variable <- factor(df2$variable, levels = c("Simulated doublet", "Artifact", "Non-artifact")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_ant_SNN_artifacts.pdf", width = 13, height = 3) -ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + geom_bar(position="dodge", stat="identity") + - geom_errorbar(aes(ymin=value-0.5*sd, ymax=value+0.5*sd), width=.2,position=position_dodge(.9)) + - theme_classic() + xlab("") + ylab("Proportion of NN") + ggtitle("Br6522 Anterior") + - theme(legend.title=element_blank(), plot.title = element_text(face = "bold")) +ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + + geom_bar(position = "dodge", stat = "identity") + + geom_errorbar(aes(ymin = value - 0.5 * sd, ymax = value + 0.5 * sd), width = .2, position = position_dodge(.9)) + + theme_classic() + + xlab("") + + ylab("Proportion of NN") + + ggtitle("Br6522 Anterior") + + theme(legend.title = element_blank(), plot.title = element_text(face = "bold")) dev.off() df <- Br6522_mid_all@meta.data df <- df[!df$Type == "Simulated doublet", ] df$Layer_Wrinkle <- paste(df$Layers, as.numeric(!df$Wrinkles == "None"), sep = "-") -df2 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(), mean), - .groups = 'drop') %>% - as.data.frame() -df3 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(),sd), - .groups = 'drop') %>% - as.data.frame() +df2 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), mean), + .groups = "drop" + ) %>% + as.data.frame() +df3 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), sd), + .groups = "drop" + ) %>% + as.data.frame() df2 <- reshape2::melt(df2) df3 <- reshape2::melt(df3) df2$sd <- df3$value df2$Wrinkles <- gsub("_", " ", df2$Wrinkles) -df2$Wrinkles <- factor(df2$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", - "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", - "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", - "Wrinkle 12", "Wrinkle 13")) +df2$Wrinkles <- factor(df2$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", + "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", + "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", + "Wrinkle 12", "Wrinkle 13" +)) df2$variable <- factor(df2$variable, levels = c("Simulated doublet", "Artifact", "Non-artifact")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_mid_SNN_artifacts.pdf", width = 13, height = 3) -ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + geom_bar(position="dodge", stat="identity") + - geom_errorbar(aes(ymin=value-0.5*sd, ymax=value+0.5*sd), width=.2,position=position_dodge(.9)) + - theme_classic() + xlab("") + ylab("Proportion of NN") + ggtitle("Br6522 Middle") + - theme(legend.title=element_blank(), plot.title = element_text(face = "bold")) +ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + + geom_bar(position = "dodge", stat = "identity") + + geom_errorbar(aes(ymin = value - 0.5 * sd, ymax = value + 0.5 * sd), width = .2, position = position_dodge(.9)) + + theme_classic() + + xlab("") + + ylab("Proportion of NN") + + ggtitle("Br6522 Middle") + + theme(legend.title = element_blank(), plot.title = element_text(face = "bold")) dev.off() df <- Br8667_post_all@meta.data df <- df[!df$Type == "Simulated doublet", ] df$Layer_Wrinkle <- paste(df$Layers, as.numeric(!df$Wrinkles == "None"), sep = "-") -df2 <- df[ ,c(6, 25, 26, 27)] %>% group_by(Wrinkles) %>% - summarise(across(everything(), mean), - .groups = 'drop') %>% - as.data.frame() -df3 <- df[ ,c(6, 25, 26, 27)] %>% group_by(Wrinkles) %>% - summarise(across(everything(),sd), - .groups = 'drop') %>% - as.data.frame() +df2 <- df[, c(6, 25, 26, 27)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), mean), + .groups = "drop" + ) %>% + as.data.frame() +df3 <- df[, c(6, 25, 26, 27)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), sd), + .groups = "drop" + ) %>% + as.data.frame() df2 <- reshape2::melt(df2) df3 <- reshape2::melt(df3) df2$sd <- df3$value df2$Wrinkles <- gsub("_", " ", df2$Wrinkles) -df2$Wrinkles <- factor(df2$Wrinkles, levels = c("None", "Shear 1", - "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", - "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 11", - "Wrinkle 12", "Wrinkle 13")) +df2$Wrinkles <- factor(df2$Wrinkles, levels = c( + "None", "Shear 1", + "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", + "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 11", + "Wrinkle 12", "Wrinkle 13" +)) df2$variable <- factor(df2$variable, levels = c("Simulated doublet", "Artifact", "Non-artifact")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br8667_post_SNN_artifacts.pdf", width = 13, height = 3) -ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + geom_bar(position="dodge", stat="identity") + - geom_errorbar(aes(ymin=value-0.5*sd, ymax=value+0.5*sd), width=.2,position=position_dodge(.9)) + - theme_classic() + xlab("") + ylab("Proportion of NN") + ggtitle("Br8667 Posterior") + - theme(legend.title=element_blank(), plot.title = element_text(face = "bold")) +ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + + geom_bar(position = "dodge", stat = "identity") + + geom_errorbar(aes(ymin = value - 0.5 * sd, ymax = value + 0.5 * sd), width = .2, position = position_dodge(.9)) + + theme_classic() + + xlab("") + + ylab("Proportion of NN") + + ggtitle("Br8667 Posterior") + + theme(legend.title = element_blank(), plot.title = element_text(face = "bold")) dev.off() @@ -342,8 +391,10 @@ L1_cells <- WhichCells(Br6522_ant_all, idents = "Layer 1") L5_cells <- WhichCells(Br6522_ant_all, idents = "Layer 5") L_1_5_cells <- WhichCells(Br6522_ant_all, idents = "Layer 1/Layer 5") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_ant_simulated.pdf", width = 8, height = 4) -DimPlot(Br6522_ant_all, split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5"= L_1_5_cells), - cols.highlight = c("blue", "purple", "red"), cols= "grey") + ggtitle("Br6522 Anterior") + xlab("UMAP 1") + ylab("UMAP 2") +DimPlot(Br6522_ant_all, + split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5" = L_1_5_cells), + cols.highlight = c("blue", "purple", "red"), cols = "grey" +) + ggtitle("Br6522 Anterior") + xlab("UMAP 1") + ylab("UMAP 2") dev.off() Br6522_mid_all <- RunUMAP(Br6522_mid_all, dims = 1:30) @@ -352,8 +403,10 @@ L1_cells <- WhichCells(Br6522_mid_all, idents = "Layer 1") L5_cells <- WhichCells(Br6522_mid_all, idents = "Layer 5") L_1_5_cells <- WhichCells(Br6522_mid_all, idents = "Layer 1/Layer 5") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_mid_simulated.pdf", width = 8, height = 4) -DimPlot(Br6522_mid_all, split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5"= L_1_5_cells), - cols.highlight = c("blue", "purple", "red"), cols= "grey") + ggtitle("Br6522 Middle") + xlab("UMAP 1") + ylab("UMAP 2") +DimPlot(Br6522_mid_all, + split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5" = L_1_5_cells), + cols.highlight = c("blue", "purple", "red"), cols = "grey" +) + ggtitle("Br6522 Middle") + xlab("UMAP 1") + ylab("UMAP 2") dev.off() Br8667_post_all <- RunUMAP(Br8667_post_all, dims = 1:30) @@ -362,7 +415,8 @@ L2_cells <- WhichCells(Br8667_post_all, idents = "Layer 2") L6_cells <- WhichCells(Br8667_post_all, idents = "Layer 6") L_2_6_cells <- WhichCells(Br8667_post_all, idents = "Layer 2/Layer 6") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br8667_post_simulated.pdf", width = 8, height = 4) -DimPlot(Br8667_post_all, split.by = "Type", cells.highlight = list("Layer 2" = L2_cells, "Layer 6" = L6_cells, "Layer 2/Layer 6"= L_2_6_cells), - cols.highlight = c("blue", "purple", "red"), cols= "grey") + ggtitle("Br8667 Posterior") + xlab("UMAP 1") + ylab("UMAP 2") +DimPlot(Br8667_post_all, + split.by = "Type", cells.highlight = list("Layer 2" = L2_cells, "Layer 6" = L6_cells, "Layer 2/Layer 6" = L_2_6_cells), + cols.highlight = c("blue", "purple", "red"), cols = "grey" +) + ggtitle("Br8667 Posterior") + xlab("UMAP 1") + ylab("UMAP 2") dev.off() - diff --git a/code/qc_artifact/Spot_based_analysis_artifact.R b/code/qc_artifact/Spot_based_analysis_artifact.R index c705af7f..3d61eb77 100644 --- a/code/qc_artifact/Spot_based_analysis_artifact.R +++ b/code/qc_artifact/Spot_based_analysis_artifact.R @@ -14,29 +14,35 @@ library(dplyr) library(ggspavis) # Read in the data datDir <- "/home/pravich2/scratch16-abattle4/prashanthi/dewrinkler/processed-data/" -Br6522_ant <- read10xVisiumWrapper(samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_ant_manual_alignment_all/outs/"), - sample_id = "Br6522_ant", - type = "sparse", - data = "filtered", - images = c("lowres", "hires", "detected", "aligned"), - load = TRUE, - reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf") - -Br6522_mid <- read10xVisiumWrapper(samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_mid_manual_alignment_all/outs/"), - sample_id = "Br6522_mid", - type = "sparse", - data = "filtered", - images = c("lowres", "hires", "detected", "aligned"), - load = TRUE, - reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf") - -Br8667_post <- read10xVisiumWrapper(samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br8667_post_manual_alignment_all/outs/"), - sample_id = "Br8667_post", - type = "sparse", - data = "filtered", - images = c("lowres", "hires", "detected", "aligned"), - load = TRUE, - reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf") +Br6522_ant <- read10xVisiumWrapper( + samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_ant_manual_alignment_all/outs/"), + sample_id = "Br6522_ant", + type = "sparse", + data = "filtered", + images = c("lowres", "hires", "detected", "aligned"), + load = TRUE, + reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf" +) + +Br6522_mid <- read10xVisiumWrapper( + samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_mid_manual_alignment_all/outs/"), + sample_id = "Br6522_mid", + type = "sparse", + data = "filtered", + images = c("lowres", "hires", "detected", "aligned"), + load = TRUE, + reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf" +) + +Br8667_post <- read10xVisiumWrapper( + samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br8667_post_manual_alignment_all/outs/"), + sample_id = "Br8667_post", + type = "sparse", + data = "filtered", + images = c("lowres", "hires", "detected", "aligned"), + load = TRUE, + reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf" +) Br6522_ant$subject <- "Br6522" Br6522_ant$diagnosis <- "control" @@ -87,33 +93,33 @@ Br6522_ant_spot_counts <- Br6522_ant_spot_counts[match(colnames(Br6522_ant), Br6 Br6522_mid_spot_counts <- Br6522_mid_spot_counts[match(colnames(Br6522_mid), Br6522_mid_spot_counts$barcode), ] Br8667_post_spot_counts <- Br8667_post_spot_counts[match(colnames(Br8667_post), Br8667_post_spot_counts$barcode), ] -Br6522_ant_spot_counts <- Br6522_ant_spot_counts[ ,colnames(Br6522_ant_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] -Br6522_mid_spot_counts <- Br6522_mid_spot_counts[ ,colnames(Br6522_mid_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] -Br8667_post_spot_counts <- Br8667_post_spot_counts[ ,colnames(Br8667_post_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] +Br6522_ant_spot_counts <- Br6522_ant_spot_counts[, colnames(Br6522_ant_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] +Br6522_mid_spot_counts <- Br6522_mid_spot_counts[, colnames(Br6522_mid_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] +Br8667_post_spot_counts <- Br8667_post_spot_counts[, colnames(Br8667_post_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] colData(Br6522_ant) <- cbind(colData(Br6522_ant), Br6522_ant_spot_counts) colData(Br6522_mid) <- cbind(colData(Br6522_mid), Br6522_mid_spot_counts) colData(Br8667_post) <- cbind(colData(Br8667_post), Br8667_post_spot_counts) -manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df){ - spots <- colnames(sobj) - layers <- c() - wrinkle <- c() - for(i in c(1:length(spots))){ - if(spots[i] %in% layers_df$spot_name){ - layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] - }else{ - layers[i] <- "Unknown" - } - if(spots[i] %in% wrinkles_df$spot_name){ - wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] - }else{ - wrinkle[i] <- "None" +manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df) { + spots <- colnames(sobj) + layers <- c() + wrinkle <- c() + for (i in c(1:length(spots))) { + if (spots[i] %in% layers_df$spot_name) { + layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] + } else { + layers[i] <- "Unknown" + } + if (spots[i] %in% wrinkles_df$spot_name) { + wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] + } else { + wrinkle[i] <- "None" + } } - } - sobj$Layers <- layers - sobj$Wrinkles <- wrinkle - sobj + sobj$Layers <- layers + sobj$Wrinkles <- wrinkle + sobj } Br6522_ant <- manually_annotate(Br6522_ant, Br6522_ant_layers, Br6522_ant_wrinkles, Br6522_ant_spot_counts) @@ -157,24 +163,25 @@ Br8667_post <- Br8667_post[-no_expr, ] Br8667_post <- Br8667_post[, !Br8667_post@colData$sum_umi == 0] Br6522_ant_qcstats <- perCellQCMetrics(Br6522_ant, subsets = list( - Mito = which(seqnames(Br6522_ant) == "chrM") + Mito = which(seqnames(Br6522_ant) == "chrM") )) Br6522_ant_qcfilter <- quickPerCellQC(Br6522_ant_qcstats, sub.fields = "subsets_Mito_percent") colSums(as.matrix(Br6522_ant_qcfilter)) Br6522_ant$scran_discard <- - factor(Br6522_ant_qcfilter$discard, levels = c("TRUE", "FALSE")) + factor(Br6522_ant_qcfilter$discard, levels = c("TRUE", "FALSE")) Br6522_ant$scran_low_lib_size <- - factor( - isOutlier( - Br6522_ant$sum_umi, - type = "lower", - log = TRUE), - levels = c("TRUE", "FALSE") - ) + factor( + isOutlier( + Br6522_ant$sum_umi, + type = "lower", + log = TRUE + ), + levels = c("TRUE", "FALSE") + ) Br6522_ant$scran_low_n_features <- - factor(Br6522_ant_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) + factor(Br6522_ant_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) Br6522_ant$scran_high_subsets_Mito_percent <- - factor(Br6522_ant_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) + factor(Br6522_ant_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_low_lib_size", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Anterior") plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_low_n_features", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Anterior") @@ -182,24 +189,25 @@ plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_high_s plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_discard", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Anterior") Br6522_mid_qcstats <- perCellQCMetrics(Br6522_mid, subsets = list( - Mito = which(seqnames(Br6522_mid) == "chrM") + Mito = which(seqnames(Br6522_mid) == "chrM") )) Br6522_mid_qcfilter <- quickPerCellQC(Br6522_mid_qcstats, sub.fields = "subsets_Mito_percent") colSums(as.matrix(Br6522_mid_qcfilter)) Br6522_mid$scran_discard <- - factor(Br6522_mid_qcfilter$discard, levels = c("TRUE", "FALSE")) + factor(Br6522_mid_qcfilter$discard, levels = c("TRUE", "FALSE")) Br6522_mid$scran_low_lib_size <- - factor( - isOutlier( - Br6522_mid$sum_umi, - type = "lower", - log = TRUE), - levels = c("TRUE", "FALSE") - ) + factor( + isOutlier( + Br6522_mid$sum_umi, + type = "lower", + log = TRUE + ), + levels = c("TRUE", "FALSE") + ) Br6522_mid$scran_low_n_features <- - factor(Br6522_mid_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) + factor(Br6522_mid_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) Br6522_mid$scran_high_subsets_Mito_percent <- - factor(Br6522_mid_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) + factor(Br6522_mid_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_low_lib_size", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_low_n_features", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") @@ -207,24 +215,25 @@ plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_high_s plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_discard", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") Br8667_post_qcstats <- perCellQCMetrics(Br8667_post, subsets = list( - Mito = which(seqnames(Br8667_post) == "chrM") + Mito = which(seqnames(Br8667_post) == "chrM") )) Br8667_post_qcfilter <- quickPerCellQC(Br8667_post_qcstats, sub.fields = "subsets_Mito_percent") colSums(as.matrix(Br8667_post_qcfilter)) Br8667_post$scran_discard <- - factor(Br8667_post_qcfilter$discard, levels = c("TRUE", "FALSE")) + factor(Br8667_post_qcfilter$discard, levels = c("TRUE", "FALSE")) Br8667_post$scran_low_lib_size <- - factor( - isOutlier( - Br8667_post$sum_umi, - type = "lower", - log = TRUE), - levels = c("TRUE", "FALSE") - ) + factor( + isOutlier( + Br8667_post$sum_umi, + type = "lower", + log = TRUE + ), + levels = c("TRUE", "FALSE") + ) Br8667_post$scran_low_n_features <- - factor(Br8667_post_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) + factor(Br8667_post_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) Br8667_post$scran_high_subsets_Mito_percent <- - factor(Br8667_post_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) + factor(Br8667_post_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) plotSpots(Br8667_post, x_coord = "row", y_coord = "col", annotate = "scran_low_lib_size", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") plotSpots(Br8667_post, x_coord = "row", y_coord = "col", annotate = "scran_low_n_features", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") @@ -241,9 +250,9 @@ Br6522_ant_samples <- gsub("_Br6522_ant", "", Br6522_ant_samples) Br6522_mid_samples <- gsub("_Br6522_mid", "", Br6522_mid_samples) Br8667_post_samples <- gsub("_Br8667_post", "", Br8667_post_samples) -Br6522_ant <- Br6522_ant[ ,colnames(Br6522_ant) %in% Br6522_ant_samples] -Br6522_mid <- Br6522_mid[ ,colnames(Br6522_mid) %in% Br6522_mid_samples] -Br8667_post <- Br8667_post[ ,colnames(Br8667_post) %in% Br8667_post_samples] +Br6522_ant <- Br6522_ant[, colnames(Br6522_ant) %in% Br6522_ant_samples] +Br6522_mid <- Br6522_mid[, colnames(Br6522_mid) %in% Br6522_mid_samples] +Br8667_post <- Br8667_post[, colnames(Br8667_post) %in% Br8667_post_samples] plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "Layers", y_reverse = FALSE) plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "Layers", y_reverse = FALSE) @@ -254,7 +263,7 @@ plotSpots(Br8667_post, x_coord = "row", y_coord = "col", annotate = "Layers", y_ Br6522_ant <- Br6522_ant[!grepl("MALAT1", rownames(Br6522_ant)), ] # Filter Mitocondrial Br6522_ant <- Br6522_ant[!grepl("^MT-", rownames(Br6522_ant)), ] -# Filter Ribosomal +# Filter Ribosomal Br6522_ant <- Br6522_ant[!grepl("^RP[SL]", rownames(Br6522_ant)), ] @@ -262,19 +271,19 @@ Br6522_ant <- Br6522_ant[!grepl("^RP[SL]", rownames(Br6522_ant)), ] Br6522_mid <- Br6522_mid[!grepl("MALAT1", rownames(Br6522_mid)), ] # Filter Mitocondrial Br6522_mid <- Br6522_mid[!grepl("^MT-", rownames(Br6522_mid)), ] -# Filter Ribosomal +# Filter Ribosomal Br6522_mid <- Br6522_mid[!grepl("^RP[SL]", rownames(Br6522_mid)), ] # Filter MALAT1 Br8667_post <- Br8667_post[!grepl("MALAT1", rownames(Br8667_post)), ] # Filter Mitocondrial Br8667_post <- Br8667_post[!grepl("^MT-", rownames(Br8667_post)), ] -# Filter Ribosomal +# Filter Ribosomal Br8667_post <- Br8667_post[!grepl("^RP[SL]", rownames(Br8667_post)), ] -Br6522_ant_normal <- Br6522_ant[ ,Br6522_ant$Wrinkles == "None"] -Br6522_mid_normal <- Br6522_mid[ ,Br6522_mid$Wrinkles == "None"] -Br8667_post_normal <- Br8667_post[ ,Br8667_post$Wrinkles == "None"] +Br6522_ant_normal <- Br6522_ant[, Br6522_ant$Wrinkles == "None"] +Br6522_mid_normal <- Br6522_mid[, Br6522_mid$Wrinkles == "None"] +Br8667_post_normal <- Br8667_post[, Br8667_post$Wrinkles == "None"] # Normalize the count data set.seed(030122) @@ -282,9 +291,9 @@ Br6522_ant$scran_quick_cluster <- quickCluster(Br6522_ant) Br6522_mid$scran_quick_cluster <- quickCluster(Br6522_mid) Br8667_post$scran_quick_cluster <- quickCluster(Br8667_post) -Br6522_ant <- computeSumFactors(Br6522_ant,clusters = Br6522_ant$scran_quick_cluster) -Br6522_mid <- computeSumFactors(Br6522_mid,clusters = Br6522_mid$scran_quick_cluster) -Br8667_post <- computeSumFactors(Br8667_post,clusters = Br8667_post$scran_quick_cluster) +Br6522_ant <- computeSumFactors(Br6522_ant, clusters = Br6522_ant$scran_quick_cluster) +Br6522_mid <- computeSumFactors(Br6522_mid, clusters = Br6522_mid$scran_quick_cluster) +Br8667_post <- computeSumFactors(Br8667_post, clusters = Br8667_post$scran_quick_cluster) Br6522_ant <- logNormCounts(Br6522_ant) Br6522_mid <- logNormCounts(Br6522_mid) @@ -294,27 +303,38 @@ Br6522_ant_normal$scran_quick_cluster <- quickCluster(Br6522_ant_normal) Br6522_mid_normal$scran_quick_cluster <- quickCluster(Br6522_mid_normal) Br8667_post_normal$scran_quick_cluster <- quickCluster(Br8667_post_normal) -Br6522_ant_normal <- computeSumFactors(Br6522_ant_normal,clusters = Br6522_ant_normal$scran_quick_cluster) -Br6522_mid_normal <- computeSumFactors(Br6522_mid_normal,clusters = Br6522_mid_normal$scran_quick_cluster) -Br8667_post_normal <- computeSumFactors(Br8667_post_normal,clusters = Br8667_post_normal$scran_quick_cluster) +Br6522_ant_normal <- computeSumFactors(Br6522_ant_normal, clusters = Br6522_ant_normal$scran_quick_cluster) +Br6522_mid_normal <- computeSumFactors(Br6522_mid_normal, clusters = Br6522_mid_normal$scran_quick_cluster) +Br8667_post_normal <- computeSumFactors(Br8667_post_normal, clusters = Br8667_post_normal$scran_quick_cluster) Br6522_ant_normal <- logNormCounts(Br6522_ant_normal) Br6522_mid_normal <- logNormCounts(Br6522_mid_normal) Br8667_post_normal <- logNormCounts(Br8667_post_normal) -compare_gene_prop <- function(normal, all, title){ - plot_df <- data.frame("Mean_expr" = rowMeans(all@assays@data$logcounts), - "Var_expr" = rowVars(all@assays@data$logcounts), - "Mean_expr_normal" = rowMeans(normal@assays@data$logcounts), - "Var_expr_normal" = rowVars(normal@assays@data$logcounts)) - p1 <- ggplot(plot_df, aes(x = Mean_expr_normal, y = Mean_expr)) + geom_point(colour = "#00BFC4", alpha = 0.5) + - theme_classic() + xlab("Mean (excl. artifacts)") + ylab("Mean (all spots)") + - geom_abline(intercept = 0, slope = 1, lty = 2) + theme(axis.title = element_text(size = 10), plot.title = element_text(face = "bold", size = 10)) - p2 <- ggplot(plot_df, aes(x = Var_expr_normal, y = Var_expr)) + geom_point(colour = "#00BFC4", alpha = 0.5) + - theme_classic() + xlab("Variance (excl. artifacts)") + ylab("Variance (all spots)") + - geom_abline(intercept = 0, slope = 1, lty = 2) + theme(axis.title = element_text(size = 10)) + ggtitle("") - title <- ggdraw() + draw_label(title, fontface='bold') - plot_grid(title, plot_grid(p1, p2, rel_widths = c(1, 1), nrow = 1, align = "h", labels = c("I", "II")), nrow = 2, rel_heights = c(0.1, 1)) +compare_gene_prop <- function(normal, all, title) { + plot_df <- data.frame( + "Mean_expr" = rowMeans(all@assays@data$logcounts), + "Var_expr" = rowVars(all@assays@data$logcounts), + "Mean_expr_normal" = rowMeans(normal@assays@data$logcounts), + "Var_expr_normal" = rowVars(normal@assays@data$logcounts) + ) + p1 <- ggplot(plot_df, aes(x = Mean_expr_normal, y = Mean_expr)) + + geom_point(colour = "#00BFC4", alpha = 0.5) + + theme_classic() + + xlab("Mean (excl. artifacts)") + + ylab("Mean (all spots)") + + geom_abline(intercept = 0, slope = 1, lty = 2) + + theme(axis.title = element_text(size = 10), plot.title = element_text(face = "bold", size = 10)) + p2 <- ggplot(plot_df, aes(x = Var_expr_normal, y = Var_expr)) + + geom_point(colour = "#00BFC4", alpha = 0.5) + + theme_classic() + + xlab("Variance (excl. artifacts)") + + ylab("Variance (all spots)") + + geom_abline(intercept = 0, slope = 1, lty = 2) + + theme(axis.title = element_text(size = 10)) + + ggtitle("") + title <- ggdraw() + draw_label(title, fontface = "bold") + plot_grid(title, plot_grid(p1, p2, rel_widths = c(1, 1), nrow = 1, align = "h", labels = c("I", "II")), nrow = 2, rel_heights = c(0.1, 1)) } p <- compare_gene_prop(Br6522_ant_normal, Br6522_ant, "Br6522 Anterior") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br6522_ant_gene_mean_gene_var.pdf", width = 4.5, height = 3) @@ -353,58 +373,68 @@ Br6522_ant_normal <- runPCA(Br6522_ant, subset_row = Br6522_ant_normal_top.hvgs, Br6522_mid_normal <- runPCA(Br6522_mid, subset_row = Br6522_mid_normal_top.hvgs, ncomponents = 50) Br8667_post_normal <- runPCA(Br8667_post, subset_row = Br8667_post_normal_top.hvgs, ncomponents = 50) -# Find clusters -findClusters_sce <- function(sce){ - output <- getClusteredPCs(reducedDim(sce)) - npcs <- metadata(output)$chosen - cat(npcs) - reducedDim(sce, "PCAsub") <- reducedDim(sce, "PCA")[,1:npcs,drop=FALSE] - g <- buildSNNGraph(sce, use.dimred="PCAsub") - cluster <- igraph::cluster_walktrap(g)$membership - # Assigning to the 'colLabels' of the 'sce'. - colLabels(sce) <- factor(cluster) - table(colLabels(sce)) - sce +# Find clusters +findClusters_sce <- function(sce) { + output <- getClusteredPCs(reducedDim(sce)) + npcs <- metadata(output)$chosen + cat(npcs) + reducedDim(sce, "PCAsub") <- reducedDim(sce, "PCA")[, 1:npcs, drop = FALSE] + g <- buildSNNGraph(sce, use.dimred = "PCAsub") + cluster <- igraph::cluster_walktrap(g)$membership + # Assigning to the 'colLabels' of the 'sce'. + colLabels(sce) <- factor(cluster) + table(colLabels(sce)) + sce } Br6522_ant <- findClusters_sce(Br6522_ant) Br6522_mid <- findClusters_sce(Br6522_mid) Br8667_post <- findClusters_sce(Br8667_post) -get_cluster_comp <- function(sobj, title){ -Layers <- unique(sobj@colData$Layers) -Layers <- Layers[order(Layers)] -Labels <- levels(sobj@colData$label) -layer_mat <- matrix(NA, nrow = length(Labels), ncol = length(Layers)) -for(i in c(1:dim(layer_mat)[1])){ - for(j in c(1:dim(layer_mat)[2])){ - layer_mat[i, j] <- sum(sobj@colData$Layers[sobj@colData$label == Labels[i]] == Layers[j]) - } -} -artifact_mat <- matrix(NA, nrow = length(Labels), ncol = 2) -for(i in c(1:dim(layer_mat)[1])){ - artifact_mat[i, 1] <- sum(!sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) - artifact_mat[i, 2] <- sum(sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) +get_cluster_comp <- function(sobj, title) { + Layers <- unique(sobj@colData$Layers) + Layers <- Layers[order(Layers)] + Labels <- levels(sobj@colData$label) + layer_mat <- matrix(NA, nrow = length(Labels), ncol = length(Layers)) + for (i in c(1:dim(layer_mat)[1])) { + for (j in c(1:dim(layer_mat)[2])) { + layer_mat[i, j] <- sum(sobj@colData$Layers[sobj@colData$label == Labels[i]] == Layers[j]) + } + } + artifact_mat <- matrix(NA, nrow = length(Labels), ncol = 2) + for (i in c(1:dim(layer_mat)[1])) { + artifact_mat[i, 1] <- sum(!sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) + artifact_mat[i, 2] <- sum(sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) + } + colnames(artifact_mat) <- c("None", "Artifact") + colnames(layer_mat) <- Layers + rownames(layer_mat) <- paste("Cluster", Labels) + rownames(artifact_mat) <- paste("Cluster", Labels) + colnames(layer_mat)[colnames(layer_mat) == "Unknown"] <- "NA" + layer_mat <- reshape2::melt(layer_mat) + artifact_mat <- reshape2::melt(artifact_mat) + p1 <- ggplot(layer_mat, aes(x = Var1, y = value, fill = Var2)) + + geom_bar(position = "dodge", stat = "identity") + + theme_classic() + + scale_fill_manual(name = "Layers", values = c( + "Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", + "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", + "WM" = "#1A1A1A", "NA" = "transparent" + )) + + xlab("") + + ylab("Number of spots") + + ggtitle(title) + + theme(plot.title = element_text(face = "bold")) + + p2 <- ggplot(artifact_mat, aes(x = Var1, y = value, fill = Var2)) + + geom_bar(position = "fill", stat = "identity") + + theme_classic() + + scale_fill_manual(name = "", values = c("None" = "#619CFF", "Artifact" = "#F8766D")) + + xlab("") + + ylab("Fraction of spots") + + theme(plot.title = element_text(face = "bold")) + list(p1, p2) } -colnames(artifact_mat) <- c("None", "Artifact") -colnames(layer_mat) <- Layers -rownames(layer_mat) <- paste("Cluster", Labels) -rownames(artifact_mat) <- paste("Cluster", Labels) -colnames(layer_mat)[colnames(layer_mat) == "Unknown"] <- "NA" -layer_mat <- reshape2::melt(layer_mat) -artifact_mat <- reshape2::melt(artifact_mat) -p1 <- ggplot(layer_mat, aes(x = Var1, y = value, fill = Var2)) + - geom_bar(position="dodge", stat="identity") + theme_classic() + - scale_fill_manual(name = "Layers", values = c("Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", - "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", - "WM" = "#1A1A1A", "NA" = "transparent")) + xlab("") + ylab("Number of spots") + - ggtitle(title) + theme(plot.title = element_text(face = "bold")) - -p2 <- ggplot(artifact_mat, aes(x = Var1, y = value, fill = Var2)) + - geom_bar(position="fill", stat="identity") + theme_classic() + - scale_fill_manual(name = "", values = c("None" = "#619CFF", "Artifact" = "#F8766D")) + xlab("") + ylab("Fraction of spots") + - theme(plot.title = element_text(face = "bold")) -list(p1, p2)} p_list_1 <- get_cluster_comp(Br6522_ant, "Br6522 Anterior") p_list_2 <- get_cluster_comp(Br6522_mid, "Br6522 Middle") @@ -469,21 +499,27 @@ Br8667_post_normal <- runUMAP(Br8667_post_normal, dimred = "PCA") colnames(reducedDim(Br8667_post_normal, "UMAP")) <- c("UMAP1", "UMAP2") -viz_umap <- function(sobj, title){ - df <- data.frame(reducedDim(sobj, "UMAP")) - df$Layers <- sobj$Layers - df$is_wrinkle <- sobj$is_wrinkle - df$Artifact <- df$is_wrinkle - df$Artifact[df$is_wrinkle] <- "Artifact" - df$Artifact[!df$is_wrinkle] <- "Excluding Artifacts" - df$Artifact <- factor(df$Artifact, levels = c("Excluding Artifacts", "Artifact")) - df$Layers[df$Layers == "Unknown"] <- NA - layer_palette <- c("Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", - "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", - "WM" = "#1A1A1A", "NA" = "transparent") - ggplot(df, aes(x = UMAP1, y = UMAP2, colour = Layers)) + geom_point(size = 0.8, alpha = 0.7) + theme_bw() + - scale_color_manual(name = "Layers", values = layer_palette) + facet_wrap(~Artifact) + ggtitle(title) + - theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), plot.title = element_text(face = "bold")) +viz_umap <- function(sobj, title) { + df <- data.frame(reducedDim(sobj, "UMAP")) + df$Layers <- sobj$Layers + df$is_wrinkle <- sobj$is_wrinkle + df$Artifact <- df$is_wrinkle + df$Artifact[df$is_wrinkle] <- "Artifact" + df$Artifact[!df$is_wrinkle] <- "Excluding Artifacts" + df$Artifact <- factor(df$Artifact, levels = c("Excluding Artifacts", "Artifact")) + df$Layers[df$Layers == "Unknown"] <- NA + layer_palette <- c( + "Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", + "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", + "WM" = "#1A1A1A", "NA" = "transparent" + ) + ggplot(df, aes(x = UMAP1, y = UMAP2, colour = Layers)) + + geom_point(size = 0.8, alpha = 0.7) + + theme_bw() + + scale_color_manual(name = "Layers", values = layer_palette) + + facet_wrap(~Artifact) + + ggtitle(title) + + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), plot.title = element_text(face = "bold")) } p1 <- viz_umap(Br6522_ant, "Br6522 Anterior") @@ -502,244 +538,280 @@ pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br8667_post_UMAP.pdf", p3 dev.off() -get_PC_var_explained <- function(sobj){ -df <- data.frame(reducedDim(sobj, "PCA")) -df <- df[ ,1:10] -df$Layers <- sobj$Layers -df$is_wrinkle <- sobj$is_wrinkle -df$libSize <- sobj$sum_gene -df$percent_mito <- sobj$expr_chrM_ratio -res <- anova(lm(PC1 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- res$`Sum Sq`/sum(res$`Sum Sq`) -res <- anova(lm(PC2 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC3 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC4 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC5 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC6 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC7 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC8 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC9 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC10 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -all_res <- all_res[ ,c(1, 2, 3, 4)] -rownames(all_res) <- c(1:10) -colnames(all_res) <- c("Layers", "Is Wrinkle", "Library Size", "Percent mito") -all_res <- data.frame(all_res) -all_res$PC <- paste0("PC", c(1:10)) -all_res <- reshape2::melt(all_res, id.vars = "PC") -all_res$variable <- as.character(all_res$variable) -all_res$variable[all_res$variable == "Is.Wrinkle"] <- "Is wrinkle" -all_res$variable[all_res$variable == "Library.Size"] <- "Library size" -all_res$variable[all_res$variable == "Percent.mito"] <- "Percent mito" -all_res$variable <- as.factor(all_res$variable) -all_res} +get_PC_var_explained <- function(sobj) { + df <- data.frame(reducedDim(sobj, "PCA")) + df <- df[, 1:10] + df$Layers <- sobj$Layers + df$is_wrinkle <- sobj$is_wrinkle + df$libSize <- sobj$sum_gene + df$percent_mito <- sobj$expr_chrM_ratio + res <- anova(lm(PC1 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- res$`Sum Sq` / sum(res$`Sum Sq`) + res <- anova(lm(PC2 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC3 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC4 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC5 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC6 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC7 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC8 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC9 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC10 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + all_res <- all_res[, c(1, 2, 3, 4)] + rownames(all_res) <- c(1:10) + colnames(all_res) <- c("Layers", "Is Wrinkle", "Library Size", "Percent mito") + all_res <- data.frame(all_res) + all_res$PC <- paste0("PC", c(1:10)) + all_res <- reshape2::melt(all_res, id.vars = "PC") + all_res$variable <- as.character(all_res$variable) + all_res$variable[all_res$variable == "Is.Wrinkle"] <- "Is wrinkle" + all_res$variable[all_res$variable == "Library.Size"] <- "Library size" + all_res$variable[all_res$variable == "Percent.mito"] <- "Percent mito" + all_res$variable <- as.factor(all_res$variable) + all_res +} Br6522_ant_anova <- get_PC_var_explained(Br6522_ant) Br6522_mid_anova <- get_PC_var_explained(Br6522_mid) Br8667_post_anova <- get_PC_var_explained(Br8667_post) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br6522_ant_PC_anova.pdf", width = 5, height = 3.5) -ggplot(aes(x=variable, y=PC, fill=value), data=Br6522_ant_anova) + geom_tile() + scale_fill_gradient(low="white", high="#416A1D") + - labs(y=NULL, x=NULL, fill="R-squared") + geom_text(aes(label = round(value, 2)), size = 3) + - theme_classic() + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + - scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + - ggtitle("Br6522 Anterior") + theme(plot.title = element_text(face="bold")) +ggplot(aes(x = variable, y = PC, fill = value), data = Br6522_ant_anova) + + geom_tile() + + scale_fill_gradient(low = "white", high = "#416A1D") + + labs(y = NULL, x = NULL, fill = "R-squared") + + geom_text(aes(label = round(value, 2)), size = 3) + + theme_classic() + + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + + scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + + ggtitle("Br6522 Anterior") + + theme(plot.title = element_text(face = "bold")) dev.off() pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br6522_mid_PC_anova.pdf", width = 5, height = 3.5) -ggplot(aes(x=variable, y=PC, fill=value), data=Br6522_mid_anova) + geom_tile() + scale_fill_gradient(low="white", high="#416A1D") + - labs(y=NULL, x=NULL, fill="R-squared") + geom_text(aes(label = round(value, 2)), size = 3) + - theme_classic() + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + - scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + - ggtitle("Br6522 Middle") + theme(plot.title = element_text(face="bold")) +ggplot(aes(x = variable, y = PC, fill = value), data = Br6522_mid_anova) + + geom_tile() + + scale_fill_gradient(low = "white", high = "#416A1D") + + labs(y = NULL, x = NULL, fill = "R-squared") + + geom_text(aes(label = round(value, 2)), size = 3) + + theme_classic() + + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + + scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + + ggtitle("Br6522 Middle") + + theme(plot.title = element_text(face = "bold")) dev.off() pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br8667_post_PC_anova.pdf", width = 5, height = 3.5) -ggplot(aes(x=variable, y=PC, fill=value), data=Br8667_post_anova) + geom_tile() + scale_fill_gradient(low="white", high="#416A1D") + - labs(y=NULL, x=NULL, fill="R-squared") + geom_text(aes(label = round(value, 2)), size = 3) + - theme_classic() + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + - scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + - ggtitle("Br8667 Posterior") + theme(plot.title = element_text(face="bold")) +ggplot(aes(x = variable, y = PC, fill = value), data = Br8667_post_anova) + + geom_tile() + + scale_fill_gradient(low = "white", high = "#416A1D") + + labs(y = NULL, x = NULL, fill = "R-squared") + + geom_text(aes(label = round(value, 2)), size = 3) + + theme_classic() + + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + + scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + + ggtitle("Br8667 Posterior") + + theme(plot.title = element_text(face = "bold")) dev.off() Br6522_ant$Layer_wrinkle <- paste(Br6522_ant$Layers, as.numeric(Br6522_ant$is_wrinkle), sep = "_") Br6522_mid$Layer_wrinkle <- paste(Br6522_mid$Layers, as.numeric(Br6522_mid$is_wrinkle), sep = "_") Br8667_post$Layer_wrinkle <- paste(Br8667_post$Layers, as.numeric(Br8667_post$is_wrinkle), sep = "_") -plot_DE_genes <- function(df_list, opt = "all", quantile_thresh = 0.95){ - df_list <- lapply(df_list, function(df){ - if(is.null(df)){ - NULL - }else{ - df <- data.frame(df) - df$gene <- rownames(df) - rownames(df) <- c(1:dim(df)[1]) - df +plot_DE_genes <- function(df_list, opt = "all", quantile_thresh = 0.95) { + df_list <- lapply(df_list, function(df) { + if (is.null(df)) { + NULL + } else { + df <- data.frame(df) + df$gene <- rownames(df) + rownames(df) <- c(1:dim(df)[1]) + df + } + }) + if (opt == "all") { + layer_1 <- df_list[[1]] + layer_1$logFC.Layer.1_1 <- NULL + layer_1$Layer <- "Layer 1" + layer_1 <- layer_1[layer_1$FDR < 0.01, ] + layer_1 <- layer_1[abs(layer_1$summary.logFC) >= quantile(abs(layer_1$summary.logFC), quantile_thresh), ] + # layer_1 <- layer_1[abs(layer_1$summary.logFC) >= 0.2, ] + layer_1 <- layer_1[order(abs(layer_1$summary.logFC)), ] + + layer_WM <- df_list[[7]] + layer_WM$Layer <- "WM" + layer_WM$logFC.WM_1 <- NULL + layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] + layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= quantile(abs(layer_WM$summary.logFC), quantile_thresh), ] + # layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= 0.2, ] + layer_WM <- layer_WM[order(abs(layer_WM$summary.logFC)), ] } - }) - if(opt == "all"){ - layer_1 <- df_list[[1]] - layer_1$logFC.Layer.1_1 <- NULL - layer_1$Layer <- "Layer 1" - layer_1 <- layer_1[layer_1$FDR < 0.01, ] - layer_1 <- layer_1[abs(layer_1$summary.logFC) >= quantile(abs(layer_1$summary.logFC), quantile_thresh), ] - #layer_1 <- layer_1[abs(layer_1$summary.logFC) >= 0.2, ] - layer_1 <- layer_1[order(abs(layer_1$summary.logFC)), ] - - layer_WM <- df_list[[7]] - layer_WM$Layer <- "WM" - layer_WM$logFC.WM_1 <- NULL - layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] - layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= quantile(abs(layer_WM$summary.logFC), quantile_thresh), ] - #layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= 0.2, ] - layer_WM <- layer_WM[order(abs(layer_WM$summary.logFC)), ] - } - - layer_2 <- df_list[[2]] - layer_2$logFC.Layer.2_1 <- NULL - layer_2$Layer <- "Layer 2" - layer_2 <- layer_2[layer_2$FDR < 0.01, ] - layer_2 <- layer_2[abs(layer_2$summary.logFC) >= quantile(abs(layer_2$summary.logFC), quantile_thresh), ] - #layer_2 <- layer_2[abs(layer_2$summary.logFC) >= 0.2, ] - layer_2 <- layer_2[order(abs(layer_2$summary.logFC)), ] - - layer_3 <- df_list[[3]] - layer_3$logFC.Layer.3_1 <- NULL - layer_3$Layer <- "Layer 3" - layer_3 <- layer_3[layer_3$FDR < 0.01, ] - layer_3 <- layer_3[abs(layer_3$summary.logFC) >= quantile(abs(layer_3$summary.logFC), quantile_thresh), ] - #layer_3 <- layer_3[abs(layer_3$summary.logFC) >= 0.2, ] - layer_3 <- layer_3[order(abs(layer_3$summary.logFC)), ] - - layer_4 <- df_list[[4]] - layer_4$logFC.Layer.4_1 <- NULL - layer_4$Layer <- "Layer 4" - layer_4 <- layer_4[layer_4$FDR < 0.01, ] - #layer_4 <- layer_4[abs(layer_4$summary.logFC) >= 0.2, ] - layer_4 <- layer_4[abs(layer_4$summary.logFC) >= quantile(abs(layer_4$summary.logFC), quantile_thresh), ] - layer_4 <- layer_4[order(abs(layer_4$summary.logFC)), ] - - layer_5 <- df_list[[5]] - layer_5$logFC.Layer.5_1 <- NULL - layer_5$Layer <- "Layer 5" - layer_5 <- layer_5[layer_5$FDR < 0.01, ] - layer_5 <- layer_5[abs(layer_5$summary.logFC) >= quantile(abs(layer_5$summary.logFC), quantile_thresh), ] - #layer_5 <- layer_5[abs(layer_5$summary.logFC) >= 0.2, ] - layer_5 <- layer_5[order(abs(layer_5$summary.logFC)), ] - - layer_6 <- df_list[[6]] - layer_6$logFC.Layer.6_1 <- NULL - layer_6$Layer <- "Layer 6" - layer_6 <- layer_6[layer_6$FDR < 0.01, ] - #layer_6 <- layer_6[abs(layer_6$summary.logFC) >= 0.2, ] - layer_6 <- layer_6[abs(layer_6$summary.logFC) >= quantile(abs(layer_6$summary.logFC), quantile_thresh), ] - layer_6 <- layer_6[order(abs(layer_6$summary.logFC)), ] - - if(opt == "all"){ - plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) - }else{ - plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) - } - plot_df$Absolute_logFC <- abs(plot_df$summary.logFC) - plot_df$genes_ordered <- factor(plot_df$gene, levels=unique(plot_df$gene)) - ggplot(plot_df, aes(x= Layer, y=genes_ordered, size=Absolute_logFC, color=FDR)) + geom_point(alpha = 0.8) + - theme_bw() + xlab("") + ylab("") + scale_colour_gradient(low = "#3D07F4", high = "#E2DBF8") + - scale_size_continuous(name = "|log FC|") + theme(panel.grid.major = element_line(colour = "black",linewidth = 0.2, linetype="dashed")) + theme( - panel.grid.major.x = element_blank()) + + layer_2 <- df_list[[2]] + layer_2$logFC.Layer.2_1 <- NULL + layer_2$Layer <- "Layer 2" + layer_2 <- layer_2[layer_2$FDR < 0.01, ] + layer_2 <- layer_2[abs(layer_2$summary.logFC) >= quantile(abs(layer_2$summary.logFC), quantile_thresh), ] + # layer_2 <- layer_2[abs(layer_2$summary.logFC) >= 0.2, ] + layer_2 <- layer_2[order(abs(layer_2$summary.logFC)), ] + + layer_3 <- df_list[[3]] + layer_3$logFC.Layer.3_1 <- NULL + layer_3$Layer <- "Layer 3" + layer_3 <- layer_3[layer_3$FDR < 0.01, ] + layer_3 <- layer_3[abs(layer_3$summary.logFC) >= quantile(abs(layer_3$summary.logFC), quantile_thresh), ] + # layer_3 <- layer_3[abs(layer_3$summary.logFC) >= 0.2, ] + layer_3 <- layer_3[order(abs(layer_3$summary.logFC)), ] + + layer_4 <- df_list[[4]] + layer_4$logFC.Layer.4_1 <- NULL + layer_4$Layer <- "Layer 4" + layer_4 <- layer_4[layer_4$FDR < 0.01, ] + # layer_4 <- layer_4[abs(layer_4$summary.logFC) >= 0.2, ] + layer_4 <- layer_4[abs(layer_4$summary.logFC) >= quantile(abs(layer_4$summary.logFC), quantile_thresh), ] + layer_4 <- layer_4[order(abs(layer_4$summary.logFC)), ] + + layer_5 <- df_list[[5]] + layer_5$logFC.Layer.5_1 <- NULL + layer_5$Layer <- "Layer 5" + layer_5 <- layer_5[layer_5$FDR < 0.01, ] + layer_5 <- layer_5[abs(layer_5$summary.logFC) >= quantile(abs(layer_5$summary.logFC), quantile_thresh), ] + # layer_5 <- layer_5[abs(layer_5$summary.logFC) >= 0.2, ] + layer_5 <- layer_5[order(abs(layer_5$summary.logFC)), ] + + layer_6 <- df_list[[6]] + layer_6$logFC.Layer.6_1 <- NULL + layer_6$Layer <- "Layer 6" + layer_6 <- layer_6[layer_6$FDR < 0.01, ] + # layer_6 <- layer_6[abs(layer_6$summary.logFC) >= 0.2, ] + layer_6 <- layer_6[abs(layer_6$summary.logFC) >= quantile(abs(layer_6$summary.logFC), quantile_thresh), ] + layer_6 <- layer_6[order(abs(layer_6$summary.logFC)), ] + + if (opt == "all") { + plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) + } else { + plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) + } + plot_df$Absolute_logFC <- abs(plot_df$summary.logFC) + plot_df$genes_ordered <- factor(plot_df$gene, levels = unique(plot_df$gene)) + ggplot(plot_df, aes(x = Layer, y = genes_ordered, size = Absolute_logFC, color = FDR)) + + geom_point(alpha = 0.8) + + theme_bw() + + xlab("") + + ylab("") + + scale_colour_gradient(low = "#3D07F4", high = "#E2DBF8") + + scale_size_continuous(name = "|log FC|") + + theme(panel.grid.major = element_line(colour = "black", linewidth = 0.2, linetype = "dashed")) + + theme( + panel.grid.major.x = element_blank() + ) } -plot_DE_violin_plot <- function(df_list, opt = "all"){ - df_list <- lapply(df_list, function(df){ - data.frame(df) - }) - if(opt == "all"){ - layer_1 <- df_list[[1]] - layer_1$logFC.Layer.1_1 <- NULL - layer_1$Layer <- "Layer 1" - #layer_1 <- layer_1[layer_1$FDR < 0.01, ] - } - layer_2 <- df_list[[2]] - layer_2$logFC.Layer.2_1 <- NULL - layer_2$Layer <- "Layer 2" - #layer_2 <- layer_2[layer_2$FDR < 0.01, ] - - layer_3 <- df_list[[3]] - layer_3$Layer <- "Layer 3" - layer_3$logFC.Layer.3_1 <- NULL - #layer_3 <- layer_3[layer_3$FDR < 0.01, ] - - layer_4 <- df_list[[4]] - layer_4$Layer <- "Layer 4" - layer_4$logFC.Layer.4_1 <- NULL - #layer_4 <- layer_4[layer_4$FDR < 0.01, ] - - layer_5 <- df_list[[5]] - layer_5$Layer <- "Layer 5" - layer_5$logFC.Layer.5_1 <- NULL - #layer_5 <- layer_5[layer_5$FDR < 0.01, ] - - layer_6 <- df_list[[6]] - layer_6$Layer <- "Layer 6" - layer_6$logFC.Layer.6_1 <- NULL - #layer_6 <- layer_6[layer_6$FDR < 0.01, ] - - if(opt == "all"){ - layer_WM <- df_list[[7]] - layer_WM$Layer <- "WM" - layer_WM$logFC.WM_1 <- NULL - #layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] - } - if(opt == "all"){ - plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) - }else{ - plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) - } - plot_df$pvalue_cat <- plot_df$FDR - plot_df$pvalue_cat[plot_df$FDR > 0.1] <- "FDR > 0.1" - plot_df$pvalue_cat[plot_df$FDR < 0.1 & plot_df$FDR > 0.05] <- "0.05 < FDR < 0.1" - plot_df$pvalue_cat[plot_df$FDR < 0.05 & plot_df$FDR > 0.01] <- "0.01 < FDR < 0.05" - plot_df$pvalue_cat[plot_df$FDR < 0.01 & plot_df$FDR > 0.001] <- "0.001 < FDR < 0.01" - plot_df$pvalue_cat[plot_df$FDR < 0.001] <- "FDR < 0.001" - plot_df$pvalue_cat <- factor(plot_df$pvalue_cat, levels = c("FDR > 0.1", "0.05 < FDR < 0.1", "0.01 < FDR < 0.05", "0.001 < FDR < 0.01", - "FDR < 0.001")) - plot_df.summary <- plot_df %>% - group_by(Layer, pvalue_cat) %>% - summarise( - mad = mad(summary.logFC), - median = median(summary.logFC) - ) - plot_df.summary$lowerLim <- plot_df.summary$median - 3*plot_df.summary$mad - plot_df.summary$upperLim <- plot_df.summary$median + 3*plot_df.summary$mad - ggplot(plot_df.summary, aes(x=Layer, y = median)) + xlab("") + ylab("Log Fold-change") + - geom_hline(yintercept = -0.1, lty = 2, linewidth = 0.3) + geom_hline(yintercept = 0.1, lty = 2, linewidth = 0.3) + - theme_classic() + geom_point(aes(color = pvalue_cat), position = position_dodge(0.5)) + - geom_errorbar(aes(ymin = lowerLim, ymax = upperLim, color = pvalue_cat), position = position_dodge(0.5), width = 0) + - ylim(c(-0.5, 0.5)) + scale_color_manual(name = "", values = c("FDR > 0.1" = "#C3B2F9", - "0.05 < FDR < 0.1" = "#BBA8F8", - "0.01 < FDR < 0.05" = "#9B7DF8", - "0.001 < FDR < 0.01" = "#784FF8", - "FDR < 0.001" = "#4A12FA")) +plot_DE_violin_plot <- function(df_list, opt = "all") { + df_list <- lapply(df_list, function(df) { + data.frame(df) + }) + if (opt == "all") { + layer_1 <- df_list[[1]] + layer_1$logFC.Layer.1_1 <- NULL + layer_1$Layer <- "Layer 1" + # layer_1 <- layer_1[layer_1$FDR < 0.01, ] + } + layer_2 <- df_list[[2]] + layer_2$logFC.Layer.2_1 <- NULL + layer_2$Layer <- "Layer 2" + # layer_2 <- layer_2[layer_2$FDR < 0.01, ] + + layer_3 <- df_list[[3]] + layer_3$Layer <- "Layer 3" + layer_3$logFC.Layer.3_1 <- NULL + # layer_3 <- layer_3[layer_3$FDR < 0.01, ] + + layer_4 <- df_list[[4]] + layer_4$Layer <- "Layer 4" + layer_4$logFC.Layer.4_1 <- NULL + # layer_4 <- layer_4[layer_4$FDR < 0.01, ] + + layer_5 <- df_list[[5]] + layer_5$Layer <- "Layer 5" + layer_5$logFC.Layer.5_1 <- NULL + # layer_5 <- layer_5[layer_5$FDR < 0.01, ] + + layer_6 <- df_list[[6]] + layer_6$Layer <- "Layer 6" + layer_6$logFC.Layer.6_1 <- NULL + # layer_6 <- layer_6[layer_6$FDR < 0.01, ] + + if (opt == "all") { + layer_WM <- df_list[[7]] + layer_WM$Layer <- "WM" + layer_WM$logFC.WM_1 <- NULL + # layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] + } + if (opt == "all") { + plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) + } else { + plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) + } + plot_df$pvalue_cat <- plot_df$FDR + plot_df$pvalue_cat[plot_df$FDR > 0.1] <- "FDR > 0.1" + plot_df$pvalue_cat[plot_df$FDR < 0.1 & plot_df$FDR > 0.05] <- "0.05 < FDR < 0.1" + plot_df$pvalue_cat[plot_df$FDR < 0.05 & plot_df$FDR > 0.01] <- "0.01 < FDR < 0.05" + plot_df$pvalue_cat[plot_df$FDR < 0.01 & plot_df$FDR > 0.001] <- "0.001 < FDR < 0.01" + plot_df$pvalue_cat[plot_df$FDR < 0.001] <- "FDR < 0.001" + plot_df$pvalue_cat <- factor(plot_df$pvalue_cat, levels = c( + "FDR > 0.1", "0.05 < FDR < 0.1", "0.01 < FDR < 0.05", "0.001 < FDR < 0.01", + "FDR < 0.001" + )) + plot_df.summary <- plot_df %>% + group_by(Layer, pvalue_cat) %>% + summarise( + mad = mad(summary.logFC), + median = median(summary.logFC) + ) + plot_df.summary$lowerLim <- plot_df.summary$median - 3 * plot_df.summary$mad + plot_df.summary$upperLim <- plot_df.summary$median + 3 * plot_df.summary$mad + ggplot(plot_df.summary, aes(x = Layer, y = median)) + + xlab("") + + ylab("Log Fold-change") + + geom_hline(yintercept = -0.1, lty = 2, linewidth = 0.3) + + geom_hline(yintercept = 0.1, lty = 2, linewidth = 0.3) + + theme_classic() + + geom_point(aes(color = pvalue_cat), position = position_dodge(0.5)) + + geom_errorbar(aes(ymin = lowerLim, ymax = upperLim, color = pvalue_cat), position = position_dodge(0.5), width = 0) + + ylim(c(-0.5, 0.5)) + + scale_color_manual(name = "", values = c( + "FDR > 0.1" = "#C3B2F9", + "0.05 < FDR < 0.1" = "#BBA8F8", + "0.01 < FDR < 0.05" = "#9B7DF8", + "0.001 < FDR < 0.01" = "#784FF8", + "FDR < 0.001" = "#4A12FA" + )) } Br6522_ant_out <- pairwiseTTests(Br6522_ant, groups = Br6522_ant$Layer_wrinkle) Br6522_ant_out_all <- scran::combineMarkers( - de.lists = Br6522_ant_out$statistics[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1")], - pairs = Br6522_ant_out$pairs[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1"), ], - pval.type = "all" + de.lists = Br6522_ant_out$statistics[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + )], + pairs = Br6522_ant_out$pairs[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + ), ], + pval.type = "all" ) Br6522_ant_DE_plots <- plot_DE_genes(Br6522_ant_out_all, "all", 0.98) + ggtitle("Br6522 Anterior") + theme(plot.title = element_text(face = "bold")) Br6522_ant_vln_plots <- plot_DE_violin_plot(Br6522_ant_out_all, "all") + ggtitle("Br6522 Anterior") + theme(plot.title = element_text(face = "bold")) @@ -753,15 +825,19 @@ dev.off() Br6522_mid_out <- pairwiseTTests(Br6522_mid, groups = Br6522_mid$Layer_wrinkle) Br6522_mid_out_all <- scran::combineMarkers( - de.lists = Br6522_mid_out$statistics[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1")], - pairs = Br6522_mid_out$pairs[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1"), ], - pval.type = "all" + de.lists = Br6522_mid_out$statistics[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + )], + pairs = Br6522_mid_out$pairs[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + ), ], + pval.type = "all" ) Br6522_mid_DE_plots <- plot_DE_genes(Br6522_mid_out_all, "all", 0.05) + ggtitle("Br6522 Middle") + theme(plot.title = element_text(face = "bold")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br6522_mid_topDEgenes.pdf", width = 5, height = 5) @@ -774,15 +850,19 @@ dev.off() Br8667_post_out <- pairwiseTTests(Br8667_post, groups = Br8667_post$Layer_wrinkle) Br8667_post_out_some <- scran::combineMarkers( - de.lists = Br8667_post_out$statistics[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1")], - pairs = Br8667_post_out$pairs[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1"), ], - pval.type = "all" + de.lists = Br8667_post_out$statistics[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + )], + pairs = Br8667_post_out$pairs[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + ), ], + pval.type = "all" ) Br8667_post_out_all <- list() Br8667_post_out_all[[1]] <- NULL @@ -801,14 +881,14 @@ pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br8667_post_logFC_dotPl Br8667_post_vln_plots + theme(legend.position = "none") dev.off() -get_legend<-function(myggplot){ - tmp <- ggplot_gtable(ggplot_build(myggplot)) - leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") - legend <- tmp$grobs[[leg]] - return(legend) +get_legend <- function(myggplot) { + tmp <- ggplot_gtable(ggplot_build(myggplot)) + leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") + legend <- tmp$grobs[[leg]] + return(legend) } -Br8667_post_vln_plots <- Br8667_post_vln_plots + theme(legend.position = "bottom") + guides(color=guide_legend(nrow=2, byrow=TRUE)) +Br8667_post_vln_plots <- Br8667_post_vln_plots + theme(legend.position = "bottom") + guides(color = guide_legend(nrow = 2, byrow = TRUE)) FDR_legend_forDotPlot <- get_legend(Br8667_post_vln_plots) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/legend_logFC_dotPlot.pdf", width = 6, height = 1) plot_grid(FDR_legend_forDotPlot) @@ -821,17 +901,17 @@ Br6522_ant_out_all[[4]]$Layer <- "Layer 4" Br6522_ant_out_all[[5]]$Layer <- "Layer 5" Br6522_ant_out_all[[6]]$Layer <- "Layer 6" Br6522_ant_out_all[[7]]$Layer <- "WM" -Br6522_ant_out_all <- lapply(Br6522_ant_out_all, function(df){ - df$gene <- rownames(df) - df <- df[df$FDR < 0.01, ] - df[ ,4] <- NULL - colnames(df) <- c("p_value", "FDR", "logFC", "Layer", "Gene") - df +Br6522_ant_out_all <- lapply(Br6522_ant_out_all, function(df) { + df$gene <- rownames(df) + df <- df[df$FDR < 0.01, ] + df[, 4] <- NULL + colnames(df) <- c("p_value", "FDR", "logFC", "Layer", "Gene") + df }) Br6522_ant_out_df <- do.call(rbind, Br6522_ant_out_all) Br6522_ant_out_df <- data.frame(Br6522_ant_out_df) rownames(Br6522_ant_out_df) <- c(1:dim(Br6522_ant_out_df)[1]) -Br6522_ant_out_df <- Br6522_ant_out_df[ ,c("Layer", "Gene", "logFC", "p_value", "FDR")] +Br6522_ant_out_df <- Br6522_ant_out_df[, c("Layer", "Gene", "logFC", "p_value", "FDR")] Br6522_ant_out_df <- cbind("Sample" = "Br6522_ant", Br6522_ant_out_df) Br6522_mid_out_all[[1]]$Layer <- "Layer 1" @@ -841,17 +921,17 @@ Br6522_mid_out_all[[4]]$Layer <- "Layer 4" Br6522_mid_out_all[[5]]$Layer <- "Layer 5" Br6522_mid_out_all[[6]]$Layer <- "Layer 6" Br6522_mid_out_all[[7]]$Layer <- "WM" -Br6522_mid_out_all <- lapply(Br6522_mid_out_all, function(df){ - df$gene <- rownames(df) - df <- df[df$FDR < 0.01, ] - df[ ,4] <- NULL - colnames(df) <- c("p_value", "FDR", "logFC", "Layer", "Gene") - df +Br6522_mid_out_all <- lapply(Br6522_mid_out_all, function(df) { + df$gene <- rownames(df) + df <- df[df$FDR < 0.01, ] + df[, 4] <- NULL + colnames(df) <- c("p_value", "FDR", "logFC", "Layer", "Gene") + df }) Br6522_mid_out_df <- do.call(rbind, Br6522_mid_out_all) Br6522_mid_out_df <- data.frame(Br6522_mid_out_df) rownames(Br6522_mid_out_df) <- c(1:dim(Br6522_mid_out_df)[1]) -Br6522_mid_out_df <- Br6522_mid_out_df[ ,c("Layer", "Gene", "logFC", "p_value", "FDR")] +Br6522_mid_out_df <- Br6522_mid_out_df[, c("Layer", "Gene", "logFC", "p_value", "FDR")] Br6522_mid_out_df <- cbind("Sample" = "Br6522_mid", Br6522_mid_out_df) Br8667_post_out_all[[2]]$Layer <- "Layer 2" @@ -859,24 +939,23 @@ Br8667_post_out_all[[3]]$Layer <- "Layer 3" Br8667_post_out_all[[4]]$Layer <- "Layer 4" Br8667_post_out_all[[5]]$Layer <- "Layer 5" Br8667_post_out_all[[6]]$Layer <- "Layer 6" -Br8667_post_out_all <- lapply(Br8667_post_out_all, function(df){ - if(is.null(df)){ - NULL - }else{ - df$gene <- rownames(df) - df <- df[df$FDR < 0.01, ] - df[ ,4] <- NULL - colnames(df) <- c("p_value", "FDR", "logFC", "Layer", "Gene") - df} +Br8667_post_out_all <- lapply(Br8667_post_out_all, function(df) { + if (is.null(df)) { + NULL + } else { + df$gene <- rownames(df) + df <- df[df$FDR < 0.01, ] + df[, 4] <- NULL + colnames(df) <- c("p_value", "FDR", "logFC", "Layer", "Gene") + df + } }) Br8667_post_out_df <- do.call(rbind, Br8667_post_out_all) Br8667_post_out_df <- data.frame(Br8667_post_out_df) rownames(Br8667_post_out_df) <- c(1:dim(Br8667_post_out_df)[1]) -Br8667_post_out_df <- Br8667_post_out_df[ ,c("Layer", "Gene", "logFC", "p_value", "FDR")] +Br8667_post_out_df <- Br8667_post_out_df[, c("Layer", "Gene", "logFC", "p_value", "FDR")] Br8667_post_out_df <- cbind("Sample" = "Br8667_post", Br8667_post_out_df) all_res <- rbind(Br6522_ant_out_df, Br6522_mid_out_df, Br8667_post_out_df) write.csv(all_res, "/data/abattle4/prashanthi/dewrinkler/tables/summary_stats_differential_expressed_genes_artifact.csv", row.names = FALSE) - - diff --git a/code/qc_artifact/evalute_cellType_correlations.R b/code/qc_artifact/evalute_cellType_correlations.R index 8b1dbf91..7defc7eb 100644 --- a/code/qc_artifact/evalute_cellType_correlations.R +++ b/code/qc_artifact/evalute_cellType_correlations.R @@ -16,263 +16,330 @@ cellTypes <- unique(cell_meta$cellType_broad_hc) map <- as.matrix(map) map_cellType <- matrix(NA, nrow = dim(spot_meta)[1], ncol = length(cellTypes)) -for(i in c(1:dim(map)[2])){ - weights_df <- data.frame(map[ ,i], cell_meta$cellType_broad_hc) - colnames(weights_df) <- c("spot_weight", "cell_type") - weights_df$cell_type <- factor(weights_df$cell_type, levels = cellTypes) - summary_df <- aggregate(weights_df$spot_weight, by=list(Category=weights_df$cell_type), FUN=sum) - map_cellType[i, ] <- summary_df$x +for (i in c(1:dim(map)[2])) { + weights_df <- data.frame(map[, i], cell_meta$cellType_broad_hc) + colnames(weights_df) <- c("spot_weight", "cell_type") + weights_df$cell_type <- factor(weights_df$cell_type, levels = cellTypes) + summary_df <- aggregate(weights_df$spot_weight, by = list(Category = weights_df$cell_type), FUN = sum) + map_cellType[i, ] <- summary_df$x } colnames(map_cellType) <- cellTypes map_cellType <- data.frame(map_cellType) -map_cellType$sumCells <- rowSums(map_cellType[ ,1:7]) +map_cellType$sumCells <- rowSums(map_cellType[, 1:7]) map_cellType$Layer <- spot_meta$LayerAnnot map_cellType$Wrinkle <- spot_meta$WrinkleAnnot map_cellType <- map_cellType[!map_cellType$Layer == "Unknown", ] -if(sample == "Br6522_ant"){ -map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c("None", "Fold_1", "Shear_1", "Shear_2", - "Shear_3", "Wrinkle_1", "Wrinkle_2", "Wrinkle_3", - "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", - "Wrinkle_8", "Wrinkle_9"))} -if(sample == "Br6522_mid"){ - map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c("None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", - "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", - "Wrinkle_6", "Wrinkle_7", - "Wrinkle_8", "Wrinkle_9", - "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) - +if (sample == "Br6522_ant") { + map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", + "Shear_3", "Wrinkle_1", "Wrinkle_2", "Wrinkle_3", + "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", + "Wrinkle_8", "Wrinkle_9" + )) } -if(sample == "Br8667_post"){ - map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c("None", "Shear_1", "Wrinkle_1", - "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", - "Wrinkle_6", "Wrinkle_7", - "Wrinkle_8", "Wrinkle_9", - "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) - +if (sample == "Br6522_mid") { + map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", + "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", + "Wrinkle_6", "Wrinkle_7", + "Wrinkle_8", "Wrinkle_9", + "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" + )) } -ggplot(map_cellType, aes(x = Layer, y = sumCells, fill = Wrinkle)) + geom_boxplot() + theme_classic() +if (sample == "Br8667_post") { + map_cellType$Wrinkle <- factor(map_cellType$Wrinkle, levels = c( + "None", "Shear_1", "Wrinkle_1", + "Wrinkle_2", "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", + "Wrinkle_6", "Wrinkle_7", + "Wrinkle_8", "Wrinkle_9", + "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" + )) +} +ggplot(map_cellType, aes(x = Layer, y = sumCells, fill = Wrinkle)) + + geom_boxplot() + + theme_classic() -diff_corr <- function(none, all){ - p_value_mat <- matrix(NA, nrow = 7, ncol = 7) - for(i in c(1:7)){ - for(j in c(1:7)){ - if(i == j){ - p_value_mat[i,j] <- NA - }else{ - res <- st1(all[ ,i], all[ ,j], none[ ,i], none[ ,j]) - p_value_mat[i, j] <- res$pval - } +diff_corr <- function(none, all) { + p_value_mat <- matrix(NA, nrow = 7, ncol = 7) + for (i in c(1:7)) { + for (j in c(1:7)) { + if (i == j) { + p_value_mat[i, j] <- NA + } else { + res <- st1(all[, i], all[, j], none[, i], none[, j]) + p_value_mat[i, j] <- res$pval + } + } } - } - colnames(p_value_mat) <- colnames(none)[1:7] - rownames(p_value_mat) <- colnames(p_value_mat) - p_value_mat[lower.tri(p_value_mat)] <- NA - p_values_df <- melt(p_value_mat) - colnames(p_values_df) <- c("cell_type_1", "cell_type_2", "p_value") - p_values_df <- p_values_df[!is.na(p_values_df$p_value), ] - # sig_mat <- p_value_mat - # sig_mat[p_value_mat > 0.1] <- "n.s" - # sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" - # sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" - # sig_mat[p_value_mat < 0.01] <- "***" - # sig_mat[lower.tri(sig_mat)] <- "" - # diag(sig_mat) <- "" - # p_value_mat[lower.tri(p_value_mat)] <- NA - # pheatmap(p_value_mat, cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, - # color = colorRampPalette(rev(brewer.pal(n = 7, name ="Reds")))(100), breaks= seq(0, 1, 0.01), - # main = title, border_color = NA, na_col = "transparent") - p_values_df + colnames(p_value_mat) <- colnames(none)[1:7] + rownames(p_value_mat) <- colnames(p_value_mat) + p_value_mat[lower.tri(p_value_mat)] <- NA + p_values_df <- melt(p_value_mat) + colnames(p_values_df) <- c("cell_type_1", "cell_type_2", "p_value") + p_values_df <- p_values_df[!is.na(p_values_df$p_value), ] + # sig_mat <- p_value_mat + # sig_mat[p_value_mat > 0.1] <- "n.s" + # sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" + # sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" + # sig_mat[p_value_mat < 0.01] <- "***" + # sig_mat[lower.tri(sig_mat)] <- "" + # diag(sig_mat) <- "" + # p_value_mat[lower.tri(p_value_mat)] <- NA + # pheatmap(p_value_mat, cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, + # color = colorRampPalette(rev(brewer.pal(n = 7, name ="Reds")))(100), breaks= seq(0, 1, 0.01), + # main = title, border_color = NA, na_col = "transparent") + p_values_df } -if(!sample == "Br8667_post"){ -L1 <- map_cellType[map_cellType$Layer == "Layer 1", ] -L1_mat <- as.matrix(L1[ ,1:7]) -L1_mat <- scale(L1_mat, center = TRUE, scale = FALSE) -L1_pca <- svd(L1_mat) -L1_u <- L1_pca$u -colnames(L1_u) <- paste0("U", c(1:dim(L1_u)[2])) -L1 <- cbind(L1, L1_u) -L1$Wrinkle <- as.factor(L1$Wrinkle) -ggplot(L1, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L1, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() -L1_none <- L1[L1$Wrinkle == "None", ] -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample ,"_layer1.pdf"), width = 5, height = 5) -corrplot(cor(L1[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample ,"_layer1_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L1_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -L1_pvalue <- diff_corr(L1_none, L1) -L1_pvalue$Layers <- "Layer 1" +if (!sample == "Br8667_post") { + L1 <- map_cellType[map_cellType$Layer == "Layer 1", ] + L1_mat <- as.matrix(L1[, 1:7]) + L1_mat <- scale(L1_mat, center = TRUE, scale = FALSE) + L1_pca <- svd(L1_mat) + L1_u <- L1_pca$u + colnames(L1_u) <- paste0("U", c(1:dim(L1_u)[2])) + L1 <- cbind(L1, L1_u) + L1$Wrinkle <- as.factor(L1$Wrinkle) + ggplot(L1, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() + ggplot(L1, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() + L1_none <- L1[L1$Wrinkle == "None", ] + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1.pdf"), width = 5, height = 5) + corrplot(cor(L1[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1_excl_artifact.pdf"), width = 5, height = 5) + corrplot(cor(L1_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + L1_pvalue <- diff_corr(L1_none, L1) + L1_pvalue$Layers <- "Layer 1" } L2 <- map_cellType[map_cellType$Layer == "Layer 2", ] -L2_mat <- as.matrix(L2[ ,1:7]) +L2_mat <- as.matrix(L2[, 1:7]) L2_mat <- scale(L2_mat, center = TRUE, scale = FALSE) L2_pca <- svd(L2_mat) L2_u <- L2_pca$u colnames(L2_u) <- paste0("U", c(1:dim(L2_u)[2])) L2 <- cbind(L2, L2_u) L2$Wrinkle <- as.factor(L2$Wrinkle) -ggplot(L2, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L2, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L2, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L2, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L2_none <- L2[L2$Wrinkle == "None", ] -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample ,"_layer2.pdf"), width = 5, height = 5) -corrplot(cor(L2[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer2.pdf"), width = 5, height = 5) +corrplot(cor(L2[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer2_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L2_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L2_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L2_pvalue <- diff_corr(L2_none, L2) L2_pvalue$Layers <- "Layer 2" L3 <- map_cellType[map_cellType$Layer == "Layer 3", ] -L3_mat <- as.matrix(L3[ ,1:7]) +L3_mat <- as.matrix(L3[, 1:7]) L3_mat <- scale(L3_mat, center = TRUE, scale = FALSE) L3_pca <- svd(L3_mat) L3_u <- L3_pca$u colnames(L3_u) <- paste0("U", c(1:dim(L3_u)[2])) L3 <- cbind(L3, L3_u) L3$Wrinkle <- as.factor(L3$Wrinkle) -ggplot(L3, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L3, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L3, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L3, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L3_none <- L3[L3$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer3.pdf"), width = 5, height = 5) -corrplot(cor(L3[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L3[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer3_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L3_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L3_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L3_pvalue <- diff_corr(L3_none, L3) L3_pvalue$Layers <- "Layer 3" L4 <- map_cellType[map_cellType$Layer == "Layer 4", ] -L4_mat <- as.matrix(L4[ ,1:7]) +L4_mat <- as.matrix(L4[, 1:7]) L4_mat <- scale(L4_mat, center = TRUE, scale = FALSE) L4_pca <- svd(L4_mat) L4_u <- L4_pca$u colnames(L4_u) <- paste0("U", c(1:dim(L4_u)[2])) L4 <- cbind(L4, L4_u) L4$Wrinkle <- as.factor(L4$Wrinkle) -ggplot(L4, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L4, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L4, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L4, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L4_none <- L4[L4$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer4.pdf"), width = 5, height = 5) -corrplot(cor(L4[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L4[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer4_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L4_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L4_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L4_pvalue <- diff_corr(L4_none, L4) L4_pvalue$Layers <- "Layer 4" L5 <- map_cellType[map_cellType$Layer == "Layer 5", ] -L5_mat <- as.matrix(L5[ ,1:7]) +L5_mat <- as.matrix(L5[, 1:7]) L5_mat <- scale(L5_mat, center = TRUE, scale = FALSE) L5_pca <- svd(L5_mat) L5_u <- L5_pca$u colnames(L5_u) <- paste0("U", c(1:dim(L5_u)[2])) L5 <- cbind(L5, L5_u) L5$Wrinkle <- as.factor(L5$Wrinkle) -ggplot(L5, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L5, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L5, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L5, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L5_none <- L5[L5$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer5.pdf"), width = 5, height = 5) -corrplot(cor(L5[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L5[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer5_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L5_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L5_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L5_pvalue <- diff_corr(L5_none, L5) L5_pvalue$Layers <- "Layer 5" L6 <- map_cellType[map_cellType$Layer == "Layer 6", ] -L6_mat <- as.matrix(L6[ ,1:7]) +L6_mat <- as.matrix(L6[, 1:7]) L6_mat <- scale(L6_mat, center = TRUE, scale = FALSE) L6_pca <- svd(L6_mat) L6_u <- L6_pca$u colnames(L6_u) <- paste0("U", c(1:dim(L6_u)[2])) L6 <- cbind(L6, L6_u) L6$Wrinkle <- as.factor(L6$Wrinkle) -ggplot(L6, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(L6, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() +ggplot(L6, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() +ggplot(L6, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() L6_none <- L6[L6$Wrinkle == "None", ] pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer6.pdf"), width = 5, height = 5) -corrplot(cor(L6[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L6[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer6_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(L6_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) +corrplot(cor(L6_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 +) dev.off() L6_pvalue <- diff_corr(L6_none, L6) L6_pvalue$Layers <- "Layer 6" -if(!sample == "Br8667_post"){ -WM <- map_cellType[map_cellType$Layer == "WM", ] -WM_mat <- as.matrix(WM[ ,1:7]) -WM_mat <- scale(WM_mat, center = TRUE, scale = FALSE) -WM_pca <- svd(WM_mat) -WM_u <- WM_pca$u -colnames(WM_u) <- paste0("U", c(1:dim(WM_u)[2])) -WM <- cbind(WM, WM_u) -WM$Wrinkle <- as.factor(WM$Wrinkle) -ggplot(WM, aes(x = U1, y = U2, colour = Wrinkle)) + geom_point() + theme_classic() -ggplot(WM, aes(x = U1, y = U2, colour = sumCells)) + geom_point() + theme_classic() -WM_none <- WM[WM$Wrinkle == "None", ] -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM.pdf"), width = 5, height = 5) -corrplot(cor(WM[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_excl_artifact.pdf"), width = 5, height = 5) -corrplot(cor(WM_none[ ,1:7]), method = 'color', diag = TRUE, type = 'upper', addCoef.col = 'black', - order = 'original', tl.col = "black", number.digits = 2, number.cex =0.8) -dev.off() -WM_pvalue <- diff_corr(WM_none, WM) -WM_pvalue$Layers <- "WM"} +if (!sample == "Br8667_post") { + WM <- map_cellType[map_cellType$Layer == "WM", ] + WM_mat <- as.matrix(WM[, 1:7]) + WM_mat <- scale(WM_mat, center = TRUE, scale = FALSE) + WM_pca <- svd(WM_mat) + WM_u <- WM_pca$u + colnames(WM_u) <- paste0("U", c(1:dim(WM_u)[2])) + WM <- cbind(WM, WM_u) + WM$Wrinkle <- as.factor(WM$Wrinkle) + ggplot(WM, aes(x = U1, y = U2, colour = Wrinkle)) + + geom_point() + + theme_classic() + ggplot(WM, aes(x = U1, y = U2, colour = sumCells)) + + geom_point() + + theme_classic() + WM_none <- WM[WM$Wrinkle == "None", ] + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM.pdf"), width = 5, height = 5) + corrplot(cor(WM[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_excl_artifact.pdf"), width = 5, height = 5) + corrplot(cor(WM_none[, 1:7]), + method = "color", diag = TRUE, type = "upper", addCoef.col = "black", + order = "original", tl.col = "black", number.digits = 2, number.cex = 0.8 + ) + dev.off() + WM_pvalue <- diff_corr(WM_none, WM) + WM_pvalue$Layers <- "WM" +} -if(!sample == "Br8667_post"){ - pvalue_df <- rbind(L1_pvalue, L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue, WM_pvalue) -}else{ - pvalue_df <- rbind(L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue) +if (!sample == "Br8667_post") { + pvalue_df <- rbind(L1_pvalue, L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue, WM_pvalue) +} else { + pvalue_df <- rbind(L2_pvalue, L3_pvalue, L4_pvalue, L5_pvalue, L6_pvalue) } pvalue_df$corr_p_values <- p.adjust(pvalue_df$p_value, method = "fdr") -plot_heatmap <- function(pvalue_df, layer){ - p_value_mat <-dcast(pvalue_df[pvalue_df$Layers == layer, c(1, 2, 5)], cell_type_1 ~ cell_type_2) - rownames(p_value_mat) <- p_value_mat$cell_type_1 - p_value_mat$cell_type_1 <- NULL - p_value_mat <- as.matrix(p_value_mat) - sig_mat <- p_value_mat - sig_mat[p_value_mat > 0.1] <- "n.s" - sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" - sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" - sig_mat[p_value_mat < 0.01] <- "***" - sig_mat[is.na(sig_mat)] <- "" - pheatmap(p_value_mat, cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, - color = colorRampPalette(rev(brewer.pal(n = 7, name ="Reds")))(100), breaks= seq(0, 1, 0.01), - main = layer, border_color = NA, na_col = "transparent", number_color = "black", fontsize = 14) +plot_heatmap <- function(pvalue_df, layer) { + p_value_mat <- dcast(pvalue_df[pvalue_df$Layers == layer, c(1, 2, 5)], cell_type_1 ~ cell_type_2) + rownames(p_value_mat) <- p_value_mat$cell_type_1 + p_value_mat$cell_type_1 <- NULL + p_value_mat <- as.matrix(p_value_mat) + sig_mat <- p_value_mat + sig_mat[p_value_mat > 0.1] <- "n.s" + sig_mat[p_value_mat < 0.1 & p_value_mat > 0.05] <- "*" + sig_mat[p_value_mat < 0.05 & p_value_mat > 0.01] <- "**" + sig_mat[p_value_mat < 0.01] <- "***" + sig_mat[is.na(sig_mat)] <- "" + pheatmap(p_value_mat, + cluster_rows = FALSE, cluster_cols = FALSE, display_numbers = sig_mat, + color = colorRampPalette(rev(brewer.pal(n = 7, name = "Reds")))(100), breaks = seq(0, 1, 0.01), + main = layer, border_color = NA, na_col = "transparent", number_color = "black", fontsize = 14 + ) } -if(!sample == "Br8667_post"){ -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1_pval.pdf"), width = 4, height = 4) -plot_heatmap(pvalue_df, "Layer 1") -dev.off() -pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_pval.pdf"), width = 4, height = 4) -plot_heatmap(pvalue_df, "WM") -dev.off()} +if (!sample == "Br8667_post") { + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer1_pval.pdf"), width = 4, height = 4) + plot_heatmap(pvalue_df, "Layer 1") + dev.off() + pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_WM_pval.pdf"), width = 4, height = 4) + plot_heatmap(pvalue_df, "WM") + dev.off() +} pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer2_pval.pdf"), width = 4, height = 4) plot_heatmap(pvalue_df, "Layer 2") @@ -289,6 +356,3 @@ dev.off() pdf(paste0("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/", sample, "_layer6_pval.pdf"), width = 4, height = 4) plot_heatmap(pvalue_df, "Layer 6") dev.off() - - - \ No newline at end of file diff --git a/code/qc_artifact/heterotypic_doublets.R b/code/qc_artifact/heterotypic_doublets.R index c22ec7e3..7950de38 100644 --- a/code/qc_artifact/heterotypic_doublets.R +++ b/code/qc_artifact/heterotypic_doublets.R @@ -7,28 +7,28 @@ library(cowplot) library(DoubletFinder) set.seed(1001) -manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df){ - spots <- rownames(sobj@meta.data) - layers <- c() - wrinkle <- c() - nCells <- c() - for(i in c(1:length(spots))){ - if(spots[i] %in% layers_df$spot_name){ - layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] - }else{ - layers[i] <- "Unknown" +manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df) { + spots <- rownames(sobj@meta.data) + layers <- c() + wrinkle <- c() + nCells <- c() + for (i in c(1:length(spots))) { + if (spots[i] %in% layers_df$spot_name) { + layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] + } else { + layers[i] <- "Unknown" + } + if (spots[i] %in% wrinkles_df$spot_name) { + wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] + } else { + wrinkle[i] <- "None" + } + nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] } - if(spots[i] %in% wrinkles_df$spot_name){ - wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] - }else{ - wrinkle[i] <- "None" - } - nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] - } - sobj@meta.data["Layers"] <- layers - sobj@meta.data["Wrinkles"] <- wrinkle - sobj@meta.data["nCells"] <- nCells - sobj + sobj@meta.data["Layers"] <- layers + sobj@meta.data["Wrinkles"] <- wrinkle + sobj@meta.data["nCells"] <- nCells + sobj } # Read manual annotationss @@ -54,62 +54,69 @@ Br6522_ant <- manually_annotate(Br6522_ant, Br6522_ant_layers, Br6522_ant_wrinkl Br6522_mid <- manually_annotate(Br6522_mid, Br6522_mid_layers, Br6522_mid_wrinkles, Br6522_mid_spot_counts) Br8667_post <- manually_annotate(Br8667_post, Br8667_post_layers, Br8667_post_wrinkles, Br8667_post_spot_counts) -# Exclude points that do not have a definitive layer assignment -Br6522_ant <- Br6522_ant[ ,!Br6522_ant$Layers == "Unknown"] -Br6522_mid <- Br6522_mid[ ,!Br6522_mid$Layers == "Unknown"] -Br8667_post <- Br8667_post[ ,!Br8667_post$Layers == "Unknown"] +# Exclude points that do not have a definitive layer assignment +Br6522_ant <- Br6522_ant[, !Br6522_ant$Layers == "Unknown"] +Br6522_mid <- Br6522_mid[, !Br6522_mid$Layers == "Unknown"] +Br8667_post <- Br8667_post[, !Br8667_post$Layers == "Unknown"] # Format the metadata Br6522_ant$Layers <- factor(Br6522_ant$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) Br6522_mid$Layers <- factor(Br6522_mid$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) Br8667_post$Layers <- factor(Br8667_post$Layers, levels = c("Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6")) -Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c("None", "Fold_1", "Shear_1", "Shear_2", "Shear_3", "Wrinkle_1", "Wrinkle_2", - "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", - "Wrinkle_9")) -Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c("None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", "Wrinkle_2", - "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", - "Wrinkle_9", "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) -Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c("None", "Shear_1", "Wrinkle_1", "Wrinkle_2", - "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", - "Wrinkle_9", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13")) +Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", "Shear_3", "Wrinkle_1", "Wrinkle_2", + "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", + "Wrinkle_9" +)) +Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c( + "None", "Fold_1", "Shear_1", "Shear_2", "Wrinkle_1", "Wrinkle_2", + "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", + "Wrinkle_9", "Wrinkle_10", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" +)) +Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c( + "None", "Shear_1", "Wrinkle_1", "Wrinkle_2", + "Wrinkle_3", "Wrinkle_4", "Wrinkle_5", "Wrinkle_6", "Wrinkle_7", "Wrinkle_8", + "Wrinkle_9", "Wrinkle_11", "Wrinkle_12", "Wrinkle_13" +)) Br6522_ant$is_wrinkle <- !Br6522_ant$Wrinkles == "None" Br6522_mid$is_wrinkle <- !Br6522_mid$Wrinkles == "None" Br8667_post$is_wrinkle <- !Br8667_post$Wrinkles == "None" -simulate_doublets <- function(sobj){ -sobj <- subset(sobj, Wrinkles == "None") -nSim <- round(0.05*dim(sobj)[2]) -layer_combinations <- combn(levels(sobj$Layers), 2) -simulated_doublets <- list() -for(i in c(1:dim(layer_combinations)[2])){ - print(i) - L1 <- layer_combinations[1, i] - L2 <- layer_combinations[2, i] - L1_sobj <- subset(sobj, Layers == L1) - L2_sobj <- subset(sobj, Layers == L2) - prop <- runif(nSim, min = 0.3, max = 0.7) - #prop <- rep(0.5, nSim) - sim_Dat <- matrix(NA, nrow = dim(L1_sobj)[1], ncol = nSim) - dat1 <- L1_sobj@assays$Spatial@counts - dat2 <- L2_sobj@assays$Spatial@counts - for(j in c(1:nSim)){ - sim_Dat[ ,j] <- (prop[j]*dat1[ ,sample(c(1:dim(dat1)[2]),1)]) + ((1 - prop[j])*dat2[ ,sample(c(1:dim(dat2)[2]),1)]) - } - sim_Dat <- data.frame(t(sim_Dat)) - colnames(sim_Dat) <- rownames(sobj) - rownames(sim_Dat) <- paste(gsub(" ", "", L1), gsub(" ", "", L2), c(1:dim(sim_Dat)[1]), sep = "_") - sim_Dat$L1 <- L1 - sim_Dat$L2 <- L2 - sim_Dat$Layer <- paste(sim_Dat$L1, sim_Dat$L2, sep = "/") - sim_Dat$prop_L1 <- prop - sim_Dat$Type <- "Simulated" - simulated_doublets[[i]] <- sim_Dat - rm(sim_Dat) - rm(prop) +simulate_doublets <- function(sobj) { + sobj <- subset(sobj, Wrinkles == "None") + nSim <- round(0.05 * dim(sobj)[2]) + layer_combinations <- combn(levels(sobj$Layers), 2) + simulated_doublets <- list() + for (i in c(1:dim(layer_combinations)[2])) { + print(i) + L1 <- layer_combinations[1, i] + L2 <- layer_combinations[2, i] + L1_sobj <- subset(sobj, Layers == L1) + L2_sobj <- subset(sobj, Layers == L2) + prop <- runif(nSim, min = 0.3, max = 0.7) + # prop <- rep(0.5, nSim) + sim_Dat <- matrix(NA, nrow = dim(L1_sobj)[1], ncol = nSim) + dat1 <- L1_sobj@assays$Spatial@counts + dat2 <- L2_sobj@assays$Spatial@counts + for (j in c(1:nSim)) { + sim_Dat[, j] <- (prop[j] * dat1[, sample(c(1:dim(dat1)[2]), 1)]) + ((1 - prop[j]) * dat2[, sample(c(1:dim(dat2)[2]), 1)]) + } + sim_Dat <- data.frame(t(sim_Dat)) + colnames(sim_Dat) <- rownames(sobj) + rownames(sim_Dat) <- paste(gsub(" ", "", L1), gsub(" ", "", L2), c(1:dim(sim_Dat)[1]), sep = "_") + sim_Dat$L1 <- L1 + sim_Dat$L2 <- L2 + sim_Dat$Layer <- paste(sim_Dat$L1, sim_Dat$L2, sep = "/") + sim_Dat$prop_L1 <- prop + sim_Dat$Type <- "Simulated" + simulated_doublets[[i]] <- sim_Dat + rm(sim_Dat) + rm(prop) + } + simulated_doublets <- do.call(rbind, simulated_doublets) + simulated_doublets } -simulated_doublets <- do.call(rbind, simulated_doublets) -simulated_doublets} Br6522_ant_simulated <- simulate_doublets(Br6522_ant) Br6522_mid_simulated <- simulate_doublets(Br6522_mid) @@ -120,9 +127,9 @@ Br6522_mid$Type <- ifelse(Br6522_mid$Wrinkles == "None", "Non-artifact", "Artifa Br8667_post$Type <- ifelse(Br8667_post$Wrinkles == "None", "Non-artifact", "Artifact") -Br6522_ant_expr <- cbind(Br6522_ant@assays$Spatial@counts, t(Br6522_ant_simulated[ ,1:36601])) -Br6522_mid_expr <- cbind(Br6522_mid@assays$Spatial@counts, t(Br6522_mid_simulated[ ,1:36601])) -Br8667_post_expr <- cbind(Br8667_post@assays$Spatial@counts, t(Br8667_post_simulated[ ,1:36601])) +Br6522_ant_expr <- cbind(Br6522_ant@assays$Spatial@counts, t(Br6522_ant_simulated[, 1:36601])) +Br6522_mid_expr <- cbind(Br6522_mid@assays$Spatial@counts, t(Br6522_mid_simulated[, 1:36601])) +Br8667_post_expr <- cbind(Br8667_post@assays$Spatial@counts, t(Br8667_post_simulated[, 1:36601])) Br6522_ant_all <- CreateSeuratObject(Br6522_ant_expr, project = "Br6522 Anterior") Br6522_mid_all <- CreateSeuratObject(Br6522_mid_expr, project = "Br6522 Middle") @@ -183,66 +190,78 @@ Br8667_post_all <- Br8667_post_all[!grepl("^RP[SL]", rownames(Br8667_post_all)), Br8667_post_all <- NormalizeData(Br8667_post_all) Br6522_ant_all <- FindVariableFeatures(Br6522_ant_all, verbose = F) -Br6522_ant_all <- ScaleData(Br6522_ant_all, vars.to.regress = c("nFeature_RNA", "percent_mito"), - verbose = F) +Br6522_ant_all <- ScaleData(Br6522_ant_all, + vars.to.regress = c("nFeature_RNA", "percent_mito"), + verbose = F +) Br6522_ant_all <- RunPCA(Br6522_ant_all, verbose = FALSE) stdv <- Br6522_ant[["pca"]]@stdev sum.stdv <- sum(Br6522_ant[["pca"]]@stdev) percent.stdv <- (stdv / sum.stdv) * 100 cumulative <- cumsum(percent.stdv) co1 <- which(cumulative > 90 & percent.stdv < 5)[1] -co2 <- sort(which((percent.stdv[1:length(percent.stdv) - 1] - - percent.stdv[2:length(percent.stdv)]) > 0.1), - decreasing = T)[1] + 1 +co2 <- sort( + which((percent.stdv[1:length(percent.stdv) - 1] - + percent.stdv[2:length(percent.stdv)]) > 0.1), + decreasing = T +)[1] + 1 min.pc <- min(co1, co2) Br6522_ant_all <- FindNeighbors(Br6522_ant_all, reduction = "pca", dims = 1:8, return.neighbor = TRUE) Br6522_mid_all <- FindVariableFeatures(Br6522_mid_all, verbose = F) -Br6522_mid_all <- ScaleData(Br6522_mid_all, vars.to.regress = c("nFeature_RNA", "percent_mito"), - verbose = F) +Br6522_mid_all <- ScaleData(Br6522_mid_all, + vars.to.regress = c("nFeature_RNA", "percent_mito"), + verbose = F +) Br6522_mid_all <- RunPCA(Br6522_mid_all, verbose = FALSE) stdv <- Br6522_mid[["pca"]]@stdev sum.stdv <- sum(Br6522_mid[["pca"]]@stdev) percent.stdv <- (stdv / sum.stdv) * 100 cumulative <- cumsum(percent.stdv) co1 <- which(cumulative > 90 & percent.stdv < 5)[1] -co2 <- sort(which((percent.stdv[1:length(percent.stdv) - 1] - - percent.stdv[2:length(percent.stdv)]) > 0.1), - decreasing = T)[1] + 1 +co2 <- sort( + which((percent.stdv[1:length(percent.stdv) - 1] - + percent.stdv[2:length(percent.stdv)]) > 0.1), + decreasing = T +)[1] + 1 min.pc <- min(co1, co2) Br6522_mid_all <- FindNeighbors(Br6522_mid_all, reduction = "pca", dims = 1:8, return.neighbor = TRUE) Br8667_post_all <- FindVariableFeatures(Br8667_post_all, verbose = F) -Br8667_post_all <- ScaleData(Br8667_post_all, vars.to.regress = c("nFeature_RNA", "percent_mito"), - verbose = F) +Br8667_post_all <- ScaleData(Br8667_post_all, + vars.to.regress = c("nFeature_RNA", "percent_mito"), + verbose = F +) Br8667_post_all <- RunPCA(Br8667_post_all, verbose = FALSE) stdv <- Br8667_post[["pca"]]@stdev sum.stdv <- sum(Br8667_post[["pca"]]@stdev) percent.stdv <- (stdv / sum.stdv) * 100 cumulative <- cumsum(percent.stdv) co1 <- which(cumulative > 90 & percent.stdv < 5)[1] -co2 <- sort(which((percent.stdv[1:length(percent.stdv) - 1] - - percent.stdv[2:length(percent.stdv)]) > 0.1), - decreasing = T)[1] + 1 +co2 <- sort( + which((percent.stdv[1:length(percent.stdv) - 1] - + percent.stdv[2:length(percent.stdv)]) > 0.1), + decreasing = T +)[1] + 1 min.pc <- min(co1, co2) Br8667_post_all <- FindNeighbors(Br8667_post_all, reduction = "pca", dims = 1:8, return.neighbor = TRUE) -add_info_neighbors <- function(sobj){ - frac_layers <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Layers))) - for(i in c(1:dim(sobj)[2])){ - layers <- sobj$Layers[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] - frac_layers[i, ] <- table(layers) - } - colnames(frac_layers) <- levels(sobj$Layers) - sobj@meta.data <- cbind(sobj@meta.data, frac_layers) - frac_type <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Type))) - for(i in c(1:dim(sobj)[2])){ - type <- sobj$Type[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] - frac_type[i, ] <- table(type) - } - colnames(frac_type) <- levels(sobj$Type) - sobj@meta.data <- cbind(sobj@meta.data, frac_type) - sobj +add_info_neighbors <- function(sobj) { + frac_layers <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Layers))) + for (i in c(1:dim(sobj)[2])) { + layers <- sobj$Layers[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] + frac_layers[i, ] <- table(layers) + } + colnames(frac_layers) <- levels(sobj$Layers) + sobj@meta.data <- cbind(sobj@meta.data, frac_layers) + frac_type <- matrix(NA, nrow = dim(sobj)[2], ncol = length(levels(sobj$Type))) + for (i in c(1:dim(sobj)[2])) { + type <- sobj$Type[sobj@neighbors$RNA.nn@nn.idx[i, 1:10]] + frac_type[i, ] <- table(type) + } + colnames(frac_type) <- levels(sobj$Type) + sobj@meta.data <- cbind(sobj@meta.data, frac_type) + sobj } Br6522_ant_all <- add_info_neighbors(Br6522_ant_all) @@ -252,87 +271,117 @@ Br8667_post_all <- add_info_neighbors(Br8667_post_all) df <- Br6522_ant_all@meta.data df <- df[!df$Type == "Simulated doublet", ] df$Layer_Wrinkle <- paste(df$Layers, as.numeric(!df$Wrinkles == "None"), sep = "-") -df2 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(), mean), - .groups = 'drop') %>% - as.data.frame() -df3 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(),sd), - .groups = 'drop') %>% - as.data.frame() +df2 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), mean), + .groups = "drop" + ) %>% + as.data.frame() +df3 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), sd), + .groups = "drop" + ) %>% + as.data.frame() df2 <- reshape2::melt(df2) df3 <- reshape2::melt(df3) df2$sd <- df3$value df2$Wrinkles <- gsub("_", " ", df2$Wrinkles) -df2$Wrinkles <- factor(df2$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", - "Shear 3", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", - "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9")) +df2$Wrinkles <- factor(df2$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", + "Shear 3", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", + "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9" +)) df2$variable <- factor(df2$variable, levels = c("Simulated doublet", "Artifact", "Non-artifact")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_ant_SNN_artifacts.pdf", width = 13, height = 3) -ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + geom_bar(position="dodge", stat="identity") + - geom_errorbar(aes(ymin=value-0.5*sd, ymax=value+0.5*sd), width=.2,position=position_dodge(.9)) + - theme_classic() + xlab("") + ylab("Proportion of NN") + ggtitle("Br6522 Anterior") + - theme(legend.title=element_blank(), plot.title = element_text(face = "bold")) +ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + + geom_bar(position = "dodge", stat = "identity") + + geom_errorbar(aes(ymin = value - 0.5 * sd, ymax = value + 0.5 * sd), width = .2, position = position_dodge(.9)) + + theme_classic() + + xlab("") + + ylab("Proportion of NN") + + ggtitle("Br6522 Anterior") + + theme(legend.title = element_blank(), plot.title = element_text(face = "bold")) dev.off() df <- Br6522_mid_all@meta.data df <- df[!df$Type == "Simulated doublet", ] df$Layer_Wrinkle <- paste(df$Layers, as.numeric(!df$Wrinkles == "None"), sep = "-") -df2 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(), mean), - .groups = 'drop') %>% - as.data.frame() -df3 <- df[ ,c(6, 38, 39, 40)] %>% group_by(Wrinkles) %>% - summarise(across(everything(),sd), - .groups = 'drop') %>% - as.data.frame() +df2 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), mean), + .groups = "drop" + ) %>% + as.data.frame() +df3 <- df[, c(6, 38, 39, 40)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), sd), + .groups = "drop" + ) %>% + as.data.frame() df2 <- reshape2::melt(df2) df3 <- reshape2::melt(df3) df2$sd <- df3$value df2$Wrinkles <- gsub("_", " ", df2$Wrinkles) -df2$Wrinkles <- factor(df2$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", - "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", - "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", - "Wrinkle 12", "Wrinkle 13")) +df2$Wrinkles <- factor(df2$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", + "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", + "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", + "Wrinkle 12", "Wrinkle 13" +)) df2$variable <- factor(df2$variable, levels = c("Simulated doublet", "Artifact", "Non-artifact")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_mid_SNN_artifacts.pdf", width = 13, height = 3) -ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + geom_bar(position="dodge", stat="identity") + - geom_errorbar(aes(ymin=value-0.5*sd, ymax=value+0.5*sd), width=.2,position=position_dodge(.9)) + - theme_classic() + xlab("") + ylab("Proportion of NN") + ggtitle("Br6522 Middle") + - theme(legend.title=element_blank(), plot.title = element_text(face = "bold")) +ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + + geom_bar(position = "dodge", stat = "identity") + + geom_errorbar(aes(ymin = value - 0.5 * sd, ymax = value + 0.5 * sd), width = .2, position = position_dodge(.9)) + + theme_classic() + + xlab("") + + ylab("Proportion of NN") + + ggtitle("Br6522 Middle") + + theme(legend.title = element_blank(), plot.title = element_text(face = "bold")) dev.off() df <- Br8667_post_all@meta.data df <- df[!df$Type == "Simulated doublet", ] df$Layer_Wrinkle <- paste(df$Layers, as.numeric(!df$Wrinkles == "None"), sep = "-") -df2 <- df[ ,c(6, 25, 26, 27)] %>% group_by(Wrinkles) %>% - summarise(across(everything(), mean), - .groups = 'drop') %>% - as.data.frame() -df3 <- df[ ,c(6, 25, 26, 27)] %>% group_by(Wrinkles) %>% - summarise(across(everything(),sd), - .groups = 'drop') %>% - as.data.frame() +df2 <- df[, c(6, 25, 26, 27)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), mean), + .groups = "drop" + ) %>% + as.data.frame() +df3 <- df[, c(6, 25, 26, 27)] %>% + group_by(Wrinkles) %>% + summarise(across(everything(), sd), + .groups = "drop" + ) %>% + as.data.frame() df2 <- reshape2::melt(df2) df3 <- reshape2::melt(df3) df2$sd <- df3$value df2$Wrinkles <- gsub("_", " ", df2$Wrinkles) -df2$Wrinkles <- factor(df2$Wrinkles, levels = c("None", "Shear 1", - "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", - "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 11", - "Wrinkle 12", "Wrinkle 13")) +df2$Wrinkles <- factor(df2$Wrinkles, levels = c( + "None", "Shear 1", + "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", + "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 11", + "Wrinkle 12", "Wrinkle 13" +)) df2$variable <- factor(df2$variable, levels = c("Simulated doublet", "Artifact", "Non-artifact")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br8667_post_SNN_artifacts.pdf", width = 13, height = 3) -ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + geom_bar(position="dodge", stat="identity") + - geom_errorbar(aes(ymin=value-0.5*sd, ymax=value+0.5*sd), width=.2,position=position_dodge(.9)) + - theme_classic() + xlab("") + ylab("Proportion of NN") + ggtitle("Br8667 Posterior") + - theme(legend.title=element_blank(), plot.title = element_text(face = "bold")) +ggplot(df2, aes(x = Wrinkles, y = value, fill = variable)) + + geom_bar(position = "dodge", stat = "identity") + + geom_errorbar(aes(ymin = value - 0.5 * sd, ymax = value + 0.5 * sd), width = .2, position = position_dodge(.9)) + + theme_classic() + + xlab("") + + ylab("Proportion of NN") + + ggtitle("Br8667 Posterior") + + theme(legend.title = element_blank(), plot.title = element_text(face = "bold")) dev.off() @@ -342,8 +391,10 @@ L1_cells <- WhichCells(Br6522_ant_all, idents = "Layer 1") L5_cells <- WhichCells(Br6522_ant_all, idents = "Layer 5") L_1_5_cells <- WhichCells(Br6522_ant_all, idents = "Layer 1/Layer 5") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_ant_simulated.pdf", width = 8, height = 4) -DimPlot(Br6522_ant_all, split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5"= L_1_5_cells), - cols.highlight = c("blue", "purple", "red"), cols= "grey") + ggtitle("Br6522 Anterior") + xlab("UMAP 1") + ylab("UMAP 2") +DimPlot(Br6522_ant_all, + split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5" = L_1_5_cells), + cols.highlight = c("blue", "purple", "red"), cols = "grey" +) + ggtitle("Br6522 Anterior") + xlab("UMAP 1") + ylab("UMAP 2") dev.off() Br6522_mid_all <- RunUMAP(Br6522_mid_all, dims = 1:30) @@ -352,8 +403,10 @@ L1_cells <- WhichCells(Br6522_mid_all, idents = "Layer 1") L5_cells <- WhichCells(Br6522_mid_all, idents = "Layer 5") L_1_5_cells <- WhichCells(Br6522_mid_all, idents = "Layer 1/Layer 5") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br6522_mid_simulated.pdf", width = 8, height = 4) -DimPlot(Br6522_mid_all, split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5"= L_1_5_cells), - cols.highlight = c("blue", "purple", "red"), cols= "grey") + ggtitle("Br6522 Middle") + xlab("UMAP 1") + ylab("UMAP 2") +DimPlot(Br6522_mid_all, + split.by = "Type", cells.highlight = list("Layer 1" = L1_cells, "Layer 5" = L5_cells, "Layer 1/Layer 5" = L_1_5_cells), + cols.highlight = c("blue", "purple", "red"), cols = "grey" +) + ggtitle("Br6522 Middle") + xlab("UMAP 1") + ylab("UMAP 2") dev.off() Br8667_post_all <- RunUMAP(Br8667_post_all, dims = 1:30) @@ -362,7 +415,8 @@ L2_cells <- WhichCells(Br8667_post_all, idents = "Layer 2") L6_cells <- WhichCells(Br8667_post_all, idents = "Layer 6") L_2_6_cells <- WhichCells(Br8667_post_all, idents = "Layer 2/Layer 6") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S6/Br8667_post_simulated.pdf", width = 8, height = 4) -DimPlot(Br8667_post_all, split.by = "Type", cells.highlight = list("Layer 2" = L2_cells, "Layer 6" = L6_cells, "Layer 2/Layer 6"= L_2_6_cells), - cols.highlight = c("blue", "purple", "red"), cols= "grey") + ggtitle("Br8667 Posterior") + xlab("UMAP 1") + ylab("UMAP 2") +DimPlot(Br8667_post_all, + split.by = "Type", cells.highlight = list("Layer 2" = L2_cells, "Layer 6" = L6_cells, "Layer 2/Layer 6" = L_2_6_cells), + cols.highlight = c("blue", "purple", "red"), cols = "grey" +) + ggtitle("Br8667 Posterior") + xlab("UMAP 1") + ylab("UMAP 2") dev.off() - diff --git a/code/qc_artifact/qc_gene_artifact.R b/code/qc_artifact/qc_gene_artifact.R index 882ce729..051b9cd6 100644 --- a/code/qc_artifact/qc_gene_artifact.R +++ b/code/qc_artifact/qc_gene_artifact.R @@ -27,37 +27,37 @@ Br6522_mid <- readRDS(paste0(datDir, "Br6522_mid.rds")) Br8667_post <- readRDS(paste0(datDir, "Br8667_post.rds")) # Add manual metadata -manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df){ - spots <- rownames(sobj@meta.data) - layers <- c() - wrinkle <- c() - nCells <- c() - for(i in c(1:length(spots))){ - if(spots[i] %in% layers_df$spot_name){ - layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] - }else{ - layers[i] <- "Unknown" +manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df) { + spots <- rownames(sobj@meta.data) + layers <- c() + wrinkle <- c() + nCells <- c() + for (i in c(1:length(spots))) { + if (spots[i] %in% layers_df$spot_name) { + layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] + } else { + layers[i] <- "Unknown" + } + if (spots[i] %in% wrinkles_df$spot_name) { + wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] + } else { + wrinkle[i] <- "None" + } + nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] } - if(spots[i] %in% wrinkles_df$spot_name){ - wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] - }else{ - wrinkle[i] <- "None" - } - nCells[i] <- sc_df$Nmask_dark_blue[sc_df$barcode == spots[i]] - } - sobj@meta.data["Layers"] <- layers - sobj@meta.data["Wrinkles"] <- wrinkle - sobj@meta.data["nCells"] <- nCells - sobj + sobj@meta.data["Layers"] <- layers + sobj@meta.data["Wrinkles"] <- wrinkle + sobj@meta.data["nCells"] <- nCells + sobj } Br6522_ant <- manually_annotate(Br6522_ant, Br6522_ant_layers, Br6522_ant_wrinkles, Br6522_ant_spot_counts) Br6522_mid <- manually_annotate(Br6522_mid, Br6522_mid_layers, Br6522_mid_wrinkles, Br6522_mid_spot_counts) Br8667_post <- manually_annotate(Br8667_post, Br8667_post_layers, Br8667_post_wrinkles, Br8667_post_spot_counts) -Br6522_ant <- subset(Br6522_ant, Layers!="Unknown") -Br6522_mid <- subset(Br6522_mid, Layers!="Unknown") -Br8667_post <- subset(Br8667_post, Layers!="Unknown") +Br6522_ant <- subset(Br6522_ant, Layers != "Unknown") +Br6522_mid <- subset(Br6522_mid, Layers != "Unknown") +Br8667_post <- subset(Br8667_post, Layers != "Unknown") Br6522_ant$Layers <- factor(Br6522_ant$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) Br6522_mid$Layers <- factor(Br6522_mid$Layers, levels = c("Layer 1", "Layer 2", "Layer 3", "Layer 4", "Layer 5", "Layer 6", "WM")) @@ -67,15 +67,21 @@ Br6522_ant$Wrinkles <- gsub("_", " ", Br6522_ant$Wrinkles) Br6522_mid$Wrinkles <- gsub("_", " ", Br6522_mid$Wrinkles) Br8667_post$Wrinkles <- gsub("_", " ", Br8667_post$Wrinkles) -Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9")) -Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c("None", "Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) -Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c("None", "Shear 1", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) +Br6522_ant$Wrinkles <- factor(Br6522_ant$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9" +)) +Br6522_mid$Wrinkles <- factor(Br6522_mid$Wrinkles, levels = c( + "None", "Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) +Br8667_post$Wrinkles <- factor(Br8667_post$Wrinkles, levels = c( + "None", "Shear 1", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) Br6522_ant_1 <- Br6522_ant Br6522_mid_1 <- Br6522_mid @@ -83,43 +89,53 @@ Br8667_post_1 <- Br8667_post Br6522_ant_1$Wrinkles <- as.character(Br6522_ant_1$Wrinkles) Br6522_ant_1$Wrinkles[Br6522_ant_1$Wrinkles == "None"] <- NA -Br6522_ant_1$Wrinkles <- factor(Br6522_ant_1$Wrinkles, c("Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9")) +Br6522_ant_1$Wrinkles <- factor(Br6522_ant_1$Wrinkles, c( + "Fold 1", "Shear 1", "Shear 2", "Shear 3", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9" +)) Br6522_mid_1$Wrinkles <- as.character(Br6522_mid_1$Wrinkles) Br6522_mid_1$Wrinkles[Br6522_mid_1$Wrinkles == "None"] <- NA -Br6522_mid_1$Wrinkles <- factor(Br6522_mid_1$Wrinkles, c("Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) +Br6522_mid_1$Wrinkles <- factor(Br6522_mid_1$Wrinkles, c( + "Fold 1", "Shear 1", "Shear 2", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 10", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) Br8667_post_1$Wrinkles <- as.character(Br8667_post_1$Wrinkles) Br8667_post_1$Wrinkles[Br8667_post_1$Wrinkles == "None"] <- NA -Br8667_post_1$Wrinkles <- factor(Br8667_post_1$Wrinkles, c("Shear 1", "Wrinkle 1", "Wrinkle 2", - "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", - "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13")) - -layer_palette <- c("Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", - "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", - "WM" = "#1A1A1A", "NA" = "transparent") -wrinkle_palette <- c("Fold 1" = "#e6194B", "Shear 1" = "#3cb44b", - "Shear 2" = "#4363d8", "Shear 3" = "#f58231", - "Wrinkle 1" = "#911eb4", "Wrinkle 2" = "#42d4f4", - "Wrinkle 3" = "#f032e6", "Wrinkle 4" = "#bfef45", - "Wrinkle 5" = "#469990", "Wrinkle 6" = "#9A6324", - "Wrinkle 7" = "#800000", "Wrinkle 8" = "#aaffc3", - "Wrinkle 9" = "#373e02", "Wrinkle 10" = "#000075", - "Wrinkle 11" = "#ffd8b1" , "Wrinkle 12" = "#fffac8", - "Wrinkle 13" = "#ffe119", "NA" = "transparent") - -make_spatial_plots <- function(sobj, title){ - Idents(sobj) <- sobj$Layers - p1 <- SpatialDimPlot(sobj, cols = layer_palette) + theme_bw() + guides(fill=guide_legend(title="")) + xlab("") + ylab("") + - theme(axis.ticks = element_blank(), axis.text = element_blank(), plot.title = element_text(face = "bold", size = 10), legend.text = element_text(size = 7)) - Idents(sobj) <- sobj$Wrinkles - p2 <- SpatialDimPlot(sobj, cols = wrinkle_palette)+ theme_bw() + guides(fill=guide_legend(title="", ncol = 2)) + xlab("") + ylab("") + - theme(axis.ticks = element_blank(), axis.text = element_blank(), legend.text = element_text(size = 7)) - list(p1, p2) +Br8667_post_1$Wrinkles <- factor(Br8667_post_1$Wrinkles, c( + "Shear 1", "Wrinkle 1", "Wrinkle 2", + "Wrinkle 3", "Wrinkle 4", "Wrinkle 5", "Wrinkle 6", "Wrinkle 7", "Wrinkle 8", + "Wrinkle 9", "Wrinkle 11", "Wrinkle 12", "Wrinkle 13" +)) + +layer_palette <- c( + "Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", + "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", + "WM" = "#1A1A1A", "NA" = "transparent" +) +wrinkle_palette <- c( + "Fold 1" = "#e6194B", "Shear 1" = "#3cb44b", + "Shear 2" = "#4363d8", "Shear 3" = "#f58231", + "Wrinkle 1" = "#911eb4", "Wrinkle 2" = "#42d4f4", + "Wrinkle 3" = "#f032e6", "Wrinkle 4" = "#bfef45", + "Wrinkle 5" = "#469990", "Wrinkle 6" = "#9A6324", + "Wrinkle 7" = "#800000", "Wrinkle 8" = "#aaffc3", + "Wrinkle 9" = "#373e02", "Wrinkle 10" = "#000075", + "Wrinkle 11" = "#ffd8b1", "Wrinkle 12" = "#fffac8", + "Wrinkle 13" = "#ffe119", "NA" = "transparent" +) + +make_spatial_plots <- function(sobj, title) { + Idents(sobj) <- sobj$Layers + p1 <- SpatialDimPlot(sobj, cols = layer_palette) + theme_bw() + guides(fill = guide_legend(title = "")) + xlab("") + ylab("") + + theme(axis.ticks = element_blank(), axis.text = element_blank(), plot.title = element_text(face = "bold", size = 10), legend.text = element_text(size = 7)) + Idents(sobj) <- sobj$Wrinkles + p2 <- SpatialDimPlot(sobj, cols = wrinkle_palette) + theme_bw() + guides(fill = guide_legend(title = "", ncol = 2)) + xlab("") + ylab("") + + theme(axis.ticks = element_blank(), axis.text = element_blank(), legend.text = element_text(size = 7)) + list(p1, p2) } sp_plot_1 <- make_spatial_plots(Br6522_ant_1, "Br6522 Anterior") @@ -150,100 +166,138 @@ pdf(file = "/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br8667_post_arti sp_plot_3[[2]] dev.off() -Br6522_ant$percent_reads_LG <- apply(Br6522_ant@assays$Spatial@counts, 2, max)/ apply(Br6522_ant@assays$Spatial@counts, 2, sum) -Br6522_mid$percent_reads_LG <- apply(Br6522_mid@assays$Spatial@counts, 2, max)/ apply(Br6522_mid@assays$Spatial@counts, 2, sum) -Br8667_post$percent_reads_LG <- apply(Br8667_post@assays$Spatial@counts, 2, max)/ apply(Br8667_post@assays$Spatial@counts, 2, sum) +Br6522_ant$percent_reads_LG <- apply(Br6522_ant@assays$Spatial@counts, 2, max) / apply(Br6522_ant@assays$Spatial@counts, 2, sum) +Br6522_mid$percent_reads_LG <- apply(Br6522_mid@assays$Spatial@counts, 2, max) / apply(Br6522_mid@assays$Spatial@counts, 2, sum) +Br8667_post$percent_reads_LG <- apply(Br8667_post@assays$Spatial@counts, 2, max) / apply(Br8667_post@assays$Spatial@counts, 2, sum) -Br6522_ant$percent_reads_LG <- Br6522_ant$percent_reads_LG*100 -Br6522_mid$percent_reads_LG <- Br6522_mid$percent_reads_LG*100 -Br8667_post$percent_reads_LG <- Br8667_post$percent_reads_LG*100 +Br6522_ant$percent_reads_LG <- Br6522_ant$percent_reads_LG * 100 +Br6522_mid$percent_reads_LG <- Br6522_mid$percent_reads_LG * 100 +Br8667_post$percent_reads_LG <- Br8667_post$percent_reads_LG * 100 Br6522_ant$is_wrinkle <- !Br6522_ant$Wrinkles == "None" Br6522_mid$is_wrinkle <- !Br6522_mid$Wrinkles == "None" Br8667_post$is_wrinkle <- !Br8667_post$Wrinkles == "None" -make_metadata_layers_plots <- function(sobj, title){ - Layers <- levels(sobj$Layers) - nSpots_normal <- c() - nSpots_artifacts <- c() - for(i in c(1:length(Layers))){ - if(sum(sobj$Layers == Layers[i]) == 0){ - nSpots_normal[i] <- 0 - nSpots_artifacts[i] <- 0 - }else{ - nSpots_normal[i] <- sum(!sobj$is_wrinkle[sobj$Layers == Layers[i]]) - nSpots_artifacts[i] <- sum(sobj$is_wrinkle[sobj$Layers == Layers[i]]) +make_metadata_layers_plots <- function(sobj, title) { + Layers <- levels(sobj$Layers) + nSpots_normal <- c() + nSpots_artifacts <- c() + for (i in c(1:length(Layers))) { + if (sum(sobj$Layers == Layers[i]) == 0) { + nSpots_normal[i] <- 0 + nSpots_artifacts[i] <- 0 + } else { + nSpots_normal[i] <- sum(!sobj$is_wrinkle[sobj$Layers == Layers[i]]) + nSpots_artifacts[i] <- sum(sobj$is_wrinkle[sobj$Layers == Layers[i]]) + } } - } - count_df_artifact <- data.frame("Layers" = Layers, "nSpots" = nSpots_artifacts, - "Artifact" = TRUE) - count_df_normal <- data.frame("Layers" = Layers, "nSpots" = nSpots_normal, - "Artifact" = FALSE) - count_df <- rbind(count_df_artifact, count_df_normal) - p0 <- ggplot(count_df, aes(x = Layers, y = nSpots, fill = Artifact)) + geom_bar(position="dodge", stat="identity") + theme_classic() + - ylab("Number of spots") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) - - stat.test1 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCount_Spatial ~ is_wrinkle, alternative = "less") %>% - add_significance("p") - stat.test1 <- stat.test1 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p1 <- ggplot(sobj@meta.data) + geom_boxplot( aes(x = Layers, y = nCount_Spatial, fill = is_wrinkle),outlier.size = 0.4) + theme_classic() + - ylab("Library Size") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test1, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test2 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent.mt ~ is_wrinkle, alternative = "greater") %>% - add_significance("p") - stat.test2 <- stat.test2 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p2 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent.mt , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Percentage mitochondrial reads") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test2, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test3 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nFeature_Spatial ~ is_wrinkle, alternative = "less") %>% - add_significance("p") - stat.test3 <- stat.test3 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p3 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nFeature_Spatial , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Detected genes") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test3, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test4 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCells ~ is_wrinkle, alternative = "less") %>% - add_significance("p") - stat.test4 <- stat.test4 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p4 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nCells , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Nuclei detected (DAPI)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test4, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test5 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent_reads_LG ~ is_wrinkle, alternative = "greater") %>% - add_significance("p") - stat.test5 <- stat.test5 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p5 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent_reads_LG , fill = is_wrinkle), outlier.size = 0.4) + theme_classic() + - ylab("Percent reads (Largest gene)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test5, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - list(p0, p1, p2, p3, p4, p5) + count_df_artifact <- data.frame( + "Layers" = Layers, "nSpots" = nSpots_artifacts, + "Artifact" = TRUE + ) + count_df_normal <- data.frame( + "Layers" = Layers, "nSpots" = nSpots_normal, + "Artifact" = FALSE + ) + count_df <- rbind(count_df_artifact, count_df_normal) + p0 <- ggplot(count_df, aes(x = Layers, y = nSpots, fill = Artifact)) + + geom_bar(position = "dodge", stat = "identity") + + theme_classic() + + ylab("Number of spots") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat.test1 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCount_Spatial ~ is_wrinkle, alternative = "less") %>% + add_significance("p") + stat.test1 <- stat.test1 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p1 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Library Size") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test1, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test2 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent.mt ~ is_wrinkle, alternative = "greater") %>% + add_significance("p") + stat.test2 <- stat.test2 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p2 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent.mt, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Percentage mitochondrial reads") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test2, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test3 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nFeature_Spatial ~ is_wrinkle, alternative = "less") %>% + add_significance("p") + stat.test3 <- stat.test3 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p3 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Detected genes") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test3, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test4 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCells ~ is_wrinkle, alternative = "less") %>% + add_significance("p") + stat.test4 <- stat.test4 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p4 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCells, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Nuclei detected (DAPI)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test4, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test5 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent_reads_LG ~ is_wrinkle, alternative = "greater") %>% + add_significance("p") + stat.test5 <- stat.test5 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p5 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent_reads_LG, fill = is_wrinkle), outlier.size = 0.4) + + theme_classic() + + ylab("Percent reads (Largest gene)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test5, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + list(p0, p1, p2, p3, p4, p5) } md_plot_1 <- make_metadata_layers_plots(Br6522_ant, "Br6522 Anterior") @@ -257,140 +311,191 @@ md_plot_1[[4]] + md_plot_2[[4]] + md_plot_3[[4]] md_plot_1[[5]] + md_plot_2[[5]] + md_plot_3[[5]] md_plot_1[[6]] + md_plot_2[[6]] + md_plot_3[[6]] -make_metadata_wrinkles_plots <- function(sobj, title, layer){ - Wrinkles <- levels(sobj$Wrinkles) - nSpots_L1 <- c() - nSpots_L2 <- c() - nSpots_L3 <- c() - nSpots_L4 <- c() - nSpots_L5 <- c() - nSpots_L6 <- c() - nSpots_WM <- c() - for(i in c(1:length(Wrinkles))){ - nSpots_L1[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 1") - nSpots_L2[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 2") - nSpots_L3[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 3") - nSpots_L4[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 4") - nSpots_L5[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 5") - nSpots_L6[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 6") - nSpots_WM[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer WM") - } - count_df_L1 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, - "Layer" = "Layer 1") - count_df_L2 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L2, - "Layer" = "Layer 2") - count_df_L3 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L3, - "Layer" = "Layer 3") - count_df_L4 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L4, - "Layer" = "Layer 4") - count_df_L5 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L5, - "Layer" = "Layer 5") - count_df_L6 <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, - "Layer" = "Layer 1") - count_df_WM <- data.frame("Wrinkles" = Wrinkles, "nSpots" = nSpots_L6, - "Layer" = "Layer 6") - - count_df <- rbind(count_df_L1, count_df_L2, count_df_L3, - count_df_L4, count_df_L5, count_df_L6, count_df_WM) - count_df <- count_df[!count_df$Wrinkles == "None", ] - p0 <- ggplot(count_df, aes(Wrinkles, nSpots, fill = Layer)) + geom_bar(position="dodge", stat="identity") + theme_classic() + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + ggtitle(title) + scale_fill_brewer(palette = "Dark2") + xlab("") - - stat.test1 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCount_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% - add_significance("p") - stat.test1 <- stat.test1 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p1 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = Wrinkles),outlier.size = 0.4) + theme_classic() + - ylab("Library Size") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test1, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test2 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent.mt ~ Wrinkles, alternative = "greater", ref.group = "None") %>% - add_significance("p") - stat.test2 <- stat.test2 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p2 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent.mt , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Percentage mitochondrial reads") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test2, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test3 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nFeature_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% - add_significance("p") - stat.test3 <- stat.test3 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p3 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nFeature_Spatial , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Detected genes") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test3, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test4 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(nCells ~ Wrinkles, alternative = "less", ref.group = "None") %>% - add_significance("p") - stat.test4 <- stat.test4 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p4 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = nCells , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Nuclei detected (DAPI)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test4, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - stat.test5 <- sobj@meta.data %>% - group_by(Layers) %>% - wilcox_test(percent_reads_LG ~ Wrinkles, alternative = "greater", ref.group = "None") %>% - add_significance("p") - stat.test5 <- stat.test5 %>% - add_xy_position(x = "Layers", dodge = 0.8) - p5 <- ggplot(sobj@meta.data) + geom_boxplot(aes(x = Layers, y = percent_reads_LG , fill = Wrinkles), outlier.size = 0.4) + theme_classic() + - ylab("Percent reads (Largest gene)") + guides(fill=guide_legend(title="Artifact")) + ggtitle(title) + - stat_pvalue_manual( - stat.test5, label = "{p.signif}", - tip.length = 0, hide.ns = TRUE) - - list(p0, p1, p2, p3, p4, p5) +make_metadata_wrinkles_plots <- function(sobj, title, layer) { + Wrinkles <- levels(sobj$Wrinkles) + nSpots_L1 <- c() + nSpots_L2 <- c() + nSpots_L3 <- c() + nSpots_L4 <- c() + nSpots_L5 <- c() + nSpots_L6 <- c() + nSpots_WM <- c() + for (i in c(1:length(Wrinkles))) { + nSpots_L1[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 1") + nSpots_L2[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 2") + nSpots_L3[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 3") + nSpots_L4[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 4") + nSpots_L5[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 5") + nSpots_L6[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer 6") + nSpots_WM[i] <- sum(sobj$Layers[sobj$Wrinkles == Wrinkles[i]] == "Layer WM") + } + count_df_L1 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, + "Layer" = "Layer 1" + ) + count_df_L2 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L2, + "Layer" = "Layer 2" + ) + count_df_L3 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L3, + "Layer" = "Layer 3" + ) + count_df_L4 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L4, + "Layer" = "Layer 4" + ) + count_df_L5 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L5, + "Layer" = "Layer 5" + ) + count_df_L6 <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L1, + "Layer" = "Layer 1" + ) + count_df_WM <- data.frame( + "Wrinkles" = Wrinkles, "nSpots" = nSpots_L6, + "Layer" = "Layer 6" + ) + + count_df <- rbind( + count_df_L1, count_df_L2, count_df_L3, + count_df_L4, count_df_L5, count_df_L6, count_df_WM + ) + count_df <- count_df[!count_df$Wrinkles == "None", ] + p0 <- ggplot(count_df, aes(Wrinkles, nSpots, fill = Layer)) + + geom_bar(position = "dodge", stat = "identity") + + theme_classic() + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) + + ggtitle(title) + + scale_fill_brewer(palette = "Dark2") + + xlab("") + + stat.test1 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCount_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% + add_significance("p") + stat.test1 <- stat.test1 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p1 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Library Size") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test1, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test2 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent.mt ~ Wrinkles, alternative = "greater", ref.group = "None") %>% + add_significance("p") + stat.test2 <- stat.test2 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p2 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent.mt, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Percentage mitochondrial reads") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test2, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test3 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nFeature_Spatial ~ Wrinkles, alternative = "less", ref.group = "None") %>% + add_significance("p") + stat.test3 <- stat.test3 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p3 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Detected genes") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test3, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test4 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(nCells ~ Wrinkles, alternative = "less", ref.group = "None") %>% + add_significance("p") + stat.test4 <- stat.test4 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p4 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = nCells, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Nuclei detected (DAPI)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test4, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + stat.test5 <- sobj@meta.data %>% + group_by(Layers) %>% + wilcox_test(percent_reads_LG ~ Wrinkles, alternative = "greater", ref.group = "None") %>% + add_significance("p") + stat.test5 <- stat.test5 %>% + add_xy_position(x = "Layers", dodge = 0.8) + p5 <- ggplot(sobj@meta.data) + + geom_boxplot(aes(x = Layers, y = percent_reads_LG, fill = Wrinkles), outlier.size = 0.4) + + theme_classic() + + ylab("Percent reads (Largest gene)") + + guides(fill = guide_legend(title = "Artifact")) + + ggtitle(title) + + stat_pvalue_manual( + stat.test5, + label = "{p.signif}", + tip.length = 0, hide.ns = TRUE + ) + + list(p0, p1, p2, p3, p4, p5) } mdw_plot_1 <- make_metadata_wrinkles_plots(Br6522_ant, "Br6522 Anterior") mdw_plot_2 <- make_metadata_wrinkles_plots(Br6522_mid, "Br6522 Middle") mdw_plot_3 <- make_metadata_wrinkles_plots(Br8667_post, "Br8667 Posterior") -get_legend<-function(myggplot){ - tmp <- ggplot_gtable(ggplot_build(myggplot)) - leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") - legend <- tmp$grobs[[leg]] - return(legend) +get_legend <- function(myggplot) { + tmp <- ggplot_gtable(ggplot_build(myggplot)) + leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") + legend <- tmp$grobs[[leg]] + return(legend) } mdw_legend_1 <- get_legend(mdw_plot_1[[2]]) mdw_legend_2 <- get_legend(mdw_plot_2[[2]]) mdw_legend_3 <- get_legend(mdw_plot_3[[2]]) -mdw_plot_1[[2]] <- mdw_plot_1[[2]] + theme(legend.position="none") -mdw_plot_1[[3]] <- mdw_plot_1[[3]] + theme(legend.position="none") -mdw_plot_1[[4]] <- mdw_plot_1[[4]] + theme(legend.position="none") -mdw_plot_1[[5]] <- mdw_plot_1[[5]] + theme(legend.position="none") -mdw_plot_1[[6]] <- mdw_plot_1[[6]] + theme(legend.position="none") +mdw_plot_1[[2]] <- mdw_plot_1[[2]] + theme(legend.position = "none") +mdw_plot_1[[3]] <- mdw_plot_1[[3]] + theme(legend.position = "none") +mdw_plot_1[[4]] <- mdw_plot_1[[4]] + theme(legend.position = "none") +mdw_plot_1[[5]] <- mdw_plot_1[[5]] + theme(legend.position = "none") +mdw_plot_1[[6]] <- mdw_plot_1[[6]] + theme(legend.position = "none") -mdw_plot_2[[2]] <- mdw_plot_2[[2]] + theme(legend.position="none") -mdw_plot_2[[3]] <- mdw_plot_2[[3]] + theme(legend.position="none") -mdw_plot_2[[4]] <- mdw_plot_2[[4]] + theme(legend.position="none") -mdw_plot_2[[5]] <- mdw_plot_2[[5]] + theme(legend.position="none") -mdw_plot_2[[6]] <- mdw_plot_2[[6]] + theme(legend.position="none") +mdw_plot_2[[2]] <- mdw_plot_2[[2]] + theme(legend.position = "none") +mdw_plot_2[[3]] <- mdw_plot_2[[3]] + theme(legend.position = "none") +mdw_plot_2[[4]] <- mdw_plot_2[[4]] + theme(legend.position = "none") +mdw_plot_2[[5]] <- mdw_plot_2[[5]] + theme(legend.position = "none") +mdw_plot_2[[6]] <- mdw_plot_2[[6]] + theme(legend.position = "none") -mdw_plot_3[[2]] <- mdw_plot_3[[2]] + theme(legend.position="none") -mdw_plot_3[[3]] <- mdw_plot_3[[3]] + theme(legend.position="none") -mdw_plot_3[[4]] <- mdw_plot_3[[4]] + theme(legend.position="none") -mdw_plot_3[[5]] <- mdw_plot_3[[5]] + theme(legend.position="none") -mdw_plot_3[[6]] <- mdw_plot_3[[6]] + theme(legend.position="none") +mdw_plot_3[[2]] <- mdw_plot_3[[2]] + theme(legend.position = "none") +mdw_plot_3[[3]] <- mdw_plot_3[[3]] + theme(legend.position = "none") +mdw_plot_3[[4]] <- mdw_plot_3[[4]] + theme(legend.position = "none") +mdw_plot_3[[5]] <- mdw_plot_3[[5]] + theme(legend.position = "none") +mdw_plot_3[[6]] <- mdw_plot_3[[6]] + theme(legend.position = "none") Br6522_ant$subject <- "Br6522 anterior" Br6522_mid$subject <- "Br6522 middle" @@ -399,63 +504,85 @@ Br8667_post$subject <- "Br8667 posterior" combined_metadata <- rbind(Br6522_ant@meta.data, Br6522_mid@meta.data, Br8667_post@meta.data) combined_metadata$sample <- combined_metadata$subject combined_metadata$sample[combined_metadata$is_wrinkle] <- paste(combined_metadata$sample[combined_metadata$is_wrinkle], "(artifact)") -combined_metadata$sample <- factor(combined_metadata$sample, levels = c("Br8667 posterior", "Br8667 posterior (artifact)", - "Br6522 middle", "Br6522 middle (artifact)", - "Br6522 anterior", "Br6522 anterior (artifact)")) +combined_metadata$sample <- factor(combined_metadata$sample, levels = c( + "Br8667 posterior", "Br8667 posterior (artifact)", + "Br6522 middle", "Br6522 middle (artifact)", + "Br6522 anterior", "Br6522 anterior (artifact)" +)) stat.test1 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(nCount_Spatial ~ sample, alternative = "less") %>% - add_significance("p") -stat.test1 <- stat.test1 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(nCount_Spatial ~ sample, alternative = "less") %>% + add_significance("p") +stat.test1 <- stat.test1 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test1$group_combined <- paste(stat.test1$group1, stat.test1$group2, sep = "-") stat.test1 <- stat.test1[stat.test1$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] -p1 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10))+ - ylab("Library Size") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test1, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) +p1 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = nCount_Spatial, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("Library Size") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test1, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) stat.test2 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(nFeature_Spatial ~ sample, alternative = "less") %>% - add_significance("p") -stat.test2 <- stat.test2 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(nFeature_Spatial ~ sample, alternative = "less") %>% + add_significance("p") +stat.test2 <- stat.test2 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test2$group_combined <- paste(stat.test2$group1, stat.test2$group2, sep = "-") stat.test2 <- stat.test2[stat.test2$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] -p2 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10)) + - ylab("Number of detected genes") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test2, label = "{p.adj.signif}",tip.length = 0, hide.ns = TRUE) +p2 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = nFeature_Spatial, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("Number of detected genes") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test2, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) stat.test3 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(percent.mt ~ sample, alternative = "greater") %>% - add_significance("p") -stat.test3 <- stat.test3 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(percent.mt ~ sample, alternative = "greater") %>% + add_significance("p") +stat.test3 <- stat.test3 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test3$group_combined <- paste(stat.test3$group1, stat.test3$group2, sep = "-") stat.test3 <- stat.test3[stat.test3$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] -p3 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = percent.mt, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10)) + - ylab("Percent mito") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test3, label = "{p.adj.signif}",tip.length = 0, hide.ns = TRUE) +p3 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = percent.mt, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("Percent mito") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test3, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) stat.test4 <- combined_metadata %>% - group_by(Layers) %>% - wilcox_test(nCells ~ sample, alternative = "less") %>% - add_significance("p") -stat.test4 <- stat.test4 %>% - add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") + group_by(Layers) %>% + wilcox_test(nCells ~ sample, alternative = "less") %>% + add_significance("p") +stat.test4 <- stat.test4 %>% + add_xy_position(x = "Layers", dodge = 0.8, fun = "median_mad") stat.test4$group_combined <- paste(stat.test4$group1, stat.test4$group2, sep = "-") stat.test4 <- stat.test4[stat.test4$group_combined %in% c("Br6522 anterior-Br6522 anterior (artifact)", "Br6522 middle-Br6522 middle (artifact)", "Br8667 posterior-Br8667 posterior (artifact)"), ] stat.test4$y.position <- stat.test4$y.position + 25 -p4 <- ggplot(combined_metadata) + geom_boxplot(aes(x = Layers, y = nCells, fill = sample),outlier.shape = NA) + - theme_classic() + guides(fill=guide_legend(title="Spot category")) + theme(legend.direction="horizontal", axis.title.y = element_text(size = 10)) + - ylab("#Cells (Vistoseg)") + xlab("") + scale_fill_brewer(palette = "Paired") + - stat_pvalue_manual(stat.test4, label = "{p.adj.signif}",tip.length = 0, hide.ns = TRUE) +p4 <- ggplot(combined_metadata) + + geom_boxplot(aes(x = Layers, y = nCells, fill = sample), outlier.shape = NA) + + theme_classic() + + guides(fill = guide_legend(title = "Spot category")) + + theme(legend.direction = "horizontal", axis.title.y = element_text(size = 10)) + + ylab("#Cells (Vistoseg)") + + xlab("") + + scale_fill_brewer(palette = "Paired") + + stat_pvalue_manual(stat.test4, label = "{p.adj.signif}", tip.length = 0, hide.ns = TRUE) qc_legend <- get_legend(p1) @@ -475,16 +602,21 @@ pdf(file = "/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/legend_QC.pdf", plot_grid(qc_legend) dev.off() -ggplotRegression <- function (fit, x, y) { - require(ggplot2) - ggplot(fit$model, aes_string(x = names(fit$model)[2], y = names(fit$model)[1])) + - geom_point() + - stat_smooth(method = "lm", col = "red") + - labs(title = paste("Adj R2 = ",signif(summary(fit)$adj.r.squared, 5), - "Intercept =",signif(fit$coef[[1]],5 ), - " Slope =",signif(fit$coef[[2]], 5), - " P =",signif(summary(fit)$coef[2,4], 5))) + theme_classic() + - xlab(x) + ylab(y) + theme(plot.title = element_text(size = 10), axis.title = element_text(size = 10)) +ggplotRegression <- function(fit, x, y) { + require(ggplot2) + ggplot(fit$model, aes_string(x = names(fit$model)[2], y = names(fit$model)[1])) + + geom_point() + + stat_smooth(method = "lm", col = "red") + + labs(title = paste( + "Adj R2 = ", signif(summary(fit)$adj.r.squared, 5), + "Intercept =", signif(fit$coef[[1]], 5), + " Slope =", signif(fit$coef[[2]], 5), + " P =", signif(summary(fit)$coef[2, 4], 5) + )) + + theme_classic() + + xlab(x) + + ylab(y) + + theme(plot.title = element_text(size = 10), axis.title = element_text(size = 10)) } fit_wrinkle <- lm(nCount_Spatial ~ nCells, Br6522_ant@meta.data[Br6522_ant$is_wrinkle, ]) @@ -500,21 +632,30 @@ fit_normal <- lm(nCount_Spatial ~ nCells, Br8667_post@meta.data[!Br8667_post$is_ plot_grid(ggplotRegression(fit_normal, "Number of cells", "Library size"), ggplotRegression(fit_wrinkle, "Number of cells", "Library size"), nrow = 2) set.seed(100) -make_plots <- function(data){ - gene_attr <- data.frame(mean = rowMeans(data), detection_rate = rowMeans(data > 0), var = apply(data, 1, var)) - gene_attr$log_mean <- log10(gene_attr$mean) - gene_attr$log_var <- log10(gene_attr$var) - rownames(gene_attr) <- rownames(data) - cell_attr <- data.frame(n_umi = colSums(data), n_gene = colSums(data > 0)) - rownames(cell_attr) <- colnames(data) - p1 <- ggplot(gene_attr, aes(log_mean, log_var)) + geom_point(alpha = 0.3, shape = 16) + - geom_density_2d(size = 0.3) + geom_abline(intercept = 0, slope = 1, color = "red")+ theme_classic() - x = seq(from = -3, to = 2, length.out = 1000) - poisson_model <- data.frame(log_mean = x, detection_rate = 1 - dpois(0, lambda = 10^x)) - p2 <- ggplot(gene_attr, aes(log_mean, detection_rate)) + geom_point(alpha = 0.3, shape = 16) + - geom_line(data = poisson_model, color = "red") + theme_gray(base_size = 8) + theme_classic() - p3 <- ggplot(cell_attr, aes(n_umi, n_gene)) + geom_point(alpha = 0.3, shape = 16) + geom_density_2d(size = 0.3) + theme_classic() - p1 + p2 + p3 +make_plots <- function(data) { + gene_attr <- data.frame(mean = rowMeans(data), detection_rate = rowMeans(data > 0), var = apply(data, 1, var)) + gene_attr$log_mean <- log10(gene_attr$mean) + gene_attr$log_var <- log10(gene_attr$var) + rownames(gene_attr) <- rownames(data) + cell_attr <- data.frame(n_umi = colSums(data), n_gene = colSums(data > 0)) + rownames(cell_attr) <- colnames(data) + p1 <- ggplot(gene_attr, aes(log_mean, log_var)) + + geom_point(alpha = 0.3, shape = 16) + + geom_density_2d(size = 0.3) + + geom_abline(intercept = 0, slope = 1, color = "red") + + theme_classic() + x <- seq(from = -3, to = 2, length.out = 1000) + poisson_model <- data.frame(log_mean = x, detection_rate = 1 - dpois(0, lambda = 10^x)) + p2 <- ggplot(gene_attr, aes(log_mean, detection_rate)) + + geom_point(alpha = 0.3, shape = 16) + + geom_line(data = poisson_model, color = "red") + + theme_gray(base_size = 8) + + theme_classic() + p3 <- ggplot(cell_attr, aes(n_umi, n_gene)) + + geom_point(alpha = 0.3, shape = 16) + + geom_density_2d(size = 0.3) + + theme_classic() + p1 + p2 + p3 } geneData <- readRDS("/data/abattle4/prashanthi/dewrinkler/data/gene_df.rds") @@ -525,9 +666,9 @@ Br6522_ant@assays$Spatial@meta.features$geneType <- geneData$gene_type Br6522_mid@assays$Spatial@meta.features$geneType <- geneData$gene_type Br8667_post@assays$Spatial@meta.features$geneType <- geneData$gene_type -Br6522_ant@assays$Spatial@meta.features$pCells <- Br6522_ant@assays$Spatial@meta.features$nCells/dim(Br6522_ant)[2] -Br6522_mid@assays$Spatial@meta.features$pCells <- Br6522_mid@assays$Spatial@meta.features$nCells/dim(Br6522_mid)[2] -Br8667_post@assays$Spatial@meta.features$pCells <- Br8667_post@assays$Spatial@meta.features$nCells/dim(Br8667_post)[2] +Br6522_ant@assays$Spatial@meta.features$pCells <- Br6522_ant@assays$Spatial@meta.features$nCells / dim(Br6522_ant)[2] +Br6522_mid@assays$Spatial@meta.features$pCells <- Br6522_mid@assays$Spatial@meta.features$nCells / dim(Br6522_mid)[2] +Br8667_post@assays$Spatial@meta.features$pCells <- Br8667_post@assays$Spatial@meta.features$nCells / dim(Br8667_post)[2] # Apply QC filters # Gene level QC @@ -551,9 +692,9 @@ Br6522_ant_normal@assays$Spatial@meta.features$nCells <- rowSums(Br6522_ant_norm Br6522_mid_normal@assays$Spatial@meta.features$nCells <- rowSums(Br6522_mid_normal@assays$Spatial@counts > 0) Br8667_post_normal@assays$Spatial@meta.features$nCells <- rowSums(Br8667_post_normal@assays$Spatial@counts > 0) -Br6522_ant_normal@assays$Spatial@meta.features$pCells <- Br6522_ant_normal@assays$Spatial@meta.features$nCells/dim(Br6522_ant_normal)[2] -Br6522_mid_normal@assays$Spatial@meta.features$pCells <- Br6522_mid_normal@assays$Spatial@meta.features$nCells/dim(Br6522_mid_normal)[2] -Br8667_post_normal@assays$Spatial@meta.features$pCells <- Br8667_post_normal@assays$Spatial@meta.features$nCells/dim(Br8667_post_normal)[2] +Br6522_ant_normal@assays$Spatial@meta.features$pCells <- Br6522_ant_normal@assays$Spatial@meta.features$nCells / dim(Br6522_ant_normal)[2] +Br6522_mid_normal@assays$Spatial@meta.features$pCells <- Br6522_mid_normal@assays$Spatial@meta.features$nCells / dim(Br6522_mid_normal)[2] +Br8667_post_normal@assays$Spatial@meta.features$pCells <- Br8667_post_normal@assays$Spatial@meta.features$nCells / dim(Br8667_post_normal)[2] Br6522_ant_normal <- Br6522_ant_normal[Br6522_ant_normal@assays$Spatial@meta.features$pCells >= 0.05, ] Br6522_mid_normal <- Br6522_mid_normal[Br6522_mid_normal@assays$Spatial@meta.features$pCells >= 0.05, ] @@ -575,93 +716,133 @@ make_plots(Br6522_ant_normal_data) make_plots(Br6522_mid_normal_data) make_plots(Br8667_post_normal_data) -Br6522_ant_normal_vst_out <- sctransform::vst(Br6522_ant_normal_data,latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br6522_mid_normal_vst_out <- sctransform::vst(Br6522_mid_normal_data, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br8667_post_normal_vst_out <- sctransform::vst(Br8667_post_normal_data, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) +Br6522_ant_normal_vst_out <- sctransform::vst(Br6522_ant_normal_data, + latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_mid_normal_vst_out <- sctransform::vst(Br6522_mid_normal_data, + latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br8667_post_normal_vst_out <- sctransform::vst(Br8667_post_normal_data, + latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) Br6522_ant_additional_params <- data.frame(Br6522_ant$is_wrinkle) colnames(Br6522_ant_additional_params) <- "is_wrinkle" -Br6522_ant_all_vst_out <- sctransform::vst(Br6522_ant_all_data, cell_attr = Br6522_ant_additional_params,latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br6522_ant_all_vst_out_libSize_only <- sctransform::vst(Br6522_ant_all_data, cell_attr = Br6522_ant_additional_params,latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br6522_ant_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_ant_all_data, cell_attr = Br6522_ant_additional_params,latent_var = c("is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) +Br6522_ant_all_vst_out <- sctransform::vst(Br6522_ant_all_data, + cell_attr = Br6522_ant_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_ant_all_vst_out_libSize_only <- sctransform::vst(Br6522_ant_all_data, + cell_attr = Br6522_ant_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_ant_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_ant_all_data, + cell_attr = Br6522_ant_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) Br6522_mid_additional_params <- data.frame(Br6522_mid$is_wrinkle) colnames(Br6522_mid_additional_params) <- "is_wrinkle" -Br6522_mid_all_vst_out <- sctransform::vst(Br6522_mid_all_data, cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br6522_mid_all_vst_out_libSize_only <- sctransform::vst(Br6522_mid_all_data, cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br6522_mid_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_mid_all_data, cell_attr = Br6522_mid_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) +Br6522_mid_all_vst_out <- sctransform::vst(Br6522_mid_all_data, + cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_mid_all_vst_out_libSize_only <- sctransform::vst(Br6522_mid_all_data, + cell_attr = Br6522_mid_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br6522_mid_all_vst_out_wrinkle_only <- sctransform::vst(Br6522_mid_all_data, + cell_attr = Br6522_mid_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) Br8667_post_additional_params <- data.frame(Br8667_post$is_wrinkle) colnames(Br8667_post_additional_params) <- "is_wrinkle" -Br8667_post_all_vst_out <- sctransform::vst(Br8667_post_all_data, cell_attr = Br8667_post_additional_params,latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE, n_genes = NULL, verbosity = 1) -Br8667_post_all_vst_out_libSize_only <- sctransform::vst(Br8667_post_all_data, cell_attr = Br8667_post_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) -Br8667_post_all_vst_out_wrinkle_only <- sctransform::vst(Br8667_post_all_data, cell_attr = Br8667_post_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, - return_cell_attr = TRUE,n_genes = NULL, verbosity = 1) +Br8667_post_all_vst_out <- sctransform::vst(Br8667_post_all_data, + cell_attr = Br8667_post_additional_params, latent_var = c("log_umi", "is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br8667_post_all_vst_out_libSize_only <- sctransform::vst(Br8667_post_all_data, + cell_attr = Br8667_post_additional_params, latent_var = c("log_umi"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) +Br8667_post_all_vst_out_wrinkle_only <- sctransform::vst(Br8667_post_all_data, + cell_attr = Br8667_post_additional_params, latent_var = c("is_wrinkle"), return_gene_attr = TRUE, + return_cell_attr = TRUE, n_genes = NULL, verbosity = 1 +) sctransform::plot_model_pars(Br6522_ant_normal_vst_out, show_theta = TRUE) sctransform::plot_model_pars(Br6522_mid_normal_vst_out, show_theta = TRUE) sctransform::plot_model_pars(Br8667_post_normal_vst_out, show_theta = TRUE) -make_compare_plots <- function(vst_out, vst_out_wrinkle_only, sample_label){ - wrinkle_only_params_df <- data.frame(rbind(cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars, "Single gene estimate"), - cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars_fit, "Regularized"))) - colnames(wrinkle_only_params_df)[1] <- "gmean" - colnames(wrinkle_only_params_df)[5] <- "estimate_type" - wrinkle_only_params_df$gmean <- as.numeric(wrinkle_only_params_df$gmean) - wrinkle_only_params_df$theta <- as.numeric(wrinkle_only_params_df$theta) - wrinkle_only_params_df$X.Intercept. <- as.numeric(wrinkle_only_params_df$X.Intercept.) - wrinkle_only_params_df$is_wrinkleTRUE <- as.numeric(wrinkle_only_params_df$is_wrinkleTRUE) - wrinkle_only_params_df$estimate_type <- factor(wrinkle_only_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) - wrinkle_only_params_df$gmean <- log10(wrinkle_only_params_df$gmean) - p0 <- ggplot(wrinkle_only_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + - geom_point(alpha = 0.5, size = 0.7) + theme_classic() + - xlab("Geometric mean of gene [log10]") + ylab(expression(beta[2])) + geom_hline(yintercept = 0, lty = 2, color = "black") + - guides(colour=guide_legend(title= "Estimate type")) + theme(axis.title.x = element_text(size = 10)) - - all_params_df <- data.frame(rbind(cbind(vst_out$gene_attr$gmean, vst_out$model_pars, "Single gene estimate"), cbind(vst_out$gene_attr$gmean, vst_out$model_pars_fit, "Regularized"))) - colnames(all_params_df)[1] <- "gmean" - colnames(all_params_df)[6] <- "estimate_type" - all_params_df$gmean <- as.numeric(all_params_df$gmean) - all_params_df$theta <- as.numeric(all_params_df$theta) - all_params_df$X.Intercept. <- as.numeric(all_params_df$X.Intercept.) - all_params_df$log_umi <- as.numeric(all_params_df$log_umi) - all_params_df$is_wrinkleTRUE <- as.numeric(all_params_df$is_wrinkleTRUE) - all_params_df$estimate_type <- factor(all_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) - all_params_df$gmean <- log10(all_params_df$gmean) - p1 <- ggplot(all_params_df, aes(x = gmean, y = log_umi, colour = estimate_type)) + - geom_point(alpha = 0.5, size = 0.7) + theme_classic() + - xlab("Geometric mean of gene [log10]") + ylab(expression(beta[1])) + guides(colour=guide_legend(title= "Estimate type")) + - theme(axis.title.x = element_text(size = 10)) + geom_hline(yintercept = 0, lty = 2, color = "black") - p2 <- ggplot(all_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + - geom_point(alpha = 0.5, size = 0.7) + theme_classic() + - xlab("Geometric mean of gene [log10]") + ylab(expression(beta[2])) + guides(colour=guide_legend(title= "Estimate type")) + - theme(axis.title.x = element_text(size = 10)) + geom_hline(yintercept = 0, lty = 2, color = "black") - estimate_type_legend <- get_legend(p0) - p0 <- p0 + theme(legend.position = "none") - p1 <- p1 + theme(legend.position = "none") - p2 <- p2 + theme(legend.position = "none") - - title_model_1 <- ggdraw() + draw_label(expression("Model 1: log(E["~x[i]~"])" == ~ beta[0] ~ + ~ beta[2] ~ w), size = 12) - title_model_2 <- ggdraw() + draw_label(expression("Model 2: log(E["~x[i]~"])" == ~ beta[0] ~ + ~ beta[1] ~ m ~ + ~ beta[2] ~ w), size = 12) - sample_name <- ggdraw() + draw_label(sample_label, size = 12) - - plot_grid(sample_name, - plot_grid(title_model_1, title_model_2, p0, plot_grid(p2, p1), rel_heights = c(1, 5), rel_widths = c(1, 2)), - estimate_type_legend, rel_widths = c(1, 6, 1), nrow = 1) +make_compare_plots <- function(vst_out, vst_out_wrinkle_only, sample_label) { + wrinkle_only_params_df <- data.frame(rbind( + cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars, "Single gene estimate"), + cbind(vst_out_wrinkle_only$gene_attr$gmean, vst_out_wrinkle_only$model_pars_fit, "Regularized") + )) + colnames(wrinkle_only_params_df)[1] <- "gmean" + colnames(wrinkle_only_params_df)[5] <- "estimate_type" + wrinkle_only_params_df$gmean <- as.numeric(wrinkle_only_params_df$gmean) + wrinkle_only_params_df$theta <- as.numeric(wrinkle_only_params_df$theta) + wrinkle_only_params_df$X.Intercept. <- as.numeric(wrinkle_only_params_df$X.Intercept.) + wrinkle_only_params_df$is_wrinkleTRUE <- as.numeric(wrinkle_only_params_df$is_wrinkleTRUE) + wrinkle_only_params_df$estimate_type <- factor(wrinkle_only_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) + wrinkle_only_params_df$gmean <- log10(wrinkle_only_params_df$gmean) + p0 <- ggplot(wrinkle_only_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + + geom_point(alpha = 0.5, size = 0.7) + + theme_classic() + + xlab("Geometric mean of gene [log10]") + + ylab(expression(beta[2])) + + geom_hline(yintercept = 0, lty = 2, color = "black") + + guides(colour = guide_legend(title = "Estimate type")) + + theme(axis.title.x = element_text(size = 10)) + + all_params_df <- data.frame(rbind(cbind(vst_out$gene_attr$gmean, vst_out$model_pars, "Single gene estimate"), cbind(vst_out$gene_attr$gmean, vst_out$model_pars_fit, "Regularized"))) + colnames(all_params_df)[1] <- "gmean" + colnames(all_params_df)[6] <- "estimate_type" + all_params_df$gmean <- as.numeric(all_params_df$gmean) + all_params_df$theta <- as.numeric(all_params_df$theta) + all_params_df$X.Intercept. <- as.numeric(all_params_df$X.Intercept.) + all_params_df$log_umi <- as.numeric(all_params_df$log_umi) + all_params_df$is_wrinkleTRUE <- as.numeric(all_params_df$is_wrinkleTRUE) + all_params_df$estimate_type <- factor(all_params_df$estimate_type, levels = c("Regularized", "Single gene estimate")) + all_params_df$gmean <- log10(all_params_df$gmean) + p1 <- ggplot(all_params_df, aes(x = gmean, y = log_umi, colour = estimate_type)) + + geom_point(alpha = 0.5, size = 0.7) + + theme_classic() + + xlab("Geometric mean of gene [log10]") + + ylab(expression(beta[1])) + + guides(colour = guide_legend(title = "Estimate type")) + + theme(axis.title.x = element_text(size = 10)) + + geom_hline(yintercept = 0, lty = 2, color = "black") + p2 <- ggplot(all_params_df, aes(x = gmean, y = is_wrinkleTRUE, colour = estimate_type)) + + geom_point(alpha = 0.5, size = 0.7) + + theme_classic() + + xlab("Geometric mean of gene [log10]") + + ylab(expression(beta[2])) + + guides(colour = guide_legend(title = "Estimate type")) + + theme(axis.title.x = element_text(size = 10)) + + geom_hline(yintercept = 0, lty = 2, color = "black") + estimate_type_legend <- get_legend(p0) + p0 <- p0 + theme(legend.position = "none") + p1 <- p1 + theme(legend.position = "none") + p2 <- p2 + theme(legend.position = "none") + + title_model_1 <- ggdraw() + draw_label(expression("Model 1: log(E[" ~ x[i] ~ "])" == ~ beta[0] ~ +~ beta[2] ~ w), size = 12) + title_model_2 <- ggdraw() + draw_label(expression("Model 2: log(E[" ~ x[i] ~ "])" == ~ beta[0] ~ +~ beta[1] ~ m ~ +~ beta[2] ~ w), size = 12) + sample_name <- ggdraw() + draw_label(sample_label, size = 12) + + plot_grid(sample_name, + plot_grid(title_model_1, title_model_2, p0, plot_grid(p2, p1), rel_heights = c(1, 5), rel_widths = c(1, 2)), + estimate_type_legend, + rel_widths = c(1, 6, 1), nrow = 1 + ) } p1 <- make_compare_plots(Br6522_ant_all_vst_out, Br6522_ant_all_vst_out_wrinkle_only, "Br6522 Anterior") @@ -677,41 +858,49 @@ pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br8667_post_NB_regressi p3 dev.off() -plot_params <- function(normal_vst_out, all_vst_out, title){ - common.genes <- intersect(rownames(normal_vst_out$model_pars), rownames(all_vst_out$model_pars)) - normal_params <- normal_vst_out$model_pars - normal_params_fit <- normal_vst_out$model_pars_fit - all_params <- all_vst_out$model_pars - all_params_fit <- all_vst_out$model_pars_fit - normal_params <- normal_params[match(common.genes, rownames(normal_params)), ] - normal_params_fit <- normal_params_fit[match(common.genes, rownames(normal_params_fit)), ] - all_params <- all_params[match(common.genes, rownames(all_params)), ] - all_params_fit <- all_params_fit[match(common.genes, rownames(all_params_fit)), ] - plot_df <- data.frame("Normal_intercept" = normal_params[ ,2], - "Normal_intercept_regularized" = normal_params_fit[ ,2], - "All_intercept" = all_params[ ,2], - "All_intercept_regularized" = all_params_fit[ ,2]) - - ggplot(plot_df) + geom_point(aes(x = Normal_intercept, y = All_intercept, colour = "Single gene estimate"), alpha = 0.5) + - geom_point(aes(x = Normal_intercept_regularized, y = All_intercept_regularized, colour = "Regularized"), alpha = 0.5) + geom_abline(slope = 1, intercept = 0, lty = 2) + - theme_classic() + xlab("Intercept (excl. artifacts)") + ylab("Intercept") + ggtitle(title) + - scale_colour_manual(name = "Estimate type", values = c("Regularized" = "#F8766D", "Single gene estimate" = "#00BFC4")) + - theme(plot.title = element_text(face = "bold", size = 14), axis.title = element_text(size = 12), legend.title = element_text(size = 12), - legend.text = element_text(size = 10)) +plot_params <- function(normal_vst_out, all_vst_out, title) { + common.genes <- intersect(rownames(normal_vst_out$model_pars), rownames(all_vst_out$model_pars)) + normal_params <- normal_vst_out$model_pars + normal_params_fit <- normal_vst_out$model_pars_fit + all_params <- all_vst_out$model_pars + all_params_fit <- all_vst_out$model_pars_fit + normal_params <- normal_params[match(common.genes, rownames(normal_params)), ] + normal_params_fit <- normal_params_fit[match(common.genes, rownames(normal_params_fit)), ] + all_params <- all_params[match(common.genes, rownames(all_params)), ] + all_params_fit <- all_params_fit[match(common.genes, rownames(all_params_fit)), ] + plot_df <- data.frame( + "Normal_intercept" = normal_params[, 2], + "Normal_intercept_regularized" = normal_params_fit[, 2], + "All_intercept" = all_params[, 2], + "All_intercept_regularized" = all_params_fit[, 2] + ) + + ggplot(plot_df) + + geom_point(aes(x = Normal_intercept, y = All_intercept, colour = "Single gene estimate"), alpha = 0.5) + + geom_point(aes(x = Normal_intercept_regularized, y = All_intercept_regularized, colour = "Regularized"), alpha = 0.5) + + geom_abline(slope = 1, intercept = 0, lty = 2) + + theme_classic() + + xlab("Intercept (excl. artifacts)") + + ylab("Intercept") + + ggtitle(title) + + scale_colour_manual(name = "Estimate type", values = c("Regularized" = "#F8766D", "Single gene estimate" = "#00BFC4")) + + theme( + plot.title = element_text(face = "bold", size = 14), axis.title = element_text(size = 12), legend.title = element_text(size = 12), + legend.text = element_text(size = 10) + ) } -p <- plot_params(Br6522_ant_normal_vst_out, Br6522_ant_all_vst_out_libSize_only, "Br6522 Anterior") +p <- plot_params(Br6522_ant_normal_vst_out, Br6522_ant_all_vst_out_libSize_only, "Br6522 Anterior") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br6522_ant_intercept.pdf", width = 7, height = 5) p dev.off() -p <- plot_params(Br6522_mid_normal_vst_out, Br6522_mid_all_vst_out_libSize_only, "Br6522 Middle") +p <- plot_params(Br6522_mid_normal_vst_out, Br6522_mid_all_vst_out_libSize_only, "Br6522 Middle") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br6522_mid_intercept.pdf", width = 7, height = 5) p dev.off() -p <- plot_params(Br8667_post_normal_vst_out, Br8667_post_all_vst_out_libSize_only, "Br8667 Posterior") +p <- plot_params(Br8667_post_normal_vst_out, Br8667_post_all_vst_out_libSize_only, "Br8667 Posterior") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br8667_post_intercept.pdf", width = 7, height = 5) p dev.off() - diff --git a/code/qc_artifact/qc_spot_artifact.R b/code/qc_artifact/qc_spot_artifact.R index 2eea851d..eaa8c662 100644 --- a/code/qc_artifact/qc_spot_artifact.R +++ b/code/qc_artifact/qc_spot_artifact.R @@ -13,29 +13,35 @@ library(harmony) library(dplyr) # Read in the data datDir <- "/home/pravich2/scratch16-abattle4/prashanthi/dewrinkler/processed-data/" -Br6522_ant <- read10xVisiumWrapper(samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_ant_manual_alignment_all/outs/"), - sample_id = "Br6522_ant", - type = "sparse", - data = "filtered", - images = c("lowres", "hires", "detected", "aligned"), - load = TRUE, - reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf") - -Br6522_mid <- read10xVisiumWrapper(samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_mid_manual_alignment_all/outs/"), - sample_id = "Br6522_mid", - type = "sparse", - data = "filtered", - images = c("lowres", "hires", "detected", "aligned"), - load = TRUE, - reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf") - -Br8667_post <- read10xVisiumWrapper(samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br8667_post_manual_alignment_all/outs/"), - sample_id = "Br8667_post", - type = "sparse", - data = "filtered", - images = c("lowres", "hires", "detected", "aligned"), - load = TRUE, - reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf") +Br6522_ant <- read10xVisiumWrapper( + samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_ant_manual_alignment_all/outs/"), + sample_id = "Br6522_ant", + type = "sparse", + data = "filtered", + images = c("lowres", "hires", "detected", "aligned"), + load = TRUE, + reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf" +) + +Br6522_mid <- read10xVisiumWrapper( + samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br6522_mid_manual_alignment_all/outs/"), + sample_id = "Br6522_mid", + type = "sparse", + data = "filtered", + images = c("lowres", "hires", "detected", "aligned"), + load = TRUE, + reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf" +) + +Br8667_post <- read10xVisiumWrapper( + samples = paste0(datDir, "NextSeq/Round3/DLPFC_Br8667_post_manual_alignment_all/outs/"), + sample_id = "Br8667_post", + type = "sparse", + data = "filtered", + images = c("lowres", "hires", "detected", "aligned"), + load = TRUE, + reference_gtf = "/data/abattle4/prashanthi/dewrinkler/data/genes.gtf" +) Br6522_ant$subject <- "Br6522" Br6522_ant$diagnosis <- "control" @@ -86,33 +92,33 @@ Br6522_ant_spot_counts <- Br6522_ant_spot_counts[match(colnames(Br6522_ant), Br6 Br6522_mid_spot_counts <- Br6522_mid_spot_counts[match(colnames(Br6522_mid), Br6522_mid_spot_counts$barcode), ] Br8667_post_spot_counts <- Br8667_post_spot_counts[match(colnames(Br8667_post), Br8667_post_spot_counts$barcode), ] -Br6522_ant_spot_counts <- Br6522_ant_spot_counts[ ,colnames(Br6522_ant_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] -Br6522_mid_spot_counts <- Br6522_mid_spot_counts[ ,colnames(Br6522_mid_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] -Br8667_post_spot_counts <- Br8667_post_spot_counts[ ,colnames(Br8667_post_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] +Br6522_ant_spot_counts <- Br6522_ant_spot_counts[, colnames(Br6522_ant_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] +Br6522_mid_spot_counts <- Br6522_mid_spot_counts[, colnames(Br6522_mid_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] +Br8667_post_spot_counts <- Br8667_post_spot_counts[, colnames(Br8667_post_spot_counts) %in% c("barcode", "tissue", "row", "col", "imagerow", "imagecol")] colData(Br6522_ant) <- cbind(colData(Br6522_ant), Br6522_ant_spot_counts) colData(Br6522_mid) <- cbind(colData(Br6522_mid), Br6522_mid_spot_counts) colData(Br8667_post) <- cbind(colData(Br8667_post), Br8667_post_spot_counts) -manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df){ - spots <- colnames(sobj) - layers <- c() - wrinkle <- c() - for(i in c(1:length(spots))){ - if(spots[i] %in% layers_df$spot_name){ - layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] - }else{ - layers[i] <- "Unknown" - } - if(spots[i] %in% wrinkles_df$spot_name){ - wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] - }else{ - wrinkle[i] <- "None" +manually_annotate <- function(sobj, layers_df, wrinkles_df, sc_df) { + spots <- colnames(sobj) + layers <- c() + wrinkle <- c() + for (i in c(1:length(spots))) { + if (spots[i] %in% layers_df$spot_name) { + layers[i] <- layers_df$ManualAnnotation[layers_df$spot_name == spots[i]] + } else { + layers[i] <- "Unknown" + } + if (spots[i] %in% wrinkles_df$spot_name) { + wrinkle[i] <- wrinkles_df$ManualAnnotation[wrinkles_df$spot_name == spots[i]] + } else { + wrinkle[i] <- "None" + } } - } - sobj$Layers <- layers - sobj$Wrinkles <- wrinkle - sobj + sobj$Layers <- layers + sobj$Wrinkles <- wrinkle + sobj } Br6522_ant <- manually_annotate(Br6522_ant, Br6522_ant_layers, Br6522_ant_wrinkles, Br6522_ant_spot_counts) @@ -157,24 +163,25 @@ Br8667_post <- Br8667_post[-no_expr, ] Br8667_post <- Br8667_post[, !Br8667_post@colData$sum_umi == 0] Br6522_ant_qcstats <- perCellQCMetrics(Br6522_ant, subsets = list( - Mito = which(seqnames(Br6522_ant) == "chrM") + Mito = which(seqnames(Br6522_ant) == "chrM") )) Br6522_ant_qcfilter <- quickPerCellQC(Br6522_ant_qcstats, sub.fields = "subsets_Mito_percent") colSums(as.matrix(Br6522_ant_qcfilter)) Br6522_ant$scran_discard <- - factor(Br6522_ant_qcfilter$discard, levels = c("TRUE", "FALSE")) + factor(Br6522_ant_qcfilter$discard, levels = c("TRUE", "FALSE")) Br6522_ant$scran_low_lib_size <- - factor( - isOutlier( - Br6522_ant$sum_umi, - type = "lower", - log = TRUE), - levels = c("TRUE", "FALSE") - ) + factor( + isOutlier( + Br6522_ant$sum_umi, + type = "lower", + log = TRUE + ), + levels = c("TRUE", "FALSE") + ) Br6522_ant$scran_low_n_features <- - factor(Br6522_ant_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) + factor(Br6522_ant_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) Br6522_ant$scran_high_subsets_Mito_percent <- - factor(Br6522_ant_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) + factor(Br6522_ant_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_low_lib_size", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Anterior") plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_low_n_features", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Anterior") @@ -182,24 +189,25 @@ plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_high_s plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "scran_discard", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Anterior") Br6522_mid_qcstats <- perCellQCMetrics(Br6522_mid, subsets = list( - Mito = which(seqnames(Br6522_mid) == "chrM") + Mito = which(seqnames(Br6522_mid) == "chrM") )) Br6522_mid_qcfilter <- quickPerCellQC(Br6522_mid_qcstats, sub.fields = "subsets_Mito_percent") colSums(as.matrix(Br6522_mid_qcfilter)) Br6522_mid$scran_discard <- - factor(Br6522_mid_qcfilter$discard, levels = c("TRUE", "FALSE")) + factor(Br6522_mid_qcfilter$discard, levels = c("TRUE", "FALSE")) Br6522_mid$scran_low_lib_size <- - factor( - isOutlier( - Br6522_mid$sum_umi, - type = "lower", - log = TRUE), - levels = c("TRUE", "FALSE") - ) + factor( + isOutlier( + Br6522_mid$sum_umi, + type = "lower", + log = TRUE + ), + levels = c("TRUE", "FALSE") + ) Br6522_mid$scran_low_n_features <- - factor(Br6522_mid_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) + factor(Br6522_mid_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) Br6522_mid$scran_high_subsets_Mito_percent <- - factor(Br6522_mid_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) + factor(Br6522_mid_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_low_lib_size", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_low_n_features", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") @@ -207,24 +215,25 @@ plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_high_s plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "scran_discard", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") Br8667_post_qcstats <- perCellQCMetrics(Br8667_post, subsets = list( - Mito = which(seqnames(Br8667_post) == "chrM") + Mito = which(seqnames(Br8667_post) == "chrM") )) Br8667_post_qcfilter <- quickPerCellQC(Br8667_post_qcstats, sub.fields = "subsets_Mito_percent") colSums(as.matrix(Br8667_post_qcfilter)) Br8667_post$scran_discard <- - factor(Br8667_post_qcfilter$discard, levels = c("TRUE", "FALSE")) + factor(Br8667_post_qcfilter$discard, levels = c("TRUE", "FALSE")) Br8667_post$scran_low_lib_size <- - factor( - isOutlier( - Br8667_post$sum_umi, - type = "lower", - log = TRUE), - levels = c("TRUE", "FALSE") - ) + factor( + isOutlier( + Br8667_post$sum_umi, + type = "lower", + log = TRUE + ), + levels = c("TRUE", "FALSE") + ) Br8667_post$scran_low_n_features <- - factor(Br8667_post_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) + factor(Br8667_post_qcfilter$low_n_features, levels = c("TRUE", "FALSE")) Br8667_post$scran_high_subsets_Mito_percent <- - factor(Br8667_post_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) + factor(Br8667_post_qcfilter$high_subsets_Mito_percent, levels = c("TRUE", "FALSE")) plotSpots(Br8667_post, x_coord = "row", y_coord = "col", annotate = "scran_low_lib_size", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") plotSpots(Br8667_post, x_coord = "row", y_coord = "col", annotate = "scran_low_n_features", y_reverse = FALSE, palette = c("red", "gray")) + ggtitle("Br6522 Middle") @@ -241,9 +250,9 @@ Br6522_ant_samples <- gsub("_Br6522_ant", "", Br6522_ant_samples) Br6522_mid_samples <- gsub("_Br6522_mid", "", Br6522_mid_samples) Br8667_post_samples <- gsub("_Br8667_post", "", Br8667_post_samples) -Br6522_ant <- Br6522_ant[ ,colnames(Br6522_ant) %in% Br6522_ant_samples] -Br6522_mid <- Br6522_mid[ ,colnames(Br6522_mid) %in% Br6522_mid_samples] -Br8667_post <- Br8667_post[ ,colnames(Br8667_post) %in% Br8667_post_samples] +Br6522_ant <- Br6522_ant[, colnames(Br6522_ant) %in% Br6522_ant_samples] +Br6522_mid <- Br6522_mid[, colnames(Br6522_mid) %in% Br6522_mid_samples] +Br8667_post <- Br8667_post[, colnames(Br8667_post) %in% Br8667_post_samples] plotSpots(Br6522_ant, x_coord = "row", y_coord = "col", annotate = "Layers", y_reverse = FALSE) plotSpots(Br6522_mid, x_coord = "row", y_coord = "col", annotate = "Layers", y_reverse = FALSE) @@ -254,7 +263,7 @@ plotSpots(Br8667_post, x_coord = "row", y_coord = "col", annotate = "Layers", y_ Br6522_ant <- Br6522_ant[!grepl("MALAT1", rownames(Br6522_ant)), ] # Filter Mitocondrial Br6522_ant <- Br6522_ant[!grepl("^MT-", rownames(Br6522_ant)), ] -# Filter Ribosomal +# Filter Ribosomal Br6522_ant <- Br6522_ant[!grepl("^RP[SL]", rownames(Br6522_ant)), ] @@ -262,19 +271,19 @@ Br6522_ant <- Br6522_ant[!grepl("^RP[SL]", rownames(Br6522_ant)), ] Br6522_mid <- Br6522_mid[!grepl("MALAT1", rownames(Br6522_mid)), ] # Filter Mitocondrial Br6522_mid <- Br6522_mid[!grepl("^MT-", rownames(Br6522_mid)), ] -# Filter Ribosomal +# Filter Ribosomal Br6522_mid <- Br6522_mid[!grepl("^RP[SL]", rownames(Br6522_mid)), ] # Filter MALAT1 Br8667_post <- Br8667_post[!grepl("MALAT1", rownames(Br8667_post)), ] # Filter Mitocondrial Br8667_post <- Br8667_post[!grepl("^MT-", rownames(Br8667_post)), ] -# Filter Ribosomal +# Filter Ribosomal Br8667_post <- Br8667_post[!grepl("^RP[SL]", rownames(Br8667_post)), ] -Br6522_ant_normal <- Br6522_ant[ ,Br6522_ant$Wrinkles == "None"] -Br6522_mid_normal <- Br6522_mid[ ,Br6522_mid$Wrinkles == "None"] -Br8667_post_normal <- Br8667_post[ ,Br8667_post$Wrinkles == "None"] +Br6522_ant_normal <- Br6522_ant[, Br6522_ant$Wrinkles == "None"] +Br6522_mid_normal <- Br6522_mid[, Br6522_mid$Wrinkles == "None"] +Br8667_post_normal <- Br8667_post[, Br8667_post$Wrinkles == "None"] # Normalize the count data set.seed(030122) @@ -282,9 +291,9 @@ Br6522_ant$scran_quick_cluster <- quickCluster(Br6522_ant) Br6522_mid$scran_quick_cluster <- quickCluster(Br6522_mid) Br8667_post$scran_quick_cluster <- quickCluster(Br8667_post) -Br6522_ant <- computeSumFactors(Br6522_ant,clusters = Br6522_ant$scran_quick_cluster) -Br6522_mid <- computeSumFactors(Br6522_mid,clusters = Br6522_mid$scran_quick_cluster) -Br8667_post <- computeSumFactors(Br8667_post,clusters = Br8667_post$scran_quick_cluster) +Br6522_ant <- computeSumFactors(Br6522_ant, clusters = Br6522_ant$scran_quick_cluster) +Br6522_mid <- computeSumFactors(Br6522_mid, clusters = Br6522_mid$scran_quick_cluster) +Br8667_post <- computeSumFactors(Br8667_post, clusters = Br8667_post$scran_quick_cluster) Br6522_ant <- logNormCounts(Br6522_ant) Br6522_mid <- logNormCounts(Br6522_mid) @@ -294,27 +303,38 @@ Br6522_ant_normal$scran_quick_cluster <- quickCluster(Br6522_ant_normal) Br6522_mid_normal$scran_quick_cluster <- quickCluster(Br6522_mid_normal) Br8667_post_normal$scran_quick_cluster <- quickCluster(Br8667_post_normal) -Br6522_ant_normal <- computeSumFactors(Br6522_ant_normal,clusters = Br6522_ant_normal$scran_quick_cluster) -Br6522_mid_normal <- computeSumFactors(Br6522_mid_normal,clusters = Br6522_mid_normal$scran_quick_cluster) -Br8667_post_normal <- computeSumFactors(Br8667_post_normal,clusters = Br8667_post_normal$scran_quick_cluster) +Br6522_ant_normal <- computeSumFactors(Br6522_ant_normal, clusters = Br6522_ant_normal$scran_quick_cluster) +Br6522_mid_normal <- computeSumFactors(Br6522_mid_normal, clusters = Br6522_mid_normal$scran_quick_cluster) +Br8667_post_normal <- computeSumFactors(Br8667_post_normal, clusters = Br8667_post_normal$scran_quick_cluster) Br6522_ant_normal <- logNormCounts(Br6522_ant_normal) Br6522_mid_normal <- logNormCounts(Br6522_mid_normal) Br8667_post_normal <- logNormCounts(Br8667_post_normal) -compare_gene_prop <- function(normal, all, title){ - plot_df <- data.frame("Mean_expr" = rowMeans(all@assays@data$logcounts), - "Var_expr" = rowVars(all@assays@data$logcounts), - "Mean_expr_normal" = rowMeans(normal@assays@data$logcounts), - "Var_expr_normal" = rowVars(normal@assays@data$logcounts)) - p1 <- ggplot(plot_df, aes(x = Mean_expr_normal, y = Mean_expr)) + geom_point(colour = "#00BFC4", alpha = 0.5) + - theme_classic() + xlab("Mean (excl. artifacts)") + ylab("Mean (all spots)") + - geom_abline(intercept = 0, slope = 1, lty = 2) + theme(axis.title = element_text(size = 10), plot.title = element_text(face = "bold", size = 10)) - p2 <- ggplot(plot_df, aes(x = Var_expr_normal, y = Var_expr)) + geom_point(colour = "#00BFC4", alpha = 0.5) + - theme_classic() + xlab("Variance (excl. artifacts)") + ylab("Variance (all spots)") + - geom_abline(intercept = 0, slope = 1, lty = 2) + theme(axis.title = element_text(size = 10)) + ggtitle("") - title <- ggdraw() + draw_label(title, fontface='bold') - plot_grid(title, plot_grid(p1, p2, rel_widths = c(1, 1), nrow = 1, align = "h", labels = c("I", "II")), nrow = 2, rel_heights = c(0.1, 1)) +compare_gene_prop <- function(normal, all, title) { + plot_df <- data.frame( + "Mean_expr" = rowMeans(all@assays@data$logcounts), + "Var_expr" = rowVars(all@assays@data$logcounts), + "Mean_expr_normal" = rowMeans(normal@assays@data$logcounts), + "Var_expr_normal" = rowVars(normal@assays@data$logcounts) + ) + p1 <- ggplot(plot_df, aes(x = Mean_expr_normal, y = Mean_expr)) + + geom_point(colour = "#00BFC4", alpha = 0.5) + + theme_classic() + + xlab("Mean (excl. artifacts)") + + ylab("Mean (all spots)") + + geom_abline(intercept = 0, slope = 1, lty = 2) + + theme(axis.title = element_text(size = 10), plot.title = element_text(face = "bold", size = 10)) + p2 <- ggplot(plot_df, aes(x = Var_expr_normal, y = Var_expr)) + + geom_point(colour = "#00BFC4", alpha = 0.5) + + theme_classic() + + xlab("Variance (excl. artifacts)") + + ylab("Variance (all spots)") + + geom_abline(intercept = 0, slope = 1, lty = 2) + + theme(axis.title = element_text(size = 10)) + + ggtitle("") + title <- ggdraw() + draw_label(title, fontface = "bold") + plot_grid(title, plot_grid(p1, p2, rel_widths = c(1, 1), nrow = 1, align = "h", labels = c("I", "II")), nrow = 2, rel_heights = c(0.1, 1)) } p <- compare_gene_prop(Br6522_ant_normal, Br6522_ant, "Br6522 Anterior") pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S4/Br6522_ant_gene_mean_gene_var.pdf", width = 4.5, height = 3) @@ -353,58 +373,68 @@ Br6522_ant_normal <- runPCA(Br6522_ant, subset_row = Br6522_ant_normal_top.hvgs, Br6522_mid_normal <- runPCA(Br6522_mid, subset_row = Br6522_mid_normal_top.hvgs, ncomponents = 50) Br8667_post_normal <- runPCA(Br8667_post, subset_row = Br8667_post_normal_top.hvgs, ncomponents = 50) -# Find clusters -findClusters_sce <- function(sce){ - output <- getClusteredPCs(reducedDim(sce)) - npcs <- metadata(output)$chosen - cat(npcs) - reducedDim(sce, "PCAsub") <- reducedDim(sce, "PCA")[,1:npcs,drop=FALSE] - g <- buildSNNGraph(sce, use.dimred="PCAsub") - cluster <- igraph::cluster_walktrap(g)$membership - # Assigning to the 'colLabels' of the 'sce'. - colLabels(sce) <- factor(cluster) - table(colLabels(sce)) - sce +# Find clusters +findClusters_sce <- function(sce) { + output <- getClusteredPCs(reducedDim(sce)) + npcs <- metadata(output)$chosen + cat(npcs) + reducedDim(sce, "PCAsub") <- reducedDim(sce, "PCA")[, 1:npcs, drop = FALSE] + g <- buildSNNGraph(sce, use.dimred = "PCAsub") + cluster <- igraph::cluster_walktrap(g)$membership + # Assigning to the 'colLabels' of the 'sce'. + colLabels(sce) <- factor(cluster) + table(colLabels(sce)) + sce } Br6522_ant <- findClusters_sce(Br6522_ant) Br6522_mid <- findClusters_sce(Br6522_mid) Br8667_post <- findClusters_sce(Br8667_post) -get_cluster_comp <- function(sobj, title){ -Layers <- unique(sobj@colData$Layers) -Layers <- Layers[order(Layers)] -Labels <- levels(sobj@colData$label) -layer_mat <- matrix(NA, nrow = length(Labels), ncol = length(Layers)) -for(i in c(1:dim(layer_mat)[1])){ - for(j in c(1:dim(layer_mat)[2])){ - layer_mat[i, j] <- sum(sobj@colData$Layers[sobj@colData$label == Labels[i]] == Layers[j]) - } -} -artifact_mat <- matrix(NA, nrow = length(Labels), ncol = 2) -for(i in c(1:dim(layer_mat)[1])){ - artifact_mat[i, 1] <- sum(!sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) - artifact_mat[i, 2] <- sum(sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) +get_cluster_comp <- function(sobj, title) { + Layers <- unique(sobj@colData$Layers) + Layers <- Layers[order(Layers)] + Labels <- levels(sobj@colData$label) + layer_mat <- matrix(NA, nrow = length(Labels), ncol = length(Layers)) + for (i in c(1:dim(layer_mat)[1])) { + for (j in c(1:dim(layer_mat)[2])) { + layer_mat[i, j] <- sum(sobj@colData$Layers[sobj@colData$label == Labels[i]] == Layers[j]) + } + } + artifact_mat <- matrix(NA, nrow = length(Labels), ncol = 2) + for (i in c(1:dim(layer_mat)[1])) { + artifact_mat[i, 1] <- sum(!sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) + artifact_mat[i, 2] <- sum(sobj@colData$is_wrinkle[sobj@colData$label == Labels[i]]) + } + colnames(artifact_mat) <- c("None", "Artifact") + colnames(layer_mat) <- Layers + rownames(layer_mat) <- paste("Cluster", Labels) + rownames(artifact_mat) <- paste("Cluster", Labels) + colnames(layer_mat)[colnames(layer_mat) == "Unknown"] <- "NA" + layer_mat <- reshape2::melt(layer_mat) + artifact_mat <- reshape2::melt(artifact_mat) + p1 <- ggplot(layer_mat, aes(x = Var1, y = value, fill = Var2)) + + geom_bar(position = "dodge", stat = "identity") + + theme_classic() + + scale_fill_manual(name = "Layers", values = c( + "Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", + "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", + "WM" = "#1A1A1A", "NA" = "transparent" + )) + + xlab("") + + ylab("Number of spots") + + ggtitle(title) + + theme(plot.title = element_text(face = "bold")) + + p2 <- ggplot(artifact_mat, aes(x = Var1, y = value, fill = Var2)) + + geom_bar(position = "fill", stat = "identity") + + theme_classic() + + scale_fill_manual(name = "", values = c("None" = "#619CFF", "Artifact" = "#F8766D")) + + xlab("") + + ylab("Fraction of spots") + + theme(plot.title = element_text(face = "bold")) + list(p1, p2) } -colnames(artifact_mat) <- c("None", "Artifact") -colnames(layer_mat) <- Layers -rownames(layer_mat) <- paste("Cluster", Labels) -rownames(artifact_mat) <- paste("Cluster", Labels) -colnames(layer_mat)[colnames(layer_mat) == "Unknown"] <- "NA" -layer_mat <- reshape2::melt(layer_mat) -artifact_mat <- reshape2::melt(artifact_mat) -p1 <- ggplot(layer_mat, aes(x = Var1, y = value, fill = Var2)) + - geom_bar(position="dodge", stat="identity") + theme_classic() + - scale_fill_manual(name = "Layers", values = c("Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", - "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", - "WM" = "#1A1A1A", "NA" = "transparent")) + xlab("") + ylab("Number of spots") + - ggtitle(title) + theme(plot.title = element_text(face = "bold")) - -p2 <- ggplot(artifact_mat, aes(x = Var1, y = value, fill = Var2)) + - geom_bar(position="fill", stat="identity") + theme_classic() + - scale_fill_manual(name = "", values = c("None" = "#619CFF", "Artifact" = "#F8766D")) + xlab("") + ylab("Fraction of spots") + - theme(plot.title = element_text(face = "bold")) -list(p1, p2)} p_list_1 <- get_cluster_comp(Br6522_ant, "Br6522 Anterior") p_list_2 <- get_cluster_comp(Br6522_mid, "Br6522 Middle") @@ -472,21 +502,27 @@ Br8667_post_normal <- runUMAP(Br8667_post_normal, dimred = "PCA") colnames(reducedDim(Br8667_post_normal, "UMAP")) <- c("UMAP1", "UMAP2") -viz_umap <- function(sobj, title){ - df <- data.frame(reducedDim(sobj, "UMAP")) - df$Layers <- sobj$Layers - df$is_wrinkle <- sobj$is_wrinkle - df$Artifact <- df$is_wrinkle - df$Artifact[df$is_wrinkle] <- "Artifact" - df$Artifact[!df$is_wrinkle] <- "Excluding Artifacts" - df$Artifact <- factor(df$Artifact, levels = c("Excluding Artifacts", "Artifact")) - df$Layers[df$Layers == "Unknown"] <- NA - layer_palette <- c("Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", - "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", - "WM" = "#1A1A1A", "NA" = "transparent") - ggplot(df, aes(x = UMAP1, y = UMAP2, colour = Layers)) + geom_point(size = 0.8, alpha = 0.7) + theme_bw() + - scale_color_manual(name = "Layers", values = layer_palette) + facet_wrap(~Artifact) + ggtitle(title) + - theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), plot.title = element_text(face = "bold")) +viz_umap <- function(sobj, title) { + df <- data.frame(reducedDim(sobj, "UMAP")) + df$Layers <- sobj$Layers + df$is_wrinkle <- sobj$is_wrinkle + df$Artifact <- df$is_wrinkle + df$Artifact[df$is_wrinkle] <- "Artifact" + df$Artifact[!df$is_wrinkle] <- "Excluding Artifacts" + df$Artifact <- factor(df$Artifact, levels = c("Excluding Artifacts", "Artifact")) + df$Layers[df$Layers == "Unknown"] <- NA + layer_palette <- c( + "Layer 1" = "#F0027F", "Layer 2" = "#377EB8", "Layer 3" = "#4DAF4A", + "Layer 4" = "#984EA3", "Layer 5" = "#FFD700", "Layer 6" = "#FF7F00", + "WM" = "#1A1A1A", "NA" = "transparent" + ) + ggplot(df, aes(x = UMAP1, y = UMAP2, colour = Layers)) + + geom_point(size = 0.8, alpha = 0.7) + + theme_bw() + + scale_color_manual(name = "Layers", values = layer_palette) + + facet_wrap(~Artifact) + + ggtitle(title) + + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), plot.title = element_text(face = "bold")) } p1 <- viz_umap(Br6522_ant, "Br6522 Anterior") @@ -505,244 +541,280 @@ pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br8667_post_UMAP.pdf", p3 dev.off() -get_PC_var_explained <- function(sobj){ -df <- data.frame(reducedDim(sobj, "PCA")) -df <- df[ ,1:10] -df$Layers <- sobj$Layers -df$is_wrinkle <- sobj$is_wrinkle -df$libSize <- sobj$sum_gene -df$percent_mito <- sobj$expr_chrM_ratio -res <- anova(lm(PC1 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- res$`Sum Sq`/sum(res$`Sum Sq`) -res <- anova(lm(PC2 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC3 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC4 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC5 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC6 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC7 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC8 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC9 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -res <- anova(lm(PC10 ~ Layers + is_wrinkle + libSize + percent_mito, df)) -all_res <- rbind(all_res, res$`Sum Sq`/sum(res$`Sum Sq`)) -all_res <- all_res[ ,c(1, 2, 3, 4)] -rownames(all_res) <- c(1:10) -colnames(all_res) <- c("Layers", "Is Wrinkle", "Library Size", "Percent mito") -all_res <- data.frame(all_res) -all_res$PC <- paste0("PC", c(1:10)) -all_res <- reshape2::melt(all_res, id.vars = "PC") -all_res$variable <- as.character(all_res$variable) -all_res$variable[all_res$variable == "Is.Wrinkle"] <- "Is wrinkle" -all_res$variable[all_res$variable == "Library.Size"] <- "Library size" -all_res$variable[all_res$variable == "Percent.mito"] <- "Percent mito" -all_res$variable <- as.factor(all_res$variable) -all_res} +get_PC_var_explained <- function(sobj) { + df <- data.frame(reducedDim(sobj, "PCA")) + df <- df[, 1:10] + df$Layers <- sobj$Layers + df$is_wrinkle <- sobj$is_wrinkle + df$libSize <- sobj$sum_gene + df$percent_mito <- sobj$expr_chrM_ratio + res <- anova(lm(PC1 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- res$`Sum Sq` / sum(res$`Sum Sq`) + res <- anova(lm(PC2 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC3 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC4 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC5 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC6 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC7 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC8 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC9 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + res <- anova(lm(PC10 ~ Layers + is_wrinkle + libSize + percent_mito, df)) + all_res <- rbind(all_res, res$`Sum Sq` / sum(res$`Sum Sq`)) + all_res <- all_res[, c(1, 2, 3, 4)] + rownames(all_res) <- c(1:10) + colnames(all_res) <- c("Layers", "Is Wrinkle", "Library Size", "Percent mito") + all_res <- data.frame(all_res) + all_res$PC <- paste0("PC", c(1:10)) + all_res <- reshape2::melt(all_res, id.vars = "PC") + all_res$variable <- as.character(all_res$variable) + all_res$variable[all_res$variable == "Is.Wrinkle"] <- "Is wrinkle" + all_res$variable[all_res$variable == "Library.Size"] <- "Library size" + all_res$variable[all_res$variable == "Percent.mito"] <- "Percent mito" + all_res$variable <- as.factor(all_res$variable) + all_res +} Br6522_ant_anova <- get_PC_var_explained(Br6522_ant) Br6522_mid_anova <- get_PC_var_explained(Br6522_mid) Br8667_post_anova <- get_PC_var_explained(Br8667_post) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br6522_ant_PC_anova.pdf", width = 5, height = 3.5) -ggplot(aes(x=variable, y=PC, fill=value), data=Br6522_ant_anova) + geom_tile() + scale_fill_gradient(low="white", high="#416A1D") + - labs(y=NULL, x=NULL, fill="R-squared") + geom_text(aes(label = round(value, 2)), size = 3) + - theme_classic() + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + - scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + - ggtitle("Br6522 Anterior") + theme(plot.title = element_text(face="bold")) +ggplot(aes(x = variable, y = PC, fill = value), data = Br6522_ant_anova) + + geom_tile() + + scale_fill_gradient(low = "white", high = "#416A1D") + + labs(y = NULL, x = NULL, fill = "R-squared") + + geom_text(aes(label = round(value, 2)), size = 3) + + theme_classic() + + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + + scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + + ggtitle("Br6522 Anterior") + + theme(plot.title = element_text(face = "bold")) dev.off() pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br6522_mid_PC_anova.pdf", width = 5, height = 3.5) -ggplot(aes(x=variable, y=PC, fill=value), data=Br6522_mid_anova) + geom_tile() + scale_fill_gradient(low="white", high="#416A1D") + - labs(y=NULL, x=NULL, fill="R-squared") + geom_text(aes(label = round(value, 2)), size = 3) + - theme_classic() + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + - scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + - ggtitle("Br6522 Middle") + theme(plot.title = element_text(face="bold")) +ggplot(aes(x = variable, y = PC, fill = value), data = Br6522_mid_anova) + + geom_tile() + + scale_fill_gradient(low = "white", high = "#416A1D") + + labs(y = NULL, x = NULL, fill = "R-squared") + + geom_text(aes(label = round(value, 2)), size = 3) + + theme_classic() + + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + + scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + + ggtitle("Br6522 Middle") + + theme(plot.title = element_text(face = "bold")) dev.off() pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br8667_post_PC_anova.pdf", width = 5, height = 3.5) -ggplot(aes(x=variable, y=PC, fill=value), data=Br8667_post_anova) + geom_tile() + scale_fill_gradient(low="white", high="#416A1D") + - labs(y=NULL, x=NULL, fill="R-squared") + geom_text(aes(label = round(value, 2)), size = 3) + - theme_classic() + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + - scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + - ggtitle("Br8667 Posterior") + theme(plot.title = element_text(face="bold")) +ggplot(aes(x = variable, y = PC, fill = value), data = Br8667_post_anova) + + geom_tile() + + scale_fill_gradient(low = "white", high = "#416A1D") + + labs(y = NULL, x = NULL, fill = "R-squared") + + geom_text(aes(label = round(value, 2)), size = 3) + + theme_classic() + + theme(axis.line = element_blank(), axis.ticks.length = unit(0, "lines")) + + scale_y_discrete(limits = c("PC1", "PC2", "PC3", "PC4", "PC5", "PC6", "PC7", "PC8", "PC9", "PC10")) + + ggtitle("Br8667 Posterior") + + theme(plot.title = element_text(face = "bold")) dev.off() Br6522_ant$Layer_wrinkle <- paste(Br6522_ant$Layers, as.numeric(Br6522_ant$is_wrinkle), sep = "_") Br6522_mid$Layer_wrinkle <- paste(Br6522_mid$Layers, as.numeric(Br6522_mid$is_wrinkle), sep = "_") Br8667_post$Layer_wrinkle <- paste(Br8667_post$Layers, as.numeric(Br8667_post$is_wrinkle), sep = "_") -plot_DE_genes <- function(df_list, opt = "all", quantile_thresh = 0.95){ - df_list <- lapply(df_list, function(df){ - if(is.null(df)){ - NULL - }else{ - df <- data.frame(df) - df$gene <- rownames(df) - rownames(df) <- c(1:dim(df)[1]) - df +plot_DE_genes <- function(df_list, opt = "all", quantile_thresh = 0.95) { + df_list <- lapply(df_list, function(df) { + if (is.null(df)) { + NULL + } else { + df <- data.frame(df) + df$gene <- rownames(df) + rownames(df) <- c(1:dim(df)[1]) + df + } + }) + if (opt == "all") { + layer_1 <- df_list[[1]] + layer_1$logFC.Layer.1_1 <- NULL + layer_1$Layer <- "Layer 1" + layer_1 <- layer_1[layer_1$FDR < 0.01, ] + layer_1 <- layer_1[abs(layer_1$summary.logFC) >= quantile(abs(layer_1$summary.logFC), quantile_thresh), ] + # layer_1 <- layer_1[abs(layer_1$summary.logFC) >= 0.2, ] + layer_1 <- layer_1[order(abs(layer_1$summary.logFC)), ] + + layer_WM <- df_list[[7]] + layer_WM$Layer <- "WM" + layer_WM$logFC.WM_1 <- NULL + layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] + layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= quantile(abs(layer_WM$summary.logFC), quantile_thresh), ] + # layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= 0.2, ] + layer_WM <- layer_WM[order(abs(layer_WM$summary.logFC)), ] + } + + layer_2 <- df_list[[2]] + layer_2$logFC.Layer.2_1 <- NULL + layer_2$Layer <- "Layer 2" + layer_2 <- layer_2[layer_2$FDR < 0.01, ] + layer_2 <- layer_2[abs(layer_2$summary.logFC) >= quantile(abs(layer_2$summary.logFC), quantile_thresh), ] + # layer_2 <- layer_2[abs(layer_2$summary.logFC) >= 0.2, ] + layer_2 <- layer_2[order(abs(layer_2$summary.logFC)), ] + + layer_3 <- df_list[[3]] + layer_3$logFC.Layer.3_1 <- NULL + layer_3$Layer <- "Layer 3" + layer_3 <- layer_3[layer_3$FDR < 0.01, ] + layer_3 <- layer_3[abs(layer_3$summary.logFC) >= quantile(abs(layer_3$summary.logFC), quantile_thresh), ] + # layer_3 <- layer_3[abs(layer_3$summary.logFC) >= 0.2, ] + layer_3 <- layer_3[order(abs(layer_3$summary.logFC)), ] + + layer_4 <- df_list[[4]] + layer_4$logFC.Layer.4_1 <- NULL + layer_4$Layer <- "Layer 4" + layer_4 <- layer_4[layer_4$FDR < 0.01, ] + # layer_4 <- layer_4[abs(layer_4$summary.logFC) >= 0.2, ] + layer_4 <- layer_4[abs(layer_4$summary.logFC) >= quantile(abs(layer_4$summary.logFC), quantile_thresh), ] + layer_4 <- layer_4[order(abs(layer_4$summary.logFC)), ] + + layer_5 <- df_list[[5]] + layer_5$logFC.Layer.5_1 <- NULL + layer_5$Layer <- "Layer 5" + layer_5 <- layer_5[layer_5$FDR < 0.01, ] + layer_5 <- layer_5[abs(layer_5$summary.logFC) >= quantile(abs(layer_5$summary.logFC), quantile_thresh), ] + # layer_5 <- layer_5[abs(layer_5$summary.logFC) >= 0.2, ] + layer_5 <- layer_5[order(abs(layer_5$summary.logFC)), ] + + layer_6 <- df_list[[6]] + layer_6$logFC.Layer.6_1 <- NULL + layer_6$Layer <- "Layer 6" + layer_6 <- layer_6[layer_6$FDR < 0.01, ] + # layer_6 <- layer_6[abs(layer_6$summary.logFC) >= 0.2, ] + layer_6 <- layer_6[abs(layer_6$summary.logFC) >= quantile(abs(layer_6$summary.logFC), quantile_thresh), ] + layer_6 <- layer_6[order(abs(layer_6$summary.logFC)), ] + + if (opt == "all") { + plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) + } else { + plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) } - }) - if(opt == "all"){ - layer_1 <- df_list[[1]] - layer_1$logFC.Layer.1_1 <- NULL - layer_1$Layer <- "Layer 1" - layer_1 <- layer_1[layer_1$FDR < 0.01, ] - layer_1 <- layer_1[abs(layer_1$summary.logFC) >= quantile(abs(layer_1$summary.logFC), quantile_thresh), ] - #layer_1 <- layer_1[abs(layer_1$summary.logFC) >= 0.2, ] - layer_1 <- layer_1[order(abs(layer_1$summary.logFC)), ] - - layer_WM <- df_list[[7]] - layer_WM$Layer <- "WM" - layer_WM$logFC.WM_1 <- NULL - layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] - layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= quantile(abs(layer_WM$summary.logFC), quantile_thresh), ] - #layer_WM <- layer_WM[abs(layer_WM$summary.logFC) >= 0.2, ] - layer_WM <- layer_WM[order(abs(layer_WM$summary.logFC)), ] - } - - layer_2 <- df_list[[2]] - layer_2$logFC.Layer.2_1 <- NULL - layer_2$Layer <- "Layer 2" - layer_2 <- layer_2[layer_2$FDR < 0.01, ] - layer_2 <- layer_2[abs(layer_2$summary.logFC) >= quantile(abs(layer_2$summary.logFC), quantile_thresh), ] - #layer_2 <- layer_2[abs(layer_2$summary.logFC) >= 0.2, ] - layer_2 <- layer_2[order(abs(layer_2$summary.logFC)), ] - - layer_3 <- df_list[[3]] - layer_3$logFC.Layer.3_1 <- NULL - layer_3$Layer <- "Layer 3" - layer_3 <- layer_3[layer_3$FDR < 0.01, ] - layer_3 <- layer_3[abs(layer_3$summary.logFC) >= quantile(abs(layer_3$summary.logFC), quantile_thresh), ] - #layer_3 <- layer_3[abs(layer_3$summary.logFC) >= 0.2, ] - layer_3 <- layer_3[order(abs(layer_3$summary.logFC)), ] - - layer_4 <- df_list[[4]] - layer_4$logFC.Layer.4_1 <- NULL - layer_4$Layer <- "Layer 4" - layer_4 <- layer_4[layer_4$FDR < 0.01, ] - #layer_4 <- layer_4[abs(layer_4$summary.logFC) >= 0.2, ] - layer_4 <- layer_4[abs(layer_4$summary.logFC) >= quantile(abs(layer_4$summary.logFC), quantile_thresh), ] - layer_4 <- layer_4[order(abs(layer_4$summary.logFC)), ] - - layer_5 <- df_list[[5]] - layer_5$logFC.Layer.5_1 <- NULL - layer_5$Layer <- "Layer 5" - layer_5 <- layer_5[layer_5$FDR < 0.01, ] - layer_5 <- layer_5[abs(layer_5$summary.logFC) >= quantile(abs(layer_5$summary.logFC), quantile_thresh), ] - #layer_5 <- layer_5[abs(layer_5$summary.logFC) >= 0.2, ] - layer_5 <- layer_5[order(abs(layer_5$summary.logFC)), ] - - layer_6 <- df_list[[6]] - layer_6$logFC.Layer.6_1 <- NULL - layer_6$Layer <- "Layer 6" - layer_6 <- layer_6[layer_6$FDR < 0.01, ] - #layer_6 <- layer_6[abs(layer_6$summary.logFC) >= 0.2, ] - layer_6 <- layer_6[abs(layer_6$summary.logFC) >= quantile(abs(layer_6$summary.logFC), quantile_thresh), ] - layer_6 <- layer_6[order(abs(layer_6$summary.logFC)), ] - - if(opt == "all"){ - plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) - }else{ - plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) - } - plot_df$Absolute_logFC <- abs(plot_df$summary.logFC) - plot_df$genes_ordered <- factor(plot_df$gene, levels=unique(plot_df$gene)) - ggplot(plot_df, aes(x= Layer, y=genes_ordered, size=Absolute_logFC, color=FDR)) + geom_point(alpha = 0.8) + - theme_bw() + xlab("") + ylab("") + scale_colour_gradient(low = "#3D07F4", high = "#E2DBF8") + - scale_size_continuous(name = "|log FC|") + theme(panel.grid.major = element_line(colour = "black",linewidth = 0.2, linetype="dashed")) + theme( - panel.grid.major.x = element_blank()) + plot_df$Absolute_logFC <- abs(plot_df$summary.logFC) + plot_df$genes_ordered <- factor(plot_df$gene, levels = unique(plot_df$gene)) + ggplot(plot_df, aes(x = Layer, y = genes_ordered, size = Absolute_logFC, color = FDR)) + + geom_point(alpha = 0.8) + + theme_bw() + + xlab("") + + ylab("") + + scale_colour_gradient(low = "#3D07F4", high = "#E2DBF8") + + scale_size_continuous(name = "|log FC|") + + theme(panel.grid.major = element_line(colour = "black", linewidth = 0.2, linetype = "dashed")) + + theme( + panel.grid.major.x = element_blank() + ) } -plot_DE_violin_plot <- function(df_list, opt = "all"){ - df_list <- lapply(df_list, function(df){ - data.frame(df) - }) - if(opt == "all"){ - layer_1 <- df_list[[1]] - layer_1$logFC.Layer.1_1 <- NULL - layer_1$Layer <- "Layer 1" - #layer_1 <- layer_1[layer_1$FDR < 0.01, ] - } - layer_2 <- df_list[[2]] - layer_2$logFC.Layer.2_1 <- NULL - layer_2$Layer <- "Layer 2" - #layer_2 <- layer_2[layer_2$FDR < 0.01, ] - - layer_3 <- df_list[[3]] - layer_3$Layer <- "Layer 3" - layer_3$logFC.Layer.3_1 <- NULL - #layer_3 <- layer_3[layer_3$FDR < 0.01, ] - - layer_4 <- df_list[[4]] - layer_4$Layer <- "Layer 4" - layer_4$logFC.Layer.4_1 <- NULL - #layer_4 <- layer_4[layer_4$FDR < 0.01, ] - - layer_5 <- df_list[[5]] - layer_5$Layer <- "Layer 5" - layer_5$logFC.Layer.5_1 <- NULL - #layer_5 <- layer_5[layer_5$FDR < 0.01, ] - - layer_6 <- df_list[[6]] - layer_6$Layer <- "Layer 6" - layer_6$logFC.Layer.6_1 <- NULL - #layer_6 <- layer_6[layer_6$FDR < 0.01, ] - - if(opt == "all"){ - layer_WM <- df_list[[7]] - layer_WM$Layer <- "WM" - layer_WM$logFC.WM_1 <- NULL - #layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] - } - if(opt == "all"){ - plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) - }else{ - plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) - } - plot_df$pvalue_cat <- plot_df$FDR - plot_df$pvalue_cat[plot_df$FDR > 0.1] <- "FDR > 0.1" - plot_df$pvalue_cat[plot_df$FDR < 0.1 & plot_df$FDR > 0.05] <- "0.05 < FDR < 0.1" - plot_df$pvalue_cat[plot_df$FDR < 0.05 & plot_df$FDR > 0.01] <- "0.01 < FDR < 0.05" - plot_df$pvalue_cat[plot_df$FDR < 0.01 & plot_df$FDR > 0.001] <- "0.001 < FDR < 0.01" - plot_df$pvalue_cat[plot_df$FDR < 0.001] <- "FDR < 0.001" - plot_df$pvalue_cat <- factor(plot_df$pvalue_cat, levels = c("FDR > 0.1", "0.05 < FDR < 0.1", "0.01 < FDR < 0.05", "0.001 < FDR < 0.01", - "FDR < 0.001")) - plot_df.summary <- plot_df %>% - group_by(Layer, pvalue_cat) %>% - summarise( - mad = mad(summary.logFC), - median = median(summary.logFC) - ) - plot_df.summary$lowerLim <- plot_df.summary$median - 3*plot_df.summary$mad - plot_df.summary$upperLim <- plot_df.summary$median + 3*plot_df.summary$mad - ggplot(plot_df.summary, aes(x=Layer, y = median)) + xlab("") + ylab("Log Fold-change") + - geom_hline(yintercept = -0.1, lty = 2, linewidth = 0.3) + geom_hline(yintercept = 0.1, lty = 2, linewidth = 0.3) + - theme_classic() + geom_point(aes(color = pvalue_cat), position = position_dodge(0.5)) + - geom_errorbar(aes(ymin = lowerLim, ymax = upperLim, color = pvalue_cat), position = position_dodge(0.5), width = 0) + - ylim(c(-0.5, 0.5)) + scale_color_manual(name = "", values = c("FDR > 0.1" = "#C3B2F9", - "0.05 < FDR < 0.1" = "#BBA8F8", - "0.01 < FDR < 0.05" = "#9B7DF8", - "0.001 < FDR < 0.01" = "#784FF8", - "FDR < 0.001" = "#4A12FA")) +plot_DE_violin_plot <- function(df_list, opt = "all") { + df_list <- lapply(df_list, function(df) { + data.frame(df) + }) + if (opt == "all") { + layer_1 <- df_list[[1]] + layer_1$logFC.Layer.1_1 <- NULL + layer_1$Layer <- "Layer 1" + # layer_1 <- layer_1[layer_1$FDR < 0.01, ] + } + layer_2 <- df_list[[2]] + layer_2$logFC.Layer.2_1 <- NULL + layer_2$Layer <- "Layer 2" + # layer_2 <- layer_2[layer_2$FDR < 0.01, ] + + layer_3 <- df_list[[3]] + layer_3$Layer <- "Layer 3" + layer_3$logFC.Layer.3_1 <- NULL + # layer_3 <- layer_3[layer_3$FDR < 0.01, ] + + layer_4 <- df_list[[4]] + layer_4$Layer <- "Layer 4" + layer_4$logFC.Layer.4_1 <- NULL + # layer_4 <- layer_4[layer_4$FDR < 0.01, ] + + layer_5 <- df_list[[5]] + layer_5$Layer <- "Layer 5" + layer_5$logFC.Layer.5_1 <- NULL + # layer_5 <- layer_5[layer_5$FDR < 0.01, ] + + layer_6 <- df_list[[6]] + layer_6$Layer <- "Layer 6" + layer_6$logFC.Layer.6_1 <- NULL + # layer_6 <- layer_6[layer_6$FDR < 0.01, ] + + if (opt == "all") { + layer_WM <- df_list[[7]] + layer_WM$Layer <- "WM" + layer_WM$logFC.WM_1 <- NULL + # layer_WM <- layer_WM[layer_WM$FDR < 0.01, ] + } + if (opt == "all") { + plot_df <- rbind(layer_1, layer_2, layer_3, layer_4, layer_5, layer_6, layer_WM) + } else { + plot_df <- rbind(layer_2, layer_3, layer_4, layer_5, layer_6) + } + plot_df$pvalue_cat <- plot_df$FDR + plot_df$pvalue_cat[plot_df$FDR > 0.1] <- "FDR > 0.1" + plot_df$pvalue_cat[plot_df$FDR < 0.1 & plot_df$FDR > 0.05] <- "0.05 < FDR < 0.1" + plot_df$pvalue_cat[plot_df$FDR < 0.05 & plot_df$FDR > 0.01] <- "0.01 < FDR < 0.05" + plot_df$pvalue_cat[plot_df$FDR < 0.01 & plot_df$FDR > 0.001] <- "0.001 < FDR < 0.01" + plot_df$pvalue_cat[plot_df$FDR < 0.001] <- "FDR < 0.001" + plot_df$pvalue_cat <- factor(plot_df$pvalue_cat, levels = c( + "FDR > 0.1", "0.05 < FDR < 0.1", "0.01 < FDR < 0.05", "0.001 < FDR < 0.01", + "FDR < 0.001" + )) + plot_df.summary <- plot_df %>% + group_by(Layer, pvalue_cat) %>% + summarise( + mad = mad(summary.logFC), + median = median(summary.logFC) + ) + plot_df.summary$lowerLim <- plot_df.summary$median - 3 * plot_df.summary$mad + plot_df.summary$upperLim <- plot_df.summary$median + 3 * plot_df.summary$mad + ggplot(plot_df.summary, aes(x = Layer, y = median)) + + xlab("") + + ylab("Log Fold-change") + + geom_hline(yintercept = -0.1, lty = 2, linewidth = 0.3) + + geom_hline(yintercept = 0.1, lty = 2, linewidth = 0.3) + + theme_classic() + + geom_point(aes(color = pvalue_cat), position = position_dodge(0.5)) + + geom_errorbar(aes(ymin = lowerLim, ymax = upperLim, color = pvalue_cat), position = position_dodge(0.5), width = 0) + + ylim(c(-0.5, 0.5)) + + scale_color_manual(name = "", values = c( + "FDR > 0.1" = "#C3B2F9", + "0.05 < FDR < 0.1" = "#BBA8F8", + "0.01 < FDR < 0.05" = "#9B7DF8", + "0.001 < FDR < 0.01" = "#784FF8", + "FDR < 0.001" = "#4A12FA" + )) } Br6522_ant_out <- pairwiseTTests(Br6522_ant, groups = Br6522_ant$Layer_wrinkle) Br6522_ant_out_all <- scran::combineMarkers( - de.lists = Br6522_ant_out$statistics[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1")], - pairs = Br6522_ant_out$pairs[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1"), ], - pval.type = "all" + de.lists = Br6522_ant_out$statistics[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + )], + pairs = Br6522_ant_out$pairs[paste(Br6522_ant_out$pairs$first, Br6522_ant_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + ), ], + pval.type = "all" ) Br6522_ant_DE_plots <- plot_DE_genes(Br6522_ant_out_all, "all", 0.98) + ggtitle("Br6522 Anterior") + theme(plot.title = element_text(face = "bold")) Br6522_ant_vln_plots <- plot_DE_violin_plot(Br6522_ant_out_all, "all") + ggtitle("Br6522 Anterior") + theme(plot.title = element_text(face = "bold")) @@ -756,15 +828,19 @@ dev.off() Br6522_mid_out <- pairwiseTTests(Br6522_mid, groups = Br6522_mid$Layer_wrinkle) Br6522_mid_out_all <- scran::combineMarkers( - de.lists = Br6522_mid_out$statistics[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1")], - pairs = Br6522_mid_out$pairs[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1"), ], - pval.type = "all" + de.lists = Br6522_mid_out$statistics[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + )], + pairs = Br6522_mid_out$pairs[paste(Br6522_mid_out$pairs$first, Br6522_mid_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + ), ], + pval.type = "all" ) Br6522_mid_DE_plots <- plot_DE_genes(Br6522_mid_out_all, "all", 0.05) + ggtitle("Br6522 Middle") + theme(plot.title = element_text(face = "bold")) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br6522_mid_topDEgenes.pdf", width = 5, height = 5) @@ -777,15 +853,19 @@ dev.off() Br8667_post_out <- pairwiseTTests(Br8667_post, groups = Br8667_post$Layer_wrinkle) Br8667_post_out_some <- scran::combineMarkers( - de.lists = Br8667_post_out$statistics[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1")], - pairs = Br8667_post_out$pairs[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c("Layer 1_0 Layer 1_1", - "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", - "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", - "Layer 6_0 Layer 6_1", "WM_0 WM_1"), ], - pval.type = "all" + de.lists = Br8667_post_out$statistics[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + )], + pairs = Br8667_post_out$pairs[paste(Br8667_post_out$pairs$first, Br8667_post_out$pairs$second) %in% c( + "Layer 1_0 Layer 1_1", + "Layer 2_0 Layer 2_1", "Layer 3_0 Layer 3_1", + "Layer 4_0 Layer 4_1", "Layer 5_0 Layer 5_1", + "Layer 6_0 Layer 6_1", "WM_0 WM_1" + ), ], + pval.type = "all" ) Br8667_post_out_all <- list() Br8667_post_out_all[[1]] <- NULL @@ -804,14 +884,14 @@ pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/Br8667_post_logFC_dotPl Br8667_post_vln_plots + theme(legend.position = "none") dev.off() -get_legend<-function(myggplot){ - tmp <- ggplot_gtable(ggplot_build(myggplot)) - leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") - legend <- tmp$grobs[[leg]] - return(legend) +get_legend <- function(myggplot) { + tmp <- ggplot_gtable(ggplot_build(myggplot)) + leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") + legend <- tmp$grobs[[leg]] + return(legend) } -Br8667_post_vln_plots <- Br8667_post_vln_plots + theme(legend.position = "bottom") + guides(color=guide_legend(nrow=2, byrow=TRUE)) +Br8667_post_vln_plots <- Br8667_post_vln_plots + theme(legend.position = "bottom") + guides(color = guide_legend(nrow = 2, byrow = TRUE)) FDR_legend_forDotPlot <- get_legend(Br8667_post_vln_plots) pdf("/data/abattle4/prashanthi/dewrinkler/figures/fig_S5/legend_logFC_dotPlot.pdf", width = 6, height = 1) plot_grid(FDR_legend_forDotPlot) diff --git a/code/spot_deconvo/05-shared_utilities/02-find_markers.R b/code/spot_deconvo/05-shared_utilities/02-find_markers.R index 9ea62b48..06e689f1 100644 --- a/code/spot_deconvo/05-shared_utilities/02-find_markers.R +++ b/code/spot_deconvo/05-shared_utilities/02-find_markers.R @@ -160,9 +160,8 @@ write_markers <- function(n_markers, out_path) { writeLines(marker_stats_temp$gene, con = out_path) } -my_plotExpression <- function( - sce, genes, assay = "logcounts", ct = "cellType", fill_colors = NULL, - title = NULL, marker_stats) { +my_plotExpression <- function(sce, genes, assay = "logcounts", ct = "cellType", fill_colors = NULL, + title = NULL, marker_stats) { cat_df <- as.data.frame(colData(sce))[, ct, drop = FALSE] expression_long <- reshape2::melt(as.matrix(assays(sce)[[assay]][genes, ])) diff --git a/code/spot_deconvo/05-shared_utilities/05-assess_methods.R b/code/spot_deconvo/05-shared_utilities/05-assess_methods.R index c9fc4a60..23ee6b89 100644 --- a/code/spot_deconvo/05-shared_utilities/05-assess_methods.R +++ b/code/spot_deconvo/05-shared_utilities/05-assess_methods.R @@ -261,9 +261,8 @@ across_spots <- function(count_df, plot_name, x_angle = 0) { # in the plot given the SpatialExperiment, long-format # tibble of cell-type counts, the target sample ID, deconvo tool, and cell # type, column name of 'full_df' ('observed' or 'actual'), and a plot title -spatial_counts_plot <- function( - spe_small, full_df, sample_id1, deconvo_tool1, cell_type1, c_name, - title) { +spatial_counts_plot <- function(spe_small, full_df, sample_id1, deconvo_tool1, cell_type1, c_name, + title) { # Grab counts for just this sample, deconvo tool, and cell type counts_df <- full_df |> filter( diff --git a/code/spot_deconvo/05-shared_utilities/07-add_to_spe_IF.R b/code/spot_deconvo/05-shared_utilities/07-add_to_spe_IF.R index 8005d0c2..6909ba9a 100644 --- a/code/spot_deconvo/05-shared_utilities/07-add_to_spe_IF.R +++ b/code/spot_deconvo/05-shared_utilities/07-add_to_spe_IF.R @@ -122,7 +122,7 @@ colData(spe) <- cbind(colData(spe), added_coldata_temp) layer_ann_list <- list() for (sample_id in unique(spe$sample_id)) { this_layer_path <- sub("\\{sample_id\\}", sample_id, layer_ann_path) - + layer_ann_list[[sample_id]] <- read.csv(this_layer_path) |> as_tibble() |> mutate( @@ -130,11 +130,11 @@ for (sample_id in unique(spe$sample_id)) { sample_id = sample_id, label = sub("^[Ll]ayer", "L", label) ) |> - select(- id) + select(-id) } # Add layer label as a column in colData(spe) -spe$manual_layer_label = added_coldata |> +spe$manual_layer_label <- added_coldata |> left_join(do.call(rbind, layer_ann_list)) |> pull(label) diff --git a/code/spot_deconvo/05-shared_utilities/09-result_plots_nonIF.R b/code/spot_deconvo/05-shared_utilities/09-result_plots_nonIF.R index 0b193744..12df343a 100644 --- a/code/spot_deconvo/05-shared_utilities/09-result_plots_nonIF.R +++ b/code/spot_deconvo/05-shared_utilities/09-result_plots_nonIF.R @@ -91,9 +91,8 @@ dir.create(plot_dir, showWarnings = FALSE, recursive = TRUE) # in the plot given the SpatialExperiment, long-format # tibble of cell-type counts, the target sample ID, deconvo tool, and cell # type, column name of 'full_df' ('observed' or 'actual'), and a plot title -spatial_counts_plot <- function( - spe_small, full_df, sample_id1, deconvo_tool1, cell_type1, c_name, - title) { +spatial_counts_plot <- function(spe_small, full_df, sample_id1, deconvo_tool1, cell_type1, c_name, + title) { # Grab counts for just this sample, deconvo tool, and cell type counts_df <- full_df |> filter( diff --git a/code/spot_deconvo/05-shared_utilities/14-marker_supp_table.R b/code/spot_deconvo/05-shared_utilities/14-marker_supp_table.R index b11e9471..f3a73432 100644 --- a/code/spot_deconvo/05-shared_utilities/14-marker_supp_table.R +++ b/code/spot_deconvo/05-shared_utilities/14-marker_supp_table.R @@ -25,52 +25,52 @@ cell_types_layer <- c( "Inhib" ) -out_path = here( - "processed-data", "spot_deconvo", "05-shared_utilities", +out_path <- here( + "processed-data", "spot_deconvo", "05-shared_utilities", "marker_stats_supp_table.csv" ) -marker_stats_list = list() +marker_stats_list <- list() for (cell_group in c("broad", "layer")) { - sce = readRDS(sub('\\{cell_group\\}', cell_group, sce_in)) - marker_stats = readRDS( - sub('\\{cell_group\\}', cell_group, marker_object_in) + sce <- readRDS(sub("\\{cell_group\\}", cell_group, sce_in)) + marker_stats <- readRDS( + sub("\\{cell_group\\}", cell_group, marker_object_in) ) - + if (cell_group == "broad") { - cell_types = cell_types_broad + cell_types <- cell_types_broad } else { - cell_types = cell_types_layer + cell_types <- cell_types_layer } - + #--------------------------------------------------------------------------- # Filter out mitochondrial genes and re-rank 'rank_ratio' values. Add gene # symbols to 'marker_stats' object #--------------------------------------------------------------------------- - + # Add gene symbol marker_stats$symbol <- rowData(sce)$gene_name[ match(marker_stats$gene, rownames(sce)) ] - + # Filter out mitochondrial genes marker_stats <- marker_stats[!grepl("^MT-", marker_stats$symbol), ] - + stopifnot( identical( sort(as.character(unique(marker_stats$cellType.target))), sort(cell_types) ) ) - + # "Re-rank" rank_ratio, since there may be missing ranks now for (ct in cell_types) { old_ranks <- marker_stats |> filter(cellType.target == ct) |> pull(rank_ratio) |> sort() - + for (i in 1:length(which((marker_stats$cellType.target == ct)))) { index <- which( (marker_stats$cellType.target == ct) & @@ -80,7 +80,7 @@ for (cell_group in c("broad", "layer")) { marker_stats[index, "rank_ratio"] <- i } } - + marker_stats <- marker_stats |> # Take top N marker genes for each cell type filter( @@ -89,13 +89,13 @@ for (cell_group in c("broad", "layer")) { ) |> # Label with cell-type resolution mutate(cellTypeResolution = cell_group) - + # Warn if less than the intended number of markers is used for any cell # type num_markers_table <- marker_stats |> group_by(cellType.target) |> summarize(num_markers = n()) - + if (any(num_markers_table$num_markers < n_markers_per_type)) { warning( paste( @@ -106,10 +106,10 @@ for (cell_group in c("broad", "layer")) { print("Number of markers per cell type:") print(num_markers_table) } - + stopifnot(all(num_markers_table$num_markers > 0)) - - marker_stats_list[[cell_group]] = marker_stats + + marker_stats_list[[cell_group]] <- marker_stats } # Combine tables for both cell-type resolutions and write to CSV diff --git a/code/spot_deconvo/05-shared_utilities/15-region_white_matter.R b/code/spot_deconvo/05-shared_utilities/15-region_white_matter.R index fb08f6a2..a18ea31c 100644 --- a/code/spot_deconvo/05-shared_utilities/15-region_white_matter.R +++ b/code/spot_deconvo/05-shared_utilities/15-region_white_matter.R @@ -1,24 +1,24 @@ -library('here') -library('SpatialExperiment') -library('ggplot2') -library('sessioninfo') -library('tidyverse') +library("here") +library("SpatialExperiment") +library("ggplot2") +library("sessioninfo") +library("tidyverse") -spe_path = here( +spe_path <- here( "processed-data", "rdata", "spe", "01_build_spe", "spe_filtered_final_with_clusters_and_deconvolution_results.rds" ) sce_path <- "/dcs04/lieber/lcolladotor/deconvolution_LIBD4030/DLPFC_snRNAseq/processed-data/sce/sce_DLPFC.Rdata" -plot_dir = here("plots", "spot_deconvo", "05-shared_utilities") +plot_dir <- here("plots", "spot_deconvo", "05-shared_utilities") -spe = readRDS(spe_path) +spe <- readRDS(spe_path) load(sce_path, verbose = TRUE) # Form a tibble with sample ID, cell type, and the proportion of cells of that # type, for the snRNA-seq data -prop_df = colData(sce) |> +prop_df <- colData(sce) |> as_tibble() |> rename(sample_id = Sample) |> # For each sample, sum up counts of each cell type @@ -28,13 +28,13 @@ prop_df = colData(sce) |> group_by(sample_id) |> mutate( cellType_broad_hc_prop = n / sum(n), - position = colData(sce)[match(sample_id, sce$Sample), 'pos'] + position = colData(sce)[match(sample_id, sce$Sample), "pos"] ) |> select(-n) |> ungroup() # Now add the proportion of white matter for each spatial sample to 'prop_df' -prop_df = colData(spe) |> +prop_df <- colData(spe) |> as_tibble() |> # Grab only the spatial samples with matching snRNA-seq data filter(sample_id %in% unique(prop_df$sample_id)) |> @@ -45,11 +45,11 @@ prop_df = colData(spe) |> ungroup() |> right_join(prop_df, multiple = "all") -pdf(file.path(plot_dir, 'prop_WM_position_scatter.pdf')) +pdf(file.path(plot_dir, "prop_WM_position_scatter.pdf")) ggplot( - prop_df, aes(x = cellType_broad_hc_prop, y = prop_WM, color = position) - ) + - facet_wrap(~ cellType_broad_hc) + + prop_df, aes(x = cellType_broad_hc_prop, y = prop_WM, color = position) +) + + facet_wrap(~cellType_broad_hc) + geom_point() + labs(x = "Cell Type Prop.", y = "Prop. WM Spots", color = "Position") + theme_bw(base_size = 10) diff --git a/code/spot_deconvo/05-shared_utilities/shared_functions.R b/code/spot_deconvo/05-shared_utilities/shared_functions.R index cdf85321..edcf6c9c 100644 --- a/code/spot_deconvo/05-shared_utilities/shared_functions.R +++ b/code/spot_deconvo/05-shared_utilities/shared_functions.R @@ -18,9 +18,8 @@ # minCount: passed to 'minCount' for 'vis_gene' if not [is_discrete] # # Returns a ggplot object -spot_plot <- function( - spe, sample_id, title, var_name, include_legend, is_discrete, - colors = NULL, assayname = "logcounts", minCount = 0.5) { +spot_plot <- function(spe, sample_id, title, var_name, include_legend, is_discrete, + colors = NULL, assayname = "logcounts", minCount = 0.5) { POINT_SIZE <- 2.3 # If the quantity to plot is discrete, use 'vis_clus'. Otherwise use diff --git a/code/synapse_upload/02-metadata_files/03-write_individual.R b/code/synapse_upload/02-metadata_files/03-write_individual.R index ff8fb83d..6595b141 100644 --- a/code/synapse_upload/02-metadata_files/03-write_individual.R +++ b/code/synapse_upload/02-metadata_files/03-write_individual.R @@ -86,8 +86,8 @@ stopifnot(all(colnames(meta_df) %in% template_names)) # We were manually requested to add these 2 columns, which were not in the # up-to-date template -meta_df$psychiatricMedications = "Not reported" -meta_df$psychiatricMedicationsNotes = "Not reported" +meta_df$psychiatricMedications <- "Not reported" +meta_df$psychiatricMedicationsNotes <- "Not reported" write.csv(meta_df, write_path_synapse, row.names = FALSE)