OSCR

Multidimensional profiling of heterogeneity in supratentorial ependymomas.

A correction to this paper has been published: the notice, 42092155, from Europe PMC.

Code ↔ Paper

30 matches between paragraphs of the paper and lines of its authors' code, computed by the harvester (lexical-v1). Click a colored paragraph or line to see its counterpart.

The 30 matches · 3 of them tie a paragraph to a whole file, not to given lines: weak matches, whose lines are not tinted
  1. [1] § Methods › Differential gene expression analysis › Pseudobulk analysis. ↔ 2.Plots/FigureE3/7_ZFTA_vs_Cluster3_Fig_E3.Rmd, lines 153–221 · score 0.98 · negative binomial dispersions, calcNormFactors, estimateDisp, filterByExpr, glmFit, glmLRT
  2. [2] § Methods › Differential gene expression analysis › GO and GSEA analysis. ↔ 2.Plots/FigureE3/7_ZFTA_vs_Cluster3_Fig_E3.Rmd, lines 437–505 · score 0.95 · Homo sapiens, gseGO, maxGSSize, minGSSize, OrgDb, pAdjustMethod
  3. [3] § Methods › Differential gene expression analysis › GO and GSEA analysis. ↔ 2.Plots/FigureE2/6_Neuroepithelial_vs_embryonic_Fig_E2.Rmd, lines 253–323 · score 0.95 · Homo sapiens, gseGO, maxGSSize, minGSSize, OrgDb, pAdjustMethod
  4. [4] § Cell states mirror early human cortex ↔ 2.Plots/Figure2/3_heatmap_STEPN_NMF_genes_Fig2b.R, lines 41–117 · score 0.90 · ALDH1A2, embryonic neuronal, ACTG1, ACTN4, CD44, CTBP2
  5. [5] § Methods › Differential gene expression analysis › Validation of developmental signatures across bulk RNA-seq ST-EPNs. ↔ 3.Pseudobulk_analysis/Scoring_validation_dataset_FigE3e.R, lines 1–44 · score 0.84 · ps avgpres gse64415geo209, gene expression matrix, u133p2, validate, R2, discovery
  6. [6] § Morphology of cell states ↔ 2.Plots/FigureE8/panel_a.R, the whole file · a weak match · score 0.82 · ARL6IP1, MAP3K19, S100B, DNER, TUBB3, CCDC40
  7. [7] § Methods › Generation of single-cell expression scores › Cycling scores. ↔ 5.Co-culture/2_Processing_coculture.Rmd, lines 102–184 · score 0.79 · cell cycle scores, CellCycleScoring, low cycling cells, defined high cycling, Seurat, signatures
  8. [8] § Methods › Generation of single-cell expression scores › Cycling scores. ↔ 6.Preclinical_models/3-Downstream.R, lines 84–125 · score 0.79 · cell cycle scores, CellCycleScoring, low cycling cells, defined high cycling, Seurat, signatures
  9. [9] § Methods › Spatial transcriptomics with 10x Xenium › Linear regression. ↔ 4.Xenium/resources/epn_functions.R, lines 1143–1252 · score 0.78 · multiple linear regression, logit transformation, spatial coherence, lm, R2, fit
  10. [10] § Extended Data ↔ 1.sc_snRNAseq_preprocessing/10_classification_malignant_normal.R, lines 222–279 · score 0.77 · CD3D, CCL3, CD247, PYHIN1, SPP1, MAG
  11. [11] § Extended Data ↔ 2.Plots/Figure1/1_ST_EPN_classification_malignant_normal_Fig1c.R, lines 220–299 · score 0.77 · CD3D, CCL3, CD247, PYHIN1, SPP1, MAG
  12. [12] § Methods › Spatial transcriptomics with 10x Xenium › Xenium cell state/type cell assignment. ↔ 4.Xenium/resources/FLXenium/utils.R, lines 683–701 · score 0.76 · malignant subset, FindClusters, FindNeighbors, RunUMAP, single cell, Xenium
  13. [13] § Methods › scRNA-seq data processing › Identification of malignant and non-malignant cells. ↔ 1.sc_snRNAseq_preprocessing/10_classification_malignant_normal.R, lines 134–176 · score 0.71 · Human Primary Cell, SingleR, Atlas, classifications, single cell, Seurat
  14. [14] § Methods › scRNA-seq data processing › Identification of malignant and non-malignant cells. ↔ 2.Plots/Figure1/1_ST_EPN_classification_malignant_normal_Fig1c.R, lines 132–175 · score 0.71 · Human Primary Cell, SingleR, Atlas, classifications, single cell, Seurat
  15. [15] § Global spatial organization patterns ↔ 4.Xenium/resources/epn_functions.R, lines 1143–1252 · score 0.71 · logit transformed proportion, multiple linear regression, spatial coherence score, embryonic, correlates
  16. [16] § Methods › Spatial transcriptomics with 10x Xenium › Xenium cell state/type cell assignment. ↔ 4.Xenium/resources/epn_functions.R, lines 162–268 · score 0.67 · FindClusters, FindNeighbors, RunUMAP, Anchors, PCs, single cell
  17. [17] § Extended Data ↔ 3.Pseudobulk_analysis/Scoring_validation_dataset_FigE3e.R, lines 88–127 · score 0.64 · Discovery cohort, module scores, AU, Violin, Boxplots, outliers
  18. [18] § Methods › Spatial transcriptomics with 10x Xenium › Xenium preprocessing of data. ↔ 4.Xenium/resources/FLXenium/prep.R, lines 1–44 · score 0.61 · LoadXenium, SCTransform, segmentation, preprocessing, location, Seurat
  19. [19] § Methods › Spatial transcriptomics with 10x Xenium › Linear regression. ↔ 4.Xenium/resources/FLXenium/utils.R, lines 1306–1359 · score 0.60 · linear regression, Bonferroni correction, lm, fit, Xenium
  20. [20] § Methods › Spatial transcriptomics with 10x Xenium › Xenium preprocessing of data. ↔ 4.Xenium/resources/epn_functions.R, lines 487–518 · score 0.59 · LoadXenium, SCTransform, segmentation, preprocessing, Seurat, clustering
  21. [21] § Methods › Differential gene expression analysis › Pseudobulk analysis. ↔ 2.Plots/Figure1/5_Pseudobulk_correlation_Fig1b.R, lines 122–200 · score 0.57 · aggregateAcrossCells, SingleCellExperiment, pseudobulk, subtype, matrices, gene
  22. [22] § Methods › Generation of single-cell expression scores › Generation of developmental signatures. ↔ 3.Pseudobulk_analysis/resources/single_cell_preprocessing_helper_functions_SD_240131.R, lines 1067–1166 · score 0.57 · expression score, scRNA, normal cell, malignant cells, single cell, pseudobulked
  23. [23] § Methods › Experimental model and participant details › Full-length sc/snRNA-seq. ↔ epnApp/tabs/homeTab.R, the whole file · a weak match · score 0.55 · Smart seq2, scRNA, snRNA, nuclei, single cells, transcriptome
  24. [24] § Methods › Generation of single-cell expression scores › Program-wise hierarchical clustering. ↔ 1.sc_snRNAseq_preprocessing/4a-infercnv_frozen_step2.R, lines 1–58 · score 0.54 · pairwise correlation, hierarchical clustering, Ward, distance, EPN
  25. [25] § Methods › Generation of single-cell expression scores › Program-wise hierarchical clustering. ↔ 1.sc_snRNAseq_preprocessing/4b-infercnv_fresh_step2.R, lines 1–62 · score 0.54 · pairwise correlation, hierarchical clustering, Ward, distance, EPN
  26. [26] § Methods › scRNA-seq data processing › Defining NMF programs and metaprograms. ↔ 1.sc_snRNAseq_preprocessing/8-NMF.Rmd, lines 57–127 · score 0.54 · NMF factor, hierarchical clustering, rank, malignant cell, correlated, scored
  27. [27] § Methods › scRNA-seq data processing › Defining NMF programs and metaprograms. ↔ 4.Xenium/resources/FLXenium/niche.R, lines 124–247 · score 0.53 · NMF factor, hierarchical clustering, cutree, correlated, metaprograms, scored
  28. [28] § Transcriptionally distinct ST-EPN subgroups ↔ epnApp/tabs/homeTab.R, the whole file · a weak match · score 0.53 · spatial transcriptomics, scRNA, snRNA, nucleus, single cell, subgroups
  29. [29] § Extended Data ↔ 4.Xenium/resources/epn_functions.R, lines 1335–1368 · score 0.52 · logit transformed proportion, linear regression, maps, Xenium, sc, metaprograms
  30. [30] § Methods › Generation of single-cell expression scores › Scoring gene sets. ↔ 5.Co-culture/7_EP1NS_hiNs.Rmd, lines 277–311 · score 0.51 · MP signatures, cell cycle, NMF, scored, EPN, genes

Paper

Loaded from Europe PMC by your browser, not stored by OSCR: doi.org · Europe PMC

The paper is loaded when this pane is shown.

The authors' code

R · 1,377 lines · 81 KB · MIT · 5 matches

  1. # In this file, I store ependymoma project specific functions (used for analysis of xenium data).
  2. # set up the global vars of the epn project, without any sample_specific variables
  3. # home_dir: where the code, and light weight files, like metadata etc are stored
  4. # data_dir: where the heavy files, like raw and processed data are stored
  5. SetUpEpendymomaGlobalVarsGeneral <- function(home_dir = '/home/shk490/Multidimensional_STEPN/4.Xenium',
  6. data_dir = '/n/data1/dfci/pedonc/filbin/lab/users/shk490/ependymoma'){
  7. ### get metadata
  8. metadata <- read_xlsx(glue('{home_dir}/resources/SampleIdentifier.xlsx'))
  9. ### read the panels for zfta-rela and non-canonical subtypes
  10. marker_genes_zfta_rela <- read_xlsx(glue('{home_dir}/resources/Xenium_panel.xlsx'))
  11. marker_genes_non_canonical <- read_xlsx(glue('{home_dir}/resources/Xenium_panel_Clusters.xlsx'))
  12. ### get some directories
  13. preparation_dir <- glue('{data_dir}/analysis/1_preparation')
  14. preprocessing_dir <- glue('{data_dir}/analysis/2_preprocessing')
  15. manual_annotation_plots_dir <- glue('{data_dir}/analysis/3_manual_annotation_plots')
  16. annotation_dir <- glue('{data_dir}/analysis/3_program_annotation')
  17. cellid_dir <- glue('{annotation_dir}/data')
  18. niche_dir <- glue('{data_dir}/analysis/4_niche')
  19. coherence_dir <- glue('{data_dir}/analysis/6_coherence')
  20. nhood_dir <- glue('{data_dir}/analysis/8_neighborhood')
  21. manual_annotation_yaml <- glue('{home_dir}/resources/normal_celltypes_manual_annotation.yaml')
  22. raw_data_dir <- glue('{data_dir}/raw_data/xenium_folders')
  23. sc_mal_path <- glue('{preparation_dir}/data/seurat_obj_malignant_annotated2.qs') # mal only single cell object path
  24. sc_full_path <- glue('{preparation_dir}/data/seurat_obj_ST_normal_malig_annotated.qs') # all cells (mal and normal and from all subtypes) object
  25. sc_reference <- glue('{preparation_dir}/data/reference_Nowakowski_Eze/Nowakowski_Eze.qs') # single cell reference object path (Nowakowski + Eze)
  26. zfta_reference <- glue('{data_dir}/analysis/1_preparation/data/ZR_Xenium_projection.qs')
  27. nc_reference <- glue('{data_dir}/analysis/1_preparation/data/NC_Xenium_projection.qs')
  28. yap1_reference <- glue('{data_dir}/analysis/1_preparation/data/YAP1_Xenium_projection.qs')
  29. # the malignant celltypes we expect in our data
  30. malignant_celltypes <- c("Neuroepithelial-like", "Radial-glia-like", "Embryonic-neuronal-like", "Neuronal-like" ,"Ependymal-like", "MES-like", "Embryonic-like")
  31. non_malignant_celltypes <- c("T-cells", "Myeloid", "Endothelial", "Oligodendrocytes", 'Neurons')
  32. # this variable is required in many of the plotting functions, because we want the celltypes ordered in a particular order
  33. order_metaprograms <- c("Neuroepithelial-like", "Embryonic-like", "Radial-glia-like", "Embryonic-neuronal-like",
  34. "Neuronal-like" ,"Ependymal-like", "MES-like", "T-cells", "Myeloid", "Endothelial",
  35. "Oligodendrocytes", 'Neurons')
  36. ### source the color palette and get the colors object
  37. source(glue('{home_dir}/resources/color_palette.R'))
  38. colors <- colors_metaprograms_Xenium
  39. # make the list in which to store all the attributes and return the list
  40. all_vars <- list()
  41. all_vars$home_dir <- home_dir
  42. all_vars$data_dir <- data_dir
  43. all_vars$metadata <- metadata
  44. all_vars$marker_genes_zfta_rela <- marker_genes_zfta_rela
  45. all_vars$marker_genes_non_canonical <- marker_genes_non_canonical
  46. all_vars$preparation_dir <- preparation_dir
  47. all_vars$preprocessing_dir <- preprocessing_dir
  48. all_vars$manual_annotation_plots_dir <- manual_annotation_plots_dir
  49. all_vars$annotation_dir <- annotation_dir
  50. all_vars$cellid_dir <- cellid_dir
  51. all_vars$niche_dir <- niche_dir
  52. all_vars$coherence_dir <- coherence_dir
  53. all_vars$nhood_dir <- nhood_dir
  54. all_vars$manual_annotation_yaml <- manual_annotation_yaml
  55. all_vars$raw_data_dir <- raw_data_dir
  56. all_vars$sc_mal_path <- sc_mal_path
  57. all_vars$sc_full_path <- sc_full_path
  58. all_vars$sc_reference <- sc_reference
  59. all_vars$zfta_reference <- zfta_reference
  60. all_vars$nc_reference <- nc_reference
  61. all_vars$yap1_reference <- yap1_reference
  62. all_vars$malignant_celltypes <- malignant_celltypes
  63. all_vars$non_malignant_celltypes <- non_malignant_celltypes
  64. all_vars$order_metaprograms <- order_metaprograms
  65. all_vars$colors <- colors
  66. return (all_vars)
  67. }
  68. # set up the sample-specific (and general) global vars for the ependymoma project
  69. SetUpEpendymomaGlobalVars <- function(sample_name, home_dir = '/home/shk490/Multidimensional_STEPN/4.Xenium',
  70. data_dir = '/n/data1/dfci/pedonc/filbin/lab/users/shk490/ependymoma'){
  71. # sample_name <- 'STEPN06_Region_1' # for testing code
  72. # first get the general variables using the SetUpEpendymomaGlobalVarsGeneral function
  73. all_vars <- SetUpEpendymomaGlobalVarsGeneral(home_dir, data_dir)
  74. # get the subtype of given sample
  75. metadata <- all_vars$metadata
  76. metadata_sample <- metadata[metadata[['SampleName']] == sample_name, ] # the subset of metadata specific to the current sample
  77. diagnosis <- metadata_sample[['Subtype']]
  78. # now according to diagnosis, get the sample specific variables like ref_projection, annotation_file,
  79. # preprocessed_file, etc.
  80. if (diagnosis == "ZFTA-RELA"){ref_projection <- all_vars$zfta_reference}
  81. if (diagnosis %in% c("ZFTA-Cluster 1", "ZFTA-Cluster 2", "ZFTA-Cluster 3", "ZFTA-Cluster 4")){ref_projection <- all_vars$nc_reference}
  82. if (diagnosis == "ST-YAP1"){ref_projection <- all_vars$yap1_reference}
  83. preprocessing_file <- glue('{all_vars$preprocessing_dir}/{sample_name}/seurat.qs')
  84. annotation_file <- glue('{all_vars$annotation_dir}/data/{sample_name}.qs')
  85. niche_file <- glue('{all_vars$niche_dir}/data/{sample_name}.qs')
  86. # get the raw data directory for this sample
  87. xenium_folder <- metadata_sample[['RawDataPath']]
  88. sample_raw_data_dir <- glue('{all_vars$raw_data_dir}/{xenium_folder}')
  89. h5_file_cell_feature_mat <- glue('{sample_raw_data_dir}/cell_feature_matrix.h5')
  90. # get the marker genes list, filtered and processed appropriately
  91. if (diagnosis == 'ZFTA-RELA'){
  92. marker_genes_list <- ReadMarkerGenesEPN(all_vars$marker_genes_zfta_rela, metadata_sample)
  93. } else{
  94. marker_genes_list <- ReadMarkerGenesEPN(all_vars$marker_genes_non_canonical, metadata_sample)
  95. }
  96. # add the sample-specific information obtained in this function to all_vars and return it
  97. all_vars$metadata_sample <- metadata_sample
  98. all_vars$diagnosis <- diagnosis
  99. all_vars$ref_projection <- ref_projection
  100. all_vars$preprocessing_file <- preprocessing_file
  101. all_vars$annotation_file <- annotation_file
  102. all_vars$niche_file <- niche_file
  103. all_vars$sample_raw_data_dir <- sample_raw_data_dir
  104. all_vars$h5_file_cell_feature_mat <- h5_file_cell_feature_mat
  105. all_vars$marker_genes_list <- marker_genes_list
  106. return (all_vars)
  107. }
  108. # ReadMarkerGenesEPN is the ReadMarkerGenes function specific to ependymoma project. It returns a list which maps
  109. # the celltypes to a vector of the genes which are marker for it
  110. # NOTE: Here, we are assuming that the annotation column is called Annotation_Sara
  111. ReadMarkerGenesEPN <- function(marker_genes, metadata){
  112. # replace the spaces in the Annotation column with underscores
  113. marker_genes$Annotation_Sara <- gsub(" ", "_", marker_genes$Annotation_Sara)
  114. # just limit to the columns we are interested in
  115. marker_genes <- marker_genes[, c('Gene', 'Annotation_Sara')]
  116. # if the sample doesn't have zfta-rela fusion genes, then remove them from marker_genes
  117. if (metadata$ZFTAFusionPositive == 0){
  118. marker_genes <- marker_genes %>%
  119. filter(!(Gene %in% c('ZFTA_RELA_Fusion1', 'ZFTA_RELA_Fusion2', 'ZFTA_RELA_Fusion3')))
  120. }
  121. # extract the list for all markers as it will also be used
  122. marker_genes_list <- marker_genes %>%
  123. filter(!is.na(Annotation_Sara)) %>% # remove the NA rows (because these are those genes, which didn't have a label in excel)
  124. # do some renaming of Annotation values
  125. mutate(Annotation_Sara = str_replace(Annotation_Sara, 'Neurons.*', 'Neurons')) %>%
  126. mutate(Annotation_Sara = str_replace(Annotation_Sara, 'Microglia', 'Myeloid')) %>%
  127. mutate(Annotation_Sara = str_replace(Annotation_Sara, 'Endothelial.*', 'Endothelial')) %>%
  128. mutate(Annotation_Sara = str_replace(Annotation_Sara, 'Dendritic_cell', 'Myeloid')) %>%
  129. dplyr::group_by(Annotation_Sara) %>%
  130. dplyr::summarise(Gene_list = list(Gene)) %>%
  131. deframe()
  132. # remove astrocyte marker genes from the list because in ependymoma, we don't expect much astrocytes and
  133. # with these genes, we were observing many astrocytes where we expect cancer cells
  134. marker_genes_list$Astrocyte = NULL
  135. return (marker_genes_list)
  136. }
  137. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  138. #~~~~~~~~~~~~~~~~~~~~ FUNCTIONS WHILE PREPARING SINGLE CELL OBJECT FOR SPATIAL ANALYSIS ~~~~~~~~~~~~~~~~~~~~
  139. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  140. # function to process a single cell object by performing the standard steps like pca, clustering etc.
  141. RunFullSeurat_v5 <- function(cm, metadata, do.scale = FALSE, do.center = TRUE, doBatch = F, var2batch = NULL,
  142. batchMethod = 'harmony', resolution = 1, dims = 20, pca_dims = 100, n.neighbors = 30,
  143. tsne_perplexity = 30, project, norm.type = 'RNA', verbose = FALSE){
  144. #seurat_obj <- preprocessSeuratObject_v5(cm, project = project, min.cells = 0, min.genes = 0, scale.factor = 1E5, do.scale = do.scale, do.center = do.center, norm.type = norm.type, mt.pattern = mt.pattern, verbose = verbose)
  145. seurat_obj <- preprocessSeuratObject_v5(cm, project = project, min.cells = 0, min.genes = 0, scale.factor = 1E5, do.scale = do.scale, do.center = do.center, norm.type = norm.type, verbose = verbose)
  146. if (is.data.frame(metadata) | is.matrix(metadata)) {
  147. seurat_obj <- AddMetaData(seurat_obj, metadata)
  148. } else if (is.vector(metadata)) {
  149. seurat_obj <- AddMetaData(seurat_obj, metadata, col.name = 'sample')
  150. }
  151. if (norm.type == 'RNA') {
  152. seurat_obj <- RunPCA(object = seurat_obj, features = VariableFeatures(seurat_obj), npcs = pca_dims, ndims.print = 1:5, nfeatures.print = 5, verbose = verbose)
  153. if (dims <= 1) {
  154. dims <- optimizePCA(seurat_obj, dims)
  155. #message("Using ", dims, " PCs as optimal number!")
  156. }
  157. }
  158. if (doBatch){
  159. seurat_obj[["RNA"]] <- split(seurat_obj[["RNA"]], f = [email hidden] %>% pull(var2batch))
  160. if (norm.type == 'RNA') {
  161. seurat_obj <- suppressWarnings(NormalizeData(seurat_obj, verbose = verbose)) %>%
  162. FindVariableFeatures(verbose = verbose) %>%
  163. ScaleData(verbose = verbose) %>%
  164. RunPCA(npcs = pca_dims, verbose = verbose) %>%
  165. FindNeighbors(dims = 1:dims, reduction = "pca", verbose = verbose) %>%
  166. FindClusters(resolution = resolution, cluster.name = "unintegrated_clusters", verbose = verbose) %>%
  167. RunUMAP(dims = 1:dims, reduction = "pca", reduction.name = "umap.unintegrated", min.dist = 0.8, verbose = verbose, return.model = TRUE) %>%
  168. RunTSNE(dims = 1:dims, reduction = "pca", reduction.name = "tsne.unintegrated", num_threads = 8, perplexity = tsne_perplexity, check_duplicates = F, verbose = verbose)
  169. } else if (norm.type == 'SCT') {
  170. seurat_obj <- SCTransform(seurat_obj, vst.flavor = "v2", method = "glmGamPoi", verbose = verbose)
  171. seurat_obj <- RunPCA(seurat_obj, npcs = pca_dims, verbose = verbose)
  172. if (dims <= 1) {dims <- optimizePCA(seurat_obj, dims)}
  173. seurat_obj <- seurat_obj %>%
  174. FindNeighbors(reduction = "pca", dims = 1:dims, verbose = verbose) %>%
  175. FindClusters(resolution = resolution, cluster.name = "unintegrated_clusters", verbose = verbose) %>%
  176. RunUMAP(reduction = "pca", dims = 1:dims, reduction.name = "umap.unintegrated", min.dist = 0.8, return.model = TRUE, verbose = verbose) %>%
  177. RunTSNE(dims = 1:dims, reduction = "pca", reduction.name = "tsne.unintegrated", num_threads = 8, perplexity = tsne_perplexity, check_duplicates = F, verbose = verbose)
  178. }
  179. if (batchMethod != 'all') {
  180. message(glue("Performing batch correction using {batchMethod}"))
  181. met <- switch(batchMethod, cca = CCAIntegration, rpca = RPCAIntegration, harmony = HarmonyIntegration, mnn = FastMNNIntegration, NA)
  182. reduc <- switch(batchMethod, cca = 'integrated.cca', rpca = 'integrated.rpca', harmony = 'harmony', mnn = 'integrated.mnn', NA)
  183. #if (sum([email hidden] %>% group_by_at(var2batch) %>% summarise(n = n()) %>% arrange(n) %>% pull(n) < 200) > 0 & batchMethod %in% c('cca', 'rpca')) {
  184. # seurat_obj <- IntegrateLayers(object = seurat_obj, method = met, orig.reduction = "pca", new.reduction = reduc, verbose = verbose, k.anchor = 10)
  185. #} else {
  186. # seurat_obj <- IntegrateLayers(object = seurat_obj, method = met, orig.reduction = "pca", new.reduction = reduc, verbose = verbose)
  187. #}
  188. seurat_obj <- IntegrateLayers(object = seurat_obj, method = met, orig.reduction = "pca", new.reduction = reduc, verbose = verbose)
  189. seurat_obj <- seurat_obj %>%
  190. FindNeighbors(reduction = reduc, dims = 1:dims, verbose = verbose) %>%
  191. FindClusters(resolution = resolution, cluster.name = glue("{batchMethod}_clusters"), verbose = verbose) %>%
  192. RunUMAP(reduction = reduc, dims = 1:dims, reduction.name = glue("umap.{batchMethod}"), min.dist = 0.8, verbose = verbose, return.model = TRUE) %>%
  193. RunTSNE(reduction = reduc, dims = 1:dims, reduction.name = glue("tsne.{batchMethod}"), num_threads = 8, perplexity = tsne_perplexity, check_duplicates = F, verbose = verbose)
  194. } else if (batchMethod == 'all') {
  195. integration_methods <- c('cca', 'rpca', 'harmony', 'mnn')
  196. for (intMet in integration_methods) {
  197. message(glue("Performing batch correction using {intMet}"))
  198. met <- switch(intMet, cca = CCAIntegration, rpca = RPCAIntegration, harmony = HarmonyIntegration, mnn = FastMNNIntegration, NA)
  199. reduc <- switch(intMet, cca = 'integrated.cca', rpca = 'integrated.rpca', harmony = 'harmony', mnn = 'integrated.mnn', NA)
  200. #if (sum([email hidden] %>% group_by_at(var2batch) %>% summarise(n = n()) %>% arrange(n) %>% pull(n) < 200) > 0 & intMet %in% c('cca', 'rpca')) {
  201. # seurat_obj <- IntegrateLayers(object = seurat_obj, method = met, orig.reduction = "pca", new.reduction = reduc, verbose = verbose, k.anchor = 10)
  202. #} else {
  203. # seurat_obj <- IntegrateLayers(object = seurat_obj, method = met, orig.reduction = "pca", new.reduction = reduc, verbose = verbose)
  204. #}
  205. seurat_obj <- IntegrateLayers(object = seurat_obj, method = met, orig.reduction = "pca", new.reduction = reduc, verbose = verbose)
  206. seurat_obj <- seurat_obj %>%
  207. FindNeighbors(reduction = reduc, dims = 1:dims, verbose = verbose) %>%
  208. FindClusters(resolution = resolution, cluster.name = glue("{intMet}_clusters"), verbose = verbose) %>%
  209. RunUMAP(reduction = reduc, dims = 1:dims, reduction.name = glue("umap.{intMet}"), min.dist = 0.8, verbose = verbose, return.model = TRUE) %>%
  210. RunTSNE(reduction = reduc, dims = 1:dims, reduction.name = glue("tsne.{intMet}"), num_threads = 8, perplexity = tsne_perplexity, check_duplicates = F, verbose = verbose)
  211. }
  212. }
  213. if (norm.type == 'RNA') {
  214. seurat_obj <- JoinLayers(seurat_obj)
  215. } else if (norm.type == 'SCT') {
  216. seurat_obj <- PrepSCTFindMarkers(seurat_obj, verbose = verbose)
  217. }
  218. } else {
  219. if (norm.type == 'RNA') {
  220. seurat_obj <- seurat_obj %>%
  221. FindNeighbors(reduction = 'pca', dims = 1:dims, verbose = verbose) %>%
  222. FindClusters(resolution = resolution, verbose = verbose) %>%
  223. RunUMAP(reduction = 'pca', dims = 1:dims, n.neighbors = n.neighbors, min.dist = 0.8, verbose = verbose, return.model = TRUE) %>%
  224. RunTSNE(reduction = 'pca', dims = 1:dims, num_threads = 8, perplexity = tsne_perplexity, check_duplicates = F, verbose = verbose)
  225. } else if (norm.type == 'SCT') {
  226. seurat_obj <- SCTransform(seurat_obj, vst.flavor = "v2", method = "glmGamPoi", verbose = verbose)
  227. seurat_obj <- RunPCA(seurat_obj, npcs = pca_dims, verbose = verbose)
  228. if (dims <= 1) {dims <- optimizePCA(seurat_obj, dims)}
  229. seurat_obj <- seurat_obj %>%
  230. FindNeighbors(reduction = "pca", dims = 1:dims, verbose = verbose) %>%
  231. FindClusters(resolution = resolution, verbose = verbose) %>%
  232. RunUMAP(reduction = "pca", dims = 1:dims, min.dist = 0.8, return.model = TRUE, verbose = verbose) %>%
  233. RunTSNE(reduction = 'pca', dims = 1:dims, num_threads = 8, perplexity = tsne_perplexity, check_duplicates = F, verbose = verbose)
  234. }
  235. }
  236. return(seurat_obj)
  237. }
  238. # preprocessing helper function used in RunFullSeurat_v5 function
  239. preprocessSeuratObject_v5 <- function(cm, project, min.cells = 0, min.genes = 0, scale.factor = 1E5, do.scale = F, do.center = T, norm.type = 'RNA', verbose){
  240. if (norm.type == 'RNA') {
  241. ## Create Seurat Obj, Normalize, variable genes, scaling data,
  242. message("Creating Seurat object, normalizing, variable genes and scaling data...")
  243. suppressWarnings(seurat_obj <- CreateSeuratObject(Matrix::Matrix(as.matrix(cm),sparse = T), min.cells = min.cells, min.features = min.genes, project = project) %>%
  244. NormalizeData(normalization.method = "LogNormalize", scale.factor = scale.factor, verbose = verbose) %>%
  245. FindVariableFeatures(mean.function = ExpMean, dispersion.function = LogVMR, verbose = verbose) %>%
  246. ScaleData(do.scale = do.scale, do.center = do.center, verbose = verbose))
  247. } else if (norm.type == 'SCT') {
  248. message("Creating Seurat object...")
  249. suppressWarnings(seurat_obj <- CreateSeuratObject(Matrix::Matrix(as.matrix(cm),sparse = T), min.cells = min.cells, min.features = min.genes, project = project) %>%
  250. NormalizeData(normalization.method = "LogNormalize", scale.factor = scale.factor, verbose = verbose))
  251. }
  252. return(seurat_obj)
  253. }
  254. # create the reference from base single cell object. Specifically used in epn project.
  255. CreateReferenceFromBaseSC_EPN <- function(seurat_object, seurat_object_mal, subset){
  256. # for both objects, set the identity as subtype, and subset according to which subtype's reference we are creating
  257. Idents(seurat_object) <- 'Subtype'
  258. Idents(seurat_object_mal) <- 'Subtype'
  259. if (subset == "ZR"){
  260. seurat_object_subset <- subset(seurat_object, idents = 'ZFTA-RELA')
  261. seurat_object_subset_mal <- subset(seurat_object_mal, idents = 'ZFTA-RELA')
  262. }else if (subset == "NC"){
  263. seurat_object_subset <- subset(seurat_object, idents = c("ZFTA-Cluster 1", "ZFTA-Cluster 2", "ZFTA-Cluster 3", "ZFTA-Cluster 4"))
  264. seurat_object_subset_mal <- subset(seurat_object_mal, idents = c("ZFTA-Cluster 1", "ZFTA-Cluster 2", "ZFTA-Cluster 3", "ZFTA-Cluster 4"))
  265. }else if (subset == "YAP1"){
  266. seurat_object_subset <- subset(seurat_object, idents = 'ST-YAP1')
  267. seurat_object_subset_mal <- subset(seurat_object_mal, idents = 'ST-YAP1')
  268. }else{
  269. stop('Wrong value of argument "subset" supplied. It is should be one of "ZR", "NC", "YAP1"')
  270. }
  271. # subset seurat_object_subset to normal cells only
  272. Idents(seurat_object_subset) <- 'malignant'
  273. seurat_object_subset_normal <- subset(seurat_object_subset, idents = 'Non-malignant')
  274. sort(unique(seurat_object_subset_normal$Sample_deID))
  275. # concatenate the normal and mal subparts
  276. seurat_object <- merge(seurat_object_subset_normal, seurat_object_subset_mal) # after this point, the expression
  277. # information is still split into different layers (which is useful if doing integration). Since we
  278. # are not doing that, we rejoin the layers by calling the JoinLayers function
  279. table(seurat_object$cell_type)
  280. seurat_object <- JoinLayers(seurat_object)
  281. # remove unclassified
  282. Idents(seurat_object) <- 'cell_type'
  283. seurat_object <- subset(seurat_object, idents = 'Unclassified', invert = T)
  284. # reprocess normal+malignant object with RunFullseurat
  285. metadata <- [email hidden]
  286. cm <- seurat_object[["RNA"]]$counts
  287. cm_norm <- as.matrix(log2(cm/10+1))
  288. cm_mean <- log2(Matrix::rowMeans(cm)+1)
  289. cm_center <- cm_norm - rowMeans(cm_norm)
  290. seurat_object <- RunFullSeurat_v5(cm = cm, metadata = metadata, doBatch = F, project = 'EPN')
  291. # make plots and just display
  292. p1 <- DimPlot(seurat_object, reduction = 'umap', group.by = 'cell_type', cols = colors, label.size = 4, label = T)
  293. p2 <- DimPlot(seurat_object, reduction = 'umap', group.by = 'Sample_deID', label.size = 4, label = T)
  294. show(patchwork::wrap_plots(p1, p2, ncol = 2))
  295. # run SCT
  296. seurat_object <- SCTransform(seurat_object, verbose = T)
  297. # return object
  298. return (seurat_object)
  299. }
  300. # score the cells corresponding to provided count matrix for the provided marker genes
  301. scoreNmfGenes <- function(cm_center, cm_mean, nmf_gene_list, cores = 8, verbose = FALSE, simple = FALSE){
  302. message("Scoring signatures... \n")
  303. results <- pbapply::pblapply(nmf_gene_list, function(x) {
  304. scores <- scoreSignature(cm_center, cm_mean, x, verbose = verbose, simple = simple, cores = cores)
  305. })
  306. results <- do.call('rbind', results)
  307. return(results)
  308. }
  309. ## Compute plain average expression or control corrected signature score (used in function scoreNmfGenes)
  310. ## @param X.center centered relative expression
  311. ## @param X.mean average of relative expression of each gene (log2 transformed)
  312. ## @param n number of genes with closest average expression for control genesets, default = 100
  313. ## @param simple whether use average, default = FALSE
  314. scoreSignature <- function(X.center, X.mean, s, n = 100, cores, simple = FALSE, verbose = FALSE) {
  315. if(verbose) {
  316. message("cells: ", ncol(X.center))
  317. message("genes: ", nrow(X.center))
  318. message("genes in signature: ", length(s))
  319. message("Using simple average?", simple)
  320. message("processing...")
  321. }
  322. s <- intersect(rownames(X.center), s)
  323. if (verbose) {message("genes in signature, and also in this dataset: ", length(s))}
  324. ##message("These genes are: ", s)
  325. if (simple){
  326. s.score <- colMeans(X.center[s,])
  327. }else{
  328. if (length(s) > 100) {
  329. s.score <- Matrix::colMeans(do.call(rbind, mclapply(s, function(g) {
  330. g.n <- names(sort(abs(X.mean[g] - X.mean))[2:(n+1)])
  331. X.center[g, ] - Matrix::colMeans(X.center[g.n, ])
  332. }, mc.cores = cores)))
  333. } else {
  334. s.score <- colMeans(do.call(rbind, lapply(s, function(g) {
  335. g.n <- names(sort(abs(X.mean[g] - X.mean))[2:(n+1)])
  336. X.center[g, ] - colMeans(X.center[g.n, ])
  337. })))
  338. }
  339. }
  340. if(verbose) message(" done")
  341. return(s.score)
  342. }
  343. # get the score and corresponding annotation of each cell for a certain rank
  344. metagene_score_signature <- function(df, num_metagene, rank=1){
  345. col_names = colnames(df)
  346. df$tmp1 = apply(df[,1:num_metagene], 1,
  347. function(x) sort(x, decreasing = T)[rank])
  348. df$tmp2 = apply(df[,1:num_metagene], 1,
  349. function(x) names(sort(x, decreasing = T))[rank])
  350. col_names = c(col_names, paste0("score_", rank), paste0("signature_", rank))
  351. colnames(df) = col_names
  352. return(df)
  353. }
  354. # Project dataset in a query (dotplot). Modification of the dotplot making function by Shashank.
  355. projectDataNoScalingSK <- function(query_cm, query_degs, ref_cm, ref_degs, query_categories_ordered, ref_categories_ordered, filter_top_genes) {
  356. # Filtering out genes with none expression
  357. ref_cm_filtered <- ref_cm[rowSums(ref_cm) > 0, ref_categories_ordered]
  358. query_cm_filtered <- query_cm[rowSums(query_cm) > 0, query_categories_ordered]
  359. # filtering out genes which are not present in the other dataset
  360. common_genes <- intersect(rownames(ref_cm_filtered), rownames(query_cm_filtered))
  361. query_cm_filtered <- query_cm_filtered[common_genes, ]
  362. query_degs_filtered <- lapply(query_degs, function(x) x[x %in% common_genes])
  363. ref_cm_filtered <- ref_cm_filtered[common_genes, ]
  364. ref_degs_filtered <- lapply(ref_degs, function(x) x[x %in% common_genes])
  365. # keep only the top_n genes (designated by argument filter_top_genes) in both the deg objects
  366. # query_degs_filtered <- lapply(query_degs_filtered, function(x) x[1:filter_top_genes])
  367. # ref_degs_filtered <- lapply(ref_degs_filtered, function(x) x[1:filter_top_genes])
  368. # Normalize data
  369. query_cm_filtered <- t(t(query_cm_filtered)/colSums(query_cm_filtered))*1E4
  370. query_cm_norm <- log2(query_cm_filtered/10+1)
  371. # query_cm_norm <- log2(query_cm_filtered+1)
  372. query_cm_mean <- log2(rowMeans(query_cm_filtered)+1)
  373. query_cm_center <- t(scale(t(query_cm_norm)))
  374. ref_cm_filtered <- t(t(ref_cm_filtered)/colSums(ref_cm_filtered))*1E4
  375. ref_cm_norm <- log2(ref_cm_filtered+1)
  376. ref_cm_mean <- log2(rowMeans(ref_cm_filtered)+1)
  377. ref_cm_center <- t(scale(t(ref_cm_norm)))
  378. # Score metagene programs in ref scRNA-seq data
  379. message('Scoring query signatures in reference...')
  380. normal_score <- t(scoreNmfGenes(ref_cm_center, ref_cm_mean, query_degs_filtered, verbose = F))
  381. # Score malignant cells with ref DEGs
  382. message('Scoring reference signatures in query...')
  383. tumor_score <- scoreNmfGenes(query_cm_center, query_cm_mean, ref_degs_filtered, verbose = F)
  384. tumor_score <- tumor_score[, colnames(normal_score)]
  385. message('Saving plot...')
  386. ## max-min normalization and melt scoring normal cells by malignant metaprogram
  387. normal_score_long <- reshape2::melt(normal_score)
  388. colnames(normal_score_long) <- c("Cell_type", "Metaprogram", "normal_score")
  389. ## max-min normalization and melt scoring tumor cells by normal DEGs
  390. tumor_score_long <- reshape2::melt(tumor_score)
  391. colnames(tumor_score_long) <- c("Cell_type", "Metaprogram", "tumor_score")
  392. ## Combine into one and Trim values lower then 0 and greater then 1 (make less than 0 values into 0, and more than 1 values into 1)
  393. plot_df <- as_tibble(normal_score_long)
  394. plot_df$tumor_score <- tumor_score_long$tumor_score # simply attaching tumor scores instead of left_joining because the order of celltype-metaprogram rows should be same (it was ensured above)
  395. plot_df$normal_score = trimScores(plot_df$normal_score, 1, 0)
  396. plot_df$tumor_score = trimScores(plot_df$tumor_score, 1, 0)
  397. ## Sort metaprogram order
  398. plot_df$Metaprogram <- factor(plot_df$Metaprogram, levels = gsub("_", "-", query_categories_ordered))
  399. plot_df$Cell_type <- factor(plot_df$Cell_type, levels = ref_categories_ordered)
  400. ## Plot
  401. pt <- ggplot(plot_df, aes(x=Cell_type, y=Metaprogram)) +
  402. geom_point(aes(color=tumor_score, size=normal_score)) + scale_size_area(max_size=9) +
  403. paletteer::scale_colour_paletteer_c("viridis::mako", direction = -1) +
  404. labs(x = "Normal cell type", y = "Malignant metaprogram",
  405. color = "Expression score\n(tumor cells)", size = "Expression score\n(normal cells)") +
  406. theme_classic() +
  407. theme(axis.title = element_text(size = 16),
  408. axis.text.x = element_text(size = 16, hjust = 1, angle = 45, color = 'black'),
  409. axis.text.y = element_text(size = 16, color = 'black'),
  410. legend.title = element_text(size = 16), legend.text = element_text(size = 16),
  411. plot.background = element_rect(fill = alpha("white", 0)), panel.grid.major.x = element_blank(),
  412. panel.grid.major.y = element_line(size = 0.5, linetype = 'dashed', colour = "grey"))
  413. return (list(pt, plot_df))
  414. }
  415. # function to clip values (used in dotplot making function above)
  416. trimScores <- function(metagene_scores, upper, lower){
  417. tmp = ifelse(metagene_scores > upper, upper, ifelse(metagene_scores < lower, lower, metagene_scores))
  418. return(tmp)
  419. }
  420. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  421. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTIONS FOR PREPROCESSING XENIUM DATA ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  422. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  423. # Function to preprocess the xenium sequencing output. Steps include: sctransform, pca, umap, clustering
  424. RunFullXeniumEPN <- function(smp, rawDir, outFile) {
  425. ## Preprocessing seurat objects
  426. message(green('-------------------------------------------------------'))
  427. message(blue(glue('Starting pre-processing for sample: {yellow$underline$bold(smp)}!!')))
  428. message(blue('[1/5] Loading Xenium raw files...'))
  429. suppressWarnings(suppressMessages(xenium.obj <- LoadXenium(rawDir, fov = "fov", segmentations = 'cell')))
  430. xenium.obj <- subset(xenium.obj, subset = nCount_Xenium > 0)
  431. message(glue("{ncol(xenium.obj)} cells."))
  432. message(blue('[2/5] Running SCTransform-based normalization...'))
  433. xenium.obj <- SCTransform(xenium.obj, assay = "Xenium", vars.to.regress = c('nFeature_Xenium', 'nCount_Xenium'), vst.flavor = "v2", verbose = FALSE)
  434. message(blue('[3/5] Running PCA and UMAP reductions...'))
  435. xenium.obj <- RunPCA(xenium.obj, npcs = 50, features = rownames(xenium.obj), verbose = FALSE)
  436. xenium.obj <- RunUMAP(xenium.obj, dims = 1:optimizePCA(xenium.obj, 0.8), verbose = FALSE)
  437. message(blue('[4/5] Clustering...'))
  438. xenium.obj <- FindNeighbors(xenium.obj, reduction = "pca", dims = 1:optimizePCA(xenium.obj, 0.8), verbose = FALSE)
  439. xenium.obj <- FindClusters(xenium.obj, resolution = seq(0.1, 1, 0.1), verbose = FALSE)
  440. xenium.obj <- changeClusterNumbers(xenium.obj)
  441. message(blue('[5/5] Saving'))
  442. qsave(xenium.obj, outFile)
  443. # also return the data object, so that we can make some plots visualizing the quality of data
  444. return (xenium.obj)
  445. }
  446. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  447. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTIONS FOR ANNOTATING XENIUM DATA ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  448. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  449. # Perform annotation on the spatial sample. Some important arguments of it are: i) a yaml file with information about the
  450. # manual annotation of the normal celltypes ii) path to the single cell reference iii) marker genes list, etc. This is one
  451. # of the most important functions.
  452. # data_dir is where we save the output data and csv file with cell annotations
  453. # plot_dir is where we save the plots of annotation (dimplots and imagedimplots)
  454. XeniumCellAssignment <- function(data, ref_projection, sample_name, marker_genes_list, malignant_celltypes,
  455. manual_annotation_yaml, colors, data_dir, plot_dir) {
  456. message(green('-------------------------------------------------------'))
  457. message(blue(paste0('[1/6] Add the manual, normal celltype annotations to the seurat obj')))
  458. data <- AddNormalCellManualAnnotations(data, manual_annotation_yaml, sample_name)
  459. message(green('-------------------------------------------------------'))
  460. message(blue(paste0('[2/6] Get annotations from scMapping on the malignant subset')))
  461. # subset data to just mal cells
  462. Idents(data) <- 'cell_type'
  463. data_mal <- subset(data, idents = 'Unknown')
  464. # read and subset reference to malignant cells
  465. sc_ref <- qread(ref_projection)
  466. Idents(sc_ref) <- 'cell_type'
  467. ref_projection_mal <- subset(sc_ref, idents = intersect(malignant_celltypes, sc_ref$cell_type))
  468. # get the annotations from the single cell mapping (with mean centering)
  469. data_mal <- GetAnnotationsFromScMappingEPN(data_mal, ref_projection_mal, mean_center = TRUE)
  470. message(green('-------------------------------------------------------'))
  471. message(blue(paste0('[3/6] Also get annotations from panel on the malignant subset, just for plotting')))
  472. marker_genes_list_mal <- marker_genes_list[intersect(malignant_celltypes, names(marker_genes_list))]
  473. data_mal <- GetAnnotationsFromSpatialPanelEPN(data_mal, marker_genes_list_mal, mean_center = TRUE)
  474. message(green('-------------------------------------------------------'))
  475. message(blue(paste0('[4/6] Combine annotations from the malignant part and normal part')))
  476. [email hidden][[email hidden]$cell_type == 'Unknown', 'cell_type'] <- data_mal$predicted_label_snRNAseq # now that we have the annotations for the cancer cells too, we just have to add the annotation information from data_mal to data
  477. message(green('-------------------------------------------------------'))
  478. message(blue(paste0('[5/6] Plot cell assignment')))
  479. # UMAPs
  480. p1 <- DimPlot(data_mal, reduction = 'umap', group.by = 'predicted_label_snRNAseq', cols = colors) + labs(title = 'scMapping labels on the cancer subset')
  481. p2 <- DimPlot(data_mal, reduction = 'umap', group.by = 'predicted_label_UCell', cols = colors) + labs(title = 'Panel labels on the cancer subset')
  482. p3 <- DimPlot(data, reduction = 'umap', group.by = 'cell_type', cols = colors) + labs(title = 'Final cell type labels')
  483. p1+p2+p3
  484. ggsave(file.path(plot_dir, paste0('2_UMAP_classification_', sample_name, '.pdf')), width = 20, height = 6)
  485. # Spatial Plots
  486. dot_size <- 0.4 # dot_size suitable for visualizing samples with less cells and those with more cells
  487. ImageDimPlot(data, group.by = 'cell_type', size = dot_size, border.size = NA, dark.background = F, cols = colors)
  488. ggsave(file.path(plot_dir, paste0('3_SpatialMaps_', sample_name, '.pdf')), width = 7, height = 6)
  489. message(green('-------------------------------------------------------'))
  490. message(blue(paste0('[6/6] Save annotated object')))
  491. # save qs file
  492. qsave(data, file.path(data_dir, paste0('seurat_obj_', sample_name, '.qs')))
  493. # export cell ID
  494. cell_id <- data.frame(rownames([email hidden]), [email hidden]$cell_type)
  495. colnames(cell_id)[colnames(cell_id) == "rownames.data.meta.data."] <- "cell_id"
  496. colnames(cell_id)[colnames(cell_id) == "data.meta.data.cell_type"] <- "group"
  497. write_csv(cell_id, file.path(data_dir, paste0('cell_ID_', sample_name, ".csv")))
  498. }
  499. # GetAnnotationsFromScMapping function takes in the data, the location of the single cell reference
  500. # object and using the anchor finding and transfer anchors functions, determines the celltypes for each cell
  501. # mean_center = TRUE means that after we get scores for each cell for each celltype, we will mean center the
  502. # scores values for a given celltype.
  503. # NOTE: ENSURE THE COLUMN IN THE REFERENCE SEURAT OBJECT WITH ANNOTATIONS IS CALLED cell_type
  504. GetAnnotationsFromScMappingEPN <- function(data, ref_projection, mean_center = FALSE, sc_annotations_colname = 'predicted_label_snRNAseq'){
  505. # gracefully read ref_projection (depending on if it is the actual object or the path to it)
  506. seurat_object <- ReadRefProjection(ref_projection)
  507. # make sure the identity of the sc seurat object is 'cell_type'
  508. Idents(seurat_object) <- 'cell_type'
  509. # transfer anchors from single cell data
  510. anchors <- FindTransferAnchors(reference = seurat_object, query = data, normalization.method = "SCT", npcs = 50)
  511. # transfer labels
  512. predictions <- TransferData(anchorset = anchors, refdata = seurat_object$cell_type, weight.reduction = data[["pca"]], dims = 1:20)
  513. # store in a copy, the neatened version (removed the score.max and predicted.id cols, and renamed colnames appropriately) of predictions df.
  514. predictions_copy <- NeatenPredictionsDF(predictions)
  515. if (mean_center == TRUE){
  516. # mean-center the prediction scores so that celltypes which have high score in general get removed (like neuroepithelial)
  517. predictions_copy <- MeanCenterDF(predictions_copy, center_by = 'col')
  518. }
  519. # get the predicted id according to which col has max value in each row
  520. predicted_id <- apply(predictions_copy, 1, function(row){
  521. colnames(predictions_copy)[which.max(row)]
  522. })
  523. # add the predicted labels to the data and information about each celltypes' prediction scores
  524. data <- AddMetaData(object = data, metadata = predicted_id, col.name = sc_annotations_colname)
  525. data <- AddMetaData(object = data, metadata = predictions_copy, col.name = paste0(colnames(predictions_copy), '_sc'))
  526. return (data)
  527. }
  528. # get the annotations of different celltypes using a list of celltype:marker_genes. Returned data object has a column with predictions
  529. # for each cell (panel_annotations_colname) and an individual column storing score for each celltype for each cell.
  530. # mean_center = TRUE means that for the scores for any celltype, we will mean-center it, so that all the celltypes
  531. # are at a level playing field before finding which celltype has highest score for a given cell.
  532. GetAnnotationsFromSpatialPanelEPN <- function(data, marker_genes_list, mean_center = FALSE, panel_annotations_colname = 'predicted_label_UCell'){
  533. DefaultAssay(data) <- 'SCT'
  534. # add module scores with Ucell
  535. data <- AddModuleScore_UCell(data, features = marker_genes_list)
  536. U_Cell_signatures <- paste0(names(marker_genes_list), '_UCell')
  537. # retrieve the UCell scores and print the mean max UCell score for early identification of possible problems
  538. UCell_scores <- [email hidden][, U_Cell_signatures]
  539. max_scores <- apply(UCell_scores, 1, max)
  540. mean_max_score <- mean(max_scores)
  541. print(paste0('Mean max UCell score is ', mean_max_score))
  542. if (mean_center == TRUE){
  543. # perform mean correction on the UCell_scores df, so that the different celltypes' scores are on a level playing field
  544. UCell_scores <- MeanCenterDF(UCell_scores, center_by = 'col')
  545. # modify the existing prediction scores to the mean corrected values for each celltype in [email hidden]
  546. data <- AddMetaData(object = data, metadata = UCell_scores, col.name = colnames(UCell_scores))
  547. }
  548. # get the predictions
  549. UCell_scores$cell_type_UCell <- apply(UCell_scores, 1, function(row){
  550. names(UCell_scores)[which.max(row)]
  551. })
  552. # Remove "_UCell" from each element and add predicted labels to metadata
  553. UCell_scores$cell_type_UCell <- gsub("_UCell", "", UCell_scores$cell_type_UCell)
  554. data <- AddMetaData(object = data, metadata = UCell_scores$cell_type_UCell, col.name = panel_annotations_colname)
  555. return (data)
  556. }
  557. # version of AddNormalAnnotationsAndAnnotateRemainingCells specific to EPN project, which doesnt have step of annotating astrocytes
  558. AddNormalAnnotationsAndAnnotateRemainingCellsEPN <- function(data, manual_annotation_yaml, malignant_celltypes, ref_projection, marker_genes_list, method, mean_center){
  559. # get the annotations from the yaml file
  560. data <- AddNormalCellManualAnnotations(data, manual_annotation_yaml, sample_name)
  561. # subset data to just mal cells
  562. Idents(data) <- 'cell_type'
  563. data_mal <- subset(data, idents = 'Unknown')
  564. # now, according to which method is supplied, we obtain the annotations for the remaining cells
  565. if (method == 'sc_ref'){
  566. # read and subset reference to malignant cells
  567. sc_ref <- qread(ref_projection)
  568. Idents(sc_ref) <- 'cell_type'
  569. ref_projection_mal <- subset(sc_ref, idents = intersect(malignant_celltypes, sc_ref$cell_type))
  570. # get the annotations from the single cell mapping (with mean centering)
  571. data_mal <- GetAnnotationsFromScMapping(data_mal, ref_projection_mal, mean_center)
  572. # Combine annotations from the malignant part and normal part
  573. [email hidden][[email hidden]$cell_type == 'Unknown', 'cell_type'] <- data_mal$predicted_label_snRNAseq # now that we have the annotations for the cancer cells too, we just have to add the annotation information from data_mal to data
  574. }else if (method == 'panel'){
  575. # subset the marker_genes_list to malignant cells
  576. marker_genes_list_mal <- marker_genes_list[names(marker_genes_list) %in% malignant_celltypes]
  577. data_mal <- GetAnnotationsFromSpatialPanel(data_mal, marker_genes_list_mal, mean_center)
  578. # Combine annotations from the malignant part and normal part
  579. [email hidden][[email hidden]$cell_type == 'Unknown', 'cell_type'] <- data_mal$predicted_label_UCell # now that we have the annotations for the cancer cells too, we just have to add the annotation information from data_mal to data
  580. }else{
  581. stop("Invalid method. Should be either of 'sc_ref' or 'panel'")
  582. }
  583. return (data)
  584. }
  585. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  586. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTIONS FOR COHERENCE ANALYSIS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  587. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  588. # Prepare the data to perform Spatial Coherence. It basically modifies the cells_info df slightly by renaming cols etc,
  589. # and filters some cells and genes and returns the updated cells_info df, and cell_feature_matrix matrix.
  590. # cell_feature_matrix is the Matrix of raw counts (genes x cells). cells_info is a df with 3 cols: cell_id,
  591. # x_centroid, y_centroid
  592. prepareData <- function(cell_feature_matrix, cells_info, scale = 1, filter_genes = 10, filter_cells = 10) {
  593. # just modify the cell_feature_matrix slightly - rename the columns and make the cell_ids as rownames
  594. spatial <- cells_info %>% dplyr::select(c("cell_id", "x_centroid", "y_centroid")) %>%
  595. column_to_rownames("cell_id") %>%
  596. rename_all(~c("imagecol", "imagerow"))
  597. # multiply by the scale value, the coordinates of each cell
  598. spatial[["imagecol"]] = spatial[["imagecol"]] * scale
  599. spatial[["imagerow"]] = spatial[["imagerow"]] * scale
  600. # subset cell_feature_matrix to just those genes which are expressed in more than filter_genes cells.
  601. cell_feature_matrix <- cell_feature_matrix[rowSums(cell_feature_matrix) >= filter_genes, ]
  602. # subset cell_feature_matrix to just those cells which have more than filter_cells transcripts.
  603. cell_feature_matrix <- cell_feature_matrix[, colSums(cell_feature_matrix) >= filter_cells]
  604. # subset the spatial dataframe to just those cells which satisfied the above criteria
  605. spatial <- spatial[colnames(cell_feature_matrix), ]
  606. # return the list of spatial df, and the cell_feature_matrix, both filtered to have good cells and genes
  607. return(list(spatial = spatial, cell_feature_matrix = cell_feature_matrix))
  608. }
  609. # make a grid over the spatial data and get the information about x and y coordinates of each valid square (square in the
  610. # grid with atleast one cell beneath), and the celltype assigned to that square (the most-common celltype beneath that square)
  611. # norm_data: expression matrix of data (genes x cells), spatial: df storing x and y coordinates of each cell
  612. # variable: vector of celltypes for each cell, nbins: number of horizontal and vertical bins in the grid
  613. grid_spatial <- function(norm_data, spatial, variable, nbinsrow, nbinscol) {
  614. library(gplots)
  615. message(glue('{nbinsrow} by {nbinscol} has this many spots: {nbinsrow*nbinscol}'))
  616. n_squares = nbinsrow * nbinscol
  617. cell_bcs = colnames(norm_data)
  618. xs <- as.integer(unname(spatial$imagecol))
  619. ys <- as.integer(unname(spatial$imagerow))
  620. # make a 2d histogram which takes in two vectors of values in x and y dimensions, and the
  621. # number of bins in each dimension, and gives a histogram with the counts of cells (pair
  622. # of x and y coordinates) lying in each square of the histogram. We do this to get the x
  623. # breaks and y breaks which help in gridding.
  624. h2 <- hist2d(xs, ys, nbins = c(nbinscol, nbinsrow), show = F)
  625. grid_counts <- h2$counts
  626. xedges <- h2$x.breaks
  627. yedges <- h2$y.breaks
  628. grid_expr <- matrix(data = 0, nrow = n_squares, ncol = nrow(norm_data))
  629. grid_coords <- matrix(data = 0, nrow = n_squares, ncol = 2)
  630. grid_cell_counts <- rep(0, n_squares) # how many cells are there in each square
  631. cell_labels <- as.character(variable)
  632. cell_set = sort(unique(cell_labels))
  633. cell_info <- matrix(data = 0, nrow = n_squares, ncol = length(cell_set))
  634. pb <- txtProgressBar(min = 0, max = nbinscol, style = 3, width = 50, char = "=")
  635. for (x_coor in 1:nbinscol) {
  636. # x_coor <- 60
  637. # y_coor <- 50
  638. x_left <- xedges[x_coor]
  639. x_right <- xedges[x_coor + 1]
  640. for (y_coor in 1:nbinsrow) {
  641. # which square position we are in, in the flattened vector of bins
  642. n <- ((y_coor-1) * nbinscol) + x_coor
  643. y_down <- yedges[y_coor] # just the value of the current square's bottom edge
  644. y_up <- yedges[y_coor + 1] # just the value of the current square's top edge
  645. # get the center value of the current square and add to grid_coords matrix
  646. grid_coords[n, 1] = (x_right + x_left) / 2
  647. grid_coords[n, 2] = (y_up + y_down) / 2
  648. # Now determining the cells within the gridded area
  649. #if ((i != nbins-1) & (j == nbins-1)) { # top left corner
  650. if ((x_coor != nbinscol-1) & (y_coor == nbinsrow)) { # top left corner
  651. x_true = (xs >= x_left) & (xs < x_right)
  652. y_true = (ys <= y_up) & (ys > y_down)
  653. #} else if ((i == nbins - 1) & (j != nbins)) { # bottom right corner
  654. } else if ((x_coor == nbinscol - 1) & (y_coor != nbinsrow - 1)) { # bottom right corner
  655. x_true = (xs > x_left) & (xs <= x_right)
  656. y_true = (ys < y_up) & (ys >= y_down)
  657. } else { # average case
  658. x_true = (xs >= x_left) & (xs < x_right) # boolean of length num_cells, having true for cells with x coor within current square's x breaks
  659. y_true = (ys < y_up) & (ys >= y_down) # boolean of length num_cells, having true for cells with y coor within current square's y breaks
  660. }
  661. cell_bool = x_true & y_true # boolean of length num_cells, having true for cells with x and y coor within current square's x and y breaks
  662. grid_cells = cell_bcs[cell_bool] # barcodes of cells which are within current square
  663. grid_cell_counts[n] = length(grid_cells) # how many cells were there in the current square
  664. # Summing the expression across these cells to get the grid expression
  665. if (length(grid_cells) > 0) {
  666. if (length(grid_cells) != 1) {
  667. grid_expr[n,] = rowSums(norm_data[, cell_bool])
  668. } else {
  669. grid_expr[n,] = norm_data[, cell_bool]
  670. }
  671. }
  672. # If we have cell type information, will record
  673. if (length(grid_cells) > 0) {
  674. grid_cell_types <- cell_labels[cell_bool] # vector of celltypes of the cells in the current square
  675. tmp <- c() # vector of length=cell_set which will store the proportions of each celltype in current square
  676. for (ct in cell_set) {
  677. tmp <- c(tmp, length(which(grid_cell_types == ct)) / length(grid_cell_types))
  678. }
  679. cell_info[n, ] <- tmp
  680. }
  681. }
  682. setTxtProgressBar(pb, x_coor)
  683. }
  684. close(pb)
  685. # at the end of this loop, we have
  686. # grid_coords matrix filled (coordinate of each square),
  687. # grid_expr matrix filled (expression of each gene in each square),
  688. # grid_cell_counts vector filled (num_cells in each square),
  689. # cell_info matrix filled (proportion of each celltype in each square)
  690. # make grid_expr into a df from a matrix with appropriate rownames and colnames
  691. grid_expr <- grid_expr %>% as.data.frame()
  692. rownames(grid_expr) <- glue('grid_{1:n_squares}')
  693. colnames(grid_expr) <- rownames(norm_data)
  694. # in a list, combine all the data and store
  695. grid_data <- list(expr = grid_expr,
  696. image_col = grid_coords[,1],
  697. image_row = grid_coords[,2],
  698. n_cells = grid_cell_counts,
  699. grid_coords = grid_coords)
  700. # make cell_info into a df from a matrix with appropriate rownames and colnames
  701. cell_info <- cell_info %>% as.data.frame()
  702. rownames(cell_info) <- rownames(grid_expr)
  703. colnames(cell_info) <- cell_set
  704. # get the celltype associated to each square
  705. max_indices <- apply(cell_info, 1, function(x) names(which.max(x)))
  706. max_indices <- max_indices[grid_data$n_cells > 0] # limit to just those squares which have atleast one cell inside
  707. max_indices <- as.character(max_indices) # convert to a vector
  708. # subset the entries in grid data to just those squares which have atleast on cell inside them
  709. grid_data$expr <- grid_data$expr[grid_data$n_cells > 0, ]
  710. grid_data$image_col <- grid_data$image_col[grid_data$n_cells > 0]
  711. grid_data$image_row <- grid_data$image_row[grid_data$n_cells > 0]
  712. # make a dataframe storing the squares' x and y coordinates, and the most prominent celltypes in
  713. # them (only for the squares having atleast one cell inside)
  714. dt <- data.frame(x = grid_data$image_col, y = grid_data$image_row, Metaprogram = max_indices)
  715. return(dt)
  716. }
  717. # modification of function coherence_score. It has option of giving to pixels, a +1 even if their neighbor is empty pixel (equivalent
  718. # to taking percentage of neighboring cells same as itself)
  719. coherence_score <- function(grid_df, variable, empty_neighbors_increase_coherence = FALSE) {
  720. # get a dataframe, which will have the squares' y indices as rownames, their x indices as colnames,
  721. # and their associated celltype as entry. (There will be some entries with NA too, as not all squares were valid)
  722. mat <- grid_df %>% mutate(x = as.character(x)) %>% mutate(y = as.character(y))
  723. mat <- reshape2::acast(mat, y~x, value.var = variable) %>% as.data.frame()
  724. # IMPORTANT: here, we should reorder the colnames and rownames to be 'numeric' ascending
  725. mat <- mat[,as.character(sort(as.numeric(colnames(mat))))]
  726. mat <- mat[as.character(sort(as.numeric(rownames(mat)))),]
  727. rownames(mat) <- 1:nrow(mat)
  728. colnames(mat) <- 1:ncol(mat)
  729. programs <- unique(grid_df[[variable]]) # vector of unique cell_types
  730. results <- list()
  731. # loop through each program and for each, loop through grid to find the pixels for it and find their coherence
  732. for (program in programs) {
  733. tmp <- matrix(0, nrow = nrow(mat), ncol = ncol(mat), dimnames = list(rownames(mat), colnames(mat)))
  734. for (i in 1:nrow(mat)) {
  735. for (j in 1:ncol(mat)) {
  736. # if the current square has a celltype associated to it (and not NA)
  737. if (!is.na(mat[i,j])) {
  738. if (mat[i,j] == program) {
  739. # i = 50
  740. # j = 87
  741. # mat[i,j]
  742. # mat[49:51, 86:88]
  743. # tmp[49:51, 86:88]
  744. # perform the check for all neighbors (except itself, meaning i,j) and accordingly update tmp
  745. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i-1, j-1, mat, program, empty_neighbors_increase_coherence)
  746. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i-1, j, mat, program, empty_neighbors_increase_coherence)
  747. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i-1, j+1, mat, program, empty_neighbors_increase_coherence)
  748. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i, j-1, mat, program, empty_neighbors_increase_coherence)
  749. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i, j+1, mat, program, empty_neighbors_increase_coherence)
  750. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i+1, j-1, mat, program, empty_neighbors_increase_coherence)
  751. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i+1, j, mat, program, empty_neighbors_increase_coherence)
  752. tmp[i,j] <- tmp[i,j] + CheckIfPixelIsACelltype(i+1, j+1, mat, program, empty_neighbors_increase_coherence)
  753. }
  754. }
  755. }
  756. }
  757. results[[program]] <- tmp
  758. }
  759. counts <- grid_df %>% group_by(Metaprogram) %>% summarise(n = n())
  760. # get the mean coherence for each celltype
  761. tmp <- data.frame()
  762. for (metaprogram in counts[[variable]]) {
  763. if (sum(results[[metaprogram]]) == 0) {
  764. tmp <- rbind(tmp, data.frame(metaprogram = metaprogram, average = 0))
  765. } else {
  766. tmp <- rbind(tmp, data.frame(metaprogram = metaprogram, average = (sum(results[[metaprogram]]))/counts$n[counts[[variable]] == metaprogram]))
  767. }
  768. }
  769. # get the mean coherence for whole sample (Earlier, it was computed by simply taking average of mp_avg_coherences, but that is inaccurate)
  770. total_pixels_with_cells <- sum(counts$n)
  771. total_coherence_celltype_list <- lapply(results, sum) # list storing celltype:total_coherence
  772. total_coherence <- sum(as.numeric(total_coherence_celltype_list))
  773. overall_mean_coherence <- total_coherence/total_pixels_with_cells
  774. return(list(coherence_score = overall_mean_coherence, coherence_score_program = tmp, results_df = results, counts = counts))
  775. }
  776. # check a specific neighbor of a pixel and perform relevant checks (like being outside of grid), and return 1 if
  777. # that neighbor is causing coherence of the center pixel to increase (generally meaning its same celltype as center
  778. # pixel) and 0 otherwise. specific to usage within coherence_score function. Used when we check the neighbors of a
  779. # pixel in the grid, and assign it a coherence score.
  780. # empty_neighbors_increase_coherence = TRUE means we increase coherence if there is empty neighbor (return 1), else we dont.
  781. # tmp is the matrix in which we are storing the coherence scores for current program
  782. CheckIfPixelIsACelltype <- function(coor1, coor2, mat, program, empty_neighbors_increase_coherence = FALSE){
  783. # coor1 = 49
  784. # coor2 = 87
  785. # ensure its not outside grid. If its outside, simply return tmp
  786. if (coor1 < 1 | coor1 > nrow(mat)){return (0)}
  787. if (coor2 < 1 | coor2 > ncol(mat)){return (0)}
  788. # check if mat[coor1, coor2] is empty or non-empty (meaning there was some cell beneath the pixel or not)
  789. if (!is.na(mat[coor1,coor2])) {
  790. # if the pixel is not NA, then check its program, if same as given
  791. if (mat[coor1,coor2] == program){
  792. return (1)
  793. }
  794. }else{
  795. # if it was NA (empty pixel), then we change tmp depending on the argument empty_neighbors_increase_coherence
  796. if (empty_neighbors_increase_coherence == TRUE){
  797. return (1)
  798. }
  799. }
  800. return (0)
  801. }
  802. # plot the gridding of the coherence and save at the appropriate location. Can benefit from some reorganization.
  803. gridding_coherence_density <- function(gridding, coherence, sample_name, color_coherence_density, colors_metaprograms_Xenium) {
  804. # make the gridding plot
  805. p1 <- ggplot(gridding, aes(x = x, y = y, color = Metaprogram)) +
  806. geom_point(size = 0.2) +
  807. scale_color_manual(values = colors_metaprograms_Xenium) +
  808. theme_void() +
  809. guides(colour = guide_legend(override.aes = list(size = 4)))
  810. mat <- gridding %>% mutate(x = as.character(x)) %>% mutate(y = as.character(y))
  811. mat <- reshape2::acast(mat, y~x, value.var = 'Metaprogram') %>% as.data.frame()
  812. # IMPORTANT: reorder the columns and rows numerically and not alphabetically
  813. mat <- mat[,as.character(sort(as.numeric(colnames(mat))))]
  814. mat <- mat[as.character(sort(as.numeric(rownames(mat)))),]
  815. # Sum coherence score across all MPs for each position (regions with high coherence will score high)
  816. summed_matrix <- Reduce(`+`, coherence$results_df)
  817. #change x/y values with actual positions
  818. rownames(summed_matrix) <- rownames(mat)
  819. colnames(summed_matrix) <- colnames(mat)
  820. summed_matrix <- reshape2::melt(summed_matrix)
  821. df <- summed_matrix
  822. # y comes before because when we reshaped summed_matrix above, the rownames (which had y-values) became the first col after reshaping
  823. colnames(df) <- c("y", "x", "value") # Rename columns
  824. # Convert x and y to numeric if necessary
  825. df$x <- as.numeric(as.character(df$x))
  826. df$y <- as.numeric(as.character(df$y))
  827. df$value <- as.numeric(as.character(df$value))
  828. # Plot density of spatial cohernece score
  829. p2 <- ggplot(df, aes(x = x, y = y, color = factor(value))) +
  830. geom_point(size = 0.2) +
  831. scale_color_manual(values = color_coherence_density) +
  832. theme_void() +
  833. guides(colour = guide_legend(override.aes = list(size = 4)))
  834. # plot combined
  835. plot <- patchwork::wrap_plots(p1, p2, ncol = 2)
  836. return (plot)
  837. }
  838. # get the combined df of the average coherence values of all the samples in sample_names. coherence dir stores the coherence
  839. # qs files (lists). Returns a df with cols Identifier, coherence, and coherence_celltype corresponding to each celltype in the sample.
  840. # Identifier col stores SampleNames or SampleIDs depending on average_by_sample_id.
  841. # average_by_sample_id indicates if we want to return the average coherences averaged by replicates. This was required
  842. # in EPN project. sample_ids is a vector of length same as sample_names which holds the ids for each sample.
  843. # NOTE: this function is highly specific to EPN project.
  844. GetAverageSampleCoherencesGridVersion <- function(sample_names, coherence_dir, average_by_sample_id = FALSE, sample_ids = NULL, fill_na = 0){
  845. # ensure that if average_by_sample_id is TRUE, sample_ids is supplied
  846. if (average_by_sample_id == TRUE & is.null(sample_ids)) stop('If average_by_sample_id is TRUE, sample_ids should be supplied!')
  847. # read the coherence list of each sample and append into df with identifier col called Identifier
  848. average_coherence <- data.frame()
  849. metaprogram_wise_coherence <- data.frame() # this will be long form dataframe, with cols: sample_name, metaprogram, average
  850. metaprogram_grid_proportion_and_counts <- data.frame() # this will be a dataframe holding the information for proportion of squares in the grid of a particular celltype
  851. for (sample_name in sample_names){
  852. # sample_name = 'STEPN12_Region_3'
  853. results <- qread(glue('{coherence_dir}/results_{sample_name}.qs'))
  854. # get the sample_coherence by averaging the MP's coherences. This was found to more robustly show the correlation between hypoxia and coherence.
  855. sample_coherence <- mean(results$coherence_score_program$average)
  856. average_coherence <- rbind(average_coherence, data.frame(Identifier = sample_name, coherence = sample_coherence))
  857. # now append the metaprogram wise coherence scores to metaprogram_wise_coherence df
  858. results$coherence_score_program$Identifier <- sample_name # add the SampleName col so that can make the concatenated df into wide form later (else there will be multiple rows with same celltype without any way to identify them)
  859. metaprogram_wise_coherence <- rbind(metaprogram_wise_coherence, results$coherence_score_program)
  860. # now append the metaprogram proportion from the grid squares into metaprogram_grid_proportion_and_counts
  861. metaprogram_grid_proportion_and_counts <- rbind(metaprogram_grid_proportion_and_counts, results$counts %>% mutate(proportions = (100*n)/sum(n)) %>% mutate(Identifier = sample_name))
  862. }
  863. # make metaprogram_wise_coherence into wide form, and join to average_coherence
  864. metaprogram_wise_coherence <- metaprogram_wise_coherence %>% pivot_wider(names_from = 'metaprogram', values_from ='average', names_prefix = 'coherence_', values_fill = fill_na)
  865. # perform left join with average_coherence to get one df with all information (sample level coherence avg, and metaprogram level)
  866. average_coherence <- average_coherence %>% left_join(metaprogram_wise_coherence, by = 'Identifier')
  867. # make metaprogram_grid_proportion from metaprogram_grid_proportion_and_counts: remove counts information and make into wide form
  868. metaprogram_grid_proportion <- metaprogram_grid_proportion_and_counts %>% pivot_wider(names_from = Metaprogram, values_from = proportions, names_prefix = 'pixel_proportion_', id_cols = Identifier, values_fill = fill_na) # specifying id_cols automatically removes the col n, which stores the actual counts of the squares
  869. # perform left join with average_coherence to get one df with all information
  870. average_coherence <- average_coherence %>% left_join(metaprogram_grid_proportion, by = 'Identifier')
  871. # make metaprogram_grid_counts from metaprogram_grid_proportion_and_counts: remove proportions information and make into wide form
  872. metaprogram_grid_counts <- metaprogram_grid_proportion_and_counts %>% pivot_wider(names_from = Metaprogram, values_from = n, names_prefix = 'pixel_counts_', id_cols = Identifier, values_fill = fill_na) # specifying id_cols automatically removes the col proportions, which stores the proportions of the squares of a metaprogram
  873. # perform left join with average_coherence to get one df with all information
  874. average_coherence <- average_coherence %>% left_join(metaprogram_grid_counts, by = 'Identifier')
  875. # if we want to average the coherence values by sample id (average over the replicates), then add a new column
  876. # for sample_ids and groupby. In this case, the resultant df will have cols SampleID, coherence, instead of SampleName, coherence
  877. if (average_by_sample_id == TRUE){
  878. average_coherence$Identifier <- sample_ids
  879. average_coherence <- average_coherence %>% group_by(Identifier) %>% summarise(across(where(is.numeric), mean)) # where(is.numeric) like functions are selection_helpers and are designed to be used only with functions like across(), select(), rename()
  880. }
  881. return (average_coherence)
  882. }
  883. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  884. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTIONS FOR PLOTTING ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  885. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  886. # Make big barplot ordered by coherence scores of samples. Made originally for EPN. Requires some work.
  887. # NOTE: this only processes only samples which are rows in metadata, and plots them in same order
  888. # if we do order_by_coherence = TRUE, then the bars are ordered from left to right in ascending order of coherence,
  889. # else they are ordered in same order as in metadata, be it average_by_sample_id = TRUE or FALSE (Identifier is sample_name or sample_id)
  890. PlotXeniumMetaprogramsCoherence <- function(metadata, cellid_dir, coherence_dir, order_metaprograms, colors,
  891. malignant_vec, average_by_sample_id, order_by_coherence = TRUE){
  892. # since we don't want discrepancies between metadata and sample_names, we are extracting sample_names from metadata only.
  893. # Hence, one needs to ensure that metadata has only those entries which need to be worked on
  894. sample_names <- metadata$SampleName
  895. # if we are averaging by sample_id, get a average the metadata, so that we have just one row for each sample_id
  896. # first limit to just those columns which can be averaged with sample_id
  897. if (average_by_sample_id == TRUE){
  898. metadata_processed <- metadata %>% select(SampleID, Subtype, Source)
  899. # rename to Identifier
  900. metadata_processed$Identifier <- metadata_processed$SampleID
  901. metadata_processed$SampleID <- NULL
  902. # get unique of metadata
  903. metadata_processed <- unique(metadata_processed)
  904. } else{
  905. metadata_processed <- metadata %>% select(SampleName, Subtype, Source)
  906. # rename to Identifier
  907. metadata_processed$Identifier <- metadata_processed$SampleName
  908. metadata_processed$SampleName <- NULL
  909. }
  910. # get coherence information. Here, loading the grid version coherences, because in ependymoma, it better explained the relationship between coherence sample and MES-like proportion
  911. coherences <- GetAverageSampleCoherencesGridVersion(metadata$SampleName, coherence_dir, average_by_sample_id, metadata$SampleID)
  912. metadata_processed <- metadata_processed %>% left_join(coherences, by = 'Identifier')
  913. # order metadata according to coherence scores
  914. if (order_by_coherence == TRUE) metadata_processed <- metadata_processed %>% arrange(coherence)
  915. # get the order in which Identifier col of metadata_processed and metaprogram_proportion will be ordered
  916. datapoints_order <- unique(metadata_processed$Identifier)
  917. # now metadata_processed$Identifier will be a factor with levels same as datapoints_order
  918. metadata_processed$Identifier <- factor(metadata_processed$Identifier, levels = datapoints_order)
  919. # get the long df which has proportions of the different metaprograms in each sample_name/sample_id. (cols = Identifier, group, counts, proportions)
  920. metaprogram_proportion <- GetMetaprogramProportions(sample_names = sample_names, cellid_dir, average_by_sample_id, sample_ids = metadata$SampleID)
  921. metaprogram_proportion <- left_join(metaprogram_proportion, coherences, by = 'Identifier')
  922. # make metaprogram_proportion$Identifier as be a factor with levels same as datapoints_order
  923. metaprogram_proportion$Identifier <- factor(metaprogram_proportion$Identifier, levels = datapoints_order)
  924. # add metadata info in metaprogram_proportion by left joining by the Identifier column
  925. metaprogram_proportion <- left_join(metaprogram_proportion, metadata_processed, by = 'Identifier')
  926. # reorder metaprograms so that it is the same as in the paper
  927. metaprogram_proportion$group <- factor(metaprogram_proportion$group, levels = order_metaprograms)
  928. # add information about malignant/malignant celltype
  929. metaprogram_proportion$malignant <- ifelse(metaprogram_proportion$group %in% malignant_vec, "Malignant", "Non-malignant")
  930. # trick for plotting negative axis
  931. metaprogram_proportion <- metaprogram_proportion %>%
  932. mutate(proportions = if_else(malignant == "Non-malignant", -proportions, proportions))
  933. # Plot a stacked bar plot. Note that the order in which the bars are is according to the order of levels in Identifier col of df, which should be of factor type now
  934. p1 <- ggplot(metaprogram_proportion, aes(x = Identifier, y = proportions, fill = group)) +
  935. scale_fill_manual(values = colors, name = 'cell_type') +
  936. geom_col() +
  937. theme(panel.spacing.x = unit(0, "mm")) +
  938. geom_hline(yintercept = 0, color = "black", linetype = "solid") +
  939. scale_y_continuous(breaks = seq(-100, 100, 20),
  940. labels = abs(seq(-100, 100, 20))) +
  941. labs(y = 'Proportion, %', x = '') +
  942. theme(panel.border = element_blank(),
  943. panel.grid.major = element_blank(),
  944. panel.grid.minor = element_blank(),
  945. plot.background = element_blank(),
  946. panel.background = element_blank(),
  947. axis.line = element_line(colour = "black"),
  948. axis.text.x = element_blank(),
  949. axis.text.y = element_text(size = 14, colour = "black"),
  950. axis.title = element_text(size = 14),
  951. legend.text = element_text(size = 14),
  952. # legend.position = 'bottom'
  953. )
  954. # plot patient info
  955. p2 <- metadata_processed %>%
  956. ggplot(aes(x = Identifier, y = 1)) +
  957. geom_tile(aes(fill = Subtype), colour = "white", width = 0.9, height = 0.9) +
  958. scale_fill_manual(values = col_subtype , na.value = "grey95", guide = guide_legend(ncol = 2)) +
  959. theme_void() +
  960. theme(axis.title.y = element_text(),
  961. # legend.position = 'bottom'
  962. ) +
  963. labs(y = 'Subtype')
  964. p3 <- metadata_processed %>%
  965. ggplot(aes(x = Identifier, y = 1)) +
  966. geom_tile(aes(fill = Source), colour = "white", width = 0.9, height = 0.9) +
  967. scale_fill_manual(values = col_sampling, na.value = "grey95", guide = guide_legend(ncol = 2)) +
  968. theme_void() +
  969. theme(axis.title.y = element_text(),
  970. # legend.position = 'bottom'
  971. ) +
  972. labs(y = 'Source')
  973. p4 <- metadata_processed %>%
  974. ggplot(aes(x = Identifier, y = 1)) +
  975. geom_tile(aes(fill = coherence), colour = "white", width = 0.9, height = 0.9) +
  976. scale_fill_gradientn(colours = color_coherence_density_without_white) +
  977. theme_void() +
  978. theme(axis.title.y = element_text(),
  979. axis.text.x= element_text(color = 'black', hjust=1, angle=90)) +
  980. labs(y = 'Coherence')
  981. # plot combined plot. Editing the line below allows us to either plot the subtype information about each sample, or the source information
  982. plot <- patchwork::wrap_plots(list(p1, p3, p4), ncol = 1) + plot_layout(heights = c(1, 0.1, 0.1), guides = 'collect')
  983. return (plot)
  984. }
  985. # read in the coherence information for the samples and proportions of different celltypes in them, and
  986. # compute linear regression and make the corresponding plots.
  987. # NOTE: Ensure that metadata has only those entries which need to be worked on
  988. # On 10-21, added new argument transform_proportions, which specifies if we want to transform the proportion values
  989. # before the LR and making the plot. This was required for the second review when we performed a multiple linear
  990. # regression using all celltypes
  991. OverallCoherenceCelltypeProportionLinearRegression <- function(metadata, cellid_dir, coherence_dir, average_by_sample_id, colors, transform_proportions = F) {
  992. library(reshape)
  993. # since we don't want discrepancies between metadata and sample_names, we are extracting sample_names from metadata only.
  994. # Hence, one needs to ensure that metadata has only those entries which need to be worked on
  995. sample_names <- metadata$SampleName
  996. # read proportion of each cell type in each tumor
  997. message(green('-------------------------------------------------------'))
  998. message(blue('[1/3] Reading metaprogram proportions'))
  999. # get the long df which has proportions of the different metaprograms in each sample_name/sample_id. (cols = Identifier, group, counts, proportions)
  1000. metaprogram_proportion <- GetMetaprogramProportions(sample_names = sample_names, cellid_dir, average_by_sample_id, sample_ids = metadata$SampleID)
  1001. # obtain a vector storing the metaprograms we have in our data
  1002. cell_types <- sort(unique(metaprogram_proportion$group))
  1003. # limiting to just the relevant columns
  1004. metaprogram_proportion <- metaprogram_proportion[ , c("Identifier", "group", "proportions")]
  1005. # ensure that every combination of Identifier and group is present in the data, and if they were not present till now, their proportions will be 0
  1006. metaprogram_proportion_complete <- metaprogram_proportion %>%
  1007. complete(Identifier, group, fill = list(proportions = 0))
  1008. # here, according to transform_proportions argument value, we transform the proportion values in metaprogram_proportion_complete using logit transformation
  1009. if (transform_proportions == T){
  1010. library(car)
  1011. metaprogram_proportion_complete$proportions <- logit(metaprogram_proportion_complete$proportions/100, percents = F, adjust = 0.025)
  1012. }
  1013. # cast the just created df into wide form so that we have Identifier x group shape of df.
  1014. metaprogram_proportion_wide <- cast(metaprogram_proportion_complete, Identifier~group, value = 'proportions')
  1015. message(green('-------------------------------------------------------'))
  1016. message(blue('[2/3] Get spatial coherence scores'))
  1017. # get the df storing coherence values for each SampleName or SampleID. colnames: Identifier, coherence
  1018. average_spatial_coherence_df <- GetAverageSampleCoherencesGridVersion(sample_names, coherence_dir, average_by_sample_id, sample_ids = metadata$SampleID)
  1019. # just keep the whole-sample coherence information as only that is required in this function
  1020. average_spatial_coherence_df <- average_spatial_coherence_df %>% select(Identifier, coherence)
  1021. # calculate scaled score (get values to 0-1 range and add as a new col)
  1022. average_spatial_coherence_df <- average_spatial_coherence_df %>% mutate(scaled_spatial_coherence = MinMaxScaleVector(coherence))
  1023. # write.csv(average_spatial_coherence_df, '~/temp.csv')
  1024. message(green('-------------------------------------------------------'))
  1025. message(blue('[3/3] Perform linear regression between coherence and each MP'))
  1026. # combine the information about celltypes proportions into average_spatial_coherence_df
  1027. linear_regression_df <- average_spatial_coherence_df %>%
  1028. left_join(metaprogram_proportion_wide, by = 'Identifier')
  1029. # make the cols in linear_regression_df to have dots instead of spaces because as.formula function which we
  1030. # use below doesn't handle columns with hyphens well
  1031. cell_types <- gsub('-', '.', cell_types)
  1032. colnames(linear_regression_df) <- gsub('-', '.', colnames(linear_regression_df))
  1033. # write.csv(as.data.frame(linear_regression_df), file.path(plot_dir, '13_Linear_regression_input.csv'))
  1034. # loop through each predictor (celltype which drives coherence value), perform regression on scaled_spatial_coherence
  1035. # with just that, and save the corresponding statistics in a df, and also save the corresponding linear regression plots.
  1036. # Initialize a dataframe to store regression results
  1037. results_df <- data.frame()
  1038. results_df <- data.frame(Predictor = character(), Estimate = numeric(), StdError = numeric(),
  1039. tValue = numeric(), pValue = numeric(), stringsAsFactors = FALSE)
  1040. plot_list <- list()
  1041. # Loop over each predictor and perform regression using just that
  1042. for (cell_type in cell_types){
  1043. # cell_type <- 'T.cells'
  1044. # cell_type = 'Embryonic.like'
  1045. # Dynamically create the formula. Make quoted because else as.formula() function splits string open at the hyphen
  1046. formula <- as.formula(paste("scaled_spatial_coherence ~", cell_type))
  1047. # Fit the linear model
  1048. model <- lm(formula, data = linear_regression_df)
  1049. # Extract coefficients summary
  1050. summary_model <- summary(model)
  1051. coefficients <- summary_model$coefficients
  1052. # printing equation
  1053. slope = coefficients[2, 'Estimate']
  1054. intercept = coefficients[1, 'Estimate']
  1055. if (intercept > 0) print(glue("{cell_type}: Y = {signif(slope,3)}*X + {signif(intercept,3)}")) else print(glue("{cell_type}: Y = {signif(slope,3)}*X - {-signif(intercept,3)}"))
  1056. # Extract R-squared and p-value
  1057. r_squared <- summary_model$r.squared
  1058. p_value <- coefficients[2, "Pr(>|t|)"] # p-value of the predictor term
  1059. # also obtain the pearson correlation because the reviewer asked for it
  1060. correlation <- cor(x = linear_regression_df[, cell_type], y = linear_regression_df$scaled_spatial_coherence)
  1061. # Append results to dataframe
  1062. results_df <- rbind(results_df, data.frame(Predictor = cell_type, Estimate = coefficients[2, "Estimate"], StdError = coefficients[2, "Std. Error"],
  1063. tValue = coefficients[2, "t value"], pValue = p_value, correlation = correlation))
  1064. # Create and save the plot
  1065. plot_list[[cell_type]] <- ggplot(data.frame(linear_regression_df, celltype = cell_type), aes(x = scaled_spatial_coherence, y = .data[[cell_type]], color = celltype)) +
  1066. # labs(x = "Scaled spatial coherence score", y = cell_type) +
  1067. geom_smooth(method = 'lm', se = TRUE, color = 'black') +
  1068. geom_point(size = 4) +
  1069. scale_color_manual(values = colors) +
  1070. theme_classic() +
  1071. theme(legend.position = 'none') +
  1072. labs(title = paste0(cell_type, '\n', 'R = ', round(correlation, 2), ', R² = ', round(r_squared, 2), '\nAdj p-value: ', signif(min(p_value*length(cell_types), 1), 3), ', n = ', nrow(linear_regression_df))) +
  1073. ylab('Transformed Proportion') + xlab('Spatial coherence score') +
  1074. theme(plot.title = element_text(hjust = 0.5),
  1075. axis.title.x = element_text(size = 13), axis.title.y = element_text(size = 13),
  1076. axis.text = element_text(size = 8.5),
  1077. axis.text.x = element_text(hjust = 1, vjust = 0.5, angle = 90))
  1078. }
  1079. # Export results to a CSV file
  1080. # write.csv(results_df, file.path(plot_dir, "15_Simple_linear_regression_results.csv"), row.names = FALSE)
  1081. # plot
  1082. combined_plot <- patchwork::wrap_plots(plot_list, ncol = 4)
  1083. return(combined_plot)
  1084. }
  1085. # make the set of boxplots showing the distribution of coherence values for each metaprogram in a set of samples
  1086. MetaprogramCoherenceBoxplots <- function(metadata, coherence_dir, average_by_sample_id, colors){
  1087. # get the sample names from metadata
  1088. sample_names <- metadata$SampleName
  1089. # get the df storing coherence values for each SampleName or SampleID. colnames: Identifier, coherence,
  1090. # coherence_celltype1, coherence_celltype2, etc. Using the grid version of coherences for the ependymoma
  1091. # project, as it seemed to work better for it.
  1092. average_spatial_coherence_df <- GetAverageSampleCoherencesGridVersion(sample_names, coherence_dir, average_by_sample_id, sample_ids = metadata$SampleID)
  1093. # now, we make it into a long df, with cols: celltype, coherence.
  1094. # now, we can exclude the sample level coherence as that is not required for making metaprogram-coherence plot
  1095. df <- average_spatial_coherence_df %>%
  1096. select(!c(Identifier, coherence)) %>% # these cols are not required. Just the cols storing coherence for celltype are required
  1097. pivot_longer(everything(), names_to = 'celltype', values_to = 'coherence')
  1098. # rename the values in celltype col
  1099. df$celltype <- gsub('coherence_', '', df$celltype)
  1100. # remove the rows which have pixel_proportion values. They store that out of all the pixels, how many pixels were of a particular celltype.
  1101. df <- df %>% filter(!grepl('pixel', celltype))
  1102. # rename the MES-like entries to MES/Hypoxia
  1103. df$celltype <- gsub('MES-like', 'MES/Hypoxia', df$celltype)
  1104. # now make the plot
  1105. plot <- ggplot(df, aes(x = fct_reorder(celltype, coherence, .fun = median, .desc = TRUE), y = coherence, fill = celltype)) +
  1106. geom_boxplot(outliers = F) +
  1107. geom_jitter(size = 0.5) +
  1108. scale_fill_manual(values = colors) +
  1109. theme_classic() +
  1110. theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  1111. xlab('Metaprogram')
  1112. return (plot)
  1113. }
  1114. # get the plots showing correlation of a celltype's proportion with coherence of everything apart from it.
  1115. # Originally made with respect to MES-like celltype
  1116. OverallCoherenceCelltypeProportionLinearRegressionAfterRemoval <- function(celltype_to_remove, metadata, cellid_dir, coherence_dir, average_by_sample_id){
  1117. library(reshape)
  1118. # since we don't want discrepancies between metadata and sample_names, we are extracting sample_names from metadata only.
  1119. # Hence, one needs to ensure that metadata has only those entries which need to be worked on
  1120. sample_names <- metadata$SampleName
  1121. # read proportion of each cell type in each tumor
  1122. message(green('-------------------------------------------------------'))
  1123. message(blue('[1/3] Reading metaprogram proportions'))
  1124. # get the long df which has proportions of the different metaprograms in each sample_name/sample_id. (cols = Identifier, group, counts, proportions)
  1125. metaprogram_proportion <- GetMetaprogramProportions(sample_names = sample_names, cellid_dir, average_by_sample_id, sample_ids = metadata$SampleID)
  1126. # limiting to just the relevant columns
  1127. metaprogram_proportion <- metaprogram_proportion[ , c("Identifier", "group", "proportions")]
  1128. # ensure that every combination of Identifier and group is present in the data, and if they were not present till now, their proportions will be 0
  1129. metaprogram_proportion_complete <- metaprogram_proportion %>%
  1130. complete(Identifier, group, fill = list(proportions = 0))
  1131. # cast the just created df into wide form so that we have Identifier x group shape of df.
  1132. metaprogram_proportion_wide <- cast(metaprogram_proportion_complete, Identifier~group, value = 'proportions')
  1133. message(green('-------------------------------------------------------'))
  1134. message(blue('[2/3] Get spatial coherence scores (after removal of celltype to remove)'))
  1135. # get the df storing coherence values for each SampleName or SampleID. colnames: Identifier, coherence
  1136. average_spatial_coherence_df <- GetAverageSampleCoherencesAfterRemovingCelltype(celltype_to_remove, sample_names, coherence_dir, average_by_sample_id, sample_ids = metadata$SampleID)
  1137. # calculate scaled score (get values to 0-1 range and add as a new col)
  1138. average_spatial_coherence_df <- average_spatial_coherence_df %>% mutate(coherence = MinMaxScaleVector(coherence)) # calling the new col also coherence, because below, that general name is used of that column
  1139. message(green('-------------------------------------------------------'))
  1140. message(blue('[3/3] Organize data for performing Linear Regression'))
  1141. # combine the information about celltypes proportions into average_spatial_coherence_df
  1142. linear_regression_df <- average_spatial_coherence_df %>%
  1143. left_join(metaprogram_proportion_wide, by = 'Identifier')
  1144. # make the cols in linear_regression_df to have dots instead of spaces because as.formula function which we
  1145. # use below doesn't handle columns with hyphens well
  1146. celltype_to_remove <- gsub('-', '.', celltype_to_remove)
  1147. colnames(linear_regression_df) <- gsub('-', '.', colnames(linear_regression_df))
  1148. # just perform linear regression between the given celltype's proportion and coherence
  1149. result <- PerformLinearRegression(linear_regression_df, col1 = 'coherence', col2 = celltype_to_remove)
  1150. plot <- PlotLinearRegression(linear_regression_df, result, x_label = 'Spatial coherence score \nof everything remaining', y_label = glue('Proportion of {celltype_to_remove}'))
  1151. return (plot)
  1152. }
  1153. # plot the linear regression plot showing comparison of celltypes proportion in sc and spatial data.
  1154. # metadata should have only those samples which are to be included in the analysis (in EPN project, we had
  1155. # multiple plots for the different cancertypes, hence this point).
  1156. # sc_data should have the single cell data (which we need the proportions from only) with annotations in the cell_type col.
  1157. PlotCompositionComparisonSpatialSC <- function(sc_data, metadata, cellid_dir, transform_proportions = F){
  1158. # get the sample_names, sample_ids from metadata
  1159. sample_names <- metadata$SampleName
  1160. sample_ids <- metadata$SampleID
  1161. ### we just need the overall avg of each celltype in both datasets. Hence, no need to mapping sample to sample
  1162. # get the proportions of the different celltypes from single cell
  1163. sc_props <- [email hidden] %>% group_by(cell_type) %>% summarise(counts_sc = n()) %>% mutate(proportions_sc = 100*counts_sc/sum(counts_sc))
  1164. # get the proportions of the celltypes in the different xenium samples
  1165. metaprogram_proportions <- GetMetaprogramProportions(sample_names, cellid_dir, average_by_sample_id = TRUE, sample_ids)
  1166. spatial_props <- metaprogram_proportions %>% group_by(group) %>% summarise(counts_spatial = sum(counts)) %>% mutate(proportions_spatial = 100*counts_spatial/sum(counts_spatial))
  1167. colnames(spatial_props)[1] <- 'cell_type' # rename so that we can do the join in next step
  1168. # perform left join and combine into one df
  1169. linear_regression_df <- spatial_props %>% full_join(sc_props, by = 'cell_type')
  1170. linear_regression_df[is.na(linear_regression_df)] <- 0 # fill the na values by 0
  1171. # at this point, according to the value of the parameter transform_proportions, we perform a logit transformation
  1172. # on the proportions_spatial and proportions_sc in proportions in linear_regression_df
  1173. if (transform_proportions == T){
  1174. library(car)
  1175. linear_regression_df$proportions_sc <- logit(linear_regression_df$proportions_sc/100, percent = F, adjust = 0.025)
  1176. linear_regression_df$proportions_spatial <- logit(linear_regression_df$proportions_spatial/100, percent = F, adjust = 0.025)
  1177. }
  1178. # now do the regression
  1179. linear_reg_result <- PerformLinearRegression(linear_regression_df, 'proportions_sc', 'proportions_spatial')
  1180. plot <- PlotLinearRegression(linear_regression_df, linear_reg_result, x_label = 'Proportion Smart-seq2', y_label = 'Proportion Xenium', color = colors_metaprograms_Xenium, color_col = 'cell_type')
  1181. return (plot)
  1182. }

epn_functions.R at commit 72650ca, under MIT · at the source

Overview

Authors: Daeun Jeong1,2,3, Sara G. Danielli1,2,3, Kendra K. Maaß4,5, David R. Ghasemi4,5,6,7,8,9, Svenja K. Tetzlaff10,11, Ekin Reyhan10,11, Li Jiang1,2, Shashank Katiyar1,2, Julia K. Sundheimer4,5, Costanza Lo Cascio1,2, Sina Neyazi1,2, Carlos Alberto Oliveira de Biagi-Junior1,2, Elsa Couvillon1,2, Sophia Castellani1,2, Maria Pazyra-Murphy1,2, Matthew Mullally1,2, Marc Philipp Dehler10,11, Bernhard Englinger1,2,12, Andrezza Nascimento1,2, Gustavo Alencastro Veiga Cruzeiro1,2
and 19 other authorsJoana G. Marques1,2, Rebecca D. Haase1,2, Cuong M. Nguyen1,2, Alicia-Christina Baumgartner1,2, Jacob S. Rozowsky1,2, Olivia A. Hack1,2, McKenzie L. Shaw1,2, Daniela Lotsch-Gojo13, Katharina Bruckner14, Andrey Korshunov4,7,15,16, Stefan M. Pfister4,5,6,7, Marcel Kool4,5,7,17,18, Tomasz J. Nowakowski19, Johannes Gojo13, Lissa Baird20, Sanda Alexandrescu21, Kristian W. Pajtler4,5,6,7,22, Varun Venkataramani10,11,22, Mariella G. Filbin1,2,22
22 affiliations
  1. Department of Pediatric Oncology, Dana-Farber Boston Children’s Cancer and Blood Disorders Center, Boston, MA, USA
  2. Broad Institute of MIT and Harvard, Cambridge, MA, USA
  3. These authors contributed equally: Daeun Jeong, Sara G. Danielli
  4. Hopp Childrens Cancer Center (KiTZ), Heidelberg, Germany
  5. Division of Pediatric Neurooncology, German Cancer Consortium (DKTK), German Cancer Research Center (DKFZ), Heidelberg, Germany
  6. Department of Pediatric Oncology, Hematology and Immunology, Heidelberg University Hospital, Heidelberg, Germany
  7. National Center for Tumor Diseases (NCT) Heidelberg, Heidelberg, Germany
  8. Department of Pediatric Hematology and Oncology, University Medical Center Hamburg-Eppendorf, Hamburg, Germany
  9. Research Institute Children’s Cancer Center, Hamburg, Germany
  10. Neurology Clinic and European Center for Neurooncology, University Hospital Heidelberg, Heidelberg, Germany
  11. Clinical Cooperation Unit Neurooncology, German Cancer Consortium (DKTK), German Cancer Research Center (DKFZ), Heidelberg, Germany
  12. Department of Urology, Comprehensive Cancer Center, Medical University of Vienna, Vienna, Austria
  13. Department of Neurosurgery, Comprehensive Cancer Center, Medical University of Vienna, Vienna, Austria
  14. Department of Pediatrics and Adolescent Medicine, Comprehensive Center for Pediatrics and Comprehensive Cancer Center, Medical University of Vienna, Vienna, Austria
  15. Clinical Cooperation Unit Neuropathology, German Cancer Consortium (DKTK), German Cancer Research Center (DKFZ), Heidelberg, Germany
  16. Department of Neuropathology, Heidelberg University Hospital, Heidelberg, Germany
  17. Princess Máxima Center for Pediatric Oncology, Utrecht, The Netherlands
  18. University Medical Center Utrecht (UMCU), Utrecht, The Netherlands
  19. Department of Neurological Surgery, University of California, San Francisco, CA, USA
  20. Department of Neurosurgery, Boston Children’s Hospital, Boston, MA, USA
  21. Department of Pathology, Boston Children’s Hospital, Boston, MA, USA
  22. These authors jointly supervised this work: Kristian W. Pajtler, Varun Venkataramani, Mariella G. Filbin
Journal: Nature, volume 652, issue 8111, pages 1016-1026
Dates: published online 11 March 2026; in print April 2026
Type: Research article · Language: English
License: CC BY-NC-ND
Identifiers: DOI 10.1038/s41586-026-10214-2 · PMID 41813893 · PMCID PMC13102715 · OpenAlex W7135091135
Open access: hybrid, a free copy (OpenAlex)
Status: code verified
Categories: genetics / omics (modality), human (organism), mouse (organism), other condition (population)
Methods: Spectral & time-frequency, Statistics, Smoothing, state filtering, decompositions, Machine learning, Connectivity, Preprocessing, Physiology & signal measures
MeSH: Ependymoma*, Supratentorial Neoplasms*, Animals, Cell Differentiation, Cell Movement, Cell Proliferation, Female, Humans, Male, Mice, Neuroepithelial Cells, Neurons, Single-Cell Analysis, Transcriptome, Tumor Microenvironment (* major topic)
Topic: Glioma Diagnosis and Treatment (Genetics, Medicine), according to OpenAlex
Funding: NINDS NIH HHS (DP2 NS127705); NCI NIH HHS (U54 CA274516, P50 CA165962); Swiss National Science Foundation (217787)
Citations: not cited yet (Europe PMC); 61 references in the paper
Notices: A correction to this paper has been published (42092155, from Europe PMC)

Abstract

The abstract is not reproduced here: the paper's license (CC BY-NC-ND) does not allow it. Read it in the paper, at the publisher or on Europe PMC.

Repositories

Its files are read in the Code ↔ Paper reader above, with 30 matches between paragraphs and lines of code.

Zenodo 17871734

License: MIT
State: the link answers, verified on 30 September 2026
Evidence: files inventoried
Size: 1 file
Software Heritage: not checked
Found in: “Code availability”
Not found: README, license file, CITATION.cff, environment file, tests, continuous integration, documentation
Tools: tidyverse (62 files), Seurat (46 files), ggplot2 (37 files), ggpubr (25 files), data.table (22 files), cowplot (21 files), patchwork (17 files), pheatmap (12 files), reshape2 (12 files), ComplexHeatmap (10 files), Harmony (8 files), circlize (7 files), pandas (6 files), Scanpy (6 files), SingleCellExperiment (6 files), Matplotlib (5 files), NumPy (5 files), anndata (4 files), clusterProfiler (4 files), Squidpy (4 files), DESeq2 (3 files), SciPy (3 files), seaborn (3 files), igraph (2 files), Monocle 3 (2 files), scikit-learn (2 files), car (1 file), Cell Ranger (1 file), edgeR (1 file), PyTorch Lightning (1 file), reticulate (1 file)
Availability: 1 check, the latest on 30 September 2026: the link answers (HTTP 200)
  • 30 September 2026: the link answers (HTTP 200)
112 files

filbinlab/multidimensional_stepn

License: MIT
State: the link answers, verified on 30 September 2026
Evidence: files inventoried
Commit: 72650ca32d106fcbba0bf303a7b0720925a27dee, 23 December 2025
Languages: R (108), Jupyter (5), Shell (3), Python (1)
Size: 171 files, 117 scripts
Software Heritage: not archived
Found in: the Zenodo archive record
Holds: README, license file, 17 notebooks
Not found: CITATION.cff, environment file, tests, continuous integration, documentation
Tools: tidyverse (63 files), Seurat (46 files), ggplot2 (38 files), ggpubr (26 files), data.table (22 files), cowplot (21 files), patchwork (17 files), pheatmap (12 files), reshape2 (12 files), ComplexHeatmap (10 files), Harmony (8 files), circlize (7 files), pandas (6 files), Scanpy (6 files), SingleCellExperiment (6 files), Matplotlib (5 files), NumPy (5 files), anndata (4 files), clusterProfiler (4 files), Squidpy (4 files), DESeq2 (3 files), SciPy (3 files), seaborn (3 files), igraph (2 files), Monocle 3 (2 files), scikit-learn (2 files), car (1 file), Cell Ranger (1 file), edgeR (1 file), PyTorch Lightning (1 file), reticulate (1 file)
Availability: 1 check, the latest on 30 September 2026: the link answers
  • 30 September 2026: the link answers
119 files

Code availability statement

The paper has a code availability statement. Its license (CC BY-NC-ND) does not allow reproducing it here; in short, from what the harvester recognized in it:

Read it in the paper: doi.org/10.1038/s41586-026-10214-2.

Tracing map

Proposed by the machine: these links were found in the paper and verified at the source, without human review. The map will receive a Zenodo DOI once one of the paper's authors has validated it with their ORCID.

What the map holds:

  • 2 repositories of the authors' code, each at its verified commit, with its license and how the link was found in the paper;
  • 227 scripts, each with its path and the digest of its content;
  • 30 matches between paragraphs of the paper and lines of the code (method lexical-v1);
  • neither the text of the paper nor the code itself.

Its JSON (tracing-map.json) is deposited on Zenodo with its DOI once the map is validated.

Data

No dataset and no data link were found in the paper.

Code and data availability statement

The paper has a code and data availability statement. Its license (CC BY-NC-ND) does not allow reproducing it here; in short, from what the harvester recognized in it:

Read it in the paper: doi.org/10.1038/s41586-026-10214-2.

Versions

The history of this record: each version stored by the harvester or made by a correction of its authors or of the maintainers of its code, and what changed in its facts. The texts of the paper (its abstract, its availability statements) are not part of it; versions that changed only those are not listed.

Version 1, 30 September 2026: the first record

Recorded: type, language, journal, volume, issue, pages, dates, 39 authors, 15 MeSH terms, 3 funders, 60 references, 1 integrity notice.

Cite

This paper

Jeong, D., Danielli, S. G., Maaß, K. K., Ghasemi, D. R., Tetzlaff, S. K., Reyhan, E., Jiang, L., Katiyar, S., Sundheimer, J. K., Lo Cascio, C., Neyazi, S., de Biagi-Junior, C. A. O., Couvillon, E., Castellani, S., Pazyra-Murphy, M., Mullally, M., Dehler, M. P., Englinger, B., Nascimento, A., . . . Filbin, M. G. (2026). Multidimensional profiling of heterogeneity in supratentorial ependymomas. Nature, 652(8111), 1016-1026. https://doi.org/10.1038/s41586-026-10214-2

BibTeX

@article{jeong2026multidimensional,
author = {Jeong, Daeun and Danielli, Sara G. and Maaß, Kendra K. and Ghasemi, David R. and Tetzlaff, Svenja K. and Reyhan, Ekin and Jiang, Li and Katiyar, Shashank and Sundheimer, Julia K. and Lo Cascio, Costanza and Neyazi, Sina and de Biagi-Junior, Carlos Alberto Oliveira and Couvillon, Elsa and Castellani, Sophia and Pazyra-Murphy, Maria and Mullally, Matthew and Dehler, Marc Philipp and Englinger, Bernhard and Nascimento, Andrezza and Cruzeiro, Gustavo Alencastro Veiga and Marques, Joana G. and Haase, Rebecca D. and Nguyen, Cuong M. and Baumgartner, Alicia-Christina and Rozowsky, Jacob S. and Hack, Olivia A. and Shaw, McKenzie L. and Lotsch-Gojo, Daniela and Bruckner, Katharina and Korshunov, Andrey and Pfister, Stefan M. and Kool, Marcel and Nowakowski, Tomasz J. and Gojo, Johannes and Baird, Lissa and Alexandrescu, Sanda and Pajtler, Kristian W. and Venkataramani, Varun and Filbin, Mariella G.},
title = {{Multidimensional profiling of heterogeneity in supratentorial ependymomas}},
journal = {Nature},
year = {2026},
month = mar,
volume = {652},
number = {8111},
pages = {1016--1026},
publisher = {Nature Portfolio},
issn = {0028-0836},
doi = {10.1038/s41586-026-10214-2},
url = {https://doi.org/10.1038/s41586-026-10214-2},
pmid = {41813893},
pmcid = {PMC13102715}
}

RIS

TY - JOUR
AU - Jeong, Daeun
AU - Danielli, Sara G.
AU - Maaß, Kendra K.
AU - Ghasemi, David R.
AU - Tetzlaff, Svenja K.
AU - Reyhan, Ekin
AU - Jiang, Li
AU - Katiyar, Shashank
AU - Sundheimer, Julia K.
AU - Lo Cascio, Costanza
AU - Neyazi, Sina
AU - de Biagi-Junior, Carlos Alberto Oliveira
AU - Couvillon, Elsa
AU - Castellani, Sophia
AU - Pazyra-Murphy, Maria
AU - Mullally, Matthew
AU - Dehler, Marc Philipp
AU - Englinger, Bernhard
AU - Nascimento, Andrezza
AU - Cruzeiro, Gustavo Alencastro Veiga
AU - Marques, Joana G.
AU - Haase, Rebecca D.
AU - Nguyen, Cuong M.
AU - Baumgartner, Alicia-Christina
AU - Rozowsky, Jacob S.
AU - Hack, Olivia A.
AU - Shaw, McKenzie L.
AU - Lotsch-Gojo, Daniela
AU - Bruckner, Katharina
AU - Korshunov, Andrey
AU - Pfister, Stefan M.
AU - Kool, Marcel
AU - Nowakowski, Tomasz J.
AU - Gojo, Johannes
AU - Baird, Lissa
AU - Alexandrescu, Sanda
AU - Pajtler, Kristian W.
AU - Venkataramani, Varun
AU - Filbin, Mariella G.
TI - Multidimensional profiling of heterogeneity in supratentorial ependymomas
T2 - Nature
J2 - Nature
PY - 2026
DA - 2026/03/11
VL - 652
IS - 8111
SP - 1016
EP - 1026
SN - 0028-0836
PB - Nature Portfolio
DO - 10.1038/s41586-026-10214-2
UR - https://doi.org/10.1038/s41586-026-10214-2
LA - en
ER -

CSL-JSON

{
"id": "10.1038/s41586-026-10214-2",
"type": "article-journal",
"title": "Multidimensional profiling of heterogeneity in supratentorial ependymomas",
"container-title": "Nature",
"author": [
{
"family": "Jeong",
"given": "Daeun"
},
{
"family": "Danielli",
"given": "Sara G."
},
{
"family": "Maaß",
"given": "Kendra K."
},
{
"family": "Ghasemi",
"given": "David R."
},
{
"family": "Tetzlaff",
"given": "Svenja K."
},
{
"family": "Reyhan",
"given": "Ekin"
},
{
"family": "Jiang",
"given": "Li"
},
{
"family": "Katiyar",
"given": "Shashank"
},
{
"family": "Sundheimer",
"given": "Julia K."
},
{
"family": "Lo Cascio",
"given": "Costanza"
},
{
"family": "Neyazi",
"given": "Sina"
},
{
"family": "de Biagi-Junior",
"given": "Carlos Alberto Oliveira"
},
{
"family": "Couvillon",
"given": "Elsa"
},
{
"family": "Castellani",
"given": "Sophia"
},
{
"family": "Pazyra-Murphy",
"given": "Maria"
},
{
"family": "Mullally",
"given": "Matthew"
},
{
"family": "Dehler",
"given": "Marc Philipp"
},
{
"family": "Englinger",
"given": "Bernhard"
},
{
"family": "Nascimento",
"given": "Andrezza"
},
{
"family": "Cruzeiro",
"given": "Gustavo Alencastro Veiga"
},
{
"family": "Marques",
"given": "Joana G."
},
{
"family": "Haase",
"given": "Rebecca D."
},
{
"family": "Nguyen",
"given": "Cuong M."
},
{
"family": "Baumgartner",
"given": "Alicia-Christina"
},
{
"family": "Rozowsky",
"given": "Jacob S."
},
{
"family": "Hack",
"given": "Olivia A."
},
{
"family": "Shaw",
"given": "McKenzie L."
},
{
"family": "Lotsch-Gojo",
"given": "Daniela"
},
{
"family": "Bruckner",
"given": "Katharina"
},
{
"family": "Korshunov",
"given": "Andrey"
},
{
"family": "Pfister",
"given": "Stefan M."
},
{
"family": "Kool",
"given": "Marcel"
},
{
"family": "Nowakowski",
"given": "Tomasz J."
},
{
"family": "Gojo",
"given": "Johannes"
},
{
"family": "Baird",
"given": "Lissa"
},
{
"family": "Alexandrescu",
"given": "Sanda"
},
{
"family": "Pajtler",
"given": "Kristian W."
},
{
"family": "Venkataramani",
"given": "Varun"
},
{
"family": "Filbin",
"given": "Mariella G."
}
],
"container-title-short": "Nature",
"volume": "652",
"issue": "8111",
"page": "1016-1026",
"DOI": "10.1038/s41586-026-10214-2",
"PMID": "41813893",
"PMCID": "PMC13102715",
"ISSN": "0028-0836",
"publisher": "Nature Portfolio",
"URL": "https://doi.org/10.1038/s41586-026-10214-2",
"language": "en",
"issued": {
"date-parts": [
[
2026,
3,
11
]
]
}
}

The tracing map gets a citation of its own once an author has validated it and it has a DOI.

Similar papers

The papers with a page that share the most with this one: the tools found in their code, their categories, datasets, cited references and authors, the rarest counting most.

[1] doi:10.1016/j.xcrm.2026.102766 [code]
A longitudinal single-cell and spatial multiomic atlas of pediatric high-grade glioma.
Journal: Cell reports. Medicine
In common: Monocle 3, Harmony, SingleCellExperiment, 24 other tools, genetics / omics, other condition, 6 references
[2] doi:10.1038/s41593-026-02300-5 [code]
Integrated single-cell and spatial transcriptomic profiling in ALS uncovers peripheral-to-central immune infiltration and reprogramming.
Journal: Nature neuroscience
In common: Cell Ranger, Squidpy, Harmony, 22 other tools, genetics / omics, other condition
[3] doi:10.1002/imt2.70163 [code]
Spatial multi-omics unveils sphingolipid metabolic reprogramming within the retinal pathological niche.
Journal: iMeta
In common: Monocle 3, Harmony, SingleCellExperiment, 23 other tools, genetics / omics, mouse
[4] doi:10.1016/j.xcrm.2026.102651 [code]
Integrative CSF profiling identifies disease-specific immune responses in leptomeningeal disease.
Journal: Cell reports. Medicine
In common: PyTorch Lightning, Harmony, SingleCellExperiment, 20 other tools, genetics / omics, other condition
[5] doi:10.1038/s41467-026-73305-8 [code]
Comparative analysis of the cellular landscape in mammalian striatum.
Journal: Nature communications
In common: Cell Ranger, Harmony, SingleCellExperiment, 18 other tools, genetics / omics, mouse
[6] doi:10.1038/s42003-026-10957-8 [code]
Brain defence by the extracellular matrix protein Cochlin.
Journal: Communications biology
In common: Monocle 3, PyTorch Lightning, edgeR, 20 other tools, mouse
[7] doi:10.1038/s41593-026-02367-0 [code]
A reproducible three-dimensional model of human brain tissue to investigate physiological and disease-associated microglia phenotypes.
Journal: Nature neuroscience
In common: Monocle 3, Harmony, SingleCellExperiment, 16 other tools, 2 references
[8] doi:10.1038/s41586-026-10629-x [code]
Whole-genome duplication shaped cell-type evolution in the vertebrate brain.
Journal: Nature
In common: Harmony, reticulate, anndata, 19 other tools, genetics / omics, mouse, 1 reference
[9] doi:10.1016/j.cpblue.2026.100007 [code]
An integrated single-cell and spatial proteotranscriptomics atlas of fibroblast-driven immunoregulation within the human adult oral cavity.
Journal: Cell press blue
In common: SingleCellExperiment, edgeR, reticulate, 20 other tools
[10] doi:10.1186/s13059-026-04177-w [code]
Genomic sequence evolution underlying human neocortical interareal diversification.
Journal: Genome biology
In common: Squidpy, Monocle 3, reticulate, 18 other tools, genetics / omics, mouse, 1 reference

Contribute

The authors of this paper can claim it, correct its record and validate its tracing map, and the maintainers of its code (its owner, or a public member of its organization) correct what it says of their repository; anyone signed in can ask for its removal. Every request goes to OSCR's own machine, which answers it; your account page follows them.

Sign in with ORCID to claim this paper as one of its authors, correct its record or validate its tracing map: when the paper's metadata lists your ORCID iD, you are recognized at once. Maintainers of its code: sign in with GitHub, then claim the repository on your account page.

Request its removal

To ask OSCR to remove this record, the copies of its authors' scripts or its tracing map, use the removal request page: signed in, you say who you are, what to remove and why, then review and confirm the request. Published rules decide every request (how).

Discussion, reproductions, activity

Discussion: questions and error reports about this paper and its code, from signed-in readers and its authors. It opens with sign-in.

Reproductions: reports from readers who ran the authors' code: what they reproduced, with which environment, commit and data. It opens with sign-in.

Activity: what happens around this paper: new versions of its record, its map's validation, discussions and reproductions. It opens with sign-in.