# mean,median,max,min,sd,var,mad
# apply()函数对每一行重复计算；sort()排序，默认升序
# tail()函数指取处理过的数据集的后50个
g_mean <- apply(exprSet,1,mean)
g_median <- apply(exprSet,1,median)
g_max <- apply(exprSet,1,max)
g_min <- apply(exprSet,1,min)
g_sd <- apply(exprSet,1,sd)
g_var <-apply(exprSet,1,var)
g_mad <- apply(exprSet,1,mad)
g_sta <- data.frame(g_mean, g_median, g_max, g_min, g_sd, g_var, g_mad)
g_sta <- g_sta[tail(sort(g_sta$g_mad),50),]
# 或者
g_sta <- g_sta[sort(g_sta$g_mad, decreasing = T),]
g_sta[1:50,]
# 两者方法的不同在于获得的50个基因是降序还是升序排列
library(pheatmap)
top50_gene=names(tail(sort(apply(exprSet,1,mad)),50))
top50_exp=exprSet[top50_gene,]
# 对取出的表达矩阵取log2
pheatmap::pheatmap(log2(top50_exp))
pheatmap::pheatmap(top50_exp, scale=c("row"))
### 总思路就是：先建一个包含所有基因名的框架（unique()函数）；
### 然后将所有统计方法匹配到该框架中，存在为1，不存在为0（%in%）
### 利用upset画图
## mean_50<-tail(sort(apply(exprSet, 1, mean)), 50)
## mean_50<-names(mean_50)
# 因为要对多个取，因此直接写个函数重复
# 写个函数，取各种统计情况下的前50个基因的名字
sta_50 <- function(x){
x <- tail(sort(apply(exprSet, 1, x)), 50)
x_50 <- x
return(names(x_50))
}
library(UpSetR)
# 取不含重复的并集，用unique()函数
sta_50_all <- unique(c(sta_50(mean), sta_50(median),sta_50(max),sta_50(min),
sta_50(sd),sta_50(var), sta_50(mad)))
# sta_50_all中包含137个基因名（每个基因都只出现一次）
## 转成upset需要的格式，也就是1和0分别代表，判断其是否在sta_50_all中，用%in%
## 对mean
## u_mean <- ifelse(sta_50_all %in% sta_50(mean), 1, 0)
# 上述函数表示137个基因出现在mean中的，返回1，否则返回0
# 写成函数，一次完成
upset_sta<- function(x){
x<- ifelse(sta_50_all %in% sta_50(x), 1, 0)
u_50<- x
return(u_50)
}
upset_all <- data.frame(sta_50_all, upset_sta(mean),upset_sta(median),
upset_sta(max),upset_sta(min),upset_sta(sd),
upset_sta(var),upset_sta(mad))
# upset_all即为每个基因在总基因名的情况
upset(upset_all, nsets = 7, matrix.color = 'black',
main.bar.color = 'darkblue',sets.bar.color = 'red',
point.size = 2, line.size = 0.8, order.by = "freq",
shade.color = 'red', matrix.dot.alpha = 0.5)
# upsetR中upset()函数的部分参数
nsets: 最多展示多少个集合数据。
nintersects: 展示多少交集。
mb.ratio： 点点图和条形图的比例。
decreasing： 变量如何排序。这里表示freq降序，degree升序
order.by = "freq" #如何排序，这里freq表示从大到小排序展示
rm(list = ls())
options(stringsAsFactors = F)
suppressPackageStartupMessages(library(CLL))
data(sCLLex)
pdata=pData(sCLLex)
## 获得表达矩阵
rm(list = ls())
options(stringsAsFactors = F)
suppressPackageStartupMessages(library(CLL))
data(sCLLex)
exprSet=exprs(sCLLex)
library(hgu95av2.db)
ids<- toTable(hgu95av2SYMBOL)
dat <- as.data.frame(exprSet[match(ids$probe_id, rownames(exprSet)),])
length(which(is.na(dat)))
ids$median <- apply(dat, 1, median)
ids <- ids[order(ids$symbol, ids$median, decreasing = T),]
ids <- ids[!duplicated(ids$symbol),]
dim(ids)
dat<- dat[ids$probe_id,]
rownames(dat)=ids$symbol
exprSet=dat
## 获取分组信息
pdata=pData(sCLLex)
group_list <- as.character(pdata[,2])
## 将临床表型添加表达矩阵，使之成为表头
colnames(exprSet)=paste(group_list, 1:22, sep='')
t.exp <- t(exprSet)
hc <- hclust(dist(t.exp))
plot(as.dendrogram(hc))
#### 使用factoextra包画聚类图
exp_cluster <- t(exprSet)
exp_clust_dist <- dist(exp_cluster, method = 'euclidean')
hc <- hclust(exp_clust_dist,'ward.D')
library(factoextra)
fviz_dend(hc, k=4, cex = 0.5,
k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
color_labels_by_k = TRUE, rect = TRUE)
17.所有样本PCA绘图，同时添加表型信息
## 画主成分分析图需要加载这两个包FactoMineR包和factoextra包
library("FactoMineR")
library("factoextra")
# 将表达矩阵以表格形式存储于df中
df=as.data.frame(t(exprSet))
dat.pca <- PCA(df, graph =FALSE)
# 现在dat最后一列是group_list，需要重新赋值给一个dat.pca,这个矩阵是不含有分组信息的
fviz_pca_ind(dat.pca,
geom.ind = "point", # show points only (nbut not "text")
col.ind = group_list, # color by groups
# palette = c("#00AFBB", "#E7B800"),
addEllipses = TRUE, # Concentration ellipses
legend.title = "Groups"
)
18.批量T检验
#将group_list由字符串修改为因子，就可以对分组变量分别取progres.和stable下标
group_list=as.factor(group_list)
group1 = which(group_list == levels(group_list)[1]) # [1]为"progres."
group2 = which(group_list == levels(group_list)[2]) # [2]为"stable"
# which()函数返回下标
# 根据不同的坐标，将表达矩阵分为两个矩阵，progres和stable
dat1 = dat[, group1]
dat2 = dat[, group2]
dat = cbind(dat1, dat2)
# 对每一个基因进行t检验，根据group_list对样本分组
pvals = apply(exprSet, 1, function(x){
t.test(as.numeric(x)~group_list)$p.value # 对结果只取p值
})
# 对p值校正
p.adj = p.adjust(pvals, method = "BH")
# 计算progres和stable两个矩阵每一行的均值
avg_1 = rowMeans(dat1)
avg_2 = rowMeans(dat2)
# 两矩阵均值相减，取对数值，看差异
log2FC = avg_2-avg_1
# 将两矩阵均值，均值差，P值及校正过的p值置于同一矩阵
DEG_t.test = cbind(avg_1, avg_2, log2FC, pvals, p.adj)
# 按p值排序，默认从小到大
DEG_t.test=DEG_t.test[order(DEG_t.test[,4]),]
DEG_t.test=as.data.frame(DEG_t.test) # 改为数据框格式
head(DEG_t.test)
19.使用limma包筛选差异DEGs
### 第一步，构建设计矩阵（design matrix）
library(limma)
# 构建矩阵
design <- model.matrix(~0+factor(group_list))
# 对矩阵填充列名和行名
colnames(design) <- levels(factor(group_list))
rownames(design) <- colnames(exprSet)
design
# 对表达矩阵和设计矩阵取回归，存储于fit中（不知道为什么）
fit <- lmFit(exprSet, design)
### 第二步：构建比较矩阵
# 比较矩阵
contrast.matrix <- makeContrasts(paste0(unique(group_list),
collapse = '-'), levels = design)
# 比较差异
fit2 <- contrasts.fit(fit, contrast.matrix)
fit3 <- eBayes(fit2)
##eBayes() with trend=TRUE
### 第三步：获取差异表达矩阵nrDEG
tempOutput <- topTable(fit3, coef = 1, n=Inf)
# 检查是否有缺失值，若有，则删除
nrDEG <- na.omit(tempOutput)
dim(tempOutput)
dim(nrDEG)
head(nrDEG)
#write.csv(nrDEG,"limma_notrend.results.csv",quote = F)
### 第四步：画火山图
## 首先设定阈值，界定上调下调和不表达的基因
DEG <- nrDEG
logFC_cutoff <- with(DEG, mean(abs(logFC))+2*sd(abs(logFC)))
# ifelse判断，返回因子类型 "DOWN、UP、NOT"
DEG$change = as.factor(ifelse(DEG$P.Value < 0.05 & abs(DEG$logFC) > logFC_cutoff,
ifelse(DEG$logFC > logFC_cutoff ,'UP','DOWN'),'NOT'))
## 然后设定火山图标题
this_tile <- paste0('Cutoff for logFC is ',round(logFC_cutoff,3),
'\nThe number of up gene is ',nrow(DEG[DEG$change =='UP',]) ,
'\nThe number of down gene is ',nrow(DEG[DEG$change =='DOWN',]))
## 接着，画图
g = ggplot(data=DEG, aes(x=logFC, y=-log10(P.Value), color=change)) +
geom_point(alpha=0.4, size=1.75) +
theme_set(theme_set(theme_bw(base_size=20)))+
xlab("log2 fold change") + ylab("-log10 p-value") +
ggtitle( this_tile ) + theme(plot.title = element_text(size=15,hjust = 0.5))+
scale_colour_manual(values = c('blue','black','red'))
## corresponding to the levels(res$change)
print(g)
## last but not least，画个更漂亮的图
P_volcano=ggplot(DEG,aes(x=logFC,y=-log10(P.Value)))+
geom_point(aes(color=change))+
#设置点的颜色
scale_color_manual(values =c("UP" = "red", "DOWN" = "blue", "NOT" = "grey"))+
labs(x="log2FC",y="-log10FDR")+
#增加阈值线:分别对应FDR=0.05,|log2FC|=1
geom_hline(yintercept=-log10(0.05),linetype=4)+
geom_vline(xintercept=c(-1,1),linetype=4)+
xlim(-3,3)+
theme(plot.title = element_text(size = 25,face = "bold", vjust = 0.5, hjust = 0.5),
legend.title = element_blank(),
legend.text = element_text(size = 15, face = "bold"),
legend.position = 'right',
legend.key.size=unit(0.8,'cm'),
axis.ticks.x=element_blank(),
axis.text.x=element_text(size = 15,face = "bold", vjust = 0.5, hjust = 0.5),
axis.text.y=element_text(size = 15,face = "bold", vjust = 0.5, hjust = 0.5),
axis.title.x = element_text(size = 15,face = "bold", vjust = 0.5, hjust = 0.5),
axis.title.y = element_text(size = 15,face = "bold", vjust = 0.5, hjust = 0.5),
panel.background = element_rect(fill = "transparent",colour = "black"),
panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
plot.background = element_rect(fill = "transparent",colour = "black"))
P_volcano
20.比较T检验和limma结果
# 比较下面两个矩阵中的p值
head(nrDEG)
head(DEG_t.test)
# 将limma生成的nrDEG与t检验的矩阵基因行排列相同
DEG_t.test=DEG_t.test[rownames(nrDEG),]
## 对logFC画散点图
plot(DEG_t.test[,3],nrDEG[,1])
# 可以看到，DEG_t.test中的log2FC与nrDEG中的log2FC是相反的
# 可以看到使用limma包和t.test本身的p值差异尚可接受
## 对p值画散点图
plot(DEG_t.test[,4],nrDEG[,4])
# 可以看到使用limma包和t.test本身的p值差异尚可接受
## 对log10(p)画散点图
plot(-log10(DEG_t.test[,4]),-log10(nrDEG[,4]))
### 找3个基因，比较它们之间的差异
exprSet['GAPDH',]
exprSet['ACTB',]
exprSet['DLEU1',]
library(ggplot2)
library(ggpubr)
my_comparisons <- list(c("stable", "progres."))
dat=data.frame(group=group_list,
sampleID= names(exprSet['DLEU1',]),
values= as.numeric(exprSet['DLEU1',]))
ggboxplot( dat, x = "group", y = "values",
color = "group", add = "jitter")+
stat_compare_means(comparisons = my_comparisons, method = "t.test")
### 画热图，比较
## heatmap
library(pheatmap)
choose_gene=head(rownames(nrDEG),25)
# 选择前25个进行比较，head()将返回前25个的基因名
choose_matrix=exprSet[choose_gene,]
# 对获得的矩阵进行处理，以画热图
choose_matrix=t(scale(t(choose_matrix)))
pheatmap(choose_matrix)