为了完成学徒任务：HCC，CHC，CC这3组，跟healthy的分开比较，然后3个火山图
具体题目参考https://www.jianshu.com/p/d521459ae1d0
操作方法参见https://www.jianshu.com/p/f635f60e1c8a
1. 初始配置
rm(list = ls())
options(stringsAsFactors = F)
library(limma)
library(Glimma)
library(edgeR)
BiocManager::install("Homo.sapiens")
library(Homo.sapiens)
library(biomaRt)#biomaRt主要使用Ensembl基因ID进行检索
2. 数据整合
2.1 读入计数数据
#url <- "https://www.ncbi.nlm.nih.gov/geo/download/?acc=GSE84073&format=file"
#utils::download.file(url, destfile="GSE84073_RAW.tar", mode="wb")
#如果下载全部数据是134.9 MB，下载时间有点长，估计可能因为网络原因出错，因此可以手动下载需要分析的样本并放在当前文件夹
#手动下载的是一个2.8兆的文件
utils::untar("GSE84073_RAW.tar", exdir = ".")#解压缩文件
directory <- "."#设置需要操作的目录
sampleFiles <- grep("Counts",list.files(directory),value=TRUE)#提取文件名称
sampleNames <- sub("(.*)(.gz)", "\\1", sampleFiles)
files <- sampleNames
for(i in paste(files, ".gz", sep=""))
R.utils::gunzip(i, overwrite=TRUE)
files[1]#查看第一个文件名
read.delim(files[1], nrow=5)#查看第一个文件内容
x <- readDGE(files, columns=c(1,3))#将所有文件读入对象DEGLlist
class(x)
dim(x)
#当样本量少的时候可以通过复制来赋值，多的情况下就还是用老师推荐的函数了
#files <- c("GSM2653819_Counts_notmergedTR_Healthy1_Tissue_1.txt", "GSM2653820_Counts_notmergedTR_Healthy1_Tissue_2.txt", ...)
2.2 组织样品信息
- 我们的分析仅包含了此实验中的Healthy、HCC、CHC和CC样品，从sampleFiles可以看到，这些样品来自人的肝脏组织，可以提取不同的疾病表型，由于是不同时期取样，可以提取批次信息。
samplenames <- substring(colnames(x),31, nchar(colnames(x)))
samplenames
colnames(x) <- samplenames
group <- as.factor(rep(c('Healthy','HCC','CHC','CC'),c(4,3,3,4)))
group
x$samples$group <- group
tlist=rep(c("Tissue_1","Tissue_2","Tissue","Tissue"),4)
length(tlist)
tlist=tlist[-c(8,12)]
tlist
lane <- as.factor(tlist)
x$samples$lane <- lane
x$samples
2.3 组织基因注释
- DGEList对象中的第二个数据框名为genes，用于存储与计数矩阵的行相关联的基因水平的信息。 为检索这些信息，我们可以使用包含特定物种信息的包。
- 人类的Homo.sapiens (Bioconductor Core Team 2016a)；或者也可以使用biomaRt 包 (Durinck et al. 2005, 2009)，它通过接入Ensembl genome数据库来进行基因注释。
- 可以检索的信息类型包括基因符号（gene symbols）、基因名称（gene names）、染色体名称和位置（chromosome names and locations）、Entrez基因ID（Entrez gene IDs）、Refseq基因ID（Refseq gene IDs）和Ensembl基因ID（Ensembl gene IDs）等。biomaRt主要使用Ensembl基因ID进行检索。
- 我可以比较使用Homo.sapiens包和biomaRt 包，利用此次数据集中的Entrez基因ID来检索相关的基因符号和染色体信息。
- 先了解一下Homo.sapiens包
Based on genome: hg19
The OrgDb gene id ENTREZID is mapped to the TxDb gene id GENEID .
#Examples
Homo.sapiens
cls <- columns(Homo.sapiens)
cls
cls <- cls[c(1,19,45)]
kts <- keytypes(Homo.sapiens)
kt <- kts[2]
kts
ks <- head(keys(Homo.sapiens, keytype=kts[2]))
ks
res <- select(Homo.sapiens, keys=ks, columns=cls, keytype=kt)
head(res)
经过尝试后发现基本跟小鼠的那个代码差不多
geneid <- rownames(x)
genes <- select(Homo.sapiens, keys=geneid, columns=c("SYMBOL", "TXCHROM"),
keytype="ENSEMBL" )
head(genes)
# #试一下biomart
# ensembl = useMart( "ensembl", dataset = "hsapiens_gene_ensembl" )
# #str(ensembl)
# genemap <- getBM(listAttributes = c("ensembl_gene_id", "entrezgene", "hgnc_symbol"),
# filters = "ensembl_gene_id",
# values = rownames(x),
# mart = ensembl )
# genemap <- genemap[match(rownames(x),genemap$ensembl_gene_id),]
#
# rownames(x) <-genemap$hgnc_symbol
# x <- x[!is.na(rownames(x)),]
# #39597 genes
# x <- x[rownames(x) != "", ]
# #27884 genes
# x <- x[!duplicated(rownames(x)),]
也尝试了 OvCaBiobank/rnaseq/allPatients_deseq.R 没有成功
估计是之前的代码需要更新了。由于我得到的矩阵的基因名称是ENSG开头的，所以只需要把keytype="ENSEMBL"做一下更改即可，虽然只是这一个小地方，花了我整整1个小时才搞明白，就是因为不懂这个包的内容。
- 与任何基因ID一样，Entrez基因ID可能不能一对一地匹配我们想获得的基因信息。在处理之前，检查重复的基因ID和弄清楚重复的来源非常重要。
-
- 为了处理重复的基因ID，我们可以合并来自多重匹配基因的所有染色体信息，比如将基因Gm1987分配到chr4 and chr4_JH584294_random，或选取其中一条染色体来代表具有重复注释的基因。为了简单起见，我们选择后者，保留每个基因ID第一次出现的信息。
genes <- genes[!duplicated(genes$ENSEMBL),]
- 在此例子中，注释与数据对象中的基因顺序是相同的。
- 如果由于缺失和／或重新排列基因ID导致其顺序不一致，可以用match来正确排序基因。
- 然后将基因注释的数据框加入数据对象，数据即被整洁地整理入一个DGEList对象中，它包含原始计数数据和相关的样品信息和基因注释。
x$genes <- genes
x
3. 数据预处理
3.1 原始数据尺度转换
- 在此处，使用
edgeR中的cpm函数将原始计数转换为CPM和log-CPM值。
cpm <- cpm(x)
lcpm <- cpm(x, log=TRUE, prior.count=2)
3.2 删除低表达基因
- 所有数据集中都混有表达的基因与不表达的基因。尽管我们想要检测在一种条件中表达但再另一种条件中不表达的基因，也有一些基因在所有样品中都不表达。
table(rowSums(x$counts==0)==14)
-
edgeR包中的filterByExpr函数提供了自动过滤基因的方法，可保留尽可能多的有足够表达计数的基因。
keep.exprs <- filterByExpr(x, group=group)
x <- x[keep.exprs,, keep.lib.sizes=FALSE]
dim(x)
- 使用这个标准，基因的数量减少到了16088个，约为开始时数量的69%。过滤后的log-CPM值显示出每个样本的分布基本相同（下图B部分）。需要注意的是，从整个DGEList对象中取子集时同时删除了被过滤的基因的计数和其相关的基因信息。过滤后的DGEList对象为留下的基因保留了相对应的基因信息和计数。
- 下方给出的是绘图所用代码。参考之前的学习记录
lcpm.cutoff <- log2(10/M + 2/L)
library(RColorBrewer)
nsamples <- ncol(x)
col <- brewer.pal(nsamples, "Paired")
par(mfrow=c(1,2))
plot(density(lcpm[,1]), col=col[1], lwd=2, ylim=c(0,0.26), las=2, main="", xlab="")
title(main="A. Raw data", xlab="Log-cpm")
abline(v=lcpm.cutoff, lty=3)
for (i in 2:nsamples){
den <- density(lcpm[,i])
lines(den$x, den$y, col=col[i], lwd=2)
}
legend("topright", samplenames, text.col=col, bty="n")
lcpm <- cpm(x, log=TRUE)
plot(density(lcpm[,1]), col=col[1], lwd=2, ylim=c(0,0.26), las=2, main="", xlab="")
title(main="B. Filtered data", xlab="Log-cpm")
abline(v=lcpm.cutoff, lty=3)
for (i in 2:nsamples){
den <- density(lcpm[,i])
lines(den$x, den$y, col=col[i], lwd=2)
}
legend("topright", samplenames, text.col=col, bty="n")
figure1
3.3 归一化基因表达分布
- 在样品制备或测序过程中，不具备生物学意义的外部因素会影响单个样品的表达。比如说，在实验中第一批制备的样品会总体上表达高于第二批制备的样品。假设所有样品表达值的范围和分布都应当相似，需要进行归一化来确保整个实验中每个样本的表达分布都相似。
- 尽管如此，我们依然需要使用
edgeR中的calcNormFactors函数，用TMM(Robinson and Oshlack 2010)方法进行归一化。此处计算得到的归一化系数被用作文库大小的缩放系数。当我们使用DGEList对象时，这些归一化系数被自动存储在x$samples$norm.factors。对此数据集而言，TMM归一化的作用比较温和，这体现在所有的缩放因子都相对接近1。
x <- calcNormFactors(x, method = "TMM")
x$samples$norm.factors
- 为了更好地可视化表现出归一化的影响，我们复制了数据并进行了调整，使得第一个样品的计数减少到了其原始值的5%，而第二个样品增大到了5倍，第11，12增大了2倍。
- 归一化之后就比较整齐了
x2 <- x
x2$samples$norm.factors <- 1
x2$counts[,1] <- ceiling(x2$counts[,1]*0.05)
x2$counts[,2] <- x2$counts[,2]*5
x2$counts[,11] <- x2$counts[,2]*2
x2$counts[,12] <- x2$counts[,2]*2
par(mfrow=c(1,2))
lcpm <- cpm(x2, log=TRUE)
boxplot(lcpm, las=2, col=col, main="")
title(main="A. Example: Unnormalised data",ylab="Log-cpm")
x2 <- calcNormFactors(x2)
x2$samples$norm.factors
lcpm <- cpm(x2, log=TRUE)
boxplot(lcpm, las=2, col=col, main="")
title(main="B. Example: Normalised data",ylab="Log-cpm")
figure 2
3.4 对样本的无监督聚类
在我们看来，用于检查基因表达分析的最重要的探索性图表之一便是MDS图或其余类似的图。这种图表使用无监督聚类方法展示出了样品间的相似性和不相似性，能让我们在进行正式的检验之前对于能检测到多少差异表达基因有个大致概念。理想情况下，样本会在不同的实验组内很好的聚类，且可以鉴别出远离所属组的样本，并追踪误差或额外方差的来源。如果存在技术重复，它们应当互相非常接近。
这样的图可以用
limma中的plotMDS函数绘制。第一个维度表示能够最好地分离样品且解释最大比例的方差的引导性的倍数变化（leading-fold-change），而后续的维度的影响更小，并与之前的维度正交。当实验设计涉及到多个因子时，建议在多个维度上检查每个因子。如果在其中一些维度上样本可按照某因子聚类，这说明该因子对于表达差异有影响，在线性模型中应当将其包括进去。反之，没有或者仅有微小影响的因子在下游分析时应当被剔除。在这个数据集中，可以看出样本在维度1和2能很好地按照实验分组聚类，随后在维度3按照测序道（样品批次）分离（如下图所示）。请记住，第一维度解释了数据中最大比例的方差，需要注意到，当我们向高维度移动，维度上的取值范围会变小。
lcpm <- cpm(x, log=TRUE)
par(mfrow=c(1,2))
col.group <- group
levels(col.group) <- brewer.pal(nlevels(col.group), "Set1")
col.group <- as.character(col.group)
col.lane <- lane
levels(col.lane) <- brewer.pal(nlevels(col.lane), "Set2")
col.lane <- as.character(col.lane)
plotMDS(lcpm, labels=group, col=col.group)
title(main="A. subtype groups")
plotMDS(lcpm, labels=lane, col=col.lane, dim=c(3,4))
title(main="B.tissue times")
figure 3
- 从上图可见，样本的聚类不是太好，先看看结果吧
4. 差异表达分析
4.1 创建设计矩阵和对比
- 在此研究中，我想知道哪些基因在不同亚型之间以不同水平表达。在我们的分析中，假设基础数据是正态分布的，为其拟合一个线性模型。在此之前，需要创建一个包含疾病分类亚型以及样本提取（批次）信息的设计矩阵。
design <- model.matrix(~0+group+lane)
colnames(design) <- gsub("group", "", colnames(design))
design
先模仿看看：
contr.matrix <- makeContrasts(
HealthyvsCC = Healthy - CC,
HealthyvsCHC = Healthy - CHC,
HealthyvsHCC = Healthy - HCC,
levels = colnames(design))
contr.matrix
par(mfrow=c(1,2))
v <- voom(x, design, plot=TRUE)
v
vfit <- lmFit(v, design)
vfit <- contrasts.fit(vfit, contrasts=contr.matrix)
efit <- eBayes(vfit)
plotSA(efit, main="Final model: Mean-variance trend")
summary(decideTests(efit))
tfit <- treat(vfit, lfc=1)
dt <- decideTests(tfit)
summary(dt)
de.common <- which(dt[,1]!=0 & dt[,2]!=0)
length(de.common)
head(tfit$genes$SYMBOL[de.common], n=20)
vennDiagram(dt[,1:2], circle.col=c("turquoise", "salmon"))
write.fit(tfit, dt, file="results.txt")
Healthy.vs.CC <- topTreat(tfit, coef=1, n=Inf)
Healthy.vs.CHC <- topTreat(tfit, coef=2, n=Inf)
head(Healthy.vs.CC)
head(Healthy.vs.CHC)
plotMD(tfit, column=1, status=dt[,1], main=colnames(tfit)[1],
xlim=c(-8,13))
figure 4
这个探索的过程中得到如下结果
> summary(decideTests(efit))
HealthyvsCC HealthyvsCHC HealthyvsHCC
Down 849 408 4
NotSig 13948 15409 16084
Up 1291 271 0
> tfit <- treat(vfit, lfc=1)
> dt <- decideTests(tfit)
> summary(dt)
HealthyvsCC HealthyvsCHC HealthyvsHCC
Down 176 64 0
NotSig 15432 15985 16088
Up 480 39 0
关于火山图，明天再学习进一步美化吧，好困……