# Setup ---- setwd("~/Library/CloudStorage/OneDrive-StonyBrookUniversity/SUTD_ASRL/TMAO and TNF/Scientific Reports_Resubmission/Supplementary Files/TNF-a") pacman::p_load(tidyverse, readxl, openxlsx, janitor, patchwork, DESeq2) rm(list=ls()) # PREPARE THE DATA ---- ## Read in counts ---- counts <- read_excel("Counts file.xlsx") dim(counts) # [1] 29744 10 ## Sample annotation ---- sample_ann <- read_excel("Sample annotation file.xlsx") %>% column_to_rownames("sample") %>% mutate(condition = factor(condition, levels=c("CTRL", "TNF")), batch = factor(batch)) ## Gene annotation ---- identical( counts$gene_id, counts$gene_name) # [1] FALSE length(unique(counts$gene_name)) # has some redundant symbols [1] 29683 length(unique(counts$gene_id)) # most unique [1] 29744 counts[ which( counts$gene_id != counts$gene_name ), 1:2] ## 61 gene_ann <- counts %>% column_to_rownames("gene_id") %>% select( SYMBOL = gene_name ) map <- clusterProfiler::bitr(gene_ann$SYMBOL, fromType = "SYMBOL", toType = c("ENTREZID", "GENENAME", "GENETYPE"), OrgDb = "org.Hs.eg.db") # Warning message:In clusterProfiler::bitr(gene_ann$SYMBOL, fromType = "SYMBOL", toType = c("ENTREZID", : 21.23% of input gene IDs are fail to map... tb <- table(map$SYMBOL) dup <- names(which(tb > 1)) map %>% filter( is.element(SYMBOL, dup) ) map <- map %>% filter( !is.element(SYMBOL, dup) ) gene_ann <- left_join(gene_ann %>% rownames_to_column("id"), map) %>% column_to_rownames("id") rm(tb, dup, map) ## Cleanup the count file counts <- counts %>% column_to_rownames("gene_id") %>% select(-gene_name) dim(counts) ##[1] 29744 8 ## Checking lib size ---- summary( colSums(counts)/10^6 ) ## Generate DESeq2 object ---- identical( colnames(counts), rownames(sample_ann) ) #[1] TRUE identical( rownames(counts), rownames(gene_ann) ) #[1] TRUE dds <- DESeqDataSetFromMatrix(countData = round(counts), colData = sample_ann, rowData = gene_ann, design = ~ -1 + condition + batch) save(dds, file="dds_TNF.rda", compress=TRUE) rm(counts, sample_ann, gene_ann) # PCA ---- load("dds_TNF.rda") vst_expr <- vst(dds) assay(vst_expr) <- limma::removeBatchEffect( assay(vst_expr), dds$batch) pc0 <- plotPCA(vst_expr, intgroup=c("condition", "batch"), ntop = 1000) pc <- plotPCA(vst_expr, intgroup=c("condition", "batch"), ntop = 1000, returnData=TRUE) ggplot(pc, aes(x=PC1, y=PC2, col=condition)) + geom_point(size = 3) + labs(x = pc0$labels$x, y = pc0$labels$y) + theme_bw() ggsave(filename = "Results_DEG/PCA_plot.tiff", width = 5, height = 5) rm(pc0, pc, vst_expr) # DIFFERENTIAL EXPRESSION ---- gene_ann <- rowData(dds) %>% data.frame() %>% select(SYMBOL, ENTREZID) dds <- DESeq(dds) res <- results(dds, contrast = c("condition", "TNF", "CTRL")) %>% data.frame() %>% rownames_to_column("gene") %>% select(SYMBOL=gene, baseMean, LFC=log2FoldChange, p=pvalue, FDR=padj) %>% filter(!is.na(LFC), !is.na(FDR)) %>% arrange(p) %>% left_join(gene_ann) %>% mutate( sig = sign(LFC) * (abs(LFC) >= log2(1.3) & FDR <= 0.05) ) res %>% tabyl(sig) # 1919 down and 2399 up openxlsx::write.xlsx(list(TNF_vs_CTRL = res), file="Results_DEG/TNFvsCTRL_1.3FC_5FDR.xlsx") # VOLCANO PLOT ---- res$color <- ifelse(res$sig == 1, "red", ifelse(res$sig == -1, "mediumblue", "grey")) col_custom <- setNames(res$color, res$SYMBOL) EnhancedVolcano::EnhancedVolcano(res, lab = paste0(res$SYMBOL, "\n"), x = "LFC", y = "p", FCcutoff = log2(2), pCutoff = 0.05, title = "TNF VS CTRL", subtitle = NULL, caption = NULL, legendPosition = "none", colCustom = col_custom) ggsave(filename = "Results_DEG/Volcano_plot.tiff", width = 12, height = 10) rm(col_custom) # GSEA ---- library(clusterProfiler) ranked <- res %>% dplyr::select(ENTREZID, LFC, FDR) %>% na.omit() %>% arrange(-LFC) %>% dplyr::select(ENTREZID, LFC) %>% deframe() length(ranked) #[1] 14820 gse_GOBP <- gseGO(geneList = ranked, ont = "BP", pvalueCutoff = 1, verbose = TRUE, OrgDb = org.Hs.eg.db::org.Hs.eg.db, pAdjustMethod = "BH") gse_GOBP <- setReadable(gse_GOBP, OrgDb=org.Hs.eg.db::org.Hs.eg.db, keyType="ENTREZID") save(gse_GOBP, file = "Results_Pathway/GOBP.rda") gse_GOBP@result %>% subset(p.adjust < 0.05) %>% openxlsx::write.xlsx("Results_Pathway/GOBP_5FDR.xlsx") gse_GOBP@result %>% openxlsx::write.xlsx("Results_Pathway/GOBP.xlsx") dotplot_GOBP <- dotplot(gse_GOBP, showCategory = 15, split = ".sign", title = "GO: Biological Process", color = "pval", label_format = 100, orderBy = "x") + facet_grid(. ~ .sign) ggsave(filename = "Results_Pathway/GOBP_top15.svg", plot = dotplot_GOBP, height = 30, width = 20) ggsave(filename = "Results_Pathway/GOBP_top15.tiff", plot = dotplot_GOBP, height = 15, width = 15) # HEATMAP (GO BP) ---- vst_expr <- vst(dds) ann_col <- colData(vst_expr) %>% data.frame() %>% select(condition) plot_heatmap <- function(object, id){ genes <- object@result %>% filter(ID %in% id) %>% separate_longer_delim(core_enrichment, delim = "/") %>% pull(core_enrichment) description <- object@result %>% filter(ID %in% id) %>% pull(Description) sel_data <- assay(vst_expr)[ genes, ] ph <- pheatmap::pheatmap(sel_data, scale = "row", cluster_rows = TRUE, annotation_col = ann_col, cluster_cols = TRUE, show_colnames = FALSE, main = paste(id, description), display_numbers = FALSE, fontsize = 8, color = colorRampPalette(c("navy", "white", "firebrick3"))(50) ) # fn <- paste0("Results_Pathway/GOBP_heatmaps/", janitor::make_clean_names(description), ".png") # ggsave(filename = fn, plot = ph, height = 15, width = 10) rm(genes, description, sel_data) return(ph) } ph <-plot_heatmap(gse_GOBP, "GO:0022617") ggsave(filename = "Results_Pathway/GOBP_extracellular matrix disassembly.tiff", plot = ph, height = 6, width = 6) # KEGG ---- gse_KEGG <- gseKEGG(geneList = ranked, organism = "hsa", pvalueCutoff = 1, verbose = TRUE, pAdjustMethod = "BH") gse_KEGG <- setReadable(gse_KEGG, OrgDb=org.Hs.eg.db::org.Hs.eg.db, keyType="ENTREZID") dotplot_KEGG <- dotplot(gse_KEGG, showCategory = 10, split = ".sign", title = "KEGG pathways", color = "pval", label_format = 100, orderBy = "x") + facet_grid(. ~ .sign) dotplot_KEGG ggsave(filename = "Results_Pathway/KEGG.tiff", plot = dotplot_KEGG, height = 10, width = 12) save(gse_KEGG, file = "Results_Pathway/KEGG.rda") gse_KEGG@result %>% subset(p.adjust < 0.05) %>% openxlsx::write.xlsx("Results_Pathway/KEGG_5FDR.xlsx") # HEATMAP (KEGG) ---- vst_expr <- vst(dds) ann_col <- colData(vst_expr) %>% data.frame() %>% select(condition) plot_heatmap <- function(object, id){ genes <- object@result %>% filter(ID %in% id) %>% separate_longer_delim(core_enrichment, delim = "/") %>% pull(core_enrichment) description <- object@result %>% filter(ID %in% id) %>% pull(Description) sel_data <- assay(vst_expr)[ genes, ] ph <- pheatmap::pheatmap(sel_data, scale = "row", cluster_rows = TRUE, annotation_col = ann_col, cluster_cols = TRUE, show_colnames = FALSE, main = paste(id, description), display_numbers = FALSE, fontsize = 8, color = colorRampPalette(c("navy", "white", "firebrick3"))(50) ) # fn <- paste0("Results_Pathway/KEGG_heatmaps/", janitor::make_clean_names(description), ".png") # ggsave(filename = fn, plot = ph, height = 15, width = 10) rm(genes, description, sel_data) return(ph) } ph <- plot_heatmap(gse_KEGG, "hsa05417") ggsave(filename = "Results_Pathway/KEGG_heatmap_Lipid and atherosclerosis.tiff", plot = ph, height = 15, width = 10) # Pathview plot---- library(pathview) kegg_organism = "hsa" #Cytokine-cytokine receptor interaction# pathview(gene.data = ranked, pathway.id = "hsa04060", species = "hsa", low = list(gene = "green"), high = list(gene = "red"), na.col = "transparent", limit = list(gene=5, cpd=1)) # limit = list(gene=max(abs(ranked)), cpd=1)) #NOD-like receptor signaling pathway# pathview(gene.data=ranked, pathway.id="hsa04621", species = kegg_organism,low = list(gene = "green"), high = list(gene = "red"), na.col = "transparent", limit=list(gene=max(abs(ranked)), cpd=1)) #TNF signaling pathway# pathview(gene.data=ranked, pathway.id="hsa04668", species = kegg_organism,low = list(gene = "green"), high = list(gene = "red"), na.col = "transparent", limit=list(gene=max(abs(ranked)), cpd=1))