编写：王采荷

感觉已经很久没有在简书上分享自己的东西了，今天在集合其他大佬的力量终于把“如何用R语言做差异代谢物的kegg富集分析”这个问题给解决了。我决定将这个过程分享到简书上，一来可以给在这方面有需求的其他朋友一个参考；二来如果有错误的地方也能得到大佬的指点。这篇短文主要分为以下三个部分组成；

一、将代谢物及对应的KEGG数据库信息进行下载并整理

• 数据下载

# 加载所需要的R包
rm(list = ls())
library(XML)
library(RCurl)
library(tidyverse)
library(ggplot2)
library(magrittr)
library(clusterProfiler)
#' 第一步下载KEGG数据库信息
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, "//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 != "", ]

==注意事项==
finalData2 <- finalData[finalData$compoundId != "", ]这一步的目的是为了将finalDate$compoundId中有空值的的行进行删除，否则后面数据整理的时候会报错。

• 数据整理

#' 分别采用for和map的方式将结果进行整理
#' 整理成为result_data和result_data2
#' 采用for循环的方式 
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")) #将整理好的结果进行储存，后面可以直接读取进来用，不用重复跑前面的代码，毕竟也需要时间的
result_data2 %>% write_csv(paste0("keggAllCompoundReshapedData22-",Sys.Date(),".csv")

表1 初步整理后的代谢物kegg数据库表

• 对kegg代谢物数据库进一步整理

# 后期富集分析只需要保留表1的第1和第4列
keggannotation <- result_data %>% 
  select(c(-2,-3)) %>% set_colnames(c("ID", "pathway"))

二、进行kegg富集分析

• 先将自己测定的正负离子模式代谢物鉴定的表（注意要包含kegg id这一列，如果没有，想方设法将代谢物的kegg id找到）读取后进行整理

uploadfile1 <- "D:/其他人员2/王书/公司结果/非靶向/Result-X101SC23124721-Z01-J002-B1-42/Result-X101SC23124721-Z01-J002-B1-42/2.MetAnnotation/HMDB_KEGG_Lipidmaps"
uploadfile2 <- "D:/其他人员2/王书/公司结果/非靶向/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:", ""))

其实就是把正负离子代谢物所对应的KEGG ID合并，如表2：

表2 正负离子代谢物表读取后只保留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:", ""))

• 数据整合
  这里需要大家理解的是，我们每个人做的课题不一样，所测定到的代谢物也不一样，所以需要根据自己实际测定到的代谢物具体多少，构建自己的代谢物kegg背景库，而不是直接采用表1来进行富集分析。如表3所示：

total <- right_join(keggannotation,allkeggid,by="ID") %>% select(2,1)

表3 基于自己项目测出的代谢物构建kegg库

• kegg富集分析并导出结果

# 富集分析
x <- clusterProfiler::enricher(gene = diffkeggid$ID,TERM2GENE = total,minGSSize = 1,pvalueCutoff = 1,qvalueCutoff = 1)
# 结果导出
write.csv(as.data.frame(x@result) %>% select(-1,-2),
          file = paste0(uploadfile2,"/MP_KEGG_enrichment_result.csv"))

我们来看看富集分析的结果怎么样，如表4所示：

表4 代谢物kegg富集分析结果

三、对富集的结果进行整理和可视化

#' 1.数据清洗
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.数据可视化
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)

• 结果如图所示

  
  
  图1 kegg富集分析通路图