### 批次矫正教程（全代码+注释）！！！############################################################################################ 首先需要安装一些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" 这一块地方改就可以了，就能够看到结果### 结果图可以自己修饰，可以变得很好看
