title: DALS026-批次效应02-发现批次效应
date: 2019-08-26 12:0:00
type: "tags"
tags:
- 批次效应
categories: - Data Analysis for the life sciences
前言
这一部分是《Data Analysis for the life sciences》的第10章批次效应的第2小节，这一部分的主要内容涉及批次效应(Batch Effects)的发现与处理，有关这一部分Rmarkdown文档参见作者的Github。
前面我们已经介绍过了PCA，我们在实际运用过程中就可以使用PCA来进行探索性数据分析了。为了说明这一点，我们将会使用一个实际中的数据集，出于我们教学的目的，这个数据还是原始数据，并没有经过数据清洗。我们首先从公共数据库中下载这个原始数据，接着你要做的就是预处理这些数据，并使用Bioconductor中的一个包进行后续的数据分析。
基因表达数据
第一步，下载数据，如下所示：
library(rafalib)
library(Biobase)
# devtools::install_github("genomicsclass/GSE5859")
library(GSE5859) ##Available from GitHub
data(GSE5859)
注：这里书本中有所出入，
第二步，数据探索。这里先从探索样本相关性矩阵开始，我们注意到有一对样本的相关性是1.这就问题时着有一个样本被上传到了公共数据库2次，但是上传后的名称不同，下面的代码将会剔除这个样本，如下所示：
cors <- cor(exprs(e))
Pairs=which(abs(cors)>0.9999,arr.ind=TRUE)
out = Pairs[which(Pairs[,1]<Pairs[,2]),,drop=FALSE]
if(length(out[,2])>0) e=e[,-out[2]]
还可以移除控制组的探针名，如下所示：
out <- grep("AFFX",featureNames(e))
e <- e[-out,]
第三步，处理数据。现在我们创建一个去趋势(detrended)基因表达数据矩阵，并从样本注释表中提取日期与结果，如下所示：
y <- exprs(e)-rowMeans(exprs(e))
dates <- pData(e)$date
eth <- pData(e)$ethnicity
原始数据集中不包括样本信息中的性别。但是，我们为了出于教学的目的，我们使用下面的数据来研究一下这个性别问题，也就是说，在下面的代码中，我们会展示一下如何预测每个样本的性别。这种计算的基本思想就是观察Y染色体中基因的中位数基因表达水平。男性的这个数字应该更高。为此，我们需要上传一个注释包，用于提供这个实验中所用平台的一些特征信息，如下所示：
annotation(e)
结果如下所示：
> annotation(e)
[1] "hgfocus"
此时，我们需要下载并安装hgfocus.db包，然后提取染色体位置的信息，如下所示：
map2gene <- mapIds(hgfocus.db, keys=featureNames(e),
column="ENTREZID", keytype="PROBEID",
multiVals="first")
library(Homo.sapiens)
map2chr <- mapIds(Homo.sapiens, keys=map2gene,
column="TXCHROM", keytype="ENTREZID",
multiVals="first")
chryexp <- colMeans(y[which(unlist(map2chr)=="chrY"),])
如果我们创建Y染色体中位数基因表达水平的直方图，我们就能清楚地看到差异，如下所示：
mypar()
hist(chryexp)
现在我们预测一下性别，如下所示：
sex <- factor(ifelse(chryexp<0,"F","M"))
计算主成分
现在我们计算一下主成分，如下所示：
s <- svd(y)
dim(s$v)
结果如下所示：
> s <- svd(y)
> dim(s$v)
[1] 207 207
我们也可以使用prcomp()函数来创建一个主成分对象。
变异解释
第一步就是解释由结构(structure)诱导的样本的相关性程度是什么样的，如下所示：
library(RColorBrewer)
cols=colorRampPalette(rev(brewer.pal(11,"RdBu")))(100)
image ( cor(y) ,col=cols,zlim=c(-1,1))
image
上图显示了相关性。每个小单元络的i与j代表了样本i和样本j的相关性。红色表示高，白色表示0，蓝色表示低。
这时我们使用了术语结构(structure)，结构是指，如果样本实际上是相互独立时我们所能发现的偏差。从上面图片上我们可以明显看到，样本实际上有分组，也就是说，不同组内的样本相关性比组外的更强。
我们需要生成一个简单的探索性图来确定我们㙘多少主成分来描述这种结构，这就是方差解释图。 如果数据是独立的，那么方差的解释就如下所示：
y0 <- matrix( rnorm( nrow(y)*ncol(y) ) , nrow(y), ncol(y) )
d0 <- svd(y0)$d
plot(d0^2/sum(d0^2),ylim=c(0,.25))
image
事实上，我们看到的方差解释图是下面的这个样子：
plot(s$d^2/sum(s$d^2))
image
至少有20个PC高于我们对独立数据的预期。我们下一步就是尝试用检测的变量来解释这些PC。这些PC是由种族(ethnicity)，性别(sex)还是时间(date)或其它的因素驱动的吗？
MDS图
如前面一样，我们可以先用MDS图来探索一下数据，回答上述提到的问题。探索感兴趣的变量和PC之间的关系的一种方法就是使用颜色来表示这些变量，例如，以下是使用表示了颜色来标记种族(ethnicity)这个变量，通过前两个PC来展示的数据结果：
cols = as.numeric(eth)
mypar()
plot(s$v[,1],s$v[,2],col=cols,pch=16,
xlab="PC1",ylab="PC2")
legend("bottomleft",levels(eth),col=seq(along=levels(eth)),pch=16)
image
从上图来看，第1 PC与种族(ethnicity)有着很强的联系。但是，我们也会看到一些橙色的点有的形成了亚簇(subslusters)。我们从以前的预分析中也知道，种族(ethnicity)和预处理时间(preprocessing date)有相关性，如下所示：
year = factor(format(dates,"%y"))
table(year,eth)
结果如下所示：
> table(year,eth)
eth
year ASN CEU HAN
02 0 32 0
03 0 54 0
04 0 13 0
05 80 3 0
06 2 0 23
因此，我们通过与前面相同的图来研究一下，日期作为主要变异来源的可能性，在下面的图形中，我们使用颜色来表示年，如下所示：
cols = as.numeric(year)
mypar()
plot(s$v[,1],s$v[,2],col=cols,pch=16,
xlab="PC1",ylab="PC2")
legend("bottomleft",levels(year),col=seq(along=levels(year)),pch=16)
image
从上面图形我们看到，日期（以年为单位）也与第1PC非常相关。那么到底是哪个变量促进了这种情况呢？由于存在着很高的混杂(confounding)效应，现在还不清楚是哪个因素起了重要作用。但是，在解决这个问题方面，我们还会进一步探索数据。
PC箱线图
样本之间的相关性的图形可以展示出一个复杂的结构，它似乎有5个以的因素（其中一个是年份）参与其中。很明显，这种复杂程度远非种族(ethnicity)这一个因素能解释的。我们此时还探索一下月份之间的相关性，如下所示：
month <- format(dates,"%y%m")
length( unique(month))
variable <- as.numeric(month)
mypar(2,2)
for(i in 1:4){
boxplot(split(s$v[,i],variable),las=2,range=0)
stripchart(split(s$v[,i],variable),add=TRUE,vertical=TRUE,pch=1,cex=.5,col=1)
}
一共有21个月份，下图是按照不同月份划分场次层后，根据第1PC到第4PC来绘制的箱线图，如下所示：
image
从上图我们可以看到，月份与第1PC有着非常强烈的相关性，即使按照种族(ethnicity)和其它因素来划分层次，也是如此。我们要知道，2002-2004之间处理的样本都来自于同一种族群体。在这样的情况下，我们可以使用方差分析来查看一下PC与哪个月份相关，如下所示：
corr <- sapply(1:ncol(s$v),function(i){
fit <- lm(s$v[,i]~as.factor(month))
return( summary(fit)$adj.r.squared )
})
mypar()
plot(seq(along=corr), corr, xlab="PC")
image
从上图我们可以看到，第1 PC的相关性非常强，而对于前20左右的PC，相关性较强。我们还可以计算一下月份内与月份之间的F统计量，如下所示：
Fstats<- sapply(1:ncol(s$v),function(i){
fit <- lm(s$v[,i]~as.factor(month))
Fstat <- summary(aov(fit))[[1]][1,4]
return(Fstat)
})
mypar()
plot(seq(along=Fstats),sqrt(Fstats))
p <- length(unique(month))
abline(h=sqrt(qf(0.995,p-1,ncol(s$v)-1)))
image
上图展示的是，方差分析的F平方根，用于解释PC与月份的关系。
至此为止，我们就了解了如何使用PCA联合EDA来做为一个强大的功能检测并理解批次效应的。在后面的部分里，我们将会了解如何使用PC用于因子分析(factor analysis)，用于改进模型估计。
练习
P431
网友评论