前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >玮瑜课程

玮瑜课程

原创
作者头像
用户10803254
发布2024-01-10 16:45:47
2210
发布2024-01-10 16:45:47
举报

第一节

打开RStudio先运行以下代码

代码语言:r
复制
library(GEOquery)
library(dplyr)
library(tidyverse)
library(data.table)

1.R包的安装

代码语言:r
复制
1.install.packages("bao")

2.install.packages("BiocManager") 
BiocManager::install("bao")


3.devtools::install_github("bao")         

2.在GEO数据库中下载GSE信息

代码语言:r
复制
install.packages("tidyverse")
library(GEOquery)
gset <- getGEO(GEO = "GSE12417",destdir = ".",getGPL = F)#destdir="."表示下载到当前路径
e2 <- gset[[2]] 
phe <- e2@phenoData@data  #提取临床信息
exp <- e2@assayData[["exprs"]]  #提取表达矩阵

3.在GEO数据库中下载对应平台信息:(平台信息含探针对应的基因名)

代码语言:r
复制
library(data.table)
?fread
getwd
anno=fread("GPL96-57554.txt",sep="\t",header=T,data.table = F)#能在excel中打开的文件都可以用fread函数读取
ID_symbol <- anno[,c("ID","Gene Symbol")]  

#部分探针对应的基因名有两个(如"DDR1 /// MIR4640" ),将排在后面的去掉
symbol <- ID_symbol$`Gene Symbol`
symbol1 <- strsplit(symbol,split=" /// ",fixed=T)#fixed=T表示精确查找
gene_symbol <- sapply(symbol1,function(x){x[1]})#提取每一个子列表中的第一个元素
ID_gene_symbol <- data.frame(ID_symbol$ID,gene_symbol)
rm(ID_symbol,symbol,symbol1,gene_symbol)

4.将表达矩阵与基因名合并

代码语言:r
复制
exp <- as.data.frame(exp)#merge函数只对两个data.frame进行合并
exp1 <- merge(ID_gene_symbol,exp,by.x = 1,by.y = 0)
exp2 <- distinct(exp1,gene_symbol,.keep_all=T)#去除重复的基因名
exp3 <- na.omit(exp2)#将缺失的基因名去除
rownames(exp3) <- exp3$gene_symbol
exp4 <- exp3[,-c(1,2)]
rm(ID_gene_symbol,exp,exp1,exp2,exp3)

至此,我们获得了想要的横坐标为基因名,纵坐标为样本名的表达矩阵exp4

5.第五节:绘制生存曲线

代码语言:r
复制
s=phe$characteristics_ch1#将含生存时间和生存状态的列取出来
s[1:5] #[1] "AML, normal karyotype (training set) FAB M4; age =62 years; OS = 4 days; status (0=alive/1=dead): 1"
s1 <- strsplit(s,split="; ",fixed = T)
os.time <- sapply(s1,function(x){x[3]})#此时提取出来的生存时间为字符型向量(如OS = 4 days)
os.time1 <- strsplit(os.time,split=" ",fixed = T)
os.time2 <- sapply(os.time1,function(x){x[4]})
os <- as.numeric(os.time2)

status <- sapply(s1,function(x){x[4]})#此时提取出来的生存状态为" status (0=alive/1=dead): 0"
status1 <- strsplit(status,split=": ",fixed = T)
status2 <- sapply(status1,function(x){x[2]})
final_status <- as.numeric(status2)

rm(s,s1,os.time,os.time1,os.time2,status,status1,status2)

OS_status <- data.frame(os,final_status)
rownames(OS_status) <- row.names(phe)

提取某个基因作为分组

代码语言:r
复制
#中位数分组
OS_status_exp$EZH2 <- ifelse(OS_status_exp$EZH2>median(OS_status_exp$EZH2),"high","low")

library(survival)
library(survminer)
Surv(os,final_status)#创建生存曲线的对象
x1 <- survfit(Surv(os,final_status)~EZH2,data = OS_status_exp)#对生存曲线进行拟合
ggsurvplot(x1,conf.int =T,pval=T)#conf.int=T表示加上95%置信区间

#四分位数分组
OS_status_exp <- merge(OS_status,exp4.e,by.x=0,by.y = 0)
q <- quantile(OS_status_exp$EZH2)
OS_status_exp$fenzu <- ifelse(OS_status_exp$EZH2>q[4],"high",
                              ifelse(OS_status_exp$EZH2>q[3]& OS_status_exp$EZH2<q[4],"h.stable",
                                     ifelse(OS_status_exp$EZH2>q[2]&OS_status_exp$EZH2<q[3],"l.stable","down")))

x1 <- survfit(Surv(os,final_status)~fenzu,data = OS_status_exp)#对生存曲线进行拟合
ggsurvplot(x1,conf.int =T,pval=T,risk.table = T,#conf.int=T表示加上95%置信区间,添加风险因子表
           surv.median.line = "hv")#添加中位生存时间

#使用ggsurvplot_facet()函数绘制分面生存曲线
OS_status_exp$sex <- c(rep("m",100),rep("f",63))
x1 <- survfit(Surv(os,final_status)~EZH2,data = OS_status_exp)#对生存曲线进行拟合
ggsurvplot_facet(x1,OS_status_exp,
                 facet.by = "sex",#设置分面变量
                 palette="npg",#设置颜色画板
                 pval = T)

6.第五六节:差异分析

部分平台注释文件不能下载,解决办法:

1. gset <- getGEO("GSE149507",destdir = ".",getGPL = T)→gset[["GSE149507_series_matrix.txt.gz"]]@featureData@data

2.下载soft文件:soft <- getGEO(filename="GSE149507_family.soft")→soft@gpls[["GPL23270"]]@dataTable@table

#getGEO()可下载网页文件,也可读取soft文件 。

代码语言:r
复制
gset <- getGEO("GSE149507",destdir = ".",getGPL = T)
gset <- gset[[1]]
pdata <- gset@phenoData@data
exprset <- gset@assayData[["exprs"]]
gpl <- gset@featureData@data

#将ENTREZ_GENE_ID转换为gene symbol(构建含基因名称的平台表格)
library(org.Hs.eg.db)
keytypes(org.Hs.eg.db)#查看一下有哪些基因ID
x1 <- gpl$ENTREZ_GENE_ID
x1 <- as.character(x1)
x2 <- AnnotationDbi::select(org.Hs.eg.db,keys=x1,columns=c("ENTREZID","SYMBOL",
                                            keytype = "ENTREZID")#keys和keytype需对应
gpl$gene <- x2$SYMBOL#在gpl表中加上探针对应的基因名称

#将表达矩阵和平台信息合并
exp <- as.data.frame(exprset)
exp.pl <- merge(gpl,exp,by.x = 1,by.y = 0)#将平台信息和含探针信息的表达矩阵按照探针合并
exp.pl1 <- distinct(exp.pl,gene,.keep_all=T)#去除重复的基因名
exp.pl2 <- na.omit(exp.pl1)#将缺失的基因名去除
rownames(exp.pl2) <- exp.pl2$gene
exp.pl3 <- exp.pl2[,-c(1:5)]
rm(x1,x2,exp,exp.pl,exp.pl1,exp.pl2)

差异分析

代码语言:r
复制
tumor <- c(seq(1,35,2))
control <- tumor+1
exp4 <- exp.pl3[,c(control,tumor)]
group_list <- c(rep("control",18),rep("tumor",18))
group_list <- factor(group_list)
group_list <- relevel(group_list,ref="control")#强制限定顺序,control在前

library(limma )
exp5 <- normal izeBetweenArrays(exp4)#除去批次效应
boxplot(exp4,outline=F,notch=T,col=group_list,las=2)
boxplot(exp5,outline=F,notch=T,col=group_list,las=2)#绘制出的图形相同,说明样本已经进行过归一化处理

#构建差异分析的矩阵
design <- model.matrix(~group_list)
colnames(design) <- levels(group_list)
rownames(design) <- colnames(exp5)


fit <- lmFit(exp5,design)#构建线性拟合模型
fit <- eBayes(fit)#eBayes()使用trend=T对标准误差进行贝叶斯平滑,计算每个对比中每个基因的moderated t-statistic和log-odds
allDiff <- topTable(fit,coef=2,adjust="fdr",number = Inf)#topTable()给出一个最有可能在给定对比条件下差异表达的基因列表
#coef=2中的”2“代表design中的第2列

火山图

代码语言:javascript
复制
#画个火山图
library(ggplot2)
library(ggrepel)
data <- allDiff
data$significant <- "stable"
data$significant[data$logFC>=0.585 & data$P.Value<0.05]="up"
data$significant[data$logFC<=-0.585 & data$P.Value<0.05]="down"

ggplot(data,aes(logFC,-1*log10(P.Value)))+xlim(-2,2)+ylim(0,8)+
         geom_point(aes(color=significant),size=0.8)+theme_classic()+
  scale_color_manual(values = c("#2a9d8f","#EE7AE9","#f8961e"))+
  geom_hline(yintercept = 1.3,linetype=4,size=0.3)+
  geom_vline(xintercept = c(-0.585,0.585),linetype=4,size=0.3)+
  theme(title = element_text(size=18),text = element_text(size=18))+
  labs(x="log2(foldchange)",y="-log10(P_Value)")

#筛选差异基因
select.FPKM <- data$AveExpr>5  #表达量>5
select.log2FC <- abs(data$logFC)>1
select.Pvalue <- data$P.Value<0.05
select.vec <- select.FPKM & select.log2FC & select.Pvalue
table(select.vec)

degs.list <- as.character(rownames(data))[select.vec]
label.deg <- sample(degs.list,20)#若想单独标注某个基因,则label.deg <- c("PID1","MT3")
p=ggplot(data,aes(logFC,-1*log10(P.Value)))+xlim(-2,2)+ylim(0,8)+
  geom_point(aes(color=significant),size=0.8)+theme_classic()+
  scale_color_manual(values = c("#2a9d8f","#EE7AE9","#f8961e"))+
  geom_hline(yintercept = 1.3,linetype=4,size=0.3)+
  geom_vline(xintercept = c(-0.585,0.585),linetype=4,size=0.3)+
  theme(title = element_text(size=18),text = element_text(size=18))+
  labs(x="log2(foldchange)",y="-log10(P_Value)")
data_selected <- data[label.deg,]
p+geom_label_repel(data = data_selected,
                   aes(label=rownames(data_selected)))

热图

代码语言:javascript
复制
#热图
annotation_col1 <- data.frame(
  database <- c(rep("GEO",36)),
   CellType <- c(rep("control",18),rep("treatment",18))
  )
rownames(annotation_col1) <- colnames(exp5)
class(exp5)
exp6 <- as.data.frame(exp5)
exprset.map <- exp6[label.deg,]
install.packages("pheatmap")
library(pheatmap)
pheatmap::pheatmap(exprset.map,#热图的数据
                   cluster_rows = F,#行聚类
                   cluster_cols=F,#列聚类,可以看出样本之间的区分度
                   annotation_col = annotation_col1,
                   show_colnames = F,
                   scale="row",#以行标准化
                   color=colorRampPalette(c("blue","white","red"))(100))

原创声明:本文系作者授权腾讯云开发者社区发表,未经许可,不得转载。

如有侵权,请联系 cloudcommunity@tencent.com 删除。

原创声明:本文系作者授权腾讯云开发者社区发表,未经许可,不得转载。

如有侵权,请联系 cloudcommunity@tencent.com 删除。

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
目录
  • 第一节
    • 1.R包的安装
      • 2.在GEO数据库中下载GSE信息
        • 3.在GEO数据库中下载对应平台信息:(平台信息含探针对应的基因名)
          • 4.将表达矩阵与基因名合并
            • 至此,我们获得了想要的横坐标为基因名,纵坐标为样本名的表达矩阵exp4
          • 5.第五节:绘制生存曲线
            • 提取某个基因作为分组
            • 6.第五六节:差异分析
              • 差异分析
                • 火山图
                  • 热图
                  领券
                  问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档