如何用R語(yǔ)言做差異代謝物的kegg富集分析

編寫:王采荷

感覺已經(jīng)很久沒有在簡(jiǎn)書上分享自己的東西了嘁灯,今天在集合其他大佬的力量終于把“如何用R語(yǔ)言做差異代謝物的kegg富集分析”這個(gè)問題給解決了胸竞。我決定將這個(gè)過程分享到簡(jiǎn)書上,一來(lái)可以給在這方面有需求的其他朋友一個(gè)參考剥纷;二來(lái)如果有錯(cuò)誤的地方也能得到大佬的指點(diǎn)蜡峰。這篇短文主要分為以下三個(gè)部分組成;

一烘贴、將代謝物及對(duì)應(yīng)的KEGG數(shù)據(jù)庫(kù)信息進(jìn)行下載并整理

  • 數(shù)據(jù)下載
# 加載所需要的R包
rm(list = ls())
library(XML)
library(RCurl)
library(tidyverse)
library(ggplot2)
library(magrittr)
library(clusterProfiler)
#' 第一步下載KEGG數(shù)據(jù)庫(kù)信息
extractCompounds <- function(pathwayId) {
  compoundUrl <- paste0("https://www.genome.jp/dbget-bin/get_linkdb?-t+compound+path:", pathwayId)
  compoundDoc <- htmlParse(getURL(compoundUrl), encoding = "utf-8")
  compoundLinks <- getNodeSet(compoundDoc, "/html/body/pre/a")
  compoundIds <- sapply(compoundLinks, function(node) xmlGetAttr(node, "href"))
  compoundNames <- sapply(getNodeSet(compoundDoc, "/html/body/pre/text()"), xmlValue)[-1]
  data.frame(compoundId = paste(compoundIds, collapse = ";"), compoundName = paste(compoundNames, collapse = ";"))
}

# Main process
keggUrl <- "https://www.genome.jp/kegg/pathway.html#global"
keggDoc <- htmlParse(getURL(keggUrl), encoding = "UTF-8")

pathwayLinks <- getNodeSet(keggDoc, "http://a[@href]")
pathwayIds <- sapply(pathwayLinks[65:276], function(node) gsub("/pathway/", "", xmlGetAttr(node, "href")))
pathwayNames <- sapply(pathwayLinks[65:276], xmlValue)

# Applying extractCompounds function to each pathwayId
compoundDataList <- Map(extractCompounds, pathwayIds)
pathwayData <- do.call(rbind, compoundDataList)

# Combine all data into a single data frame
finalData <- data.frame(pathwayId = pathwayIds, pathwayName = pathwayNames, pathwayData)
finalData %>% write_csv(paste0("KeggAllcompounds-",Sys.Date(),".csv"))
finalData2 <- finalData[finalData$compoundId != "", ]

==注意事項(xiàng)==
finalData2 <- finalData[finalData$compoundId != "", ]這一步的目的是為了將finalDate$compoundId中有空值的的進(jìn)行刪除,否則后面數(shù)據(jù)整理的時(shí)候會(huì)報(bào)錯(cuò)撮胧。

  • 數(shù)據(jù)整理
#' 分別采用for和map的方式將結(jié)果進(jìn)行整理
#' 整理成為result_data和result_data2
#' 采用for循環(huán)的方式 
result_data <- data.frame()
nrow(finalData2)
for (i in 1:nrow(finalData2)) {
  cid <- finalData2$compoundId[i]
  extracted_cid <- str_extract_all(cid, "C\\d+")
  CID <- unlist(extracted_cid)
  CName <- finalData2$compoundName[i]
  split_CName <- strsplit(CName, "\n;")
  CompoundName <- lapply(split_CName[[1]], trimws) %>% unlist()
  pathway <- cbind(CID, CompoundName)
  pathwayId <- rep(finalData2$pathwayId[i], nrow(pathway))
  pathwayName <- rep(finalData2$pathwayName[i], nrow(pathway))
  dat <- cbind(pathway, pathwayId, pathwayName)
  result_data <- rbind(result_data, dat)
}

#' 采用map的方式
# Define a function to process each row
process_row <- function(row) {
  cid <- row$compoundId
  extracted_cid <- str_extract_all(cid, "C\\d+")
  CID <- unlist(extracted_cid)
  
  CName <- row$compoundName
  split_CName <- strsplit(CName, "\n;")
  CompoundName <- lapply(split_CName[[1]], trimws) %>% unlist()
  
  # Ensure the result is a data frame
  if (length(CID) > 0 && length(CompoundName) > 0) {
    pathway <- data.frame(CID, CompoundName, stringsAsFactors = FALSE)
    pathwayId <- rep(row$pathwayId, nrow(pathway))
    pathwayName <- rep(row$pathwayName, nrow(pathway))
    return(data.frame(pathway, pathwayId, pathwayName, stringsAsFactors = FALSE))
  } else {
    return(data.frame(CID = character(), CompoundName = character(), pathwayId = row$pathwayId, pathwayName = row$pathwayName, stringsAsFactors = FALSE))
  }
}

# Apply the process_row function to each row of finalData using map_df
result_data2 <- map_df(seq_len(nrow(finalData2)), ~process_row(finalData2[.x, ]))

result_data %>% write_csv(paste0("keggAllCompoundReshapedData2-",Sys.Date(),".csv")) #將整理好的結(jié)果進(jìn)行儲(chǔ)存,后面可以直接讀取進(jìn)來(lái)用老翘,不用重復(fù)跑前面的代碼芹啥,畢竟也需要時(shí)間的
result_data2 %>% write_csv(paste0("keggAllCompoundReshapedData22-",Sys.Date(),".csv")
表1 初步整理后的代謝物kegg數(shù)據(jù)庫(kù)表
  • 對(duì)kegg代謝物數(shù)據(jù)庫(kù)進(jìn)一步整理
# 后期富集分析只需要保留表1的第1和第4列
keggannotation <- result_data %>% 
  select(c(-2,-3)) %>% set_colnames(c("ID", "pathway"))

二锻离、進(jìn)行kegg富集分析

  • 先將自己測(cè)定的正負(fù)離子模式代謝物鑒定的表(注意要包含kegg id這一列,如果沒有墓怀,想方設(shè)法將代謝物的kegg id找到)讀取后進(jìn)行整理
uploadfile1 <- "D:/其他人員2/王書/公司結(jié)果/非靶向/Result-X101SC23124721-Z01-J002-B1-42/Result-X101SC23124721-Z01-J002-B1-42/2.MetAnnotation/HMDB_KEGG_Lipidmaps"
uploadfile2 <- "D:/其他人員2/王書/公司結(jié)果/非靶向/Result-X101SC23124721-Z01-J002-B1-42/Result-X101SC23124721-Z01-J002-B1-42/3.MetDiffScreening/MPP.vs.MPN" 
allkeggid <- read.csv(paste0(uploadfile1,"/meta_intensity_neg_hmdb_kegg_lipidmaps.csv")) %>% select(Kegg_ID) %>% 
  bind_rows(.,read.csv(paste0(uploadfile1,"/meta_intensity_pos_hmdb_kegg_lipidmaps.csv")) %>% select(Kegg_ID)) %>% 
  filter(Kegg_ID != "--") %>% 
  set_colnames("ID") %>% 
  mutate(across("ID",str_replace,"cpd:", ""))

其實(shí)就是把正負(fù)離子代謝物所對(duì)應(yīng)的KEGG ID合并汽纠,如表2:


表2 正負(fù)離子代謝物表讀取后只保留kegg id這一列
  • 讀取自己的差異代謝物并保留kegg id
#'差異代謝物
diffkeggid <- read.csv(paste0(uploadfile2,"/MPP.vs.MPN_neg_diff.anno.csv")) %>% select(Kegg_ID) %>% 
  bind_rows(.,read.csv(paste0(uploadfile2,"/MPP.vs.MPN_pos_diff.anno.csv")) %>% select(Kegg_ID)) %>% 
  filter(Kegg_ID != "--") %>% 
  set_colnames("ID") %>% 
  mutate(across("ID",str_replace,"cpd:", ""))
  • 數(shù)據(jù)整合
    這里需要大家理解的是,我們每個(gè)人做的課題不一樣傀履,所測(cè)定到的代謝物也不一樣虱朵,所以需要根據(jù)自己實(shí)際測(cè)定到的代謝物具體多少,構(gòu)建自己的代謝物kegg背景庫(kù)钓账,而不是直接采用表1來(lái)進(jìn)行富集分析碴犬。如表3所示:
total <- right_join(keggannotation,allkeggid,by="ID") %>% select(2,1)
表3 基于自己項(xiàng)目測(cè)出的代謝物構(gòu)建kegg庫(kù)
  • kegg富集分析并導(dǎo)出結(jié)果
# 富集分析
x <- clusterProfiler::enricher(gene = diffkeggid$ID,TERM2GENE = total,minGSSize = 1,pvalueCutoff = 1,qvalueCutoff = 1)
# 結(jié)果導(dǎo)出
write.csv(as.data.frame(x@result) %>% select(-1,-2),
          file = paste0(uploadfile2,"/MP_KEGG_enrichment_result.csv"))

我們來(lái)看看富集分析的結(jié)果怎么樣,如表4所示:


表4 代謝物kegg富集分析結(jié)果

三梆暮、對(duì)富集的結(jié)果進(jìn)行整理和可視化

#' 1.數(shù)據(jù)清洗
df <- read_csv(paste0(uploadfile2,"/MP_KEGG_enrichment_result.csv")) %>%
  dplyr::rename("Description"="...1") %>% 
  arrange(desc(Count)) %>%
  select(1,2,3,4,8) %>% 
  separate(`GeneRatio`,into=c("A","B"),sep="/") %>%
  mutate(A=as.numeric(A),B=as.numeric(B)) %>%
  mutate(count=A/B) %>% head(10) %>% arrange(Count)

#' 2.定義因子
df$Description <- factor(df$Description,levels = c(df$Description %>% as.data.frame() %>% pull()))

#' 3.數(shù)據(jù)可視化
p <- df %>% ggplot(aes(count,Description))+
  geom_point(aes(size=Count,color=pvalue,fill=pvalue),pch=21)+
  scale_color_gradientn(colours = (rev(RColorBrewer::brewer.pal(11,"RdBu"))))+
  scale_fill_gradientn(colours =(rev(RColorBrewer::brewer.pal(11,"RdBu"))))+
  guides(size=guide_legend(title="Count"))+
  labs(x=NULL,y=NULL)+
  theme(axis.title = element_blank(),
        axis.text.x=element_text(color="black",angle =0,hjust=0.5,vjust=0.5, margin = margin(b =5)),
        axis.text.y=element_text(color="black",angle =0,hjust=1,vjust=0.5),
        panel.background = element_rect(fill = NA,color = NA),
        panel.grid.minor= element_line(size=0.2,color="#e5e5e5"),
        panel.grid.major = element_line(size=0.2,color="#e5e5e5"),
        panel.border = element_rect(fill=NA,color="black",size=1,linetype="solid"),
        legend.key=element_blank(),
        legend.title = element_text(color="black",size=9),
        legend.text = element_text(color="black",size=8),
        legend.spacing.x=unit(0.1,'cm'),
        legend.key.width=unit(0.5,'cm'),
        legend.key.height=unit(0.5,'cm'),
        legend.background=element_blank(),
        legend.box="horizontal",
        legend.box.background = element_rect(color="black"),
        legend.position = c(1,0),legend.justification = c(1,0))+
  scale_y_discrete(labels = function(y) str_wrap(y,width=30))
ggsave(paste0(uploadfile2, "/MP_Kegg_enrichment.png"), plot = p, width = 6, height = 6, dpi = 300)
  • 結(jié)果如圖所示


    圖1 kegg富集分析通路圖
最后編輯于
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請(qǐng)聯(lián)系作者
  • 序言:七十年代末服协,一起剝皮案震驚了整個(gè)濱河市,隨后出現(xiàn)的幾起案子啦粹,更是在濱河造成了極大的恐慌偿荷,老刑警劉巖,帶你破解...
    沈念sama閱讀 206,602評(píng)論 6 481
  • 序言:濱河連續(xù)發(fā)生了三起死亡事件唠椭,死亡現(xiàn)場(chǎng)離奇詭異跳纳,居然都是意外死亡,警方通過查閱死者的電腦和手機(jī)贪嫂,發(fā)現(xiàn)死者居然都...
    沈念sama閱讀 88,442評(píng)論 2 382
  • 文/潘曉璐 我一進(jìn)店門寺庄,熙熙樓的掌柜王于貴愁眉苦臉地迎上來(lái),“玉大人撩荣,你說我怎么就攤上這事铣揉。” “怎么了餐曹?”我有些...
    開封第一講書人閱讀 152,878評(píng)論 0 344
  • 文/不壞的土叔 我叫張陵逛拱,是天一觀的道長(zhǎng)。 經(jīng)常有香客問我台猴,道長(zhǎng)朽合,這世上最難降的妖魔是什么? 我笑而不...
    開封第一講書人閱讀 55,306評(píng)論 1 279
  • 正文 為了忘掉前任饱狂,我火速辦了婚禮曹步,結(jié)果婚禮上,老公的妹妹穿的比我還像新娘休讳。我一直安慰自己讲婚,他們只是感情好,可當(dāng)我...
    茶點(diǎn)故事閱讀 64,330評(píng)論 5 373
  • 文/花漫 我一把揭開白布俊柔。 她就那樣靜靜地躺著筹麸,像睡著了一般活合。 火紅的嫁衣襯著肌膚如雪。 梳的紋絲不亂的頭發(fā)上物赶,一...
    開封第一講書人閱讀 49,071評(píng)論 1 285
  • 那天白指,我揣著相機(jī)與錄音,去河邊找鬼酵紫。 笑死告嘲,一個(gè)胖子當(dāng)著我的面吹牛,可吹牛的內(nèi)容都是我干的奖地。 我是一名探鬼主播橄唬,決...
    沈念sama閱讀 38,382評(píng)論 3 400
  • 文/蒼蘭香墨 我猛地睜開眼,長(zhǎng)吁一口氣:“原來(lái)是場(chǎng)噩夢(mèng)啊……” “哼鹉动!你這毒婦竟也來(lái)了轧坎?” 一聲冷哼從身側(cè)響起,我...
    開封第一講書人閱讀 37,006評(píng)論 0 259
  • 序言:老撾萬(wàn)榮一對(duì)情侶失蹤泽示,失蹤者是張志新(化名)和其女友劉穎缸血,沒想到半個(gè)月后,有當(dāng)?shù)厝嗽跇淞掷锇l(fā)現(xiàn)了一具尸體械筛,經(jīng)...
    沈念sama閱讀 43,512評(píng)論 1 300
  • 正文 獨(dú)居荒郊野嶺守林人離奇死亡捎泻,尸身上長(zhǎng)有42處帶血的膿包…… 初始之章·張勛 以下內(nèi)容為張勛視角 年9月15日...
    茶點(diǎn)故事閱讀 35,965評(píng)論 2 325
  • 正文 我和宋清朗相戀三年,在試婚紗的時(shí)候發(fā)現(xiàn)自己被綠了埋哟。 大學(xué)時(shí)的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片笆豁。...
    茶點(diǎn)故事閱讀 38,094評(píng)論 1 333
  • 序言:一個(gè)原本活蹦亂跳的男人離奇死亡,死狀恐怖赤赊,靈堂內(nèi)的尸體忽然破棺而出闯狱,到底是詐尸還是另有隱情,我是刑警寧澤抛计,帶...
    沈念sama閱讀 33,732評(píng)論 4 323
  • 正文 年R本政府宣布哄孤,位于F島的核電站,受9級(jí)特大地震影響吹截,放射性物質(zhì)發(fā)生泄漏瘦陈。R本人自食惡果不足惜,卻給世界環(huán)境...
    茶點(diǎn)故事閱讀 39,283評(píng)論 3 307
  • 文/蒙蒙 一波俄、第九天 我趴在偏房一處隱蔽的房頂上張望晨逝。 院中可真熱鬧,春花似錦懦铺、人聲如沸捉貌。這莊子的主人今日做“春日...
    開封第一講書人閱讀 30,286評(píng)論 0 19
  • 文/蒼蘭香墨 我抬頭看了看天上的太陽(yáng)昏翰。三九已至苍匆,卻和暖如春,著一層夾襖步出監(jiān)牢的瞬間棚菊,已是汗流浹背。 一陣腳步聲響...
    開封第一講書人閱讀 31,512評(píng)論 1 262
  • 我被黑心中介騙來(lái)泰國(guó)打工叔汁, 沒想到剛下飛機(jī)就差點(diǎn)兒被人妖公主榨干…… 1. 我叫王不留统求,地道東北人。 一個(gè)月前我還...
    沈念sama閱讀 45,536評(píng)論 2 354
  • 正文 我出身青樓据块,卻偏偏與公主長(zhǎng)得像码邻,于是被迫代替她去往敵國(guó)和親。 傳聞我的和親對(duì)象是個(gè)殘疾皇子另假,可洞房花燭夜當(dāng)晚...
    茶點(diǎn)故事閱讀 42,828評(píng)論 2 345

推薦閱讀更多精彩內(nèi)容