############## ### README ### ############## # Datafile S1 : Rscripts used in this study ## Description of the scripts and markdowns ### Opening10XdataFiles.R - Rscript used to open 10X genomics scRNA-seq data and explore it to access cell quality. - Input files include the downloaded expression data and the cells' metadata file. - Output files include - violin and density plots of number of genes and transcripts detected per cell as of percentage of mitochondrial genes detected. - filtered expression and cell metadata files. ### Rscripts for distinguishing malignant and non-malignant cells #### Step1_CONICSmatAnalysis.R - Rscript used to Infer CNVs from scRNA-seq data so as to distinguish malignant cells from non-malignant ones. - Input files include the expression data and the cells' metadata file as well as a matrix containing coordinates of human chromosome arms. - Output files include the assignment of malignant and non-malignant identity to each cell based on CNV inference. #### Step2_HCPConUMAPcoordinates.R - Rscript used to perform unsupervised grouping analysis using HCPC approach based on UMAP coordinates. - Input files include the cells' metadata file containing UMAP coordinates. - Output files include the clustering results, a .RData file as well as some plots (PCA/tSNE/UMAP, heatmap). #### Step3_RefiningCellAssignment.R - Rscript used to refine CNV-based cell assignment using the HCPC clustering results and the expression of marker genes. - Input files include the cells' PCA or tSNE coordinates, and their metadata. - Output files include the final assignment of cells as malignant or non-malignant. ### CorrelationAnalysis.R - Rscript used to run analysis correlation of expression between pairs of genes in a signature. - Input files include the expression data and the list of signature genes. - Output files include the descriptive statistics of the genes in the signature (mean, coefficient of variation, …) and the correlation analysis results. ### HCPCintegratingUMAP.R - Rscript used to perform unsupervised grouping analysis using the HCPC approach. - Input files include: - cells' normalised expression data file (for e.g. in log2(CPM+1) values) - cells' metadata file - lists of genes to be used for the grouping analysis - list of genes to highlight on plots - list of signatures to highlight on plots - Output files include the clustering results, a .RData file as well as some plots (PCA/tSNE/UMAP, heatmap, chord plot) to be able to analyse the results. ### SilhouetteWidthPerCellPerCluster.R - Rscript used to assess silhouette width of each cell in each cluster. - Input files include the .RData file containing the global environment related to the HCPC clustering analysis (generated using the HCPCintegratingUMAP.R script). - Output files include a box plot showing the silhouette width of each cell in each cluster. ### LinearModelsBetweenScores.R - Rscript used to perform linear regression models between signature scores to determine if two signatures are linearly related or not. - Input files include: - cells' normalised expression data file (for e.g. in log2(CPM+1) values). - list of genes in each signature to be analyzed. - cells’ metadata file containing the identity of the cluster to which each cell belongs (to highlight specific clusters on the plot) - Output files include the linear model analysis results (R-squared, p-value) and a plot to visualize the model. ### DifferentialExpressionAnalysis.R - Rscript used to compare the expression levels of genes between different cell populations, here different clusters. - Input files include the - cells' normalised expression data file (for e.g. in log2(CPM+1) values). - cells' metadata file containing the identity of the cluster to which each cell belongs. - Output files include the descriptive statistics of all genes considered and the differential expression analysis results (fold change, adjusted p-value). ### UpdateGeneSymbols.R - Rscript used to update gene symbols so as to keep the current approved gene symbols. This Rscript is used before performing enrichment analyses (GO, KEGG, Enrichment_specificGeneModules, …) and before comparing gene lists from different sources (e.g. different datasets). - Input files include the: - file containing the list of gene symbols to update (genes of interest). - filtered gene metadata file from HGNC website. - file containing the list of gene symbols that should be excluded from comparisons because the approved symbol of gene A is the previous symbol of gene B. - file containing the list of genes whose symbol was withdrawn. - gene metadata file from NCBI website. - Output files include the gene metadata file of genes of interest from which the approved symbols can be retrieved. ### EnrichmentScore_SpecificGeneModules.Rmd - Rmarkdown used to determine whether or not a specific gene module is enriched in a cluster compared to another cluster (e.g. ClusterX compared to ClusterY). - Input files include the - list fo genes unregulated in ClusterX cells compared to ClusterY cells (updated symbols). - list of gene module of interest (updated symbols). - Output files include the overlap between the two lists of genes and the over-representation analysis results (fold enrichment, p-value). ### CompareGeneLists.Rmd - Rmardown used to compare genes upregulated in SigHIGH cells compared to SigLOW cells from distinct datasets. - Input files include the lists of genes upregulated in SigHIGH cells compared to SigLOW cells in each dataset (updated symbols). - Output files include the overlap between the lists of genes and a Venn diagram for visualization. ### DotplotForORA.R - Rscript used to do a dot plot so as to visualize over-representation analysis results. - Input files include the file containing the over-representation analysis results from enrichR website. - Output files include the dot plot showing the most over-represented terms. ## Scripts used to generate the figures/results presented in the article ### Pearson correlation of expression between motility signature - Presented in Figure 1b. - Done using the CorrelationAnalysis.R script in Datafile S1. ### Unsupervised grouping analysis results (UMAP, heat map, chord plot, box plots) - Presented in Figures 1c-f, 1j and Supplementary Figures 1B (top), 1C-E, 3. - Obtained using the HCPCintegratingUMAP.R script. ### Over-representation analysis results - Gene ontology and KEGG - Presented in Figures 1g, 2a and Supplementary Figure 2. - Obtained using the DotplotForORA.R script. ### Over-representation analysis results - Gene modules - Presented in Figure 1h. - Obtained using the EnrichmentScore_SpecificGeneModules.Rmd markdown. ### Linear regression model - Presented in Figure 1i and Supplementary Figure 3. - Obtained using the LinearModelsBetweenScores.R script. ### Box plot showing the silhouette width of each cell in each cluster - Presented in Supplementary Figure 1B (bottom). - Obtained using the SilhouetteWidthPerCellPerCluster.R script. ### Analysis to identify malignant and non-malignant cells - Presented in Supplementary Figures 5 and 6. - Obtained using the Step1_CONICSmatAnalysis.R, Step2_HCPConUMAPcoordinates.R and Step3_RefiningCellAssignment.R scripts. ########################################################################################## ## Opening and exploring data from 10X Genomics scRNAseq (Opening10XdataFiles.R script)## ########################################################################################## # Load required packages library(dplyr) library(Seurat) library(patchwork) library(ggplot2) # Define variables Variables <- list( dataType = "10Xgenomics", dataset = "DatasetX", InputFiles_path1 = "DataAnalysisFolder/", InputFiles_path2 = "cellMetadata.csv", nGene_cutoff = 150, nUMI_cutoff = 250, nMito = 0.2 ) # Import 10Xgenomics data expr_data.mat <- Read10X(data.dir = Variables$InputFiles_path1) # Import cell metadata file metadata <- read.csv(file = Variables$InputFiles_path2, sep = ",", header = TRUE, row.names = 1) # Create Seurat object expr_data.object <- CreateSeuratObject(counts = expr_data.mat, project = "PomboAntenus2021", min.cells = 0, min.features = 0) rm(expr_data.mat) # Assess counts detected per cell for mitochondrial genes expr_data.object[["percent.mt"]] <- PercentageFeatureSet(expr_data.object, pattern = "^MT-") expr_data.object$mitoRatio <- expr_data.object@meta.data$percent.mt / 100 # Extract cell metadata metadata_bis <- expr_data.object@meta.data metadata_bis$cells <- rownames(metadata_bis) # Add cell IDs to metadata metadata_bis <- metadata_bis %>% dplyr::rename(nUMI = nCount_RNA, nGene = nFeature_RNA) # Rename columns metadata$cells <- rownames(metadata) # Add cell IDs to metadata metadata$TumorOrigin <- metadata$sample metadata <- merge(x= metadata, y=metadata_bis, by = "cells", all = TRUE) rownames(metadata) <- metadata$cells # Extract expression data expr_data <- as.data.frame(expr_data.object@assays$RNA@counts) rm(expr_data.object) # Filter out genes that are not detected in any cell kept_genes <- rowSums(expr_data != 0) >= 1 expr_data <- expr_data[kept_genes,] dim(expr_data) # Visualize QC metrics pdf(file = paste0(Sys.Date(), "_QualityControlMetrics_", Variables$dataset, Variables$dataType, ".pdf")) # UMI counts per cell in each tumour metadata %>% ggplot(aes(x=TumorOrigin, y = nUMI, color=TumorOrigin)) + geom_violin(trim=FALSE, color='darkgrey', fill='grey') + geom_jitter(size=0.5, alpha =0.5, shape=16, position=position_jitter(0.2)) + theme_classic() + theme(legend.position="none", axis.text.x = element_text(angle = 90, vjust = 1, hjust=1)) + theme(plot.title = element_text(hjust=0.5, face="bold")) + ggtitle("NCounts") metadata %>% ggplot(aes(color=TumorOrigin, x=nUMI, fill= TumorOrigin)) + geom_density(alpha = 0.2) + scale_x_log10() + theme_classic() + ylab("Cell density") # Number of genes detected per cell in each tumour metadata %>% ggplot(aes(x=TumorOrigin, y = nGene, color=TumorOrigin)) + geom_violin(trim=FALSE, color='darkgrey', fill='grey') + geom_jitter(size=0.5, alpha =0.5, shape=16, position=position_jitter(0.2)) + theme_classic() + theme(legend.position="none", axis.text.x = element_text(angle = 90, vjust = 1, hjust=1)) + theme(plot.title = element_text(hjust=0.5, face="bold")) + ggtitle("nGenes") metadata %>% ggplot(aes(color=TumorOrigin, x=nGene, fill= TumorOrigin)) + geom_density(alpha = 0.2) + scale_x_log10() + theme_classic() + ylab("Cell density") # % of mitochondrial genes detected per cell in each tumour metadata %>% ggplot(aes(x=TumorOrigin, y = percent.mt, color=TumorOrigin)) + geom_violin(trim=FALSE, color='darkgrey', fill='grey') + geom_jitter(size=0.5, alpha =0.5, shape=16, position=position_jitter(0.2)) + theme_classic() + theme(legend.position="none", axis.text.x = element_text(angle = 90, vjust = 1, hjust=1)) + theme(plot.title = element_text(hjust=0.5, face="bold")) + ggtitle("% mitoGenes") # Plot gene number versus UMI counts and color cells by fraction of mitochondrial reads. metadata %>% ggplot(aes(x=nUMI, y=nGene, color=mitoRatio)) + geom_point() + scale_colour_gradient(low = "gray90", high = "black") + stat_smooth(method=lm) + scale_x_log10() + scale_y_log10() + theme_classic() dev.off() # Filter out low-quality cells using selected thresholds - these will change with experiment filtered_metadata <- subset(x = metadata, subset= (nUMI >= Variables$nUMI_cutoff) & (nGene >= Variables$nGene_cutoff) & (mitoRatio < Variables$nMito)) # Filter out genes detected in < 3 cells expr_data.filtered <- expr_data[,rownames(filtered_metadata)] kept_genes <- rowSums(expr_data.filtered != 0) >= 3 expr_data.filtered <- expr_data.filtered[kept_genes,] dim(expr_data.filtered) metadata <- filtered_metadata expr_data <- expr_data.filtered ToRetain <- c("Variables", "metadata", "expr_data") rm(list=setdiff(ls(), ToRetain)) save.image(file=paste0(Sys.Date(), "_", Variables$dataset, "_", Variables$dataType, "_UMIcounts_AllCells_GBM_Filtered.RData")) # Calculate log2(CPM+1) values from UMI counts cpm <- t(t(expr_data) / colSums(expr_data)) * 1000000 log2cpm1 <- log2(cpm +1) expr_data <- as.data.frame(log2cpm1) ToRetain <- c("Variables", "metadata", "expr_data") rm(list=setdiff(ls(), ToRetain)) save.image(file=paste0(Sys.Date(), "_", Variables$dataset, "_", Variables$dataType, "_log2CPMplus1_Allcells_GBM_Filtered.RData")) # Calculate log2(CPM/100 +1) values from UMI counts NormValues <- t(t(expr_data) / colSums(expr_data)) * 10000 log2NormValuesPlus1 <- log2(NormValues +1) expr_data <- as.data.frame(log2NormValuesPlus1) ToRetain <- c("Variables", "metadata", "expr_data") rm(list=setdiff(ls(), ToRetain)) save.image(file=paste0(Sys.Date(), "_", Variables$dataset, "_", Variables$dataType, "_log2CPM:100plus1_Allcells_GBM_Filtered.RData")) ##################################################################################################################################### ## Step1 : Infer CNVs from scRNA-seq data so as to distinguish malignant cells from non-malignant ones (Step1_CONICSmatAnalysis.R) ## ##################################################################################################################################### # Load required packages library(CONICSmat) library(varhandle) library(ggplot2) library(umap) # Load expression matrix expr_data_path <- "DataX.RData" load(expr_data_path) # Define variables Variables <- list( dataType = "10Xgenomics_log2CPM:100plus1", ChrArmsCoord_path = "chromosome_arm_positions_grch38.txt", dataset = "DatasetX", Ncluster = 30 ## Determine based on Heatmap of posterior probabilities on informative regions ) # Download and import matrix containing coordinates of human chromosome arms ## From https://github.com/diazlab/CONICS/blob/master/chromosome_arm_positions_grch38.txt ## This matrix contains the chromosomal coordinates of all chromosome arms on autosomes. If no information on chromosomal alterations based on DNA sequencing (e.g. exome-seq) is available, this file can be used to test for chromosome arm-scale copy number alterations. If exome-seq is available, this file should be replaced with a file holding large-scale CNVs. regions <- read.table(file = Variables$ChrArmsCoord_path, sep="\t", row.names = 1, header = TRUE) # Replace NA by 0 expr_data <- as.matrix(expr_data) expr_data[which(is.na(expr_data))] <- 0 # Explore expression matrix dim(expr_data) # Infer a vector that holds the information from which patient the cells were derived from patients <- unfactor(metadata$TumorOrigin) unique(patients) # Obtain the chromosomal positions of genes in the expression matrix gene_pos <- getGenePositions(rownames(expr_data)) # Filter uninformative genes, ie, genes expressed in only very few cells expr_data <- filterMatrix(expr_data, gene_pos[,"hgnc_symbol"], minCells=5) dim(expr_data) expr_data_transposed <- as.data.frame(t(expr_data)) # Calculate a normalization factor for each cell ## Because the average gene expression in each cell depends on the number of expressed genes (the more genes expressed in one cell, the less reads are "available" per gene), the normalization factor centers the gene expression in each cell around the mean normFactor <- calcNormFactors(expr_data) # Determine if the average gene expression in any of the regions show a bimodal distribution across cells ## First, the average expression in each cell is centered using the previously calculated normalization factor. ## Then, the z-score of the centered gene expression across all cells is calculated. ## Based on these z-scores, a Gaussian mixture model is calculated with the mixtools package. ## Important: We only calculate results for regions harboring more than 100 expressed genes (as defined by the initial filtering step) to make sure the predictions are not influenced by a few differentially-expressed genes in a small region. l <- plotAll(expr_data, normFactor, regions, gene_pos, paste0(Variables$dataset, "_CNVs")) write.csv(l, file = paste0(Sys.Date(), "_PosteriorProbabilities_EachCell_EachChro.csv")) # Visualize a heatmap of posterior probabilities of cells for component2 of each region. ## Here, component2 is defined as the component with the larger mean. ## Therefore cells with a higher expression at that locus will appear in red, cells with a lower expression in blue. ## Posterior probabilities are given as a row-wise z-score. set.seed(123) pdf(file = paste0(Sys.Date(), "_HeatmapOfPosteriorProbabilities_AllChro_", Variables$dataset, "_", Variables$dataType, ".pdf"), width=10, height = 5) hi <- plotHistogram(l, expr_data, clusters=2, zscoreThreshold=4, patients) dev.off() # Generate a UMAP plot and visualize the expression of marker genes as well as posterior probabilities ## Aim: Visualize if CNV clusters are related to transcriptional signatures ## Identify 500 most variables genes vg <- detectVarGenes(expr_data, 500) ## UMAP plot based on expression of 500 most variables genes set.seed(123) mat <- expr_data[vg, ] mat <- as.data.frame(t(mat)) Data.umap <- umap(d = mat, init = "spectral", n_components = 2) layout <- Data.umap if (class(Data.umap) == "umap") { layout <- Data.umap$layout } layout <- as.data.frame(layout) colnames(layout) <- c("UMAP1", "UMAP2") layout <- layout[rownames(expr_data_transposed),] layout <- cbind(layout, expr_data_transposed) layout <- layout[rownames(metadata), ] metadata$UMAP1 <- layout$UMAP1 metadata$UMAP2 <- layout$UMAP2 rm(expr_data_transposed) rm(Data.umap) ## Highlight expression of marker genes on UMAP plot ### List of genes to highlight genes.highlight <- c("PTPRC", "CSF1R", "TMEM119", "ITGAM", "FCGR3A", "CD14", "CD2", "CD3D", "MBP", "MOG", "MAG") ### Plots pdf(file = paste0(Sys.Date(), "_UMAP_MarkerGenes_", Variables$dataset, "_", Variables$dataType, ".pdf")) for(j in 1:length(genes.highlight)){ GeneHighlight <- genes.highlight[[j]] plot.res <- ggplot(layout, aes(x=UMAP1, y=UMAP2)) + geom_point(size=1, aes(color = layout[,GeneHighlight])) + ggtitle(paste0("Color by ", GeneHighlight, " expression - UMAP")) + scale_color_gradient(low="blue", high="red", name = "Exp") print(plot.res) } dev.off() ## Highlight GMM-based CNV predictions on UMAP plot ### Prepare data as done for heatmap t <- 4 ## zscoreThreshold pmat <- scale(l) if (max(pmat) > t) { pmat[which(pmat > t)] <- t pmat[which(pmat < (-t))] <- (-t) } else { mx <- min(max(pmat), abs(min(pmat))) sc <- t/mx pmat <- pmat * sc pmat[which(pmat > t)] <- t pmat[which(pmat < (-t))] <- (-t) } colnames(pmat) <- paste0("Chr", colnames(pmat)) metadata <- metadata[rownames(pmat), ] metadata <- cbind(metadata, pmat) pdf(file = paste0(Sys.Date(), "_UMAP_CNVpredictions_", Variables$dataset, "_", Variables$dataType, ".pdf")) for (i in 14:ncol(metadata)){ plot.res <- ggplot(metadata, aes(x=UMAP1, y=UMAP2)) + geom_point(size=1, aes(color = metadata[,i])) + ggtitle(paste0(colnames(metadata)[i], " - UMAP")) + scale_color_gradient2(low="blue", mid="white", high="red", midpoint = 0, limits = c(-4, 4), name = "PostProb") print(plot.res) } dev.off() # Filter uninformative, noisy regions based on results of the likelihood ratio test and the BIC for each region lrbic <- read.table(file=paste0(Variables$dataset, "_CNVs_BIC_LR.txt"), sep="\t", header=TRUE, row.names=1, check.names=FALSE) candRegions <- rownames(lrbic)[which(lrbic[,"BIC difference"]>300 & lrbic[,"LRT adj. p-val"]<0.001)] # For the remaining regions, generate heatmap of posterior probabilities ## Number of clusters chosen so as to group cells that are most likely to be normal (no amplification on chro7 AND no deletion on chro10 AND no CNV on other chro) set.seed(123) rm(hi) pdf(file = paste0(Sys.Date(), "_HeatmapOfPosteriorProbabilities_InformativeRegionsOnly_", Variables$Ncluster, "clusters_", Variables$dataset, "_", Variables$dataType, ".pdf"), width=10, height = 5) hi <- plotHistogram(l[,candRegions], expr_data, clusters=Variables$Ncluster, zscoreThreshold=4, patients) dev.off() # Assign a label as malignant or non-malignant to each cell table(hi) tumor <- which(hi!=1) normal <- which(hi==1) # Plot posterior probabilities again, but with statistics for normal and tumor cells redu <- plotAll(expr_data, normFactor, regions[candRegions,], gene_pos, paste0(Variables$dataset, "_CNVs_with_info.pdf"), normal=normal, tumor=tumor) # Generate a binary matrix, where 1 indicates the presence of a CNV and 0 the absence ## By thresholding on the posterior probabilities we can next generate a binary matrix, where 1 indicates the presence of a CNV and 0 the absence. ## Based on the average expression in the normal cells, we know if an alteration is either a copy number gain or a loss. bin_mat <- binarizeMatrix(redu, normal, tumor, 0.8, withna = TRUE) write.csv(bin_mat, paste0(Sys.Date(), "_Binarized Posterior probability matrix.csv")) tumorIDs <- unique(patients) for(i in 1:length(tumorIDs)){ tumorID <- tumorIDs[i] pdf(file = paste0(Sys.Date(), "BinarizedPosteriorProbability_", tumorID, ".pdf")) plotBinaryMat(bin_mat,patients,normal,tumor,patient=tumorID) dev.off() } # Visualize the breakpoints for each chromosome in each tumor for(i in 1:length(tumorIDs)){ tumorID <- tumorIDs[i] plotAllChromosomes(mat = expr_data, normal = normal, tumor = tumor, windowsize = 101, gene_pos = gene_pos, fname = tumorID, patients = patients, patient = tumorID, breakpoints = regions) } # Matrix of corrected p-values for each cell and each CNV ## To obtain a matrix of corrected p-values for each cell and each CNV, we identify the component representing the cell population without CNVs for each region. ## Subsequently, we utilize the estimated parameters (mean and standard deviation) of this component to calculate a p-value for each of the tumor cells based on its z-scored expression with the pnorm() function. ## The matrix r holds all adjusted p-values (Benjamini-Hochberg) for each cell and each CNV candidate region. ## The matrix binr is a binarized version of r, where the presence of a CNV is thresholded on an adjusted p-val<0.1. r <- generatePvalMat(expr_data, regions[candRegions,], normFactor, normal, tumor, gene_pos,threshold=0.8) binr <- ifelse(r>0.1, 0, 1) ## adjusted p-val<0.1 boxplot(r) write.csv(r, paste0(Sys.Date(), "_BHadjPvalues_EachRegion_EachCell.csv")) write.csv(binr, paste0(Sys.Date(), "_PresenceOrAbsenceCNVPerRegion_EachCell.csv")) # Visualize chromosomal alterations in each single cell across the genome for each patient for(i in 1:length(tumorIDs)){ tumorID <- tumorIDs[i] pdf(file = paste0(Sys.Date(), "_CNVprofile_Tumor", tumorID, ".pdf")) plotChromosomeHeatmap(expr_data, normal = normal, plotcells = which(patients==tumorID), gene_pos = gene_pos, windowsize = 121, chr=TRUE, expThresh=0.2, thresh = 1) dev.off() } # Export results NormalCells <- as.data.frame(normal) colnames(NormalCells) <- "Number" NormalCells$CellID <- rownames(NormalCells) NormalCells$CellAssignment <- "normal" rownames(NormalCells) <- NULL MalignantCells <- as.data.frame(tumor) colnames(MalignantCells) <- "Number" MalignantCells$CellID <- rownames(MalignantCells) MalignantCells$CellAssignment <- "malignant" rownames(MalignantCells) <- NULL AllCells <- rbind(NormalCells, MalignantCells) rownames(AllCells) <- AllCells$CellID AllCells <- AllCells[rownames(metadata),] metadata$CellAssignment <- AllCells$CellAssignment print("Number of cells assigned as") table(metadata$CellAssignment) write.csv(metadata, file = paste0(Sys.Date(), "_", Variables$dataset, "_", Variables$dataType, "_CellMetadata.csv")) # Highlight potential malignant and normal cells on UMAP plot pdf(file = paste0(Sys.Date(), "_UMAP_TumorOrigin_CONICSmatCellAssignment.pdf")) res.plot <- ggplot(metadata, aes(x=UMAP1, y=UMAP2, color = CellAssignment)) + geom_point(size=1) + scale_color_manual(values=c("red", "black")) + ggtitle("Color by identified cell assignments - UMAP") print(res.plot) res.plot1 <- res.plot + theme(legend.position = "none") print(res.plot1) res.plot <- ggplot(metadata, aes(x=UMAP1, y=UMAP2, color = TumorOrigin)) + geom_point(size=1) + ggtitle("Color by tumor of origin - UMAP") print(res.plot) res.plot1 <- res.plot + theme(legend.position = "none") print(res.plot1) dev.off() ############################################################################################################################# # Step 2 - Cell grouping analysis based on expression levels of genes of interest (Step2_HCPConUMAPcoordinates.R) # ############################################################################################################################# # This Rscript allows to perform unsupervised grouping analysis using HCPC approach based on UMAP coordinates. # Input file include the cells' metadata file containing UMAP coordinates. # Output files include the clustering results, a .RData file as well as some plots (PCA/tSNE/UMAP, heatmap). # Example of line command ## Rscript Step2_HCPConUMAPcoordinates.R --metadata CellMetadata.csv --metadata_sep comma --dataset Dataset1 --analysis_name HCPConUMAPcoord # Load necessary packages (install them if it's not the case) requiredPackages <- c( 'optparse', 'FactoMineR', 'factoextra', 'NbClust', 'RColorBrewer', 'tsne', 'ClusterR', 'ggplot2', 'circlize', 'ComplexHeatmap', 'umap', 'psych', 'RSpectra' ) new.packages <- requiredPackages[!(requiredPackages %in% installed.packages()[,"Package"])] if(length(new.packages)) install.packages(new.packages) for (p in requiredPackages) { suppressMessages(invisible(library(p, character.only = TRUE))) } # Arguments option_list <- list( make_option( "--metadata", default = NA, type = 'character', help = "Path to get file containing cells' metadata. Rows = Cells, Columns = Variables." ), make_option( "--metadata_sep", default = "/t", type = 'character', help = "Column separator for metadata file [default : '%default' ]" ), make_option( "--analysis_name", default = NA, type = 'character', help = "Name given to current analysis. This name will be added to output file names. Example = TestAnalysis_AllGenes" ), make_option( "--dataset", default = NA, type = 'character', help = "Details about dataset under study that should appear in output file names. Example = TestDataset_log2CPMvalues" ) ) opt <- parse_args(OptionParser(option_list = option_list), args = commandArgs(trailingOnly = TRUE)) # Define function to save csv files save_csv <- function(dataframe_to_save, OutputNameFile) { write.csv(dataframe_to_save, file = paste(prefix, OutputNameFile, ".csv", sep = "_")) } # Define column separators for input files if (opt$metadata_sep == "tab") { opt$metadata_sep = "\t" } if (opt$metadata_sep == "comma") { opt$metadata_sep = "," } # Import metadata file metadata <- read.csv( opt$metadata, header = TRUE, stringsAsFactors = FALSE, sep = opt$metadata_sep, check.names = FALSE, row.names = 1 ) metadata <- metadata[colnames(expr_data), ] # Prefix for output files prefix <- paste(Sys.Date(), opt$dataset, opt$analysis_name, sep = "_") # Assess clustering tendency of dataset using Hopkins statistic (H) ## Function to calculate Hopkins statistic in package used: H = sum(minp)/(sum(minp) + sum(minq)) ## If H > 0.5, dataset is not uniformly distributed, i.e., it contains meaningful clusters. ## If H < 0.5, dataset is uniformly distributed, i.e., there is no meaningful cluster. DataOnWhichToBaseClustering <- metadata[, c("UMAP1", "UMAP2")] ## UMAP coordinates determined in Step1 clustend <- get_clust_tendency(DataOnWhichToBaseClustering, seed = 123, n = (nrow(DataOnWhichToBaseClustering) - 1)) clustend$hopkins_stat if(clustend$hopkins_stat > 0.5){ ## Determine optimal number of clusters using Silhouette method OptimalClusterNumber_Silhouette <- NbClust( data = DataOnWhichToBaseClustering, diss = NULL, distance = "euclidean", min.nc = 2, max.nc = 30, method = "ward.D2", index = "silhouette" ) SilhouetteIndex_plotData <- as.data.frame(OptimalClusterNumber_Silhouette$All.index) colnames(SilhouetteIndex_plotData) <- "SilhouetteIndex" SilhouetteIndex_plotData$Cluster <- 2:(nrow(SilhouetteIndex_plotData) + 1) ## Silhouette plot NCluster <- as.numeric(OptimalClusterNumber_Silhouette$Best.nc[1]) hc.cut <- hcut(DataOnWhichToBaseClustering, k = NCluster, hc_method = "ward.D2") Sil <- fviz_silhouette(hc.cut) sil1 <- as.data.frame(Sil$data) write.csv(sil1, file = paste0(prefix, "_Silhouette_k=", NCluster, ".csv")) pdf(paste0(prefix,"_SilhouettePlots_DifferentNumberOfClusters.pdf")) for (NClusters in 2:max(SilhouetteIndex_plotData$Cluster)) { hc.cut <- hcut(DataOnWhichToBaseClustering, k = NClusters, hc_method = "ward.D2") print(fviz_silhouette(hc.cut)) } dev.off() ## Hierarchical Clustering Followed By Kmeans Clustering pdf(file = paste0(prefix, "_Dendrogram.pdf")) res.hcpc <- HCPC( res = DataOnWhichToBaseClustering, nb.clust = NCluster, graph = TRUE ) dev.off() ## Update metadata file metadata$Cluster <- res.hcpc$data.clust[, (ncol(DataOnWhichToBaseClustering) + 1)] save_csv(metadata, "MetadataWithClusterIDs") ## Calculate number of cells per cluster CellNumberPerCluster <- as.data.frame(table(metadata$Cluster)) colnames(CellNumberPerCluster) <- c("Cluster", "CellNumber") save_csv(CellNumberPerCluster, "CellNumberPerCluster") ## UMAP plots pdf(file = paste0(Sys.Date(), "_UMAP_HCPCclusters.pdf")) res.plot <- ggplot(metadata, aes(x=UMAP1, y=UMAP2, color = Cluster)) + geom_point(size=1) + ggtitle("Color by HCPC cluster - UMAP") print(res.plot) res.plot1 <- res.plot + theme(legend.position = "none") print(res.plot1) dev.off() } else { print( paste( "Hopkins statistic (H) =", clustend$hopkins_stat, "(Since H < 0.5, dataset is uniformly distributed, i.e., there is no meaningful cluster).")) } ######################################################################################################################### ## Step 3 - Refining cell assignment as malignant and normal using clustering results (Step3_RefiningCellAssignment.R) ## ######################################################################################################################### # Load expression matrix expr_data_path <- "DataX.RData" load(expr_data_path) # Import cell metadata file metadata <- read.table(file = "CellMetadataWithClusterIDs.csv", sep = ",", header = TRUE) ## metadata file from Step2 metadata <- metadata[is.na(metadata$orig.ident) == FALSE,] rownames(metadata) <- metadata$X # Assign normal or malignant identity to each cluster based on cluster number for(i in 1:nrow(metadata)){ if((metadata[i,"Cluster"] == 3)){ metadata[i,"ClusterIdentity1"] <- "Malignant" } else{ metadata[i,"ClusterIdentity1"] <- "Normal" } } # Re-assign cell identity based on cell and cluster assignments for(i in 1:nrow(metadata)){ if((metadata[i,"ClusterIdentity1"] == "Normal") & (metadata[i,"CellAssignment"] == "normal")){ metadata[i,"CellIdentity"] <- "normal" } else { if((metadata[i,"ClusterIdentity1"] == "Malignant") & (metadata[i,"CellAssignment"] == "malignant")){ metadata[i,"CellIdentity"] <- "malignant" } else{ metadata[i,"CellIdentity"] <- "_" } } } table(metadata$CellIdentity) metadata$CellIdentity_bis <- metadata$CellIdentity metadata$CellIdentity_bis[metadata$CellIdentity_bis == "_"] <- NA table(metadata$CellIdentity_bis) write.csv(metadata, file = paste0(Sys.Date(), "_CellMetadataWithFinalCellAssignment.csv")) # UMAP plots library(ggplot2) pdf(file = paste0(Sys.Date(), "_UMAP_ClusterIdentity.pdf")) res.plot <- ggplot(metadata, aes(x=UMAP1, y=UMAP2, color = ClusterIdentity1)) + geom_point(size=1) + scale_color_manual(values=c("red", "black")) + ggtitle("Color by ClusterIdentity1 - UMAP") print(res.plot) res.plot1 <- res.plot + theme(legend.position = "none") print(res.plot1) res.plot <- ggplot(metadata, aes(x=UMAP1, y=UMAP2, color = CellIdentity)) + geom_point(size=1) + scale_color_manual(values=c("lightgrey", "red", "black")) + ggtitle("Color by CellIdentity - UMAP") print(res.plot) res.plot1 <- res.plot + theme(legend.position = "none") print(res.plot1) res.plot <- ggplot(metadata, aes(x=UMAP1, y=UMAP2, color = CellIdentity_bis)) + geom_point(size=1) + scale_color_manual(values=c("red", "black")) + ggtitle("Color by CellIdentity - UMAP (Only non-ambiguous cells)") print(res.plot) res.plot1 <- res.plot + theme(legend.position = "none") print(res.plot1) dev.off() ################################################## ## Correlation analysis (CorrelationAnalysis.R) ## ################################################## # Define variables Variables <- list( ExpData.file = "ExpressionMatrix.tsv", ExpData.file_sep = "\t", GenesUnderStudy.file = "MigrationSignature.csv", Dataset = "_Dataset1.SMARTseq_scRNAseq_log2(TPM+1)_", AnalysisType = "PearsonCorrelation", pval = 0.01, GenelistName = "SignatureX") # Load required packages library(Hmisc) library(corrplot) # Define function for descriptive statistics desc_stats <- function(InputData){ SummaryData <- data.frame(t(apply(InputData, 1, summary))) SummaryData$SD <- apply(InputData, 1, sd) SummaryData$Variance <- apply(InputData, 1, var) SummaryData$Coeff_Var <- (SummaryData$SD/SummaryData$Mean)*100 SummaryData$Detection <- apply(InputData, 1, function(x) sum(x !=0)) SummaryData$Percentage_Detection <- (SummaryData$Detection / ncol(InputData)) *100 nameDatasetX <- deparse(substitute(InputData)) write.csv(as.data.frame(SummaryData), file = paste(Sys.Date(), Variables$Dataset, "DescriptiveStats.csv")) } # Define function to flatten correlation matrix flattenCorrMatrix <- function(cormat, pmat) { ut <- upper.tri(cormat) data.frame( row = rownames(cormat)[row(cormat)[ut]], column = rownames(cormat)[col(cormat)[ut]], cor =(cormat)[ut], p = pmat[ut] ) } ## Defining function for the Pearson correlation between each pair of variable GenePearsonCorr <- function(x,y) { nameDataset <- paste0(y) corr <- rcorr(as.matrix(t(x)), type="pearson") # x is a dataframe with observations as columns and variables as rows. corr_flat <- flattenCorrMatrix(corr$r, corr$P) write.csv(corr$r, file=paste(Sys.Date(), Variables$AnalysisType, nameDataset, "Correlation_Coeff.csv")) write.csv(corr$P, file=paste(Sys.Date(), Variables$AnalysisType, nameDataset, "Correlation_Pval.csv")) write.csv(corr_flat, file=paste(Sys.Date(), Variables$AnalysisType, nameDataset, "Correlation_Analysis_pairwise.csv")) corr$r.bis <- corr$r corr$r.bis[corr$r.bis ==1] <- max(corr_flat$cor) pdf(paste(Sys.Date(), nameDataset, "Corrplot.pdf")) corrplot(corr$r, method = "color", type = "full", order = "original", tl.cex = 0.5, tl.col = "black", insig = "blank") corrplot(corr$r, method = "color", type = "full", order = "original", tl.cex = 0.5, tl.col = "black", p.mat = corr$P, sig.level = Variables$pval, insig = "blank") corrplot(corr$r.bis, method = "color", type = "full", order = "original", tl.cex = 0.5, tl.col = "black", p.mat = corr$P, sig.level = Variables$pval, insig = "blank", cl.lim=c(-0.03,0.35), is.corr=FALSE) dev.off() } # Import expression data norm_data <- read.csv(file = Variables$ExpData.file, header = TRUE, row.names = 1, sep = Variables$ExpData.file_sep) # Import list of signature genes GenesUnderStudy <- read.csv(file = Variables$GenesUnderStudy.file, header = TRUE) # Extract expression values of genes under study GenesUnderStudy_Expression <- norm_data GenesUnderStudy_Expression$gene <- rownames(GenesUnderStudy_Expression) GenesUnderStudy_Expression <- merge(x=GenesUnderStudy, y = GenesUnderStudy_Expression, by.y = "gene", by.x = colnames(GenesUnderStudy)[1]) rownames(GenesUnderStudy_Expression) <- GenesUnderStudy_Expression[, colnames(GenesUnderStudy)[1]] GenesUnderStudy_Expression <- GenesUnderStudy_Expression[, (ncol(GenesUnderStudy)+1):ncol(GenesUnderStudy_Expression)] # Descriptive statistics of genes under study desc_stats(GenesUnderStudy_Expression) # Correlation between genes under study GenePearsonCorr(x=GenesUnderStudy_Expression, y=Variables$GenelistName) ############################################################################################################################################################## # Grouping analysis based on Hierarchical Clustering on Principal Components (HCPC) approach integrating UMAP (HCPCintegratingUMAP.R) # ############################################################################################################################################################## # This Rscript allows to perform unsupervised grouping analysis using the HCPC approach. # Input files include: ## the cells' normalised expression data (for e.g. in log2(CPM+1) values) ## the cells' metadata ## the lists of genes to be used for the grouping analysis ## the list of genes to highlight on plots ## the list of signatures to highlight on plots # Output files include the clustering results, a .RData file as well as some plots (PCA/tSNE/UMAP, heatmap). # Example of line command ## Rscript GroupingAnalysis.R --file Dataset1.RData --dataset Dataset1 --analysis_name SignatureXanalysis --tumor TumorOrigin --tumorColor gray0,chartreuse,darkorchid1,gold2,blue,violetred2 --PreClusteringSteps PCA,UMAP --tsne FALSE --numberPCsToUseForClustering 10 --UMAPcomponentsClustering 2 --GenesUnderStudy SignatureX.csv --Signatures OtherSignatures.csv --Signatures_sep ; --Genes GenesOnPlots.csv --Genes_sep , # Load necessary packages (install them if it's not the case) requiredPackages <- c( 'optparse', 'FactoMineR', 'factoextra', 'NbClust', 'RColorBrewer', 'tsne', 'ClusterR', 'ggplot2', 'circlize', 'ComplexHeatmap', 'umap', 'psych', 'RSpectra' ) new.packages <- requiredPackages[!(requiredPackages %in% installed.packages()[,"Package"])] if(length(new.packages)) install.packages(new.packages) for (p in requiredPackages) { suppressMessages(invisible(library(p, character.only = TRUE))) } # Arguments option_list <- list( make_option( "--file", default = NA, type = 'character', help = "Path to get the expression data (log-transformed normalized values) and cell metadata file in .RData format. expr_data slot contains expression values, metadata slot contains cell metadata." ), make_option( "--Group", default = NA, type = 'character', help = "Group of cells to which further analysis should be restricted." ), make_option( "--GenesUnderStudy", default = NA, type = 'character', help = "Path to get the lists of genes to use for the grouping analysis. 1 gene per row. There can be multiple columns with different column names to distinguish the different gene lists. File in csv format with comma as separator." ), make_option( "--analysis_name", default = NA, type = 'character', help = "Name given to the current analysis. This name will be added to the output file names. Exmaple = TestAnalysis_AllGenes" ), make_option( "--dataset", default = NA, type = 'character', help = "Details about the dataset under study that should appear in the output file names. Example = TestDataset_log2CPMvalues" ), make_option( "--numberPCsToUseForClustering", default = 10, type = 'integer', help = "Number of principal components to consider for grouping analyses [default : '%default' ]" ), make_option( "--UMAPcomponentsClustering", default = 10, type = 'integer', help = "Number of UMAP components to consider for grouping analyses [default : '%default' ]" ), make_option( "--tumor", default = NA, type = 'character', help = "Column name corresponding to tumor identity" ), make_option( "--tumorColor", default = NA, type = 'character', help = "Color to assign to each tumor. List of colors. Comma separated" ), make_option( "--PreClusteringSteps", default = NA, type = 'character', help = "A comma-separated list of 2 steps to do prior to running HCPC analysis. For e.g. PCA,UMAP means doing a PCA, then a UMAP analysis on the PCs prior to running HCPC analysi on the UMAP coordinates" ), make_option( "--tsne", default = FALSE, type = 'logical', help = "Whether or not to run tSNE for data visualization [default : '%default' ]" ), make_option( "--Signatures", default = NA, type = 'character', help = "Path to get the file that contains the signatures for which a score should be calculated and visualised on the PCA/tSNE/UMAP plot. 1 Column = 1 signature, 1 Row = 1 Gene" ), make_option( "--Signatures_sep", default = "/t", type = 'character', help = "Column separator for the Signatures file [default : '%default' ]" ), make_option( "--Genes", default = NA, type = 'character', help = "Path to get the file that contains the list of genes whose expression should be highlighted on the PCA/tSNE/UMAP plot. 1 Column with 1 Gene per row. Column name = gene." ), make_option( "--Genes_sep", default = "/t", type = 'character', help = "Column separator for the SignatureScores file [default : '%default' ]" ), make_option( "--out", default = "~", type = 'character', help = "Path to set the working directory [default : '%default' ]" ) ) opt <- parse_args(OptionParser(option_list = option_list), args = commandArgs(trailingOnly = TRUE)) # Descriptive Statistics Function descriptive_stats <- function(InputData, OutputFileName) { SummaryData <- data.frame( mean = rowMeans(InputData), SD = apply(InputData, 1, sd), Variance = apply(InputData, 1, var), Percentage_Detection = apply(InputData, 1, function(x, y = InputData) { (sum(x != 0) / ncol(y)) * 100 }) ) write.csv(SummaryData, file = paste0(Sys.Date(), "_DescriptiveStats_", OutputFileName, ".csv")) return(SummaryData) } # Define function to save csv files save_csv <- function(dataframe_to_save, OutputNameFile) { write.csv(dataframe_to_save, file = paste(prefix, OutputNameFile, ".csv", sep = "_")) } # Define function for 2D plots plot_function <- function(SampleCoord, AssignBasedOn, PlotType) { ## Assign a color to each cell if (AssignBasedOn == "tumor") { ### Get tumor names SampleLegend <- levels(as.factor(metadata[, opt$tumor])) ### Define color palette to be used colorPalette <- unlist(strsplit(opt$tumorColor, split = ",")) ### Assign a color to each cell based on tumor of origin SampleColor <- colorPalette[as.factor(metadata[, opt$tumor])] } else { ### Get cluster names SampleLegend <- levels(as.factor(metadata$Cluster)) ### Define color palette to be used qual_col_pals <- brewer.pal.info[brewer.pal.info$category == 'qual', ] colorPalette <- unique(unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals)))) ### Assign a color to each cell based on clustering results SampleColor <- vector() for (cell_index in 1:length(metadata$Cluster)) { SampleColor[cell_index] <- colorPalette[which(SampleLegend == metadata$Cluster[cell_index])] } } ## Define all axes to be plotted AxisCombinationsList <- lapply(1:(ncol(SampleCoord) - 1), function(xaxis) { PossibleXaxis <- xaxis yaxisPlot <- (xaxis + 1):ncol(SampleCoord) Combinations <- expand.grid(PossibleXaxis, yaxisPlot) }) AxisCombinations_dataframe <- do.call("rbind", AxisCombinationsList) ## Plot XY graph lapply(1:nrow(AxisCombinations_dataframe), function(CombinationNumber) { xaxisPlot <- AxisCombinations_dataframe[CombinationNumber, 1] yaxisPlot <- AxisCombinations_dataframe[CombinationNumber, 2] ### Define the label for the x-axis and y-axis if (PlotType == "PCA") { xlabel <- paste("PC", xaxisPlot, "(", format(round(Vartab[xaxisPlot, 2], 2)), " %)") ylabel <- paste("PC", yaxisPlot, "(", format(round(Vartab[yaxisPlot, 2], 2)), " %)") } else { xlabel <- paste("Component", xaxisPlot) ylabel <- paste("Component", yaxisPlot) } ### XY plot plot( SampleCoord[, c(xaxisPlot, yaxisPlot)], type = "p", pch = 16, col = SampleColor, cex = 1.5, xlab = xlabel, ylab = ylabel, axes = TRUE ) #### Add legend on the XY plot legend( "topleft", legend = SampleLegend, col = colorPalette, pch = 16, cex = 1.5 ) ### empty return because otherwise legend coordinates are returned return() ### XY plot without legend plot( SampleCoord[, c(xaxisPlot, yaxisPlot)], type = "p", pch = 16, col = SampleColor, cex = 1.5, xlab = xlabel, ylab = ylabel, axes = TRUE ) }) } # Define function to plot heatmap HeatmapPlot <- function(DataToPlot, SplitData, ColumnSplit, ColorPalette, Transform, Rowv, Colv, dendrogram, Top_ha, Bottom_ha, TextSize_Rownames) { ## Transform data if (Transform == "Scale") { HeatmapData <- as.data.frame(t(scale(t(DataToPlot)))) HeatmapTitle <- "Expression (scaled)" } else { if (Transform == "Normalize") { HeatmapData <- apply(DataToPlot, 1, function(x) (x - min(x)) / (max(x) - min(x))) HeatmapData <- as.data.frame(t(HeatmapData)) HeatmapTitle <- "Expression (Normalized)" } else { HeatmapData <- DataToPlot HeatmapTitle <- "Expression" } } ## Plot heatmap Heatmap( as.matrix(HeatmapData), name = HeatmapTitle, # title of legend column_title = "Cells", row_title = "Genes", row_names_gp = gpar(fontsize = TextSize_Rownames), # Text size for row names cluster_rows = Rowv, cluster_row_slices = Rowv, clustering_distance_rows = "euclidean", clustering_method_rows = "ward.D2", clustering_distance_columns = "euclidean", clustering_method_columns = "ward.D2", row_dend_side = c("left", "right"), row_dend_width = unit(10, "mm"), show_row_dend = dendrogram, cluster_columns = Colv, column_names_gp = gpar(fontsize = 0), column_names_rot = 0, top_annotation = Top_ha, bottom_annotation = Bottom_ha, heatmap_height = unit(12, "cm"), col = ColorPalette, column_split = SplitData[, ColumnSplit], column_gap = unit(1, "mm"), border = TRUE ) } # Function to color cells on PCA/tSNE/UMAP plot based on each signature score ScoreOnPlot <- function(DataOnPlot, PlotType, SampleCoord) { VariableData <- as.data.frame(t(DataOnPlot)) for (score in 1:ncol(VariableData)) { SignatureName <- colnames(VariableData)[score] ScaleLength <- nrow(VariableData[VariableData[SignatureName] != 0, ]) ColorPalette <- colorRampPalette(brewer.pal(9, "YlOrRd"))(n = ScaleLength) SampleColor <- ColorPalette[as.factor(VariableData[, SignatureName])] GraphTitle <- SignatureName ## Define all axes to be plotted AxisCombinationsList <- lapply(1:(ncol(SampleCoord) - 1), function(xaxis) { PossibleXaxis <- xaxis yaxisPlot <- (xaxis + 1):ncol(SampleCoord) Combinations <- expand.grid(PossibleXaxis, yaxisPlot) }) AxisCombinations_dataframe <- do.call("rbind", AxisCombinationsList) ## Plot XY graph lapply(1:nrow(AxisCombinations_dataframe), function(CombinationNumber) { xaxisPlot <- AxisCombinations_dataframe[CombinationNumber, 1] yaxisPlot <- AxisCombinations_dataframe[CombinationNumber, 2] ### Define the labels for the x-axis and y-axis if (PlotType == "PCA") { xlabel <- paste("PC", xaxisPlot) ylabel <- paste("PC", yaxisPlot) } else { xlabel <- paste("Component", xaxisPlot) ylabel <- paste("Component", yaxisPlot) } ### XY plot plot( SampleCoord[, c(xaxisPlot, yaxisPlot)], type = "p", pch = 16, col = SampleColor, cex = 1.5, xlab = xlabel, ylab = ylabel, axes = TRUE, main = GraphTitle ) return() }) } } # Import data file load(opt$file) data.normCounts <- expr_data rm(expr_data) metadata <- metadata[colnames(data.normCounts), ] # Extract expression values of cells under study if (is.na(opt$Group) == FALSE) { GroupDetails <- unlist(strsplit(opt$Group, split = ",")) metadata <- metadata[metadata[GroupDetails[1]] == GroupDetails[2], ] data.normCounts <- data.normCounts[, rownames(metadata)] } data.normCounts_bis <- data.normCounts data.normCounts_bis$gene <- rownames(data.normCounts_bis) # Prefix for output files prefix <- paste(Sys.Date(), opt$dataset, opt$analysis_name, sep = "_") # Import the list of the genes which should be retained in the grouping analysis GenesUnderStudy <- read.csv( opt$GenesUnderStudy, header = TRUE, stringsAsFactors = FALSE, sep = ",", check.names = FALSE ) # For each molecular signature SignatureNumber <- 1 while (SignatureNumber <= ncol(GenesUnderStudy)) { ## Get name of molecular signature SignatureID <- colnames(GenesUnderStudy)[SignatureNumber] ## Extract expression values of signature genes Filtered_Dataset <- merge( x = GenesUnderStudy, y = data.normCounts_bis, by.x = SignatureID, by.y = "gene" ) rownames(Filtered_Dataset) <- Filtered_Dataset[, SignatureID] Filtered_Dataset <- Filtered_Dataset[, (ncol(GenesUnderStudy) + 1):ncol(Filtered_Dataset)] # save_csv(Filtered_Dataset, "ExpressionMatrix") ## save expression data of genes under study ## Descriptive statistics of the genes under study signature_stats <- descriptive_stats(Filtered_Dataset, opt$analysis_name) ## Prepare data for the clustering step if(is.na(opt$PreClusteringSteps) != TRUE){ PreClusteringSteps <- unlist(strsplit(opt$PreClusteringSteps, split = ",")) ### Usual Strategy if(PreClusteringSteps[1] == "PCA" & PreClusteringSteps[2] == "NA"){ #### PCA res.pca <- PCA( t(Filtered_Dataset), ncp = opt$numberPCsToUseForClustering, graph = FALSE, scale.unit = FALSE ) Cells_coord_onPCA <- as.data.frame(res.pca$ind$coord) ## cells' coordinates on PCA plot save_csv(Cells_coord_onPCA, "PCA_SamplesCoordinates") DataOnWhichToBaseClustering <- Cells_coord_onPCA #### Extract variance data from PCA Vartab <- get_eig(res.pca) save_csv(Vartab, "PCA_VariationTable") save_csv(res.pca$var$contrib, "PCA_VariableContribution") } ### Strategy integrating UMAP if(PreClusteringSteps[1] == "PCA" & PreClusteringSteps[2] == "UMAP"){ #### PCA res.pca <- PCA( t(Filtered_Dataset), ncp = opt$numberPCsToUseForClustering, graph = FALSE, scale.unit = FALSE ) Cells_coord_onPCA <- as.data.frame(res.pca$ind$coord) ## cells' coordinates on PCA plot save_csv(Cells_coord_onPCA, "PCA_SamplesCoordinates") #### Extract variance data from PCA Vartab <- get_eig(res.pca) save_csv(Vartab, "PCA_VariationTable") save_csv(res.pca$var$contrib, "PCA_VariableContribution") #### UMAP analysis on PCs set.seed(123) Data.umap <- umap( d = Cells_coord_onPCA, init = "spectral", n_components = opt$UMAPcomponentsClustering ) layout <- Data.umap if (class(Data.umap) == "umap") {layout <- Data.umap$layout} save_csv(layout, "UMAP_SampleCoordinates") DataOnWhichToBaseClustering <- as.data.frame(layout) } } ## Assess clustering tendency of the dataset using Hopkins statistic (H) ### Function to calculate Hopkins statistic in the package: H = sum(minp)/(sum(minp) + sum(minq)) ### If H > 0.5, the dataset is not uniformly distributed, i.e., it contains meaningful clusters. ### If H < 0.5, the dataset is uniformly distributed, i.e., there is no meaningful clusters. clustend <- get_clust_tendency(DataOnWhichToBaseClustering, seed = 123, n = (nrow(DataOnWhichToBaseClustering) - 1)) clustend$hopkins_stat ## If H>0.5, proceed with clustering if (clustend$hopkins_stat > 0.5) { ### Determine the number of clusters using Silhouette method OptimalClusterNumber_Silhouette <- NbClust( data = DataOnWhichToBaseClustering, diss = NULL, distance = "euclidean", min.nc = 2, max.nc = 30, method = "ward.D2", index = "silhouette" ) SilhouetteIndex_plotData <- as.data.frame(OptimalClusterNumber_Silhouette$All.index) colnames(SilhouetteIndex_plotData) <- "SilhouetteIndex" SilhouetteIndex_plotData$Cluster <- 2:(nrow(SilhouetteIndex_plotData) + 1) ### Silhouette plot NCluster <- as.numeric(OptimalClusterNumber_Silhouette$Best.nc[1]) hc.cut <- hcut(DataOnWhichToBaseClustering, k = NCluster, hc_method = "ward.D2") Sil <- fviz_silhouette(hc.cut) sil1 <- as.data.frame(Sil$data) write.csv(sil1, file = paste0(prefix, "_Silhouette_k=", NCluster, ".csv")) pdf(paste0(prefix, "_SilhouettePlots_DifferentNumberOfClusters.pdf")) for (NClusters in 2:max(SilhouetteIndex_plotData$Cluster)) { hc.cut <- hcut(DataOnWhichToBaseClustering, k = NClusters, hc_method = "ward.D2") print(fviz_silhouette(hc.cut)) } dev.off() ### Hierarchical Clustering Followed By Kmeans Clustering pdf(file = paste0(prefix, "_Dendrogram.pdf")) res.hcpc <- HCPC( res = DataOnWhichToBaseClustering, nb.clust = NCluster, graph = TRUE ) dev.off() ### Update metadata file metadata$Cluster <- res.hcpc$data.clust[, (ncol(DataOnWhichToBaseClustering) + 1)] save_csv(metadata, "MetadataWithClusterIDs") ### Calculate number of cells per cluster CellNumberPerCluster <- as.data.frame(table(metadata$Cluster)) colnames(CellNumberPerCluster) <- c("Cluster", "CellNumber") save_csv(CellNumberPerCluster, "CellNumberPerCluster") ### Calculate NMI score to determine if clustering biased is by tumor of origin sink(paste0(Sys.Date(), "_External-validation-ContributionOfEachTumorToEachCluster.txt")) external_validation(as.numeric(factor(metadata[, opt$tumor])), as.numeric(metadata$Cluster), summary_stats = TRUE) sink() ### Chord diagram to visually compare clustering result and tumor of origin #### Define variables Group <- metadata$Cluster Tumor <- metadata[, opt$tumor] #### Prepare data dat_Tumor <- data.frame(Group, Tumor) dat_Tumor <- with(dat_Tumor, table(Group, Tumor)) #### Define color palette to be used to color cells based on tumor of origin TumorPalette <- unlist(strsplit(opt$tumorColor, split = ",")) #### Define color palette to be used to color cells based on clustering results qual_col_pals <- brewer.pal.info[brewer.pal.info$category == 'qual', ] ClusterPalette <- unique(unlist(mapply( brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals) ))) #### Chord diagram pdf(file = paste0(Sys.Date(), "_Chord diagrams.pdf")) chordDiagram( as.data.frame(dat_Tumor), transparency = 0.5, col = c(ClusterPalette[1:length(unique(metadata$Cluster))]), grid.col = c(ClusterPalette[1:length(unique(metadata$Cluster))], TumorPalette) ) dev.off() ### Highlight cells by signature score of interest on 2D plot #### Import signature gene lists SignatureGenes <- read.table( opt$Signatures, header = TRUE, stringsAsFactors = FALSE, sep = opt$Signatures_sep, check.names = FALSE ) #### Calculate signature score per cell ##### Score = geometric mean of expression values of genes in each signature ##### Each column in the SignatureGenes dataframe corresponds to one molecular signature SignatureScoreTable <- data.frame(matrix(, nrow = nrow(metadata), ncol = 0)) rownames(SignatureScoreTable) <- rownames(metadata) SignatureScoreTable$cell <- rownames(metadata) i <- 1 while (i <= ncol(SignatureGenes)) { ColInterest <- colnames(SignatureGenes[i]) Genes_interest1 <- merge( y = data.normCounts_bis, x = SignatureGenes, by.x = ColInterest, by.y = "gene" ) rownames(Genes_interest1) <- Genes_interest1[, ColInterest] Genes_interest1 <- Genes_interest1[, (ncol(SignatureGenes) + 1):ncol(Genes_interest1)] Genes_interest_GBM <- Genes_interest1 Genes_interest_GBM[Genes_interest_GBM == 0] <- 1 GeomMean1 <- as.data.frame(apply(Genes_interest_GBM, 2, geometric.mean)) colnames(GeomMean1) <- ColInterest SignatureScoreTable[, ColInterest] <- GeomMean1[, ColInterest] i <- i + 1 } rm(ColInterest) rm(Genes_interest1) rm(Genes_interest_GBM) rm(GeomMean1) SignatureScoreTable <- SignatureScoreTable[, -1] SignatureScoreTable <- SignatureScoreTable[rownames(metadata), ] save_csv(SignatureScoreTable, "SignatureScores") #### add migration score to metadata file metadata <- cbind(metadata, SignatureScoreTable) #### Plots of Signature Score per cluster pdf(file = paste0(prefix, "_Violin and box plots of signature scores per cluster.pdf")) for(i in 1:ncol(SignatureScoreTable)){ SignatureName <- colnames(SignatureScoreTable)[i] ##### Violin plot ViolinPlot <- ggplot(metadata, aes(Cluster, metadata[,SignatureName])) + geom_violin(aes(fill = Cluster), alpha = 1, trim = FALSE, show.legend = FALSE) + scale_fill_manual(values=c(ClusterPalette[1:length(unique(metadata$Cluster))])) + geom_jitter(color = "grey", alpha = .5) + labs(y = paste(SignatureName, " Score"), x = "Cluster") + stat_summary(fun.data="mean_sdl", geom="pointrange") print(ViolinPlot) # Box plot BoxPlot <- ggplot(metadata, aes(Cluster, metadata[,SignatureName])) + geom_boxplot(fill = "gray88", outlier.colour="white") + labs(y = paste(SignatureName, " Score"), x = "Cluster") + geom_jitter(shape=16, position=position_jitter(0.2), color = ClusterPalette[metadata$Cluster], alpha = .5) + theme_classic() + theme(axis.text.x = element_text(angle = 90)) plot(BoxPlot) } dev.off() ### Highlight cells by expression of genes of interest on 2D plot #### Import list of genes whose expression should be highlighted GenesOnPlot <- read.table( opt$Genes, header = TRUE, stringsAsFactors = FALSE, sep = opt$Genes_sep, check.names = FALSE ) Genes_plot <- merge(x = GenesOnPlot, y = data.normCounts_bis, by = "gene") rownames(Genes_plot) <- Genes_plot$gene Genes_plot <- Genes_plot[, (ncol(GenesOnPlot) + 1):ncol(Genes_plot)] Genes_plot <- Genes_plot[, rownames(metadata)] Genes_plot <- rbind (Filtered_Dataset, Genes_plot) ### PCA visualization of results if(PreClusteringSteps[1] == "PCA"){ pdf(file = paste0(prefix, "_PCAplots_PCAresults.pdf")) print(fviz_eig(res.pca)) ## Scree Plot print(fviz_pca_ind(res.pca, label = "none")) ## Visualize the repartition of the samples in space print(fviz_pca_var(res.pca, col.var = "contrib", geom = c("text", "arrow"))) ## Visualize contribution of each variable dev.off() pdf(file = paste0(prefix, "_PCAplots_TumorOrigin_Cluster.pdf")) plot_function( SampleCoord = Cells_coord_onPCA, AssignBasedOn = "tumor", PlotType = "PCA" ) ## Color by tumor of origin plot_function( SampleCoord = Cells_coord_onPCA, AssignBasedOn = "cluster", PlotType = "PCA" ) ## Color by cluster dev.off() pdf(file = paste(Sys.Date(), "PCAplots_CellsColoredBySignatureScores.pdf")) ScoreOnPlot(t(SignatureScoreTable), "PCA", Cells_coord_onPCA) dev.off() pdf(file = paste(Sys.Date(), "PCAplots_CellsColoredByGeneExpression.pdf")) ScoreOnPlot(Genes_plot, "PCA", Cells_coord_onPCA) dev.off() } ### UMAP visualization of results if(PreClusteringSteps[2] == "UMAP"){ pdf(file = paste(prefix, "UMAPplots_TumorOrigin_Cluster.pdf", sep = "_")) plot_function( SampleCoord = layout, AssignBasedOn = "tumor", PlotType = "UMAP" ) plot_function( SampleCoord = layout, AssignBasedOn = "cluster", PlotType = "UMAP" ) dev.off() pdf(file = paste(Sys.Date(),"UMAPplots_CellsColoredBySignatureScores.pdf")) ScoreOnPlot(t(SignatureScoreTable), "UMAP", layout) dev.off() pdf(file = paste(Sys.Date(),"UMAPplots_CellsColoredByGeneExpression.pdf")) ScoreOnPlot(Genes_plot, "UMAP", layout) dev.off() } ### Heatmap representation #### Order cells based on cluster number metadata_orderedByCluster <- metadata[order(metadata$Cluster), ] Filtered_Dataset_orderedByCluster <- Filtered_Dataset[, rownames(metadata_orderedByCluster)] #### Define colors for each level of qualitative variables and a gradient color for continuous variable ##### Clusters Cluster_Color <- ClusterPalette[1:length(unique(metadata_orderedByCluster$Cluster))] names(Cluster_Color) <- levels(unique(as.factor(metadata_orderedByCluster$Cluster))) ##### Expression values ExpressionData_ColorPalette <- colorRamp2( breaks = c(0, 0.5, 1), colors = c("lightgoldenrodyellow", "orange", "red") ) ##### Score values Score_ColorPalette <- colorRamp2(breaks = c(0, ceiling(max( metadata[,SignatureID] ))), colors = c("gray100", "black")) ## Create the heatmap annotation Top_ha <- HeatmapAnnotation( Cluster = metadata_orderedByCluster$Cluster, Score = as.numeric(metadata_orderedByCluster[,SignatureID]), col = list( Cluster = Cluster_Color, Score = Score_ColorPalette ), show_legend = TRUE ) ## Plot the heatmap pdf(paste0(Sys.Date(), "_Heatmaps.pdf")) print(HeatmapPlot( DataToPlot = Filtered_Dataset_orderedByCluster, SplitData = metadata_orderedByCluster, ColumnSplit = "Cluster", ColorPalette = ExpressionData_ColorPalette, Transform = "Normalize", Rowv = TRUE, Colv = FALSE, dendrogram = TRUE, Top_ha = Top_ha, Bottom_ha = NULL, TextSize_Rownames = 5 )) dev.off() # tSNE visualization of HCPC clustering if (opt$tsne == TRUE) { set.seed(1) x1 <- 0 # initialize counter to 0 epc <- function(x1) { x1 <<- x1 + 1 filename <- paste(prefix, "_tSNEplot", x1, "jpg", sep = ".") cat("> Plotting TSNE to ", filename, " ") jpeg(filename, width = 2400, height = 1800) plot( x1, t = 'p', main = "T-SNE", col = "black", cex = 2, pch = 16 ) dev.off() } DistanceMatrix <- dist(Cells_coord_onPCA, method = "euclidean") ## Distance matrix used by HCPC function Cells_coord_onTSNE <- tsne( DistanceMatrix, initial_config = NULL, k = 10, initial_dims = 30, perplexity = 50, max_iter = 1000, min_cost = 0, epoch_callback = epc, whiten = TRUE, epoch = 100 ) Cells_coord_onTSNE <- as.data.frame(Cells_coord_onTSNE) rownames(Cells_coord_onTSNE) <- rownames(Cells_coord_onPCA) save_csv(Cells_coord_onTSNE, "SampleCoordinates_OnTSNEplot") pdf(file = paste(prefix, "tSNEplots_TumorOrigin_Cluster.pdf", sep = "_")) plot_function( SampleCoord = Cells_coord_onTSNE, AssignBasedOn = "tumor", PlotType = "tSNE" ) plot_function( SampleCoord = Cells_coord_onTSNE, AssignBasedOn = "cluster", PlotType = "tSNE" ) dev.off() pdf(file = paste(Sys.Date(),"tSNEplots_CellsColoredBySignatureScores.pdf")) ScoreOnPlot(SignatureScoreTable, "tSNE", Cells_coord_onTSNE) dev.off() pdf(file = paste(Sys.Date(),"tSNEplots_CellsColoredByGeneExpression.pdf")) ScoreOnPlot(Genes_plot, "tSNE", Cells_coord_onTSNE) dev.off() } # Save complete workspace (for later use if needed) save.image(file = paste0(prefix, ".RData")) # Save input parameters used sink(paste0(prefix, "_InputParameters.txt")) print(cat( '\nUsing :\n- Data file (--file) :', opt$file, '\n- Metadata file (--metadata) :', opt$metadata, '\n- Metadata file containing tumorigenic status/score (--metadata_bis) :', opt$metadata_bis, '\n- Genes used for the grouping analysis (--GenesUnderStudy) :', opt$GenesUnderStudy, '\n- Genes highlighted on the PCA/tSNE/UMAP plot (--Genes) :', opt$Genes, '\n- Signature genes for which a score should be calculated (--Signatures) :', opt$Signatures, '\n- OutputFolder (--out) :', opt$out, '\n\nOther parameters :\n- Type of analysis (--analysis_name) :', opt$analysis_name, '\n- Name of dataset (--dataset) :', opt$dataset, '\n- Cell group to which further analysis was restricted (--Group) :', opt$Group, '\n- Number of principal components considered for grouping analyses (--numberPCsToUseForClustering) :', opt$numberPCsToUseForClustering, '\n- Column name corresponding to tumor identity (--tumor) :', opt$tumor, '\n- Color assigned to each tumor (--tumorColor) :', opt$tumorColor, '\n- Should tSNE be run (TRUE = Yes and FALSE = No) (--tsne) :', opt$tsne, '\n- List of 2 steps to do prior to running HCPC analysis (--PreClusteringSteps) :', opt$PreClusteringSteps, '\n' )) sink() # Save the versions of R and R packages used sink(paste0(prefix, "_RpackagesVersions.txt")) print(sessionInfo()) sink() } else { print(paste("Hopkins statistic (H) =", clustend$hopkins_stat, "(Since H < 0.5, the dataset is uniformly distributed, i.e., there is no meaningful clusters.")) } SignatureNumber <- SignatureNumber + 1 } ################################################################################################# ### Assess silhouette width of each cell in each cluster (SilhouetteWidthPerCellPerCluster.R) ### ################################################################################################# # Define variables Variables <- list( ClusterPalette1 = c("chartreuse3", "deepskyblue", "goldenrod3", "slateblue1", "darkorange1"), ## Color palette for clusters NumberOfClusters = 5, OutputFolder = "DataAnalysisFolder/", RDataFilePath = "DataAnalysisX.RData") ## .RData file containing the global environment related to the HCPC clustering analysis (generated using the HCPCintegratingUMAP.R script). # Load required packages library(factoextra) library(FactoMineR) library(cluster) # Set working directory setwd(Variables$OutputFolder) # Load the appropriate .RData load(Variables$RDataFilePath) # Silhouette width per cell per cluster kmeans.res <- kmeans(Cells_coord_onPCA, iter.max = 10, nstart = 4, centers = NumberOfClusters) SilhouetteWidth <- silhouette(x=kmeans.res$cluster, dist = dist(Cells_coord_onPCA), full = FALSE) SilhouetteWidth_cells <- data.frame(cluster=kmeans.res$cluster, row.names = names(kmeans.res$cluster)) SilhouetteWidth_cells$neighbor <- SilhouetteWidth[,2] SilhouetteWidth_cells$sil_width <- SilhouetteWidth[,3] SilhouetteWidth_cells <- SilhouetteWidth_cells[rownames(metadata),] # Silhouette width plot per cluster pdf(file = paste0(Sys.Date(), "_Silhouette width per cell in each cluster.pdf")) Plot <- ggplot(SilhouetteWidth_cells, aes(x=Cluster, y=sil_width)) + geom_boxplot(fill = "gray88", outlier.colour="white") + geom_jitter(color = ClusterPalette1[as.factor(SilhouetteWidth_cells$Cluster)]) + labs(y = "Silhouette width", x = "Cluster") + theme_classic() + theme(axis.text.x = element_text(angle = 90)) + geom_hline(yintercept = 0, linetype = "dotted")+ ylim(-0.5,1) plot(Plot) dev.off() ########################################################################## ## Linear models between signature scores (LinearModelsBetweenScores.R) ## ########################################################################## # Define varables Variables <- list( Dataset = "Dataset1", ExprData = "Dataset1.RData", cellMetadata = "MetadataWithClusterIDs.csv", cellMetadata.sep = ",", SignatureGenesList = "SignatureGenes.csv", SignatureGenesList.sep = ",", ClustersToHighlight = "4,1", ClusterPalette = c("deepskyblue", "firebrick1", "chartreuse3", "deeppink", "goldenrod3", "darkorange1", "slateblue1"), ## Color palette for clusters ClusterPalette1 = c("deepskyblue", "grey", "grey", "deeppink", "grey", "grey", "grey") ## Color palette for clusters ) # Load required packages library(psych) library(ggplot2) # Import expression data load(Variables$ExprData) # Import cell metadata files containing cluster membership metadata <- read.table(file = Variables$cellMetadata, header = TRUE, sep= Variables$cellMetadata.sep, row.names = 1) # Import signature genes SignatureGenes <- read.table(file = Variables$SignatureGenesList, header = TRUE, sep= Variables$SignatureGenesList.sep) # Calculate signature score per cell ## Score = geometric mean of expression values of genes in each signature ## Each column in the SignatureGenes dataframe corresponds to one molecular signature SignatureScoreTable <- data.frame(matrix(, nrow = ncol(expr_data), ncol = 0)) rownames(SignatureScoreTable) <- colnames(expr_data) SignatureScoreTable$cell <- colnames(expr_data) data.normCounts_bis <- expr_data data.normCounts_bis$gene <- rownames(data.normCounts_bis) i <- 1 while (i <= ncol(SignatureGenes)) { ColInterest <- colnames(SignatureGenes[i]) Genes_interest1 <- merge( y = data.normCounts_bis, x = SignatureGenes, by.x = ColInterest, by.y = "gene" ) rownames(Genes_interest1) <- Genes_interest1[, ColInterest] Genes_interest1 <- Genes_interest1[, (ncol(SignatureGenes) + 1):ncol(Genes_interest1)] Genes_interest_GBM <- Genes_interest1 Genes_interest_GBM[Genes_interest_GBM == 0] <- 1 GeomMean1 <- as.data.frame(apply(Genes_interest_GBM, 2, geometric.mean)) colnames(GeomMean1) <- ColInterest SignatureScoreTable[, ColInterest] <- GeomMean1[, ColInterest] i <- i + 1 } rm(ColInterest) rm(Genes_interest1) rm(Genes_interest_GBM) rm(GeomMean1) SignatureScoreTable <- SignatureScoreTable[, -1] SignatureScoreTable <- SignatureScoreTable[colnames(expr_data),] # Extract columns with numeric data for any dataframe dfNum <- function(InputDataFrame) { DF_NUM_Output <- data.frame ( matrix (data=NA, nrow=nrow(InputDataFrame), ncol=0)) i <- 1 while (i <= ncol(InputDataFrame)) { if (is.numeric(InputDataFrame[,i])) { DF_NUM_Output <- data.frame(DF_NUM_Output, InputDataFrame[i]) } i <- i+1 } return(DF_NUM_Output) } # Linear Model plots between signature scores ## Prepare data DN_Num <- dfNum(SignatureScoreTable) DN_Num <- DN_Num[rownames(metadata),] ## Clusters to highlight ClusterList <- unlist(strsplit(Variables$ClustersToHighlight, split = ",")) DN_Num$Cluster <- metadata$Cluster ## Order cells so that clusters of interest are in front on plot DN_Num1 <- DN_Num[DN_Num$Cluster == as.integer(ClusterList[1]), ] DN_Num2 <- DN_Num[DN_Num$Cluster == as.integer(ClusterList[2]), ] DN_Num_Others <- DN_Num[(DN_Num$Cluster != as.integer(ClusterList[1])) & (DN_Num$Cluster != as.integer(ClusterList[2])), ] DN_Num <- rbind(DN_Num_Others, DN_Num1, DN_Num2) DN_Num$Cluster <- as.factor(DN_Num$Cluster) ## Linear model Summary_Table <- data.frame(matrix(, nrow=0, ncol=0)) i <- 2 while(i <= ncol(SignatureGenes)){ VariableYname <- names(DN_Num[i]) Model <- lm(DN_Num[,i] ~ DN_Num[,1], data = DN_Num) print(Model) print(summary(Model)$adj.r.squared) RM <- summary(Model) Rcoeff <- RM$adj.r.squared pval <- RM$coefficients[2,4] Summary_Table[VariableYname,"R-squared"] <- Rcoeff Summary_Table[VariableYname,"p-value"] <- pval write.csv(Summary_Table, file = paste0(Sys.Date(), "LinearModelBetween", colnames(DN_Num)[1], "scoreAnd", VariableYname, "score - AcrossCellsFrom", Variables$Dataset, "dataset.csv")) pdf(file = paste0(Sys.Date(), "LinearModelBetween", colnames(DN_Num)[1], "scoreAnd", VariableYname, "score - AcrossCellsFrom", Variables$Dataset, "dataset.pdf")) Plot <- ggplot(DN_Num, aes(x=DN_Num[,1], y=DN_Num[,i])) + labs(y = paste0(VariableYname, " Score"), x = paste(colnames(DN_Num)[1], " score")) + geom_jitter(shape=16, size=2.5, position=position_jitter(0.2), color = "black") + theme_classic() + theme(axis.text.x = element_text(angle = 90)) + geom_abline(intercept =Model$coefficients[[1]], slope =Model$coefficients[[2]], linetype = "dashed", color = "red") + ylim(0,NA)+ xlim(0,NA) plot(Plot) Plot <- ggplot(DN_Num, aes(x=DN_Num[,1], y=DN_Num[,i], color = DN_Num$Cluster)) + labs(y = paste0(VariableYname, " Score"), x = paste(colnames(DN_Num)[1], " score")) + geom_jitter(shape=16, size=2.5, position=position_jitter(0.2), alpha = 0.7) + theme_classic() + scale_color_manual(values = Variables$ClusterPalette) + theme(axis.text.x = element_text(angle = 90), legend.position = "bottom") + geom_abline(intercept =Model$coefficients[[1]], slope =Model$coefficients[[2]], linetype = "dashed", color = "black") + ylim(0,NA)+ xlim(0,NA) plot(Plot) Plot <- ggplot(DN_Num, aes(x=DN_Num[,1], y=DN_Num[,i], color = DN_Num$Cluster)) + labs(y = paste0(VariableYname, " Score"), x = paste(colnames(DN_Num)[1], " score")) + geom_jitter(shape=16, size=2.5, position=position_jitter(0.2), alpha = 0.7) + theme_classic() + scale_color_manual(values = Variables$ClusterPalette) + theme(axis.text.x = element_text(angle = 90), legend.position = "none") + geom_abline(intercept =Model$coefficients[[1]], slope =Model$coefficients[[2]], linetype = "dashed", color = "black") + ylim(0,NA)+ xlim(0,NA) plot(Plot) Plot <- ggplot(DN_Num, aes(x=DN_Num[,1], y=DN_Num[,i], color = DN_Num$Cluster)) + labs(y = paste0(VariableYname, " Score"), x = paste(colnames(DN_Num)[1], " score")) + geom_jitter(shape=16, size=2.5, position=position_jitter(0.2), alpha = 0.7) + theme_classic() + scale_color_manual(values = Variables$ClusterPalette1) + theme(axis.text.x = element_text(angle = 90), legend.position = "bottom") + geom_abline(intercept =Model$coefficients[[1]], slope =Model$coefficients[[2]], linetype = "dashed", color = "black") + ylim(0,NA)+ xlim(0,NA) plot(Plot) Plot <- ggplot(DN_Num, aes(x=DN_Num[,1], y=DN_Num[,i], color = DN_Num$Cluster)) + labs(y = paste0(VariableYname, " Score"), x = paste(colnames(DN_Num)[1], " score")) + geom_jitter(shape=16, size=2.5, position=position_jitter(0.2), alpha = 0.7) + theme_classic() + scale_color_manual(values = Variables$ClusterPalette1) + theme(axis.text.x = element_text(angle = 90), legend.position = "none") + geom_abline(intercept =Model$coefficients[[1]], slope =Model$coefficients[[2]], linetype = "dashed", color = "black") + ylim(0,NA)+ xlim(0,NA) plot(Plot) dev.off() i <- i+1 } ######################################################################### ## Differential expression analysis (DifferentialExpressionAnalysis.R) ## ######################################################################### # Load required packages library(RColorBrewer) library(ggplot2) library(circlize) library(ClusterR) # Define variables Variables <- list( ExpData = "Dataset1.RData", CellMetadata = "MetadataWithClusterIDs.csv", CellMetadata.sep = ",", ClusterPalette1 = c("deepskyblue", "firebrick1", "chartreuse3", "deeppink", "goldenrod3", "darkorange1", "slateblue1") ## Color palette for clusters ) # Load expression data load(Variables$ExpData) # Import cell metadata file containing cluster membership metadata <- read.table(file= Variables$CellMetadata, sep = Variables$CellMetadata.sep, header = TRUE, row.names = 1) expr_data <- expr_data[,rownames(metadata)] # Descriptive Statistics function descriptive_stats <- function(InputData) { SummaryData <- data.frame( Mean_allCells = rowMeans(InputData), SD_allCells = apply(InputData, 1, sd), Variance_allCells = apply(InputData, 1, var), Percentage_Detection = apply(InputData, 1, function(x, y = InputData) {(sum(x != 0) / ncol(y)) * 100}), mean_factor2 = rowMeans(InputData[, Group2cellIDs]), mean_factor1 = rowMeans(InputData[, Group1cellIDs]), Variance_factor2 = apply(InputData[, Group2cellIDs], 1, var), Variance_factor1 = apply(InputData[, Group1cellIDs], 1, var) ) SummaryData$fold_change <- SummaryData$mean_factor1 - SummaryData$mean_factor2 return(SummaryData) } # Define function for differential expression (DE) analysis DE_analysis <- function(InputData, padj_method, pval, column1Name, OutputFileName){ ## Mann-Whitney test (Two-sample Wilcoxon test) MW_test <- data.frame(t(apply(InputData, 1, function(x) { do.call("cbind", wilcox.test(x[names(Group1cellIDs)[Group1cellIDs]], x[names(Group2cellIDs)[Group2cellIDs]]))[, 1:2] })), stringsAsFactors = FALSE) ## Benjamini-Hochberg correction and significativity MW_test$p.adjust <- p.adjust(as.numeric(MW_test$p.value), method = padj_method, n = nrow(MW_test)) MW_test$Significant <- MW_test$p.adjust < pval ## Descritpive statistics of all analyzed genes gene_stats <- descriptive_stats(InputData) ## Create a gene metadata dataframe results <- merge(gene_stats, MW_test, by = "row.names") colnames(results)[1] <- column1Name colnames(results)[6] <- paste0("Mean_Cluster", cluster2Number) colnames(results)[7] <- paste0("Mean_Cluster", cluster1Number) colnames(results)[8] <- paste0("Variance_Cluster", cluster2Number) colnames(results)[9] <- paste0("Variance_Cluster", cluster1Number) ## Save files write.table( results, paste0("DEresults_", OutputFileName, "_Cluster", cluster1Number, "Vs_Cluster", cluster2Number, ".csv"), sep = ",", quote = FALSE, col.names = TRUE, row.names = FALSE ) } # Search for genes that are expressed in at least 3% cells kept_genes <- rowSums(expr_data != 0) >= (0.03 * ncol(expr_data)) # Filter matrix data.normCounts_DE <- expr_data[kept_genes,] # Differential expression analysis ClusterList <- unique(metadata$Cluster) for (cluster1ID in 1:length(ClusterList)){ cluster1Number <- ClusterList[[cluster1ID]] ### Specify the 2 groups to be compared by creating two logical name vectors Group1cellIDs <- setNames(metadata$Cluster == cluster1Number, rownames(metadata)) for(cluster2ID in (cluster1ID+1):length(ClusterList)){ cluster2Number <- ClusterList[[cluster2ID]] Group2cellIDs <- setNames(metadata$Cluster == cluster2Number, rownames(metadata)) ### Run DE analysis DE_analysis(InputData = data.normCounts_DE, padj_method = "BH", pval= 0.01, column1Name = "gene", OutputFileName = "AllGenes") } } ##################################################################### # Update gene symbols (UpdateGeneSymbols.R) # ##################################################################### # Input files include: ## the file containing the list of gene symbols to update ## the filtered gene metadata file from HGNC website ## the file containing the list of gene symbols that should be excluded from comparisons because the approved symbol of gene A is the previous symbol of gene B" ## the file containing the list of genes whose symbol was withdrawn ## the gene metadata file from NCBI website # Define variables Variables <- list( GeneListInterest.file = "DEresults_AllGenes_SigHIGHvsSigLOW.csv", OutputFileName = "_SignXclustering_DEresultsSigHIGHvsSigLOW_DatasetY", GeneListInterest.file_sep = ",", GeneMetadata_HGNC.file = "2020-10-15_FilteredGeneMetadataFromHGNC.csv", GeneMetadata_HGNC.file_sep = ",", AmbiGenes.file = "2020-10-15_GenesExcludedBecauseApprovedSymbolIsPreviousSymbolOfAnotherGene.csv", AmbiGenes.file_sep = ",", WithdrawnGenes.file = "2020-10-15_GenesExcludedBecauseEntryOrSymbolWithdrawn.csv", WithdrawnGenes.file_sep = ",", NCBIgeneInfo.file = "2020-10-16_GeneMetadataFromNCBI.csv") # Load necessary packages (install them if it's not the case) requiredPackages <- c('stringr', 'plyr', 'venn', 'dplyr', 'tibble') new.packages <- requiredPackages[!(requiredPackages %in% installed.packages()[,"Package"])] if(length(new.packages)) install.packages(new.packages) for (p in requiredPackages) { suppressMessages(invisible(library(p, character.only = TRUE))) } # Import gene metadata file from HGNC website GeneMetadata_HGNC <- read.delim( Variables$GeneMetadata_HGNC.file, header = TRUE, sep = Variables$GeneMetadata_HGNC.file_sep, row.names = 1 ) # Import gene metadata file from NCBI GeneMetadata_NCBI <- read.csv( Variables$NCBIgeneInfo.file, header = TRUE, sep = ",", row.names = 1 ) # Import file containing genes with ambiguous genes symbols ## Ambiguous : we are not sure if they correspond to the approved symbol of a gene or the previous symbol of another gene AmbiguousGenes <- read.table( Variables$AmbiGenes.file, header = TRUE, stringsAsFactors = FALSE, sep = Variables$AmbiGenes.file_sep, check.names = FALSE, row.names = 1 ) # Import file containing genes whose symbol was withdrawn ## Status was 'Entry withdrawn' or 'Symbol withdrawn' in the downloaded HGNC file WithdrawnGenes <- read.table( Variables$WithdrawnGenes.file, header = TRUE, stringsAsFactors = FALSE, sep = Variables$WithdrawnGenes.file_sep, check.names = FALSE, row.names = 1 ) # Define function to split a column into multiple number of columns split_into_multiple <- function(column, pattern = ", ", into_prefix){ cols <- str_split_fixed(column, pattern, n = Inf) cols[which(cols == "")] <- NA cols <- as_tibble(cols) m <- dim(cols)[2] names(cols) <- paste(into_prefix, 1:m, sep = "_") return(cols) } # Separate one column into multiple columns GeneSymbols.split <- GeneMetadata_HGNC %>% bind_cols(split_into_multiple(column = .$Previous.symbols, pattern = ", ", into_prefix = "Previous.symbol")) # Import file containing gene symbols to update InputData <- read.table( Variables$GeneListInterest.file, header = TRUE, stringsAsFactors = FALSE, sep = Variables$GeneListInterest.file_sep, check.names = FALSE ) rownames(InputData) <- InputData$gene # Among genes of interest, identify genes with ambiguous symbols GeneListToUpdate <- InputData$gene AmbiguousSymbols <- as.data.frame(GeneListToUpdate %in% AmbiguousGenes$x) GeneListToUpdate <- cbind(GeneListToUpdate, AmbiguousSymbols) colnames(GeneListToUpdate) <- c("InputGeneSymbol", "AmbiguousSymbol") # Identify genes whose symbols are the approved symbol CompareGenes <- list() CompareGenes["NonAmbiguousGenes"] <- list(GeneListToUpdate[GeneListToUpdate$AmbiguousSymbol == FALSE,1]) CompareGenes["ApprovedSymbols"] <- list(GeneSymbols.split$Approved.symbol) CompareNonAmbiguousGenesToApprovedSymbols <- venn(CompareGenes, simplify = FALSE, intersections = TRUE, show.plot=TRUE, zcolor = "style") Intersection.NonAmbiguousGenesToApprovedSymbols <- attr(CompareNonAmbiguousGenesToApprovedSymbols, "intersections") for(i in 1:nrow(GeneListToUpdate)){ if(GeneListToUpdate[i, "AmbiguousSymbol"] == FALSE){ GeneSymbol <- as.character(GeneListToUpdate[i,1]) if(GeneSymbol %in% Intersection.NonAmbiguousGenesToApprovedSymbols$`NonAmbiguousGenes:ApprovedSymbols`){ GeneListToUpdate[i, "IsApprovedSymbol"] <- TRUE GeneListToUpdate[i, "ApprovedSymbol"] <- GeneSymbol } else { GeneListToUpdate[i, "IsApprovedSymbol"] <- FALSE } } } # Determine whether the other gene symbols correspond to previous symbols for(j in 1:nrow(GeneListToUpdate)){ if(GeneListToUpdate[j, "AmbiguousSymbol"] == FALSE){ GeneSymbolX <- as.character(GeneListToUpdate[j,1]) if(GeneListToUpdate[j,"IsApprovedSymbol"] == FALSE){ RowNumber <- which(GeneSymbols.split == GeneSymbolX, arr.ind=TRUE) if(nrow(RowNumber) == 0){ GeneListToUpdate[j, "Note"] <- "InputSymbolNotFoundInHGNCFile" } else { if(length(unique(RowNumber[,1])) == 1){ RowNumber <- RowNumber[1,1] GeneListToUpdate[j, "ApprovedSymbol"] <- as.character(GeneSymbols.split[RowNumber, "Approved.symbol"]) } else { GeneListToUpdate[j, "Note"] <- "PreviousSymbolOfMoreThan1Gene" } } } } } # For genes not found, check if they are among the entries/symbols that were withdrawn GeneListToUpdate$EntryOrSymbolWithdrawn <- NA for(k in 1:nrow(GeneListToUpdate)){ if(is.na(GeneListToUpdate[k, "Note"]) ==FALSE){ if(GeneListToUpdate[k, "Note"] == "InputSymbolNotFoundInHGNCFile"){ GeneSymbolY <- as.character(GeneListToUpdate[k,1]) if(GeneSymbolY %in% WithdrawnGenes$x){ GeneListToUpdate[k, "EntryOrSymbolWithdrawn"] <- TRUE } else { GeneListToUpdate[k, "EntryOrSymbolWithdrawn"] <- FALSE # Check if we identify the gene in the NCBI gene info file NCBIsymbol <- GeneMetadata_NCBI %>% filter_all(any_vars(. %in% GeneSymbolY)) if(nrow(NCBIsymbol) == 0){ GeneListToUpdate[k, "Note"] <- paste0(GeneListToUpdate[k, "Note"], "_InputSymbolNotFoundInNCBIfile") } else { if(length(unique(NCBIsymbol[,1])) == 1){ GeneListToUpdate[k, "ApprovedSymbol"] <- as.character(NCBIsymbol[1,"Symbol"]) GeneListToUpdate[k, "Note"] <- paste0(GeneListToUpdate[k, "Note"], "_InputSymbolFoundInNCBIfile") } else { GeneListToUpdate[k, "Note"] <- paste0(GeneListToUpdate[k, "Note"], "_SynonymnForMoreThan1GeneNCBI") } } } } } } # Retrieve metadata for genes of interest GeneListToUpdate_metadata <- GeneMetadata_HGNC %>% filter_all(any_vars(Approved.symbol %in% GeneListToUpdate[GeneListToUpdate$AmbiguousSymbol == FALSE,4])) GeneListToUpdate_metadata <- merge(x = GeneListToUpdate, y= GeneListToUpdate_metadata, by.x = "ApprovedSymbol", by.y = "Approved.symbol", all.x = TRUE) GeneListToUpdate_metadata <- merge(x = InputData, y= GeneListToUpdate_metadata, by.x = "gene", by.y = "InputGeneSymbol") # Save results write.csv(GeneListToUpdate_metadata, file = paste0(Sys.Date(), Variables$OutputFileName, "_UpdatedGeneSymbols.csv")) ############################################### ### EnrichmentScore_SpecificGeneModules.Rmd ### ############################################### --- title: "Determining whether or not a specific gene module is enriched in a cluster compared to another cluster" author: "MSS" date: "06/08/2021" output: html_document: code_folding: hide --- ```{r setup, include=TRUE, message=FALSE, warning=FALSE} knitr::opts_chunk$set(echo = TRUE) ``` ## Define variables and load packages ```{r Variables_Packages} # Define variables Variables <- list( Gene.list1_path = "UpregulatedGenes_UpdatedSymbols.csv", Genelist1_name = "UpRegGenes_Dataset1", Gene.list1_sep = ",", Gene.list2_path = "GeneModule1.csv", Genelist2_name = "GeneModule1", Gene.list2_sep = ",", nGenes_DEanalysis = 41915 ## Number of genes in human genome (from HGNC and NCBI gene metadata file; excluded genes whose entry or symbol was withdrawn, genes with ambiguous symbols and duplicated genes) ) # Load required packages requiredPackages <- c('stringr', 'plyr', 'venn', 'dplyr', 'tibble', 'openxlsx', 'readxl') new.packages <- requiredPackages[!(requiredPackages %in% installed.packages()[,"Package"])] if(length(new.packages)) install.packages(new.packages) for (p in requiredPackages) { suppressMessages(invisible(library(p, character.only = TRUE))) } ``` ## Import data ```{r Import Data} # Import gene lists to be compared (update gene symbols before using this Rmd) Gene.list1 <- read.table(file = Variables$Gene.list1_path, header = TRUE, sep= Variables$Gene.list1_sep, row.names = 1) Gene.list2 <- read.table(file = Variables$Gene.list2_path, header = TRUE, sep= Variables$Gene.list2_sep, row.names = 1) ``` ## Explore gene lists ```{r Explore Gene lists} # Initial number of genes print("Number of upregulated genes:") nrow(Gene.list1) print("Number of genes in gene module:") nrow(Gene.list2) # Explore notes related to upregulated genes print("Exploring list of upregulated genes") Gene.list1_Notes <- all(is.na(Gene.list1$Note)) if(Gene.list1_Notes == FALSE){ print(table(Gene.list1$Note)) # Identify genes that were not found in the HGNC and NCBI files print("Genes not found in HGNC and NCBI gene metadata files:") unique(Gene.list1[Gene.list1$Note == "InputSymbolNotFoundInHGNCFile_InputSymbolNotFoundInNCBIfile","gene"]) # Determine if some genes should be excluded because they have ambiguous symbols print("Number of genes with ambiguous symbols:") sum(Gene.list1$AmbiguousSymbol == TRUE) # Get list of genes that should be excluded because they have ambiguous symbols Gene.list1[Gene.list1$AmbiguousSymbol == TRUE,"gene"] # Identify genes that should be excluded because they are the previous symbols of >= 2 genes print("Genes whose symbol is the previous symbol of another gene:") unique(Gene.list1[Gene.list1$Note == "PreviousSymbolOfMoreThan1Gene","gene"]) } # Exclude genes that have ambiguous symbols, genes whose symbol is the previous symbol of atleast 2 genes and genes that were not identified in the HGNC and NCBI gene metadata file Gene.list1 <- Gene.list1[is.na(Gene.list1$ApprovedSymbol) == FALSE,] # Identify duplicated genes Gene.list1[duplicated(Gene.list1$ApprovedSymbol) == TRUE, "ApprovedSymbol"] # Exclude duplicated genes DuplicatedGene.list1 <- Gene.list1[duplicated(Gene.list1$ApprovedSymbol) == TRUE, "ApprovedSymbol"] Gene.list1 <- Gene.list1[ !(Gene.list1$ApprovedSymbol %in% DuplicatedGene.list1), ] # Number of genes retained print("Number of genes retained:") nrow(Gene.list1) # Explore notes related to gene module print("Exploring list of genes in gene module") Gene.list2_Notes <- all(is.na(Gene.list2$Note)) if(Gene.list2_Notes == FALSE){ print(table(Gene.list2$Note)) # Identify genes that were not found in the HGNC and NCBI files print("Genes not found in HGNC and NCBI gene metadata files:") unique(Gene.list2[Gene.list2$Note == "InputSymbolNotFoundInHGNCFile_InputSymbolNotFoundInNCBIfile","gene"]) # Determine if some genes should be excluded because they have ambiguous symbols print("Number of genes with ambiguous symbols:") sum(Gene.list2$AmbiguousSymbol == TRUE) # Get list of genes that should be excluded because they have ambiguous symbols Gene.list2[Gene.list2$AmbiguousSymbol == TRUE,"gene"] # Identify genes that should be excluded because they are the previous symbols of >= 2 genes print("Genes whose symbol is the previous symbol of another gene:") unique(Gene.list2[Gene.list2$Note == "PreviousSymbolOfMoreThan1Gene","gene"]) } # Exclude genes that have ambiguous symbols, genes whose symbol is the previous symbol of atleast 2 genes and genes that were not identified in the HGNC and NCBI gene metadata file Gene.list2 <- Gene.list2[is.na(Gene.list2$ApprovedSymbol) == FALSE,] # Identify duplicated genes Gene.list2[duplicated(Gene.list2$ApprovedSymbol) == TRUE, "ApprovedSymbol"] # Exclude duplicated genes DuplicatedGene.list2 <- Gene.list2[duplicated(Gene.list2$ApprovedSymbol) == TRUE, "ApprovedSymbol"] Gene.list2 <- Gene.list2[ !(Gene.list2$ApprovedSymbol %in% DuplicatedGene.list2), ] # Number of genes retained print("Number of genes retained:") nrow(Gene.list2) ``` ## Compare gene lists to compare ```{r Compare GeneList} # Compare gene lists ## Define lists to be compared CompareGenes <- list() CompareGenes[Variables$Genelist1_name] <- list(as.character(Gene.list1$ApprovedSymbol)) CompareGenes[Variables$Genelist2_name] <- list(as.character(Gene.list2$ApprovedSymbol)) ## Plot venn diagram comparing the different lists CompareGenes.venn <- venn(CompareGenes, simplify = FALSE, intersections = TRUE, show.plot=TRUE, zcolor = "style") Intersection <- attr(CompareGenes.venn, "intersections") names(Intersection) <- gsub(pattern = ":", replacement = "Vs", x = names(Intersection)) ## Save results in one Excel file write.xlsx(Intersection, file = paste0(Sys.Date(),"_ComparingGeneLists_", Variables$Genelist1_name, "Vs", Variables$Genelist2_name, ".xlsx")) # Over-representation analysis (ORA) ## Define variables InputList_size <- nrow(Gene.list1) ## Size of input gene list Geneset_size <- nrow(Gene.list2) ## Number of genes belonging to a given gene module AllGenes <- Variables$nGenes_DEanalysis ## All genes (universe) CommonGenes <- length(Intersection[[length(Intersection)]]) ## Number of genes from input gene list that belongs to the geneset ## Calculate fold enrichment as computed by DAVID fold.enrichment <- (CommonGenes / InputList_size ) / (Geneset_size / AllGenes) print(paste("Fold enrichment =", fold.enrichment)) ## Compute hypergeometric P-value p.value <- phyper(q=CommonGenes-1, m=Geneset_size, n=(AllGenes - Geneset_size), k=InputList_size, lower.tail=FALSE) print(paste("p-value of enrichment =", p.value)) ``` ############################ ### CompareGeneLists.Rmd ### ############################ --- title: "Comparing genes upregulated in SigHIGH compared to SigLOW cells from distinct datasets" author: "MSS" date: "06/08/2021" output: html_document: code_folding: hide --- ```{r setup, include=FALSE, message=FALSE, warning=FALSE} knitr::opts_chunk$set(echo = TRUE) ``` ## Import data ```{r Import Data} # Load required packages library(venn) library(openxlsx) library(dplyr) library(readxl) # Define variables Variables <- list( Gene.list1_path = "DEresults_UpdatedGeneSymbols_Dataset1.csv", Genelist1_name <- "Dataset1", Gene.list2_path = "DEresults_UpdatedGeneSymbols_Dataset2.csv", Genelist2_name <- "Dataset2", Gene.list3_path = "DEresults_UpdatedGeneSymbols_Dataset3.csv", Genelist3_name <- "Dataset3", Gene.list4_path = "DEresults_UpdatedGeneSymbols_Dataset4.csv", Genelist4_name <- "Dataset4" ) # Import gene lists to be compared ## Gene symbols from different lists should be updated before importing gene lists Gene.list1 <- read.table(file = Variables$Gene.list1_path, header = TRUE, sep= ",", row.names = 1) Gene.list2 <- read.table(file = Variables$Gene.list2_path, header = TRUE, sep= ",", row.names = 1) Gene.list3 <- read.table(file = Variables$Gene.list3_path, header = TRUE, sep= ",", row.names = 1) Gene.list4 <- read.table(file = Variables$Gene.list4_path, header = TRUE, sep= ",", row.names = 1) ``` ## Explore and clean gene lists to compare ```{r Prepare GeneList} # Exclude genes that have ambiguous symbols, genes whose symbol is the previous symbol of atleast 2 genes and genes that were not identified in the HGNC and NCBI gene metadata file Gene.list1 <- Gene.list1[is.na(Gene.list1$ApprovedSymbol) == FALSE,] Gene.list2 <- Gene.list2[is.na(Gene.list2$ApprovedSymbol) == FALSE,] Gene.list3 <- Gene.list3[is.na(Gene.list3$ApprovedSymbol) == FALSE,] Gene.list4 <- Gene.list4[is.na(Gene.list4$ApprovedSymbol) == FALSE,] # Exclude duplicated genes DuplicatedGene.list1 <- Gene.list1[duplicated(Gene.list1$ApprovedSymbol) == TRUE, "ApprovedSymbol"] Gene.list1 <- Gene.list1[ !(Gene.list1$ApprovedSymbol %in% DuplicatedGene.list1), ] DuplicatedGene.list2 <- Gene.list2[duplicated(Gene.list2$ApprovedSymbol) == TRUE, "ApprovedSymbol"] Gene.list2 <- Gene.list2[ !(Gene.list2$ApprovedSymbol %in% DuplicatedGene.list2), ] DuplicatedGene.list3 <- Gene.list3[duplicated(Gene.list3$ApprovedSymbol) == TRUE, "ApprovedSymbol"] Gene.list3 <- Gene.list3[ !(Gene.list3$ApprovedSymbol %in% DuplicatedGene.list3), ] DuplicatedGene.list4 <- Gene.list4[duplicated(Gene.list4$ApprovedSymbol) == TRUE, "ApprovedSymbol"] Gene.list4 <- Gene.list4[ !(Gene.list4$ApprovedSymbol %in% DuplicatedGene.list4), ] # Number of genes considered for DE analyses in both datasets ## Get list of genes detected in at least 3% cells in each dataset List1_AllDetectedGenes <- na.omit(as.character(Gene.list1$ApprovedSymbol)) List2_AllDetectedGenes <- na.omit(as.character(Gene.list2$ApprovedSymbol)) List3_AllDetectedGenes <- na.omit(as.character(Gene.list3$ApprovedSymbol)) List4_AllDetectedGenes <- na.omit(as.character(Gene.list4$ApprovedSymbol)) ## Compare gene lists ### Define lists to be compared CompareLists <- list() CompareLists[Genelist1_name] <- list(List1_AllDetectedGenes) CompareLists[Genelist2_name] <- list(List2_AllDetectedGenes) CompareLists[Genelist3_name] <- list(List3_AllDetectedGenes) CompareLists[Genelist4_name] <- list(List4_AllDetectedGenes) ### Venn diagram comparing the different lists print("Genes considered in DE analysis in each dataset") CompareLists.venn <- venn(CompareLists, simplify = FALSE, intersections = TRUE, show.plot=TRUE, zcolor = "style") Intersection.lists <- attr(CompareLists.venn, "intersections") ## Number of genes considered in all datasets CommonGenesConsidered <- as.data.frame(Intersection.lists[[15]]) colnames(CommonGenesConsidered) <- "ApprovedSymbol" print("Number of genes considered in DE analysis in all datasets") nrow(CommonGenesConsidered) # Filter genes so as to keep only genes considered in all datasets Gene.list1 <- merge(x= CommonGenesConsidered, y = Gene.list1, by = "ApprovedSymbol") rownames(Gene.list1) <- Gene.list1$ApprovedSymbol Gene.list2 <- merge(x= CommonGenesConsidered, y = Gene.list2, by = "ApprovedSymbol") rownames(Gene.list2) <- Gene.list2$ApprovedSymbol Gene.list3 <- merge(x= CommonGenesConsidered, y = Gene.list3, by = "ApprovedSymbol") rownames(Gene.list3) <- Gene.list3$ApprovedSymbol Gene.list4 <- merge(x= CommonGenesConsidered, y = Gene.list4, by = "ApprovedSymbol") rownames(Gene.list4) <- Gene.list4$ApprovedSymbol # Filter out genes that are not significantly deregulated between MigHIGH and MigLOW clusters ## Significance level set at BH-adj pval<0.01 Gene.list1 <- Gene.list1[Gene.list1$Significant == TRUE,] Gene.list2 <- Gene.list2[Gene.list2$Significant == TRUE,] Gene.list3 <- Gene.list3[Gene.list3$Significant == TRUE,] Gene.list4 <- Gene.list4[Gene.list4$Significant == TRUE,] # Number of genes retained for comparison print(paste0("Number of DE genes retained for comparison - Dataset ", Genelist1_name)) table(Gene.list1$Deregulation) print(paste0("Number of DE genes retained for comparison - Dataset ", Genelist2_name)) table(Gene.list2$Deregulation) print(paste0("Number of DE genes retained for comparison - Dataset ", Genelist3_name)) table(Gene.list3$Deregulation) print(paste0("Number of DE genes retained for comparison - Dataset ", Genelist4_name)) table(Gene.list4$Deregulation) ``` ## Compare downregulated genes in MigHIGH cells ```{r CompareDownregGenes} # Get list of downregulated genes Gene.list1_down <- Gene.list1[Gene.list1$Deregulation != "UP",] Gene.list2_down <- Gene.list2[Gene.list2$Deregulation != "UP",] Gene.list3_down <- Gene.list3[Gene.list3$Deregulation != "UP",] Gene.list4_down <- Gene.list4[Gene.list4$Deregulation != "UP",] # Define lists to be compared CompareGenes <- list() CompareGenes[Genelist1_name] <- list(as.character(Gene.list1_down$ApprovedSymbol)) CompareGenes[Genelist2_name] <- list(as.character(Gene.list2_down$ApprovedSymbol)) CompareGenes[Genelist3_name] <- list(as.character(Gene.list3_down$ApprovedSymbol)) CompareGenes[Genelist4_name] <- list(as.character(Gene.list4_down$ApprovedSymbol)) # Plot venn diagram comparing the different lists CompareGenes.venn <- venn(CompareGenes, simplify = FALSE, intersections = TRUE, show.plot=TRUE, zcolor = "style") Intersection <- attr(CompareGenes.venn, "intersections") names(Intersection) <- gsub(pattern = ":", replacement = "Vs", x = names(Intersection)) ## Save results in one Excel file write.xlsx(Intersection, file = paste0(Sys.Date(),"_ComparingDownregulatedGenes_", Genelist1_name, "vs", Genelist2_name, "vs", Genelist3_name, "vs", Genelist4_name, "Datasets.xlsx")) ``` ## Compare upregulated genes in MigHIGH cells ```{r CompareUpregGenes} # Get list of upregulated genes Gene.list1_up <- Gene.list1[Gene.list1$Deregulation == "UP",] Gene.list2_up <- Gene.list2[Gene.list2$Deregulation == "UP",] Gene.list3_up <- Gene.list3[Gene.list3$Deregulation == "UP",] Gene.list4_up <- Gene.list4[Gene.list4$Deregulation == "UP",] # Define lists to be compared CompareGenes <- list() CompareGenes[Genelist1_name] <- list(as.character(Gene.list1_up$ApprovedSymbol)) CompareGenes[Genelist2_name] <- list(as.character(Gene.list2_up$ApprovedSymbol)) CompareGenes[Genelist3_name] <- list(as.character(Gene.list3_up$ApprovedSymbol)) CompareGenes[Genelist4_name] <- list(as.character(Gene.list4_up$ApprovedSymbol)) # Plot venn diagram comparing the different lists CompareGenes.venn <- venn(CompareGenes, simplify = FALSE, intersections = TRUE, show.plot=TRUE, zcolor = "style") Intersection <- attr(CompareGenes.venn, "intersections") names(Intersection) <- gsub(pattern = ":", replacement = "Vs", x = names(Intersection)) ## Save results in one Excel file write.xlsx(Intersection, file = paste0(Sys.Date(),"_ComparingUpregulatedGenes_", Genelist1_name, "vs", Genelist2_name, "vs", Genelist3_name, "vs", Genelist4_name, "Datasets.xlsx")) library(eulerr) plot(venn(CompareGenes)) plot(euler(CompareGenes), quantities = TRUE) ## Proportional venn ``` ################################################################################## ## Dot plot to represent over-representation analysis results (DotplotForORA.R) ## ################################################################################## # Define variables Variables <- list( Input_path = "GOres_MigHIGHvsLOW_UpregGenesFC1.5_Dataset1.xlsx", ## Results from enrichR sheet = 1, data ="MigSign_Dataset1_OEG_MigHIGHvsLOW_FC1.5", pval = 0.05, Category ="Motility" ) # Load required packages requiredPackages <- c('ggplot2', 'RColorBrewer', 'readxl', 'scales', 'dplyr') for (p in requiredPackages) { if (!require(p, character.only = TRUE)) { install.packages(p, repos = "https://cran.univ-paris1.fr/") } suppressMessages(invisible(library(p, character.only = TRUE))) } # Import GO results GO.res <- read_excel(path = Variables$Input_path, sheet = Variables$sheet, col_names = TRUE) GO.res$Overlap <- sapply(GO.res$Overlap, function(x) eval(parse(text=x))) # Filter out non-significant terms GO.res <- GO.res[GO.res$`Adjusted P-value` < Variables$pval,] # Keep only category of interest GO.res <- GO.res[GO.res$Category == Variables$Category,] GO.res<- GO.res[is.na(GO.res$GO)== FALSE,] # Rank terms by fold enrichment GO.res$FoldEnrichment <- GO.res$`Odds Ratio` GO.res <- GO.res[order(GO.res$FoldEnrichment, decreasing = FALSE),] GO.res_InterestA1 <- GO.res[GO.res$GO == "BP", ] GO.res_InterestA1$Term <- factor(GO.res_InterestA1$Term, levels = GO.res_InterestA1$Term) GO.res_InterestB1 <- GO.res[GO.res$GO == "CC", ] GO.res_InterestB1$Term <- factor(GO.res_InterestB1$Term, levels = GO.res_InterestB1$Term) GO.res_InterestC1 <- GO.res[GO.res$GO == "MF", ] GO.res_InterestC1$Term <- factor(GO.res_InterestC1$Term, levels = GO.res_InterestC1$Term) GO.res_InterestD1 <- GO.res[GO.res$GO == "KEGG", ] GO.res_InterestD1$Term <- factor(GO.res_InterestD1$Term, levels = GO.res_InterestD1$Term) GO.res_Interest1 <- rbind(GO.res_InterestA1, GO.res_InterestB1, GO.res_InterestC1, GO.res_InterestD1) # Dot plot DotPlot <- ggplot(GO.res_Interest1, aes(x=FoldEnrichment, y = Term)) + ylab(NULL) + geom_point(aes(color = `Adjusted P-value`), size = 2) + scale_colour_gradient(high = "red", low="blue") + theme_bw(base_size = 14) + facet_grid(GO ~ ., scales = "free_y", space = "free_y", switch = "y") pdf(file = paste0(Sys.Date(), "_Plots_GO and KEGG enrichment_", Variables$data, "_TermsRankedByOddsRatio.pdf"), width = 10, height = 6) DotPlot dev.off()