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

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

作者: whykm | 来源:发表于2021-02-12 23:50 被阅读0次
    ### 批次矫正教程(全代码+注释)!!!############################################################################################ 首先需要安装一些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" 这一块地方改就可以了,就能够看到结果### 结果图可以自己修饰,可以变得很好看
    

    相关文章

      网友评论

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

          本文链接:https://www.haomeiwen.com/subject/jbajxltx.html