R語言作業(yè)-20題

教程對應B站:【生信技能樹】生信人應該這樣學R語言
配套資料:B站的11套生物信息學公益視頻配套講義、練習題及思維導圖
先仔細觀看視頻,理解代碼含義

題目

鏈接:http://www.bio-info-trainee.com/3409.html

  • 安裝包
  • 數據處理
  • 數據分析
  • 差異分析

簡書也可以左側目錄欄,效果如下,簡書上有程序作者寫的教程,我覺得很方便,推薦給大家。

目錄.gif

安裝包

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()
20題-基因表達-1.png
20題-基因表達-2.png
20題-基因表達-3.png



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")
20題-統(tǒng)計值.png


樣本數據分析

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)
20題-聚類.png



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)
20題-PCA分析.png



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題-差異火山圖.png



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]))

更多學習資源:
生信技能樹公益視頻合輯
生信技能樹簡書賬號
生信工程師入門最佳指南
生信技能樹全球公益巡講
招學徒
...
你的宣傳能讓數以萬計的初學者找到他們的家,技能樹平臺一定不會辜負每一個熱愛學習和分享的同道中人 ??

?著作權歸作者所有,轉載或內容合作請聯(lián)系作者
平臺聲明:文章內容(如有圖片或視頻亦包括在內)由作者上傳并發(fā)布,文章內容僅代表作者本人觀點,簡書系信息發(fā)布平臺,僅提供信息存儲服務。

推薦閱讀更多精彩內容