批次矫正教程(全代码+注释)-转载,非原创

2021-02-12  本文已影响0人  whykm
### 批次矫正教程(全代码+注释)!!!############################################################################################ 首先需要安装一些R包
options("repos"=c(CRAN="https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))
options(BioC_mirror="https://mirrors.tuna.tsinghua.edu.cn/bioconductor")
if(!require("limma")) BiocManager::install("limma",update = F,ask = F)
if(!require("bladderbatch")) BiocManager::install("bladderbatch",update = F,ask = F)
if(!require("sva")) BiocManager::install("sva",update = F,ask = F)
if(!require("preprocessCore")) BiocManager::install("preprocessCore",update = F,ask = F)
if(!require("tidyr")) install.packages("tidyr",update = F,ask = F)
if(!require("dplyr")) install.packages("dplyr",update = F,ask = F)
if(!require("tibble")) install.packages("tibble",update = F,ask = F)
if(!require("factoextra")) install.packages("factoextra",update = F,ask = F)
if(!require("FactoMineR")) install.packages("FactoMineR",update = F,ask = F)
if(!require("ggplot2")) install.packages("ggplot2",update = F,ask = F)
if(!require("ggrepel")) install.packages("ggrepel",update = F,ask = F)
if(!require("ggpubr")) install.packages("ggpubr",update = F,ask = F)
if(!require("dendextend")) install.packages("dendextend",update = F,ask = F)
if(!require("RobustRankAggreg")) install.packages("RobustRankAggreg",update = F,ask = F)
### 准备工作完成############################################################################################ 加载数据
rm(list = ls())
library(sva)
library(bladderbatch)
data(bladderdata)
### bladder的属性是EsetExpressionSet,所以可以用pData和exprs方法### 提取注释数据
pheno <- pData(bladderEset)
### 提取表达数据
edata <- exprs(bladderEset)
### 我们自己的表达量数据(参考edata)需要调整为行名是探针、列名是样本### 注释数据的调整参考pheno:batch代表批次############################################################################################ 先看一下样本聚类的情况:处理数据之前的必要步骤### 聚类画图展示批次信息### 不懂的代码可以这样了解,例如:将?dist输入Console
dist_mat <- dist(t(edata))
### 上面的t代表转置### 用hclust进行聚类
res.hc <- hclust(dist_mat, method = "complete")
### 下面进行图形化展示
  # plot(res.hc, labels = pheno$batch) # 展示的是批次信息
  # plot(res.hc, labels = pheno$cancer) # 加上样本名称
  # 但是这种方法不适合人类阅读### 我们采取下面的方法:
  # 点开res.hc发现是个List,里面labels代表的样本名称不是我们想要的Normal或Cancer
  # 两个方括号获取res.hc的labels
labels = res.hc[["labels"]]
  # labels # 可以看到名称被提取出来了### 在行上按这个labels重新排序pheno,再调取它的cancer列
  # pheno[labels,]$cancer # 就是这个### 再赋值给res.hc的labels
res.hc[["labels"]] = as.character(pheno[labels,]$cancer)
### 开始画图
  # 设置颜色
label_color = as.numeric(as.factor(labels(res.hc))) # 先变成factor,再变成数字library(factoextra)
  # 画图
fviz_dend(res.hc,label_cols = label_color, cex = 0.6) # cex代表字体大小
  # 示例里:这时候在正常组里混入仨Cancer,在肿瘤组里混入一Normal
  # 现在就要用批次看能不能矫正回去### 除此之外,也可以用主成分分析(PCA分析)来观察### 需要的同样是样本在行,基因在列的表达数据### PCA分析library(FactoMineR)
ddb.pca <- PCA(t(edata), graph = FALSE)
fviz_pca_ind(ddb.pca,
             geom.ind = "point",     # show points only (but not "text")
             col.ind = pheno$cancer, # color by groups
             addEllipses = TRUE,     # Concentration ellipses
             legend.title = "Groups"
)
### 具体怎么看PCA图,Bing搜索一下############################################################################################ 下面开始批次矫正### 矫正批次效应,model可以有也可以没有:如果有,就是告诉combat,有些分组本来就有差别,不要矫枉过正
  # 用我们感兴趣的pheno$cancer构建一个矩阵model <- model.matrix(~as.factor(pheno$cancer))
### 重点来了!!!### 重点来了!!!### 重点来了!!!# 方法一(ComBat)
combat_edata <- ComBat(dat = edata, batch = pheno$batch, mod = model)
  # 使用sva包中的combat函数!
  # 依次是什么数据、批次来自于哪、想保留什么信息# 方法二(removeBatchEffect)library(limma)
rb_edata <- removeBatchEffect(edata, batch = pheno$batch, design = model)
### 这两种方法相互验证,作为评测工具### 重点结束!!!### 重点结束!!!### 重点结束!!!### 画图展示矫正后的效果library(factoextra)
# 方法一(ComBat)
dist_mat <- dist(t(combat_edata))
# 方法二(removeBatchEffect)
dist_mat <- dist(t(rb_edata))
### 上面要二选一噢!### 上面要二选一噢!### 上面要二选一噢!
res.hc <- hclust(dist_mat, method = "complete")
### 把标签换成我们想要的Normal和Cancer这类的
labels = res.hc[["labels"]]
res.hc[["labels"]] = as.character(pheno[labels,]$cancer)
  # 设置颜色
label_color = as.numeric(as.factor(labels(res.hc)))
  # 画图
fviz_dend(res.hc,label_cols = label_color, cex = 0.6)

### 同样进行PCA分析library(FactoMineR)
ddb.pca <- PCA(t(combat_edata), graph = FALSE)
fviz_pca_ind(ddb.pca,
             geom.ind = "point",     # show points only (but not "text")
             col.ind = pheno$cancer, # color by groups
             addEllipses = TRUE,     # Concentration ellipses
             legend.title = "Groups"
)

############################################################################################ 比较几种方案下差异分析有何区别### 火山图来了!!!### 火山图来了!!!### 火山图来了!!!### 加载数据
rm(list = ls())
library(sva)
library(bladderbatch)
data(bladderdata)
pheno <- pData(bladderEset)
edata <- exprs(bladderEset)

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 1.不矫正
exprSet <- edata # 赋值给exprSet是为了代码复用### 创建分组group <- as.character(pheno$cancer)
group[group=="Biopsy"] = "Normal" # 把Biopsy组的名字也换成Normaltable(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("Normal","Cancer"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group)
### 下面几步是流程限定要做的,不需要改
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff1=topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab1 <- subset(allDiff1,abs(logFC) >1 & adj.P.Val < 0.05)

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 2.使用ComBat
exprSet <- edata # 赋值给exprSet是为了代码复用### 创建分组group <- as.character(pheno$cancer)
group[group=="Biopsy"] = "Normal"table(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("Normal","Cancer"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group)
### ComBat一下
exprSet <- ComBat(dat = edata, batch = pheno$batch, mod = design)
### 下面几步是流程限定要做的,不需要改
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff2 = topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab2 = subset(allDiff2,abs(logFC) >1 & adj.P.Val < 0.05)

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 3.使用removeBatchEffect
exprSet <- edata # 赋值给exprSet是为了代码复用### 创建分组group <- as.character(pheno$cancer)
group[group=="Biopsy"] = "Normal"table(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("Normal","Cancer"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group)
### removeBatchEffect一下
exprSet <- removeBatchEffect(edata, batch = pheno$batch, design=design)
### 下面几步是流程限定要做的,不需要改
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff3 = topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab3 = subset(allDiff3,abs(logFC) >1 & adj.P.Val < 0.05)
### 这里暂停### 看一下发现使用removeBatchEffect做批次矫正得到的差异基因最多### 但是!!!但是!!!### 我们最好不要把数据做批次矫正改变之后,再做差异分析,就像2.和3.那样### 我们应该:### 把批次信息放入线性函数模型里面去,作为一个分组变量存在,这样的结果更好!!!#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 4.线性模型
exprSet <- edata # 赋值给exprSet是为了代码复用### 创建分组group <- as.character(pheno$cancer)
group[group=="Biopsy"] = "Normal"table(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("Normal","Cancer"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group+pheno$batch) # 这里在模型构建的时候加入了batch的信息### 下面几步是流程限定要做的,不需要改
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff4=topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab4 <- subset(allDiff4,abs(logFC) >1 & adj.P.Val < 0.05)
### 结论:### 我们倾向于线性模型的处理方式结果更可信!!!### 这里展示的是使用线性模型方式处理的原因#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 下面使用火山图来可视化一下(结果图)library(ggplot2)
library(ggrepel)
library(dplyr)
data <- allDiff4 # 这边也可以改成allDiff1、allDiff2、allDiff3噢data$gene <- rownames(data)
### 仔细观察data数据!!!### 如果是你自己的数据,至少有三列:logFC、P.Value、gene!!!### 注意!!!### 注意!!!### 注意!!!### 要把自己data里的logFC、P.Value、gene列的列名改成完全和“logFC”、“P.Value”、“gene”一样,比如代表基因的列名“symbol”要改成“gene”!!!### 这样才可以对接下面的代码### 画图
ggplot(data=data, aes(x=logFC, y =-log10(P.Value))) +
  ## 三个部分分别画点
  ## alpha代表透明度
  geom_point(data=subset(data,abs(data$logFC) <= 1),aes(size=abs(logFC)),color="black",alpha=0.1) +
  geom_point(data=subset(data,data$P.Value<0.05 & data$logFC > 1),aes(size=abs(logFC)),color="red",alpha=0.2) +
  geom_point(data=subset(data,data$P.Value<0.05 & data$logFC < -1),aes(size=abs(logFC)),color="green",alpha=0.2) +
  ## 画线
  geom_hline(yintercept = -log10(0.05),lty=4,lwd=0.6,alpha=0.8)+
  geom_vline(xintercept = c(1,-1),lty=4,lwd=0.6,alpha=0.8)+
  ## 主题
  theme_bw()+
  theme(panel.border = element_blank(),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),   
        axis.line = element_line(colour = "black"))+
  labs(x="log2 (fold change)",y="-log10 (q-value)")+
  theme(plot.title = element_text(hjust = 0.5))+
  theme(legend.position='none')+
  ## 标签
  geom_text_repel(data=subset(data, abs(logFC) > 2), aes(label=gene),col="black",alpha = 0.8)
### 这边图里的东西高度可定制#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 火山图展示不矫正、使用ComBat、removeBatchEffect或线性模型的差异基因表达情况### 提取基因
genes_u = rownames(diffLab1)                                  # 原来的差异基因
genes_combat = setdiff(rownames(diffLab2),rownames(diffLab1)) # ComBat多出来的差异基因
genes_rb = setdiff(rownames(diffLab3),rownames(diffLab1))     # removeBatchEffect多出来的差异基因
genes_liner = setdiff(rownames(diffLab4),rownames(diffLab1))  # 线性模型多出来的差异基因### 开始画火山图library(ggplot2)
library(ggrepel)
library(dplyr)
data <- allDiff1
data$gene <- rownames(data)
### 仔细观察data数据!!!### 如果是你自己的数据,至少有三列:logFC、P.Value、gene!!!
ggplot(data=data, aes(x=logFC, y =-log10(P.Value))) +
  ## 三个部分分别画点
  geom_point(data=subset(data,abs(data$logFC) <= 1),color="grey",alpha=0.05) +
  geom_point(data=data[genes_u,],color="black",alpha=0.6,size=1) +
  geom_point(data=data[genes_rb,],color="green",alpha=0.2) +
  geom_point(data=data[genes_combat,],color="blue",alpha=0.8,size=0.5) +
  geom_point(data=data[genes_liner,],color="red",alpha=0.8,size=1) +
  ## 画线
  geom_hline(yintercept = -log10(0.05),lty=4,lwd=0.6,alpha=0.8)+
  geom_vline(xintercept = c(1,-1),lty=4,lwd=0.6,alpha=0.8)+
  ## 主题
  theme_bw()+
  theme(panel.border = element_blank(),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),   
        axis.line = element_line(colour = "black"))+
  labs(x="log2 (fold change)",y="-log10 (q-value)")+
  theme(plot.title = element_text(hjust = 0.5))+
  theme(legend.position='none')
### 蓝色是ComBat多出来的差异基因### 绿色是removeBatchEffect多出来的差异基因### 红色是线性模型多出来的差异基因### 可以看到线性模型最保守,ComBat和removeBatchEffect激进一点### 如果数据批次矫正是为了聚类画热图,那么ComBat和removeBatchEffect都可以### 如果数据批次矫正是为了求差异基因,需要更稳健,那么选择线性模型############################################################################################ 下面讲怎么删掉怪怪的样本?### 也就是去掉样本里的异常值### sva::ComBat### 去除不好的样本然后再批次矫正
rm(list = ls())
### 加载数据,这里是合并了40多个平台的脾脏信息,以后用我们自己的数据,加油鸭!### 示例数据下载:链接:https://pan.baidu.com/s/1BKhFCZzAzkIf86XalPSSTQ 密码:ztl6
res = load("spleen_expression.rda")
dim(expression)

### 画箱线图
set.seed(468) # 设定随机数种子,Bing搜索一下就能明白,其中468这个编号可以随意设定,主要是为了结果的可重复性index = sample(1:ncol(expression), 40) # 随机选40个出来,ncol(expression)代表expression的列数;这句意思是在1-总共的列数里随机选40个出来
bdata = log2(expression[,index]+1) # 取log的常见手法
boxplot(bdata)

### quantile normalization### 矫正每次测量的最大值最小值,就像曝光1秒和2秒是不同的,2秒的表达量看起来普遍更高(但事实并不是这样),这时用quantile矫正### 把最大值最小值矫正到同一水平,就像矫正曝光时间library(preprocessCore)
exp = normalize.quantiles(log2(expression+1))
colnames(exp) = colnames(expression)
rownames(exp) = rownames(expression)

### 再画箱线图
boxplot(expression[,1:10])         # 这是原来的图
boxplot(log2(1+expression)[,1:10]) # 这是取log之后的图
boxplot(exp[,1:10])                # 这是做了quantile normalization之后的图### 做了quantile normalization之后齐了#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 去掉一些不好的样本:Identify outlier samples(离群值、法外狂徒)### 依据是相关性:把所有样本两两求相关性,看各个样本之间相关性如何### 注意一下这里展示的是思路,自己做的时候要修改:数据已经换掉,改成脾脏数据了,这个脾脏数据没有对照组哈
cc = cor(exp) # cor代表相关性
dend <- as.dendrogram(hclust(as.dist(1-cc))) # 聚类之后变成树形结构
useries = unique(series) # 告诉你有多少个批次:比如这里46个平台,至少有46个批次### 给上颜色信息
colos <- colorspace::rainbow_hcl(length(useries), c = 160, l = 50)
names(colos) = useries
series_color <- colos[series]

### 画树形图看一下
plot(dend, horiz = TRUE) # 这个树是水平的### 下面开始切树!!!### 下面开始切树!!!### 观察包含绝大多数样本的树的主干最上游在什么位置### 这个示例里:h=0.25library(dendextend)
clu = cutree(dend, h = 0.25)
labels_colors(dend) <- series_color[order.dendrogram(dend)]
dend <- color_branches(dend, h = 0.25)
### 再画树形图(变彩色)
plot(dend, horiz = TRUE)
colored_bars(cbind(clu, series_color), dend, rowLabels = c("Cluster", "Series"), horiz = TRUE)
legend("topleft", legend = useries, fill = colos, bg = "white", cex = 0.6)

### 选取最大的聚类
largest_cluster = names(rev(sort(table(clu))))[1]
  # 运行table(clu):有多少群,每群样本数多少
  # 运行sort(table(clu)):相同样本数的群,按样本数从小到大排列
  # 运行rev(sort(table(clu))):逆序
  # 上面解释不好看懂,运行一下就很清楚了
ww = which(clu == largest_cluster)
ddn = cor(exp[,ww]) # 重新做相关性系数
ddd = density(ddn)  # 计算相关性系数的密度值
plot(ddd, lwd = 3)  # 把密度值画出来### 把切树筛选过后的样本提取出来
reduced_expression = exp[,ww]
reduced_series = series[ww]

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 用ComBat做批次矫正
batchid = as.numeric(as.factor(reduced_series))
library(sva)
correctedExpression <- ComBat(dat = reduced_expression, batch = batchid, par.prior = TRUE, prior.plots = FALSE)
### 也用removeBatchEffect做一下library(limma)
combat_edata <- removeBatchEffect(reduced_expression, batch = batchid)
### 下面处理和之前一样
cc = cor(correctedExpression)
dend <- as.dendrogram(hclust(as.dist(1-cc)))
useries = unique(reduced_series)
colos <- colorspace::rainbow_hcl(length(useries), c = 160, l = 50)
names(colos) = useries
series_color <- colos[series]
clu = cutree(dend, h = 0.25)
labels_colors(dend) <- series_color[order.dendrogram(dend)]
dend <- color_branches(dend, h = 0.25)
### 把图再画一下看看  
plot(density(cor(exp[,ww])), lwd=3, main="correlation of leftover samples", ylim=c(0,35))
  # 这是切树(去除无用样本)之后的样本相关性分布图(黑色)lines(density(cor(correctedExpression)), lwd=3, main="correlation of leftover samples", col="red")
  # 这是ComBat批次矫正之后的样本相关性分布图(红色):相关性系数变高lines(density(cor(combat_edata)), lwd=3, main="correlation of leftover samples", col="blue")
  # 这是removeBatchEffect批次矫正之后的样本相关性分布图(蓝色):相关性系数更高
legend("topleft", legend=c("uncorrected","ComBat","removeBatchEffect"), lty=1, lwd=3, col=c("black","red","blue"))
  # 打上标签### 总结一下:这一部分讲了怎么通过切树去除无用样本!!!切树!!!############################################################################################################################################################################################################################################################################## 实战示例!!!### 实战示例!!!### 实战示例!!!
rm(list = ls())
### 加载数据集,来自于同一个平台!### 示例数据下载:链接:https://pan.baidu.com/s/1H4hcg8c6GXr4-t4wWbFZEg 密码:27byload(file = "dataset1.Rdata")
load(file = "dataset2.Rdata")
### 数据合并是关键的第一步:行是基因名,列是样本,那自然是把样本的列加在后面### inner_join函数需要作用于数据框,而且需要一个轴(基因名)### class(exprSet1)发现现在是matrix,需要变成数据框library(dplyr)
exprSet1 <- as.data.frame(exprSet1)
exprSet1 <- cbind(symbol = rownames(exprSet1),exprSet1) # 把行名变成第一列
exprSet2 <- as.data.frame(exprSet2)
exprSet2 <- cbind(symbol = rownames(exprSet2),exprSet2) # 把行名变成第一列### 可以把两个数据集交叉合并了(merge)
merge_dd =inner_join(exprSet1,exprSet2,by="symbol")     # 现在变成一个数据集了
rownames(merge_dd) <- merge_dd[,1]  # 把merge_dd的第一列变成行名
merge_dd <- merge_dd[,-1]           # 再把merge_dd的第一列去掉
merge_dd <- as.matrix(merge_dd)     # 再转换成矩阵文件
boxplot(merge_dd, outline=FALSE, notch=T, las=2) # 画个图来看一下### 组间校正!!!library(limma) 
exprSet=normalizeBetweenArrays(merge_dd)
boxplot(exprSet, outline=FALSE, notch=T, las=2)

### 自动log化:扒自GEO官网
ex <- exprSet
qx <- as.numeric(quantile(ex, c(0., 0.25, 0.5, 0.75, 0.99, 1.0), na.rm=T))
LogC <- (qx[5] > 100) ||
  (qx[6]-qx[1] > 50 && qx[2] > 0) ||
  (qx[2] > 0 && qx[2] < 1 && qx[4] > 1 && qx[4] < 2)
if (LogC) { 
  ex[which(ex <= 0)] <- NaN
  exprSet <- log2(ex)
  print("log2 transform finished")
}else{
  print("log2 transform not needed")
}
merge_dd <- exprSet # 存为merge_dd,避免后面重名### 创建分组信息:关键的第二步
pheno = data.frame(sample = colnames(merge_dd),     # 第一列sample等于merge_dd的列名
                   group = c(pheno1, pheno2),
                   batch = c(rep(1,16), rep(2,10))) # 前16个样本是第一批次,后10个样本是第二批次
rownames(pheno) = pheno$sample # 加上行名,方便下面的操作### 这时候就可以完美对接之前的技能啦!### 开始复制之前的代码了哈#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 1.不矫正
exprSet <- merge_dd
### 聚类画图展示批次信息
dist_mat <- dist(t(exprSet))
res.hc <- hclust(dist_mat, method = "complete")
labels = res.hc[["labels"]]
res.hc[["labels"]] = as.character(pheno[labels,]$group)
 ## 设置颜色
label_color = as.numeric(as.factor(labels(res.hc)))
library(factoextra)
 ## 画图
fviz_dend(res.hc,label_cols = label_color, cex = 1)

### PCA分析library(FactoMineR)
ddb.pca <- PCA(t(exprSet), graph = FALSE)
fviz_pca_ind(ddb.pca,
             geom.ind = "point", # show points only (nbut not "text")
             col.ind = pheno$group, # color by groups
             addEllipses = TRUE, # Concentration ellipses
             legend.title = "Groups"
)

### 创建分组group <- as.character(pheno$group)
table(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("normal","tumor"),ordered = F) # 自己做的时候"normal"、"tumor"要改的
 ## 构建比较矩阵
design <- model.matrix(~group)
### 下面几步是流程限定要做的,不需要改### 也就是差异基因分析
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff1=topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab1 <- subset(allDiff1,abs(logFC) >1 & adj.P.Val < 0.05)

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 2.使用ComBat### 创建分组
exprSet <- merge_dd
group <- as.character(pheno$group)
table(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("normal","tumor"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group)

library(sva)
exprSet <- ComBat(dat = exprSet, batch = pheno$batch, mod = design)
### 聚类画图展示批次信息
dist_mat <- dist(t(exprSet))
res.hc <- hclust(dist_mat, method = "complete")
labels = res.hc[["labels"]]
res.hc[["labels"]] = as.character(pheno[labels,]$group)
 ## 设置颜色
label_color = as.numeric(as.factor(labels(res.hc)))
library(factoextra)
 ## 画图
fviz_dend(res.hc,label_cols = label_color, cex = 1)

### PCA分析library(FactoMineR)
ddb.pca <- PCA(t(exprSet), graph = FALSE)
fviz_pca_ind(ddb.pca,
             geom.ind = "point",    # show points only (but not "text")
             col.ind = pheno$group, # color by groups
             addEllipses = TRUE,    # Concentration ellipses
             legend.title = "Groups"
)

### 差异分析
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff2 = topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab2 = subset(allDiff2,abs(logFC) >1 & adj.P.Val < 0.05)

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 3.使用removeBatchEffect
exprSet <- merge_dd
### 创建分组group <- as.character(pheno$group)
table(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("normal","tumor"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group)

exprSet <- removeBatchEffect(exprSet, batch = pheno$batch, design=design)
### 聚类画图展示批次信息
dist_mat <- dist(t(exprSet))
res.hc <- hclust(dist_mat, method = "complete")
labels = res.hc[["labels"]]
res.hc[["labels"]] = as.character(pheno[labels,]$group)
 ## 设置颜色
label_color = as.numeric(as.factor(labels(res.hc)))
library(factoextra)
 ## 画图
fviz_dend(res.hc,label_cols = label_color, cex = 1)

### PCA分析library(FactoMineR)
ddb.pca <- PCA(t(exprSet), graph = FALSE)
fviz_pca_ind(ddb.pca,
             geom.ind = "point",    # show points only (but not "text")
             col.ind = pheno$group, # color by groups
             addEllipses = TRUE,    # Concentration ellipses
             legend.title = "Groups"
)

### 差异分析
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff3 = topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab3 = subset(allDiff3,abs(logFC) >1 & adj.P.Val < 0.05)

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 4.线性模型
exprSet <- merge_dd
### 创建分组group <- as.character(pheno$group)
table(group)
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("normal","tumor"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group+pheno$batch)

### 差异分析
fit <- lmFit(exprSet,design)
fit2 <- eBayes(fit)
allDiff4=topTable(fit2,adjust='fdr',coef=2,number=Inf) 
diffLab4 <- subset(allDiff4,abs(logFC) >1 & adj.P.Val < 0.05)
### 总体来说,这三种批次矫正就是挑个自己觉得合适的咯############################################################################################################################################################################################################################################################################## 实战二示例!!!### 实战二示例!!!### 实战二示例!!!### 这里的思路改变了:我们分别找每个芯片里的差异基因,然后再取交集!
rm(list = ls())
### 加载数据集,来自于同一个平台load(file = "dataset1.Rdata")
load(file = "dataset2.Rdata")

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 单独做第一个
exprSet = exprSet1
boxplot(exprSet, outline=FALSE, notch=T, las=2)
### 组间校正library(limma) 
exprSet=normalizeBetweenArrays(exprSet)
boxplot(exprSet, outline=FALSE, notch=T, las=2)
### 自动log化
ex <- exprSet
qx <- as.numeric(quantile(ex, c(0., 0.25, 0.5, 0.75, 0.99, 1.0), na.rm=T))
LogC <- (qx[5] > 100) ||
  (qx[6]-qx[1] > 50 && qx[2] > 0) ||
  (qx[2] > 0 && qx[2] < 1 && qx[4] > 1 && qx[4] < 2)
if (LogC) { 
  ex[which(ex <= 0)] <- NaN
  exprSet <- log2(ex)
  print("log2 transform finished")
}else{
  print("log2 transform not needed")
}

group <- pheno1
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("normal","tumor"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group)

### 线性模型拟合
fit <- lmFit(exprSet,design)
### 贝叶斯检验
fit2 <- eBayes(fit)
### 输出差异分析结果,其中coef的数目不能超过design的列数
allDiff=topTable(fit2,adjust='fdr',coef=2,number=Inf) 

### 使用一个新的函数tibblelibrary(dplyr)
library(tibble)

diffLab_p1 <- allDiff %>% 
  rownames_to_column("symbol") %>% 
  filter(logFC >1 & adj.P.Val < 0.05) %>% 
  arrange(adj.P.Val) # 根据p值从小到大排序;结果是正向表达的

diffLab_n1 <- allDiff %>% 
  rownames_to_column("symbol") %>% 
  filter(logFC < -1 & adj.P.Val < 0.05) %>% 
  arrange(adj.P.Val) # 根据p值从小到大排序;结果是负向表达的save(diffLab_p1, diffLab_n1, file = "dataset1_diff.Rdata") # 保存结果#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 单独做第二个
rm(list = ls())
load(file = "dataset2.Rdata")

exprSet = exprSet2
boxplot(exprSet,outline=FALSE, notch=T, las=2)
### 组间校正library(limma) 
exprSet=normalizeBetweenArrays(exprSet)
boxplot(exprSet,outline=FALSE, notch=T, las=2)
### 自动log化
ex <- exprSet
qx <- as.numeric(quantile(ex, c(0., 0.25, 0.5, 0.75, 0.99, 1.0), na.rm=T))
LogC <- (qx[5] > 100) ||
  (qx[6]-qx[1] > 50 && qx[2] > 0) ||
  (qx[2] > 0 && qx[2] < 1 && qx[4] > 1 && qx[4] < 2)
if (LogC) { 
  ex[which(ex <= 0)] <- NaN
  exprSet <- log2(ex)
  print("log2 transform finished")
}else{
  print("log2 transform not needed")
}

group <- pheno2
 ## 分组变成向量,并且限定leves的顺序
 ## levels里面:把对照组放在前面group <- factor(group,levels = c("normal","tumor"),ordered = F)
 ## 构建比较矩阵
design <- model.matrix(~group)

### 线性模型拟合
fit <- lmFit(exprSet,design)
### 贝叶斯检验
fit2 <- eBayes(fit)
### 输出差异分析结果,其中coef的数目不能操过design的列数
allDiff=topTable(fit2,adjust='fdr',coef=2,number=Inf) 

### 使用一个新的函数tibblelibrary(dplyr)
library(tibble)

diffLab_p2 <- allDiff %>% 
  rownames_to_column("symbol") %>% 
  filter(logFC >1 & adj.P.Val < 0.05) %>% 
  arrange(adj.P.Val) # 根据p值从小到大排序;结果是正向表达的

diffLab_n2 <- allDiff %>% 
  rownames_to_column("symbol") %>% 
  filter(logFC < -1 & adj.P.Val < 0.05) %>% 
  arrange(adj.P.Val) # 根据p值从小到大排序;结果是负向表达的save(diffLab_p2, diffLab_n2, file = "dataset2_diff.Rdata") # 保存结果#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 用RobustRankAggreg包
rm(list = ls())
load(file = "dataset1_diff.Rdata")
load(file = "dataset2_diff.Rdata")

library(RobustRankAggreg)

### 高表达的差异基因
upList = list(dataset1 = diffLab_p1$symbol, dataset2 = diffLab_p2$symbol) # 有更多的芯片就在逗号后面加同样格式的dataset3、dataset4这样
upMatrix = rankMatrix(upList)
upresults = aggregateRanks(rmat=upMatrix)
colnames(upresults)=c("symbol","Pvalue")

### 低表达的差异基因
downList = list(dataset1 = diffLab_n1$symbol,dataset2 = diffLab_n2$symbol)
downMatrix = rankMatrix(downList)
downresults = aggregateRanks(rmat=downMatrix)
colnames(downresults)=c("symbol","Pvalue")

#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#### 作图验证load(file = "dataset1.Rdata")
load(file = "dataset2.Rdata")

library(limma) 
exprSet1=normalizeBetweenArrays(exprSet1)
dd1 <- data.frame(group=pheno1,t(exprSet1))
exprSet2=normalizeBetweenArrays(exprSet2)
dd2 <- data.frame(group=pheno2,t(exprSet2))
### 两个数据合并到一起
dd <- cbind(sample = c(rep("data1",nrow(dd1)),rep("data2",nrow(dd2))),
            rbind(dd1,dd2)
)
### 有个技巧:看不懂的话就把c(rep("data1",nrow(dd1)),rep("data2",nrow(dd2)))运行一下,就明白了### 运行test <- dd[,1:10]看看,可以看到数据合并到一起了### 开始画图library(ggplot2)
library(ggpubr)
my_comparisons <- list(
  c("tumor", "normal")
)
ggboxplot(
  dd, x = "group", y = "IGF1", # 这个IGF1是点upresults挑出来的,也可以从downresults里面挑基因!!!
  color = "group", palette = c("#00AFBB", "#E7B800"),
  add = "jitter"
)+
  stat_compare_means(comparisons = my_comparisons, method = "t.test")+
  facet_grid(.~sample)
### 其实最后就是从upresults或downresults里面挑一个基因### 然后在画图代码的 y = "IGF1" 这一块地方改就可以了,就能够看到结果### 结果图可以自己修饰,可以变得很好看
上一篇下一篇

猜你喜欢

热点阅读