教程對應B站:【生信技能樹】生信人應該這樣學R語言
配套資料:B站的11套生物信息學公益視頻配套講義、練習題及思維導圖
先仔細觀看視頻,理解代碼含義
題目
鏈接:http://www.bio-info-trainee.com/3409.html
- 安裝包
- 數據處理
- 數據分析
- 差異分析
簡書也可以左側目錄欄,效果如下,簡書上有程序作者寫的教程,我覺得很方便,推薦給大家。
安裝包
1、安裝一些R包:
數據包:ALL, CLL, pasilla, airway
軟件包:limma,DESeq2,clusterProfiler
工具包:reshape2
繪圖包:ggplot2
不同領域的R包使用頻率不一樣,在生物信息學領域,尤其需要掌握bioconductor系列包。
對應視頻教程:https://www.bilibili.com/video/av25643438/?p=22
菜鳥團文字教程:http://www.bio-info-trainee.com/1565.html
library()函數檢查包是否可運行
數據處理
提取表達矩陣
2、了解ExpressionSet對象,比如CLL包里面就有data(sCLLex) ,找到它包含的元素,提取其表達矩陣(使用exprs函數),查看其大小
3、了解 str,head,help函數,作用于 第二步提取到的表達矩陣
參考:http://www.bio-info-trainee.com/bioconductor_China/software/limma.html
參考:https://github.com/bioconductor-china/basic/blob/master/ExpressionSet.md
suppressPackageStartupMessages(library(CLL))
data("sCLLex")
# 獲得表達矩陣
exprSet = exprs(sCLLex)
str(exprSet) # structure
head(exprSet) # 前六行
dim(exprSet) # 包含了12625個探針,22個樣本
sampleNames(sCLLex) # 查看樣本編號
varMetadata(sCLLex) # 查看標簽描述(表型變量)
pd = pData(sCLLex) # 查看樣本分組情況
Disease = pd[,2]
table(Disease)
## Disease
## progres. stable
## 14 8
了解hgu95av2.db
包
4、安裝并了解hgu95av2.db
包,看看 ls("package:hgu95av2.db") 后顯示的哪些變量?
鏈接:http://www.bio-info-trainee.com/tag/hgu95av2-db
hgu95av2.db
是一個關于 hgu95av2 芯片的注釋包
suppressPackageStartupMessages(library(hgu95av2.db))
ls("package:hgu95av2.db")
## [1] "hgu95av2" "hgu95av2_dbconn"
## [3] "hgu95av2_dbfile" "hgu95av2_dbInfo"
## [5] "hgu95av2_dbschema" "hgu95av2.db"
## [7] "hgu95av2ACCNUM" "hgu95av2ALIAS2PROBE"
## [9] "hgu95av2CHR" "hgu95av2CHRLENGTHS"
## [11] "hgu95av2CHRLOC" "hgu95av2CHRLOCEND"
## [13] "hgu95av2ENSEMBL" "hgu95av2ENSEMBL2PROBE"
## [15] "hgu95av2ENTREZID" "hgu95av2ENZYME"
## [17] "hgu95av2ENZYME2PROBE" "hgu95av2GENENAME"
## [19] "hgu95av2GO" "hgu95av2GO2ALLPROBES"
## [21] "hgu95av2GO2PROBE" "hgu95av2MAP"
## [23] "hgu95av2MAPCOUNTS" "hgu95av2OMIM"
## [25] "hgu95av2ORGANISM" "hgu95av2ORGPKG"
## [27] "hgu95av2PATH" "hgu95av2PATH2PROBE"
## [29] "hgu95av2PFAM" "hgu95av2PMID"
## [31] "hgu95av2PMID2PROBE" "hgu95av2PROSITE"
## [33] "hgu95av2REFSEQ" "hgu95av2SYMBOL"
## [35] "hgu95av2UNIGENE" "hgu95av2UNIPROT"
as.list(hgu95av2ENZYME[1]) # key為探針號,value為酶
## $`1000_at`
## [1] "2.7.11.24"
get(featureNames(sCLLex),hgu95av2ENZYME, mode="any", inherits=TRUE)
## [1] "2.7.11.24"
# get()、mget()都可以取
5、理解head(toTable(hgu95av2SYMBOL))
的用法,找到TP53基因對應的探針I(yè)D。
ids <- toTable(hgu95av2SYMBOL)
# 兩種寫法
ids[which(ids[,2]=="TP53"),]
ids[grep("^TP53$",ids$symbol),]
## probe_id symbol
## 966 1939_at TP53
## 997 1974_s_at TP53
## 1420 31618_at TP53
探針與基因的關系
6、理解探針與基因的對應關系,總共多少個基因,基因最多對應多少個探針,是哪些基因,是不是因為這些基因很長,所以在其上面設計多個探針呢?
class(hgu95av2SYMBOL)
## [1] "ProbeAnnDbBimap"
## attr(,"package")
## [1] "AnnotationDbi"
# hgu95av2SYMBOL is the Bimap Objects
# 2 sets of objects: the left objects and the right objects.
# 詳解:https://www.rdocumentation.org/packages/AnnotationDbi/versions/1.34.4/topics/Bimap
summary(hgu95av2SYMBOL)
# 探針I(yè)D總數為12625,能匹配上的為11460;基因總數為61050,實際為8585
mapped_probes <- mappedkeys(hgu95av2SYMBOL)
count.mappedkeys(hgu95av2SYMBOL)
## [1] 11460
ids <- toTable(hgu95av2SYMBOL)
colnames(ids)
## [1] "probe_id" "symbol"
# %>% 使用管道操作函數依次將左側獨享作為參數傳入右側函數內部,層層傳遞,不創(chuàng)建任何中間變量
suppressPackageStartupMessages(library(stringr))
unique(ids$symbol) %>% length() # unique() 避免重復基因
## [1] 8585
table(ids$symbol) %>% sort() %>% tail() # 基因最多對應8個探針
##
## YME1L1 GAPDH INPP4A MYB PTGER3 STAT1
## 7 8 8 8 8 8
table(ids$symbol) %>% table() # 最多有6555個基因對應一個探針
## .
## 1 2 3 4 5 6 7 8
## 6555 1428 451 102 22 16 6 5
7、第二步提取到的表達矩陣是12625個探針在22個樣本的表達量矩陣,找到那些不在 hgu95av2.db 包收錄的對應著SYMBOL的探針。
提示:有1165個探針是沒有對應基因名字的。
# %in% is_in
'%!in%' <- function(x,y)!('%in%'(x,y))
# Lkeys() 得到 left objects 的值
length(Lkeys(hgu95av2SYMBOL)[Rkeys(hgu95av2SYMBOL) %!in% mapped_probes])
# 得到1165個未匹配上的探針I(yè)D
8、過濾表達矩陣,刪除那1165個沒有對應基因名字的探針。
table(rownames(exprSet) %in% mapped_probes)
##
## FALSE TRUE
## 1165 11460
e = exprSet[rownames(exprSet) %in% mapped_probes,]
str(exprSet) # 12625
str(e) # 11460
# e為刪除后的表達矩陣
整合表達矩陣
9、整合表達矩陣,多個探針對應一個基因的情況下,只保留在所有樣本里面平均表達量最大的那個探針。
提示,理解 tapply,by,aggregate,split 函數 , 首先對每個基因找到最大表達量的探針,然后根據得到探針去過濾原始表達矩陣。
# by(data, INDICES, FUN, ..., simplify = TRUE)
# 舉例幫助理解函數,這是整合后的,可拆解理解
rownames(e[4:5,])[which.max(rowMeans(e[4:5,]))]
## [1] "1004_at"
# 數據框用by,向量用tapply
maxid = by(e,ids$symbol,function(x) rownames(x)[which.max(rowMeans(x))])
# aggregate 將數據按行分組,對每一組數據進行函數統(tǒng)計
uniid = as.character(maxid)
uni_e = e[rownames(e) %in% uniid,]
str(uni_e) # 8585
10、把過濾后的表達矩陣更改行名為基因的symbol,因為這個時候探針和基因是一對一關系了。
rownames(uni_e) = ids[match(rownames(uni_e),ids$probe_id),2]
suppressPackageStartupMessages(library(reshape2))
# match exprSet
m_e = melt(uni_e)
colnames(m_e) = c('symbol','sample','value')
m_e$group = rep(Disease,each=nrow(uni_e))
數據分析
基因數據分析
11、對第10步得到的表達矩陣進行探索,先畫第一個樣本的所有基因的表達量的boxplot,hist,density,然后畫所有樣本的這些圖
參考:http://bio-info-trainee.com/tmp/basic_visualization_for_expression_matrix.html 理解ggplot2的繪圖語法,數據和圖形元素的映射關系
suppressPackageStartupMessages(library(ggplot2))
ggplot(m_e,aes(x=sample,y=value,fill=group)) + geom_boxplot()
ggplot(m_e,aes(value,fill=group)) + geom_histogram(bins = 200)+facet_wrap(~sample, nrow = 4)
ggplot(m_e,aes(value,col=group)) + geom_density()
12、理解統(tǒng)計學指標mean,median,max,min,sd,var,mad并計算出每個基因在所有樣本的這些統(tǒng)計學指標,最后按照mad值排序,取top 50 mad值的基因,得到列表。
注意:這個題目出的并不合規(guī),請仔細看。
# 平均值、中位數、最大值、最小值、標準差、變量、中位數絕對偏差
e_mean = tail(sort(apply(uni_e,1,mean)),50)
e_median = tail(sort(apply(uni_e,1,median)),50)
e_max = tail(sort(apply(uni_e,1,max)),50)
e_min = tail(sort(apply(uni_e,1,min)),50)
e_sd = tail(sort(apply(uni_e,1,sd)),50)
e_var = tail(sort(apply(uni_e,1,var)),50)
e_mad = tail(sort(apply(uni_e,1,mad)),50)
13、根據第12步驟得到top 50 mad值的基因列表來取表達矩陣的子集,并且熱圖可視化子表達矩陣。試試看其它5種熱圖的包的不同效果。
# 做熱圖之前需要將數據中心化、標準化
top50_gene = tail(sort(apply(uni_e,1,mad)),50)
top50_matrix = uni_e[top50_gene,]
top50_matrix2 = t(scale(t(top50_matrix))) # scale() 對數據進行標準化
# 標準化是原始分數減去平均數然后除以標準差,中心化是原始分數減去平均數。一般流程為先中心化再標準化
14、取不同統(tǒng)計學指標mean,median,max,mean,sd,var,mad的各top50基因列表,使用UpSetR包來看他們之間的overlap情況。
suppressPackageStartupMessages(library("UpSetR"))
all = c(names(e_mean),names(e_median),names(e_max),names(e_min),names(e_sd),names(e_var),names(e_mad)) %>% unique()
e_all = data.frame(all,
e_mean=ifelse(all %in% names(e_mean),1,0),
e_median=ifelse(all %in% names(e_median),1,0),
e_max=ifelse(all %in% names(e_max),1,0),
e_min=ifelse(all %in% names(e_min),1,0),
e_sd=ifelse(all %in% names(e_sd),1,0),
e_var=ifelse(all %in% names(e_var),1,0),
e_mad=ifelse(all %in% names(e_mad),1,0)
)
upset(e_all,nsets = 7,sets.bar.color = "#BD1111")
樣本數據分析
15、在第二步的基礎上面提取CLL包里面的data(sCLLex) 數據對象的樣本的表型數據。
pd = pData(sCLLex)
group_list = as.character(pd[,2])
table(group_list)
## group_list
## progres. stable
## 14 8
16、對所有樣本的表達矩陣進行聚類并且繪圖,然后添加樣本的臨床表型數據信息(更改樣本名)
clust = t(exprSet)
rownames(clust) = colnames(exprSet)
clust_dist = dist(clust,method = "euclidean")
hc = hclust(clust_dist,"ward.D")
suppressPackageStartupMessages(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分析并且繪圖,同樣要添加表型信息。
pca_data <- prcomp(t(exprSet),scale=TRUE)
pcx <- data.frame(pca_data$x)
pcr <- cbind(samples=rownames(pcx),group_list, pcx)
ggplot(pcr, aes(PC1, PC2))+geom_point(size=5, aes(color=group_list)) +
geom_text(aes(label=samples),hjust=-0.1, vjust=-0.3)
18、根據表達矩陣及樣本分組信息進行批量T檢驗,得到檢驗結果表格
gl = as.factor(group_list)
group1 = which(group_list == levels(gl)[1])
group2 = which(group_list == levels(gl)[2])
et1 = e[,group1]
et2 = e[,group2]
data_t = cbind(et1,et2)
pvals = apply(e, 1, function(x){
t.test(as.numeric(x)~group_list)$p.value
})
p.adj = p.adjust(pvals, method = "BH")
data_mean_1 = rowMeans(et1)
#progres是對照組
data_mean_2 = rowMeans(et2)
#stable是使用藥物處理后的——處理組
log2FC = data_mean_2-data_mean_1
DEG_t.test = cbind(data_mean_1, data_mean_2, log2FC, pvals, p.adj)
DEG_t.test=DEG_t.test[order(DEG_t.test[,4]),] #從小到大排序
DEG_t.test=as.data.frame(DEG_t.test)
head(DEG_t.test)
## data_mean_1 data_mean_2 log2FC pvals p.adj
## 36129_at 7.875615 8.791753 0.9161377 1.629755e-05 0.1867699
## 37676_at 6.622749 7.965007 1.3422581 4.058944e-05 0.2211373
## 33791_at 7.616197 5.786041 -1.8301554 6.965416e-05 0.2211373
## 39967_at 4.456446 2.152471 -2.3039752 8.993339e-05 0.2211373
## 34594_at 5.988866 7.058738 1.0698718 9.648226e-05 0.2211373
## 32198_at 4.157971 3.407405 -0.7505660 2.454557e-04 0.3192169
差異分析
19、使用limma包對表達矩陣及樣本分組信息進行差異分析,得到差異分析表格,重點看logFC和P值,畫個火山圖(就是logFC和-log10(P值)的散點圖。)。
suppressPackageStartupMessages(library(limma))
design1=model.matrix(~factor(group_list))
colnames(design1)=levels(factor(group_list))
rownames(design1)=colnames(exprSet)
fit1 = lmFit(exprSet,design1)
fit1=eBayes(fit1)
options(digits = 3)
mtx1 = topTable(fit1,coef=2,adjust='BH',n=Inf)
# topTable 默認顯示前10個基因的統(tǒng)計數據;使用選項n可以設置,n=Inf就是不設上限,全部輸出
DEG_mtx1 = na.omit(mtx1) #去除缺失值
head(DEG_mtx1)
## logFC AveExpr t P.Value adj.P.Val B
## 39400_at 1.028 5.62 5.84 8.34e-06 0.0334 3.23
## 36131_at -0.989 9.95 -5.77 9.67e-06 0.0334 3.12
## 33791_at -1.830 6.95 -5.74 1.05e-05 0.0334 3.05
## 1303_at 1.384 4.46 5.73 1.06e-05 0.0334 3.04
## 36122_at -0.780 7.26 -5.14 4.21e-05 0.1062 1.93
## 36939_at -2.547 6.92 -5.04 5.36e-05 0.1128 1.74
DEG=DEG_mtx1
logFC_cutoff <- with(DEG,mean(abs(logFC)) + 2*sd(abs(logFC)) )
DEG$result = 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), #round保留小數位數
'\nThe number of up gene is ',nrow(DEG[DEG$result =='UP',]) ,
'\nThe number of down gene is ',nrow(DEG[DEG$result =='DOWN',])
)
ggplot(data=DEG, aes(x=logFC, y=-log10(P.Value), color=result)) +
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'))
20、對T檢驗結果的P值和limma包差異分析的P值畫散點圖,看看哪些基因相差很大?
DEG_t.test = DEG_t.test[rownames(DEG_mtx1),]
plot(DEG_t.test[,3],DEG_mtx1[,1])
plot(DEG_t.test[,4],DEG_mtx1[,4])
plot(-log10(DEG_t.test[,4]),-log10(DEG_mtx1[,4]))
更多學習資源:
生信技能樹公益視頻合輯
生信技能樹簡書賬號
生信工程師入門最佳指南
生信技能樹全球公益巡講
招學徒
...
你的宣傳能讓數以萬計的初學者找到他們的家,技能樹平臺一定不會辜負每一個熱愛學習和分享的同道中人 ??