GEO數據庫挖掘—生信技能樹B站視頻

以下是B站生信技能樹GEO數據庫挖掘的課程筆記

主要內容及學習目的：

  • 介紹GEO數據庫：了解數據存放位置；
  • 介紹GSE項目的3種下載方式；
  • 介紹ID轉換：使用R語言技巧實現基因ID之間的轉換，我們下載的數據通常使用的是不同的芯片探針，它們有不同的探針ID號我們需要把它轉化成ENTREZID或SYMBOLID才能被大眾認知；
  • 介紹表達矩陣的相關可視化及歸一化：從GEO數據庫下載的是作者處理好的矩陣，我們需要會判別它是否符合要求，并學會提取分組信息；
  • 比較各組基因的表達量得到差異表達基因list或感興趣基因集；
  • 得到差異表達基因list后做富集分析；
  • 用GSEA軟件做一些圖；

通過閱讀文章提煉GEO數據庫挖掘的脈絡：選擇GSE ---> 得到表達矩陣 ---> control VS treatment 進行差異分析 ---> 得到差異表達基因list ---> 5大數據庫的注釋 ---> PPI等網絡

GEO數據庫挖掘分析思路

接下來我們按照上面的分析思路，一步一步進行講解

1.了解GEO數據庫，找到文章的GSE編號

參考文案：解讀GEO數據存放規律及下載，一文就夠

任何一篇GEO數據挖掘文章，都可以找到它的GSE編號，找到后我們把網址最后的GSE編號修改一下，直接去網頁粘貼并轉到就能看到該編號在GEO數據庫的詳細頁面：
https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE42872

找到文章中的GSE編號

我們看下GEO數據庫的主頁
GEO數據庫主頁

我們只需要知道這三個概念就好：

  • GEO Platform (GPL)
  • GEO Sample (GSM)

  • GEO Series (GSE)


理解起來也很容易。一篇文章可以有一個或者多個GSE數據集，一個GSE數據集里面可以有一個或者多個GSM樣本。而每個數據集都有著自己對應的芯片平臺，就是GPL。


點開后向下滑動找到GPL的表格信息

把GPL表格信息向右滑動，找到gene_assignment那列，把//做為切割符，取出第二個字符就是真正的基因名，這時探針就和基因完美匹配啦~
得到真正的基因名

知道如何找到任何一篇文章的數據存放位置，接下來就要下載數據進行分析了。

2.下載數據

下載數據的3種方式：

一. 直接下載rawdata —— 不推薦使用

二. 從網頁上直接下載表達矩陣 ---> 讀入R里

表達矩陣

表達矩陣下載到本地后要讀入到R里：

a = read.table(file="./GSE42872_series_matrix.txt.gz",
               header = T,sep = "\t",quote = "",fill = T,
               comment.char = "!")

在讀入下載好的表達矩陣時，為什么要加那么多參數才能下載成功？
我們首先需要在電腦上解壓并打開文本文件，根據文件的樣子選擇參數

GSE42872_series_matrix.txt.gz解壓后

我們看a的rowname是行號，沒有意義的，需要轉成探針ID號即a的第一列：rownames(a)= a[,1]
a的第一列就是ID號

> head(a)
  X.ID_REF. X.GSM1052615. X.GSM1052616. X.GSM1052617. X.GSM1052618. X.GSM1052619. X.GSM1052620.
1   7892501       7.24559       6.80686       7.73301       6.18961       7.05335       7.20371
2   7892502       6.82711       6.70157       7.02471       6.20493       6.76554       6.24252
3   7892503       4.39977       4.50781       4.88250       4.36295       4.18137       4.73492
4   7892504       9.48025       9.67952       9.63074       9.69200       9.91324       9.65897
5   7892505       4.54734       4.45247       5.11753       4.87307       5.15505       3.99340
6   7892506       6.80701       6.90597       6.72472       6.77028       6.77058       6.77685
> rownames(a)
   [1] "1"    "2"    "3"    "4"    "5"    "6"    "7"    "8"    "9"    "10"   "11"   "12"   "13"  
> rownames(a)= a[,1]
> head(a)
        X.ID_REF. X.GSM1052615. X.GSM1052616. X.GSM1052617. X.GSM1052618. X.GSM1052619. X.GSM1052620.
7892501   7892501       7.24559       6.80686       7.73301       6.18961       7.05335       7.20371
7892502   7892502       6.82711       6.70157       7.02471       6.20493       6.76554       6.24252
7892503   7892503       4.39977       4.50781       4.88250       4.36295       4.18137       4.73492
7892504   7892504       9.48025       9.67952       9.63074       9.69200       9.91324       9.65897
7892505   7892505       4.54734       4.45247       5.11753       4.87307       5.15505       3.99340
7892506   7892506       6.80701       6.90597       6.72472       6.77028       6.77058       6.77685

此時，a的列名就是探針ID號了。但是現在還是不符合預期，我們還要把RefSeq ID那一列去掉，也就是去掉此時的第一列：a = a[,-1]

> a = a[,-1]
> head(a)
        X.GSM1052615. X.GSM1052616. X.GSM1052617. X.GSM1052618. X.GSM1052619. X.GSM1052620.
7892501       7.24559       6.80686       7.73301       6.18961       7.05335       7.20371
7892502       6.82711       6.70157       7.02471       6.20493       6.76554       6.24252
7892503       4.39977       4.50781       4.88250       4.36295       4.18137       4.73492
7892504       9.48025       9.67952       9.63074       9.69200       9.91324       9.65897
7892505       4.54734       4.45247       5.11753       4.87307       5.15505       3.99340
7892506       6.80701       6.90597       6.72472       6.77028       6.77058       6.77685

這就是由樣本和探針組成的表達矩陣

三. 在R里使用GSE號和GEOquery包從GEO數據庫上直接下載——最推薦使用下載方式

library(GEOquery)
eSet <- getGEO("GSE42872", 
               destdir = '.',  #下載在當前目錄
               getGPL = F) #平臺信息不要

使用以上代碼就可以將GSE42872數據下載到R里當前工作目錄并賦值給eSet，下載完成后要注意檢查數據文件的完整性——看我們下載的數據大小是否大于等于官網上給的大小。如果我們下載的數據內存大于官網上的那沒事兒，如果小于官網上的那下載的數據就不完整。

2.1得到表達矩陣

我們用方法2下載的a和用方法3下載的eSet都是GSE42872數據，但它們是不一樣的：

> class(a)
[1] "data.frame"
> class(eSet)
[1] "list"

我們可以看到a是一個數據框，eSet是一個列表這里我們稱它為對象。
得到eSet對象里包含著各種各樣的信息：表達矩陣、芯片如何設計的、樣本如何分組 等等~
eSet是一個大列表，我們需要從中提取出表達矩陣，才能進行后續的操作。
為什么？因為一個GSE號里面對應多種芯片平臺數據，我們使用GSE號下載數據就會把所有芯片平臺的數據整合到一個list里面，每個list里的元素存放一個平臺的表達矩陣。我們的數據只有一個平臺所以eSet列表里就只有一個元素：


使用列表取子集的方法提取eSet列表里的第一個元素：eSet[[1]]；并使用exprs函數把它轉化成矩陣：exp <- exprs(eSet[[1]])

> eSet[[1]]
ExpressionSet (storageMode: lockedEnvironment)
assayData: 33297 features, 6 samples 
  element names: exprs 
protocolData: none
phenoData
  sampleNames: GSM1052615 GSM1052616 ... GSM1052620 (6 total)
  varLabels: title geo_accession ... cell type:ch1 (34 total)
  varMetadata: labelDescription
featureData: none
experimentData: use 'experimentData(object)'
  pubMedIds: 24469106 
Annotation: GPL6244 
> exp <- exprs(eSet[[1]])
> exp[1:4,1:4]
        GSM1052615 GSM1052616 GSM1052617 GSM1052618
7892501    7.24559    6.80686    7.73301    6.18961
7892502    6.82711    6.70157    7.02471    6.20493
7892503    4.39977    4.50781    4.88250    4.36295
7892504    9.48025    9.67952    9.63074    9.69200

這時我們再看由方法2得到的表達矩陣a，和由方法3得到的表達矩陣exp是一模一樣的：

> head(a)
        X.GSM1052615. X.GSM1052616. X.GSM1052617. X.GSM1052618. X.GSM1052619. X.GSM1052620.
7892501       7.24559       6.80686       7.73301       6.18961       7.05335       7.20371
7892502       6.82711       6.70157       7.02471       6.20493       6.76554       6.24252
7892503       4.39977       4.50781       4.88250       4.36295       4.18137       4.73492
7892504       9.48025       9.67952       9.63074       9.69200       9.91324       9.65897
7892505       4.54734       4.45247       5.11753       4.87307       5.15505       3.99340
7892506       6.80701       6.90597       6.72472       6.77028       6.77058       6.77685
> head(exp)
        GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619 GSM1052620
7892501    7.24559    6.80686    7.73301    6.18961    7.05335    7.20371
7892502    6.82711    6.70157    7.02471    6.20493    6.76554    6.24252
7892503    4.39977    4.50781    4.88250    4.36295    4.18137    4.73492
7892504    9.48025    9.67952    9.63074    9.69200    9.91324    9.65897
7892505    4.54734    4.45247    5.11753    4.87307    5.15505    3.99340
7892506    6.80701    6.90597    6.72472    6.77028    6.77058    6.77685

基因ID之間的轉換

entrez ID <---probe_id--->symbol ID
分兩步走：

  • 過濾probe_id，得到每個基因所對應的唯一的probe_id
  • 得到probe_id與symbol ID這件的轉換關系

使用R語言技巧實現基因ID之間的轉換，我們下載的數據通常使用的是不同的芯片探針，它們有不同的探針ID（probe_id）我們需要把它轉化成entrez ID或symbol ID才能被大眾認知；

所以接下來，我們學習怎樣將探針ID（probe_id）轉換成entrez ID和symbol ID
ID轉換的第一步必須要加載特定的R包，下載哪個包，需要根據GPL來定

> eSet[[1]]
ExpressionSet (storageMode: lockedEnvironment)
assayData: 33297 features, 6 samples 
  element names: exprs 
protocolData: none
phenoData
  sampleNames: GSM1052615 GSM1052616 ... GSM1052620 (6 total)
  varLabels: title geo_accession ... cell type:ch1 (34 total)
  varMetadata: labelDescription
featureData: none
experimentData: use 'experimentData(object)'
  pubMedIds: 24469106 
Annotation: GPL6244

我們看到GPL號是：GPL6244

> eSet[[1]]@annotation
[1] "GPL6244"

用R獲取芯片探針與基因的對應關系三部曲-bioconductor里搜索GPL6244所對應的R包，發現是hugene10sttranscriptcluster

http://www.bio-info-trainee.com/1399.html

所以我們加載此包：
library(hugene10sttranscriptcluster.db) 注意加上后綴 .db

> library(hugene10sttranscriptcluster.db)
> ls("package:hugene10sttranscriptcluster.db")
 [1] "hugene10sttranscriptcluster"              "hugene10sttranscriptcluster.db"          
 [3] "hugene10sttranscriptcluster_dbconn"       "hugene10sttranscriptcluster_dbfile"      
 [5] "hugene10sttranscriptcluster_dbInfo"       "hugene10sttranscriptcluster_dbschema"    
 [7] "hugene10sttranscriptclusterACCNUM"        "hugene10sttranscriptclusterALIAS2PROBE"  
 [9] "hugene10sttranscriptclusterCHR"           "hugene10sttranscriptclusterCHRLENGTHS"   
[11] "hugene10sttranscriptclusterCHRLOC"        "hugene10sttranscriptclusterCHRLOCEND"    
[13] "hugene10sttranscriptclusterENSEMBL"       "hugene10sttranscriptclusterENSEMBL2PROBE"
[15] "hugene10sttranscriptclusterENTREZID"      "hugene10sttranscriptclusterENZYME"       
[17] "hugene10sttranscriptclusterENZYME2PROBE"  "hugene10sttranscriptclusterGENENAME"     
[19] "hugene10sttranscriptclusterGO"            "hugene10sttranscriptclusterGO2ALLPROBES" 
[21] "hugene10sttranscriptclusterGO2PROBE"      "hugene10sttranscriptclusterMAP"          
[23] "hugene10sttranscriptclusterMAPCOUNTS"     "hugene10sttranscriptclusterOMIM"         
[25] "hugene10sttranscriptclusterORGANISM"      "hugene10sttranscriptclusterORGPKG"       
[27] "hugene10sttranscriptclusterPATH"          "hugene10sttranscriptclusterPATH2PROBE"   
[29] "hugene10sttranscriptclusterPFAM"          "hugene10sttranscriptclusterPMID"         
[31] "hugene10sttranscriptclusterPMID2PROBE"    "hugene10sttranscriptclusterPROSITE"      
[33] "hugene10sttranscriptclusterREFSEQ"        "hugene10sttranscriptclusterSYMBOL"       
[35] "hugene10sttranscriptclusterUNIGENE"       "hugene10sttranscriptclusterUNIPROT"

通過命令：
ls("package:hugene10sttranscriptcluster.db")
我們可以看到這個包里面有很多數據集，想要得到probe_id和symbol的對應關系要用hugene10sttranscriptclusterSYMBOL數據集，用toTable函數提取數據集里面的信息：

> ids=toTable(hugene10sttranscriptclusterSYMBOL)
> head(ids)
  probe_id    symbol
1  7896759 LINC01128
2  7896761    SAMD11
3  7896779    KLHL17
4  7896798   PLEKHN1
5  7896817     ISG15
6  7896822      AGRN

現在我們查看下一共多少個基因？一萬八千多個基因

> length(unique(ids$symbol))
[1] 18834

unique函數是用來：Extract Unique Elements 去除重復的symbol只提取不同的元素；length函數統計去重之后還有多少個基因。

再查看每個基因對應多少個探針：

> tail(sort(table(ids$symbol)))

  RPL41  UBTFL1  CDK11B  UBE2D3    IGKC LRRFIP1 
      6       6       8       8      10      10

可以看到有的基因設計了10個探針或8個探針....
table() 函數可以生成頻數統計表，這里就是統計每個基因symbol出現的次數然后將其表格化；sort()函數將symbol出現的頻率從小到大進行排序；tail()取最后6個即出現頻率最大的6個。

> table(sort(table(ids$symbol)))

    1     2     3     4     5     6     8    10 
18072   599   132    16     5     6     2     2

table一下我們可以看到，18072個基因設計了1個探針；599個基因設計了2個探針；132個基因設計了3個探針.....也就是說大部分的基因只設計了1個探針。

其實一般基因都會設計很多探針的，我們下載的表達矩陣是作者處理之后的，把許多不好的探針都過濾掉了，我們處理作者的數據要默認人家做的是對的，否則就要下載原始數據自己處理。

> table(rownames(exp) %in% ids$probe_id)

FALSE  TRUE 
13470 19827

發現有13470個探針沒有對應的基因名；19827個探針有對應的基因名。
x %in% y表示 x 的元素在y中嗎？然后返回邏輯值。rownames(exp)即表達矩陣exp的行名是文章數據中用到的所有探針ID（probe_id）；ids$probe_id是具有對應基因的所有探針。所以返回的TRUE就是文章數據中有對應基因的探針數。

現在我們對探針進行過濾，把沒有對應基因名的探針過濾掉：

> exp = exp[rownames(exp) %in% ids$probe_id,]

過濾的本質就是矩陣取子集，如：matrix[2,]意思就是取矩陣matrix的第2行和所有的列。同理，我們這里exp[rownames(exp) %in% ids$probe_id,]就是取具有對應基因的所有探針（行），和所有的列。

對比一下過濾之前和過濾之后的探針數量：

> table(rownames(exp) %in% ids$probe_id)

FALSE  TRUE 
13470 19827 
> dim(exp)
[1] 33297     6
> exp = exp[rownames(exp) %in% ids$probe_id,]
> dim(exp)
[1] 19827     6

可以發現過濾之前有33297個探針，過濾之后就剩下19827個探針了。

然后，我們使用match函數把ids里的探針順序改一下，使ids里探針順序和我們表達矩陣的順序完全一樣：

ids=ids[match(rownames(exp),ids$probe_id),]

match()函數返回的是一個位置向量，該向量記錄著第一個參數中每個元素在第二個參數中的位置。所以，此時ids里的探針順序與表達矩陣exp的探針順序一一對應：

> head(ids)
  probe_id    symbol
1  7896759 LINC01128
2  7896761    SAMD11
3  7896779    KLHL17
4  7896798   PLEKHN1
5  7896817     ISG15
6  7896822      AGRN
> head(exp)
        GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619 GSM1052620
7896759    8.75126    8.61650    8.81149    8.32067    8.41445    8.45208
7896761    8.39069    8.52617    8.43338    9.17284    9.10216    9.14120
7896779    8.20228    8.30886    8.18518    8.13322    8.06453    8.15884
7896798    8.41004    8.37679    8.27521    8.34524    8.35557    8.44409
7896817    7.72204    7.74572    7.78022    7.72308    7.53797    7.73401
7896822    9.19237    9.10929    9.03668    9.94821    9.96994    9.99839

既然已經完全對應上，我們就可以通過probe_id將表達矩陣exp進行分組，將同一個symbol所對應的多個探針分成不同的組，并對每組探針進行統計：計算每組中每行探針表達量的平均值（也就是每個探針在6個樣本中表達量的均值rowMeans(x)），再取平均值最大的那個探針作為該symbol所對應的唯一探針，該組中的其它探針過濾掉，這樣每個symbol就對應一個探針了，看下代碼是如何操作的：

tmp = by(exp,
         ids$symbol,
         function(x) rownames(x)[which.max(rowMeans(x))])
probes = as.character(tmp)
dim(exp)
exp = exp[rownames(exp) %in% probes,] # 過濾有多個探針的基因
dim(exp)

是不是沒有理解上面代碼在干些什么？沒關系，我們詳細解釋一下：
by()函數在這里發揮的功能就是將表達矩陣exp中的探針分組，同一個symbol所對應的多個探針分到一組，并對每組探針進行統計得到symbol所對應的唯一探針。所以tmp里放著by()函數的統計結果即每個symbol所對應的唯一探針IDprobe_id，用probes = as.character(tmp)將結果變身為純字符型向量：

> head(tmp)
INDICES
     A1CF       A2M     A2ML1   A3GALT2    A4GALT     A4GNT 
"7933640" "7960947" "7953775" "7914643" "8076497" "8090955" 
> head(probes)
[1] "7933640" "7960947" "7953775" "7914643" "8076497" "8090955"
>

學習by()函數如何完成以上操作的。《R語言實戰》這本書上是這樣描述的

使用by()分組計算描述性統計量，它可以一次返回若干個統計量。格式為：
by(data, INDICES, FUN)
其中data是一個數據框或矩陣；INDICES是一個因子或因子組成的列表，定義了分組；FUN是任意函數。

簡單一句話理解就是：by()函數就是根據因子將整個data分成幾個小的data.frame，然后進行運算處理。
同理，我們這里：
by(exp, ids$symbol, function(x) rownames(x)[which.max(rowMeans(x))])
第二個參數ids$symbol定義了分組，將第一參數—exp表達矩陣分成了若干個小矩陣，每個小矩陣里存放著同一個symbol所對應的所有探針。第三個參數是我們自己定義的函數：計算每個小矩陣中每行探針表達量的平均值（也就是每個探針在6個樣本中表達量的均值rowMeans(x)），再取平均值最大的那個探針作為該symbol所對應的唯一探針which.max(rowMeans(x))。
by()函數就可以返回每個分組里的統計結果，即每個symbol所對應的唯一探針IDprobe_id。
這時，探針ID和基因symbol就一一對應了，將表達矩陣探針ID即exp表達矩陣的行名（rownames(exp)）換為基因symbol：

rownames(exp)=ids[match(rownames(exp),ids$probe_id),2]
> head(exp)
          GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619 GSM1052620
LINC01128    8.75126    8.61650    8.81149    8.32067    8.41445    8.45208
SAMD11       8.39069    8.52617    8.43338    9.17284    9.10216    9.14120
KLHL17       8.20228    8.30886    8.18518    8.13322    8.06453    8.15884
PLEKHN1      8.41004    8.37679    8.27521    8.34524    8.35557    8.44409
ISG15        7.72204    7.74572    7.78022    7.72308    7.53797    7.73401
AGRN         9.19237    9.10929    9.03668    9.94821    9.96994    9.99839

此時，我們已經將探針ID轉化成基因symbol了。
由上面的介紹我們可以看到，在轉換ID中最重要的是根據GPL平臺號找到所對應的R注釋包，可是如果找不到GPL平臺對應的R注釋包怎么辦呢？
答：我們不用GEO號進行下載，而是下載平臺信息(GPL)，從平臺信息中選擇我們想要的列：探針名、基因名....
GPL里面的信息量特別大，下載特別考驗網速。

gpl <- getGEO('GPL6480', destdir = ".")
colnames(Table(gpl))
head(Table(gpl)[,c(1,6,7)]) #看gpl對象中哪一列是我們想要的取出來，發現1/6/7列是我們想要的
write.csv(Table(gpl)[,c(1,6,7)],"GPL6480.csv") #把我們想要的部分即探針名對應的基因名....存起來

獲取分組信息—group_list

分組信息就是告訴我們哪些組是control；哪些組是tumor。
使用pData函數獲取分組信息—group_list：

pd <- pData(eSet[[1]])

pData()函數可以得到每個樣本的描述信息，一般來說數據框的第一列(title列)描述了哪些是control；哪些是treatment。

pd <- pData(eSet[[1]])

根據第一列所描述的信息我們自己創建分組信息group_list：
方法一：使用stringr函數

library(stringr)
group_list = ifelse(str_detect(pd$title,"Control")==TRUE,"contorl","treat")
group_list

stringr包用于字符串的處理，str_detect是該包里的函數，用來確定一個字符向量能否匹配一種模式。它返回一個與輸入向量具有同樣長度的邏輯向量：

> str_detect(pd$title,"Control")
[1]  TRUE  TRUE  TRUE FALSE FALSE FALSE

這里的輸入向量是數據框pd的第一列pd$title內容，即由6個元素組成的字符型向量。str_detect()函數會自動判斷Control，是否存在于pd$title向量的每一個元素中，存在返回TRUE，否則返回FALSE。
str_detect函數處理后我們再使用 ifelse生成符合要求的分組信息group_list

> group_list
[1] "contorl" "contorl" "contorl" "treat"   "treat"   "treat"

方法二：自己造一個
我們已經知道了前三個是control后三個是treatment，那就自己生成一個符合要求的分組信息：

group_list=c(rep("control",times=3),rep("treat",times=3))
group_list

3. 檢查表達矩陣

得到表達矩陣就是描述了某個基因在某個樣本的表達量。有了這個表達矩陣我們可以做后面的分析，第一步就是確定我們得到的表達矩陣是否正確：

  • 查看管家基因的表達量
  • 檢測分組之間是否有差異：PCA圖、熱圖和hclust圖等等

3.1 檢驗常見基因的表達量

查看典型管家基因（如：GAPDH、ACTB）的表達量，如果表達量高于正常值，說明我們數據沒問題。
此時表達矩陣exp的行名已經由探針ID轉換成基因名了，所以我們使用exp['GAPDH',]來提取該基因在所有樣品中的表達量。

> exp['GAPDH',]
GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619 GSM1052620 
   14.3187    14.3622    14.3638    14.4085    14.3569    14.3229 
> exp['ACTB',]
GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619 GSM1052620 
   13.8811    13.9002    13.8822    13.7773    13.6732    13.5363

我們可以看到我們數據中兩個管家基因的表達量都偏高，符合預期。為什么知道它偏高呢？畫一個整體樣本所有基因的表達量的boxplot：boxplot(exp)


發現大部分基因的表達量都在8-9，而GAPDH、ACTB在13-14左右，所以是偏高的。
假如，我們發現管家基因表達量特別低，那我們就要思考是不是在提取表達矩陣的時候哪里出了問題：比如ID轉換的時候轉換錯了等等....

3.2 看表達矩陣的分布圖—畫圖看各個樣本的表達量

使用ggplot2畫各個樣本表達量的boxplot圖

# 準備畫圖所需數據exp_L
library(reshape2)
head(exp)
exp_L = melt(exp)
head(exp_L)
colnames(exp_L)=c('symbol','sample','value')
head(exp_L)

# 獲得分組信息
library(stringr)
group_list = ifelse(str_detect(pd$title,"Control")==TRUE,"contorl","treat")
group_list
exp_L$group = rep(group_list,each=nrow(exp))
head(exp_L)

# ggplot2畫圖 
library(ggplot2)
p = ggplot(exp_L,
         aes(x=sample,y=value,fill=group))+geom_boxplot()
print(p)

##boxplot圖精修版
p=ggplot(exp_L,aes(x=sample,y=value,fill=group))+geom_boxplot()
p=p+stat_summary(fun.y="mean",geom="point",shape=23,size=3,fill="red")
p=p+theme_set(theme_set(theme_bw(base_size=20)))
p=p+theme(text=element_text(face='bold'),axis.text.x=element_text(angle=30,hjust=1),axis.title=element_blank())
print(p)

作圖函數看起來復雜我們拆開：

準備作圖所需要的數據exp_L ---> 獲得分組信息并加到exp_L中 ---> ggplot2作圖

我們先理解一下 exp_L 數據

> head(exp_L)
     symbol     sample   value   group
1 LINC01128 GSM1052615 8.75126 contorl
2    SAMD11 GSM1052615 8.39069 contorl
3    KLHL17 GSM1052615 8.20228 contorl
4   PLEKHN1 GSM1052615 8.41004 contorl
5     ISG15 GSM1052615 7.72204 contorl
6      AGRN GSM1052615 9.19237 contorl

> table(exp_L[,2])
GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619 GSM1052620 
     18834      18834      18834      18834      18834      18834 

> dim(exp_L)
[1] 113004      4

> 18834*6
[1] 113004

由以上代碼我們可以看到exp_L矩陣是這樣分布的：每個基因（18834個）在第一個樣本GSM1052615中的value值，每個基因（18834個）在第二個樣本中的value值....以此類推一共有6個樣本。

難點攻克：如何得到這樣的exp_L矩陣呢？？？使用reshape2包

reshape2包是一套重構和整合數據集的絕妙的萬能工具。大致用法就是，需要首先將數據融合（melt），以使每一行都是唯一的標識符-變量組合。然后將數據重塑（cast）為你想要的任何形狀。在重鑄過程中，你可以使用任何函數對數據進行整合。
我們這里只用到這個包里的數據融合（melt）功能。
數據集的融合（melt）是將它重構為這樣一種格式：每個測量變量（每個基因在每個樣本中的表達量）獨占一行，行中帶有要唯一確定這個測量所需的標識符變量（基因symbol和樣本sample）。注意，必須指定要唯一確定每個測量所需的變量（也就是說基因symbol和樣本sample必須對應唯一的表達量），而表示測量變量名的變量將由程序為你自動創建（即表達量獨占一行后程序會自動創建表達量所對應的symbol和sample）。
說成人話就是，以前exp矩陣是一個基因在6個樣本中的表達量占一行，melt后就會將表達量獨占一行。一個表達量的值需要有兩個定語才能唯一指定，即這個表達量是哪個樣本（sample）中的哪個基因（symbol）的。

各個樣本表達量的boxplot

從圖中可以看到兩個分組control和treat基本在一條線上，這樣的數據說明可以進行后續比較，如果不在一條線上說明有批次效應batch infect，需要用limma包內置函數normalizeBetweenArrays人工校正一下(Normalization)：

library(limma) 
exp = normalizeBetweenArrays(exp)

關于畫樣本表達量的分布圖，除了上面介紹的boxplot，ggplot2還可以畫別的，看情況使用就好，不同的圖有不同的展現方式但都在展現同一個問題那就是各個樣本的表達量，看自己喜歡用就好：

p=ggplot(exp_L,aes(x=sample,y=value,fill=group))+geom_violin()
print(p)

p=ggplot(exp_L,aes(value,fill=group))+geom_histogram(bins = 200)+facet_wrap(~sample, nrow = 4)
print(p)

p=ggplot(exp_L,aes(value,col=group))+geom_density()+facet_wrap(~sample, nrow = 4)
print(p)

p=ggplot(exp_L,aes(value,col=group))+geom_density() 
print(p)

3.3 檢查樣本分組信息

檢查樣本分組信息，一般看PCA圖，hclust圖

hclust

# 更改表達矩陣列名
head(exp)
colnames(exp) = paste(group_list,1:6,sep='')
head(exp)
# 定義nodePar
nodePar <- list(lab.cex = 0.6, pch = c(NA, 19), 
                cex = 0.7, col = "blue")
# 聚類
hc=hclust(dist(t(exp)))
par(mar=c(5,5,5,10)) 
# 繪圖
plot(as.dendrogram(hc), nodePar = nodePar,  horiz = TRUE)

畫出圖后我們發現，control和treatment很好的分開了，組內也很好的聚類到了一起說明數據過關。

PCA

library(ggfortify)
# 互換行和列，再dim一下
df=as.data.frame(t(exp))
# 不要view df，列太多，軟件會卡住；
dim(df)
dim(exp)

exp[1:6,1:6]
df[1:6,1:6]

df$group=group_list 
autoplot(prcomp( df[,1:(ncol(df)-1)] ), data=df,colour = 'group')
save(exp,group_list,file = "step2output.Rdata")

同樣發現該分開的分開了，該聚在一起的聚在一起了，數據很好，符合預期。


PCA圖

經過上面一系列的表達矩陣可視化，我們檢查了表達矩陣發現是正確的，接下來就要做差異分析啦

4. 差異分析及可視化

芯片數據做差異分析最常用的就是limma包
使用這個包需要三個數據：

  • 表達矩陣(exp)
  • 分組矩陣(design)
  • 差異比較矩陣(contrast.matrix)

下面我們開始準備這三個輸入數據：
表達矩陣(exp)我們早就得到了，不用再制作了；
我們也得到了存放分組信息的向量group_list，用它來制作我們的分組矩陣

4.1 limma包做差異分析輸入數據的準備

輸入數據—分組矩陣

rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "step2output.Rdata")
dim(exp)
library(limma)
# 做分組矩陣 
design <- model.matrix(~0+factor(group_list))
colnames(design)=levels(factor(group_list))
rownames(design)=colnames(exp)
design  #得到的分組矩陣
分組矩陣design：1代表是；0代表不是

輸入數據—差異比較矩陣

> contrast.matrix<-makeContrasts(paste0(c("treat","contorl"),collapse = "-"),levels = design)
> contrast.matrix
         Contrasts
Levels    treat-contorl
  contorl            -1
  treat               1

contrast.matrix 這個矩陣聲明，我們要把treat組和contor組進行差異分析比較：-1和1的意思是contorl是用來被比的，treat是來比的即：treat/contorl

到此，做差異分析所需要的三個矩陣就做好了：表達矩陣(exp)、分組矩陣(design)、差異比較矩陣(contrast.matrix)
我們已經制作好了必要的輸入數據，下面開始講如何使用limma包來進行差異分析！

4.2 limma包做差異分析

只有三個步驟：

  • lmFit
  • eBayes
  • topTable
##step1
fit <- lmFit(exp,design)
##step2
fit2 <- contrasts.fit(fit, contrast.matrix) ##這一步很重要，大家可以自行看看效果
fit2 <- eBayes(fit2)  ## default no trend !!!
##eBayes() with trend=TRUE
##step3
tempOutput = topTable(fit2, coef=1, n=Inf)
nrDEG = na.omit(tempOutput) 
#write.csv(nrDEG2,"limma_notrend.results.csv",quote = F)
head(nrDEG)
save(nrDEG,file = "DEGoutput.Rdata")

此時我們就得到差異分析矩陣（nrDEG），重點看logFC和P值：

差異分析結果

差異分析就是對每個基因都進行檢驗，檢驗基因的logFG是多大、平均表達量是多少、p.value是否顯著等...

4.3 差異表達基因的可視化

用limma包得到差異分析表達矩陣后作圖檢查差異基因是否真的很差異

畫熱圖

選差異最顯著的前25個基因畫熱圖，查看差異是否真的很顯著

##熱圖
rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "DEGoutput.Rdata")
load(file = "DEGinput.Rdata")

library(pheatmap)
choose_gene = head(rownames(nrDEG),25)
choose_matrix = exp[choose_gene,]
choose_matrix = t(scale(t(choose_matrix)))
pheatmap(choose_matrix)

火山圖

rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "DEGoutput.Rdata")
colnames(nrDEG)
plot(nrDEG$logFC,-log10(nrDEG$P.Value))

DEG=nrDEG
logFC_cutoff <- with(DEG,mean(abs( logFC)) + 2*sd(abs( logFC)) )
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',])
)
this_tile
head(DEG)
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)

5.富集分析—KEGG、 GO

富集分析就是用常用的數據庫來注釋基因list。差異分析通過自定義的閾值挑選了有統計學顯著的基因列表后我們其實是需要對它們進行注釋才能了解其功能，最常見的就是GO/KEGG數據庫注釋，當然也可以使用Reactome和Msigdb數據庫來進行注釋。而最常見的注釋方法就是超幾何分布檢驗。超幾何分布檢驗，運用到通路的富集概念就是“總共有多少基因（這個地方值得注意，主流認為只考慮那些在KEGG等數據庫注釋的背景基因），你的通路有多少基因，你的通路被抽中了多少基因（在差異基因里面屬于你的通路的基因）。” 目的就是知道，哪些通路中的哪些基因的表達因為藥物或者某些操作的作用發生了較大的變化，導致通路有較大改變。

5.1 KEGG pathway analysis

clusterProfiler包作KEGG富集分析

#clusterProfiler作kegg富集分析：
  library(clusterProfiler)
  gene_up= deg[deg$change == 'up','ENTREZID'] 
  gene_down=deg[deg$change == 'down','ENTREZID'] 
  gene_diff=c(gene_up,gene_down)
  gene_all = deg[,'ENTREZID']
  kk.up <- enrichKEGG(gene         = gene_up,
                      organism     = 'hsa',
                      universe     = gene_all,
                      pvalueCutoff = 0.9,
                      qvalueCutoff =0.9)
  head(kk.up)[,1:6]
  dim(kk.up)
  kk.down <- enrichKEGG(gene         =  gene_down,
                        organism     = 'hsa',
                        universe     = gene_all,
                        pvalueCutoff = 0.9,
                        qvalueCutoff =0.9)
  head(kk.down)[,1:6]
  dim(kk.down)
  kk.diff <- enrichKEGG(gene         = gene_diff,
                        organism     = 'hsa',
                        pvalueCutoff = 0.05)
  head(kk.diff)[,1:6]
  
  class(kk.diff)
  #提取出數據框
  kegg_diff_dt <- kk.diff@result
  
  #根據pvalue來選,用于可視化
  down_kegg <- kk.down@result %>%
    filter(pvalue<0.05) %>%
    mutate(group=-1)
  
  up_kegg <- kk.up@result %>%
    filter(pvalue<0.05) %>%
    mutate(group=1)
  
  #可視化走起
  kegg_plot <- function(up_kegg,down_kegg){
    dat=rbind(up_kegg,down_kegg)
    colnames(dat)
    dat$pvalue = -log10(dat$pvalue)
    dat$pvalue=dat$pvalue*dat$group 
    
    dat=dat[order(dat$pvalue,decreasing = F),]
    
    g_kegg<- ggplot(dat, aes(x=reorder(Description,order(pvalue, decreasing = F)), y=pvalue, fill=group)) + 
      geom_bar(stat="identity") + 
      scale_fill_gradient(low="blue",high="red",guide = FALSE) + 
      scale_x_discrete(name ="Pathway names") +
      scale_y_continuous(name ="log10P-value") +
      coord_flip() + theme_bw()+theme(plot.title = element_text(hjust = 0.5))+
      ggtitle("Pathway Enrichment") 
  }
  
  g_kegg <- kegg_plot(up_kegg,down_kegg)
  g_kegg
  
  ggsave(g_kegg,filename = 'kegg_up_down.png')
clusterProfiler作KEGG富集分析

GSEA作KEGG富集分析

GSEA是另一個常用的富集分析方法，目的是看看基因全局表達量的變化是否有某些特定的基因集合的傾向性。

  data(geneList, package="DOSE")
  head(geneList)
  length(geneList)
  names(geneList)
  boxplot(geneList)
  boxplot(deg$logFC)
  
  geneList=deg$logFC
  names(geneList)=deg$ENTREZID
  geneList=sort(geneList,decreasing = T)
  
  kk_gse <- gseKEGG(geneList     = geneList,
                    organism     = 'hsa',
                    nPerm        = 1000,
                    minGSSize    = 120,
                    pvalueCutoff = 0.9,
                    verbose      = FALSE)
  head(kk_gse)[,1:6]
  gseaplot(kk_gse, geneSetID = rownames(kk_gse[1,]))
  
  down_kegg<-kk_gse[kk_gse$pvalue<0.05 & kk_gse$enrichmentScore < 0,];down_kegg$group=-1
  up_kegg<-kk_gse[kk_gse$pvalue<0.05 & kk_gse$enrichmentScore > 0,];up_kegg$group=1
  
  gse_kegg=kegg_plot(up_kegg,down_kegg)
  print(gse_kegg)
  ggsave(gse_kegg,filename ='kegg_up_down_gsea.png')
GSEA作KEGG富集分析

5.2 GO database analysis

做GO數據集超幾何分布檢驗分析，重點在結果的可視化及生物學意義的理解。

GO富集分析生物學意義

GO富集分析原理：有一個term注釋了100個差異表達基因參與了哪個過程，注釋完之后（模式生物都有現成的注釋包，不用我們自己注釋），計算相對于背景它是否顯著集中在某條通路、某一個細胞學定位、某一種生物學功能。
對GO database analysis一般從三個層面進行：

  • Cellular component，CC 細胞成分
  • Biological process， BP 生物學過程
  • Molecular function，MF 分子功能

這三個層面具體是指：

  • Cellular component解釋的是基因存在在哪里，在細胞質還是在細胞核？如果存在細胞質那在哪個細胞器上？如果是在線粒體中那是存在線粒體膜上還是在線粒體的基質當中？這些信息都叫Cellular component。
  • Biological process是在說明該基因參與了哪些生物學過程，比如，它參與了rRNA的加工或參與了DNA的復制，這些信息都叫Biological process
  • Molecular function在講該基因在分子層面的功能是什么？它是催化什么反應的？
    立足于這三個方面，我們將得到基因的注釋信息。

GO富集分析的R代碼

#go富集分析--耗費時間灰常長，很正常
library(clusterProfiler)
#輸入數據
gene_up= deg[deg$change == 'up','ENTREZID'] 
gene_down=deg[deg$change == 'down','ENTREZID'] 
gene_diff=c(gene_up,gene_down)
head(deg)

  #**GO分析三大塊**
#細胞組分
    ego_CC <- enrichGO(gene = gene_diff,
                       OrgDb= org.Hs.eg.db,
                       ont = "CC",
                       pAdjustMethod = "BH",
                       minGSSize = 1,
                       pvalueCutoff = 0.01,
                       qvalueCutoff = 0.01,
                       readable = TRUE)
    #生物過程
    ego_BP <- enrichGO(gene = gene_diff,
                       OrgDb= org.Hs.eg.db,
                       ont = "BP",
                       pAdjustMethod = "BH",
                       minGSSize = 1,
                       pvalueCutoff = 0.01,
                       qvalueCutoff = 0.01,
                       readable = TRUE)
    #分子功能：
    ego_MF <- enrichGO(gene = gene_diff,
                       OrgDb= org.Hs.eg.db,
                       ont = "MF",
                       pAdjustMethod = "BH",
                       minGSSize = 1,
                       pvalueCutoff = 0.01,
                       qvalueCutoff = 0.01,
                       readable = TRUE)
    save(ego_CC,ego_BP,ego_MF,file = "ego_GPL6244.Rdata")
    rm(list = ls())  ## 魔幻操作，一鍵清空~   
  load(file = "ego_GPL6244.Rdata")
  #作圖
  #第一種，條帶圖，按p從小到大排的
  barplot(ego_CC, showCategory=20,title="EnrichmentGO_CC")
  barplot(ego_BP, showCategory=20,title="EnrichmentGO_CC")
  #如果運行了沒出圖，就dev.new()
  #第二種，點圖，按富集數從大到小的
  dotplot(ego_CC,title="EnrichmentGO_BP_dot")
  
  #保存
  pdf(file = "dotplot_GPL6244.pdf")
  dotplot(ego_CC,title="EnrichmentGO_BP_dot")
  dev.off()

純代碼版：


#GEO B站視頻 純代碼篇

#下載加載包
cran_packages <- c('tidyr',
                   'tibble',
                   'dplyr',
                   'stringr',
                   'ggplot2',
                   'ggpubr',
                   'factoextra',
                   'FactoMineR',
                   'WGCNA') 
Biocductor_packages <- c('GEOquery',
                         'hgu133plus2.db',
                         "KEGG.db",
                         "limma",
                         "impute",
                         "GSEABase",
                         "GSVA",
                         "clusterProfiler",
                         "genefu",
                         "org.Hs.eg.db",
                         "preprocessCore",
                         "hugene10sttranscriptcluster.db")

for (pkg in c(Biocductor_packages,cran_packages)){
  require(pkg,character.only=T) 
}

# 下載數據
rm(list = ls())
library(GEOquery)
eSet <- getGEO("GSE42872", 
               destdir = '.',
               getGPL = F)


# 從eSet中提取表達矩陣exp
exp <- exprs(eSet[[1]])

head(exp)

# ID轉換

##探針ID（probe_id）轉換成symbol ID

eSet[[1]]@annotation
library(hugene10sttranscriptcluster.db)
ls("package:hugene10sttranscriptcluster.db")
ids=toTable(hugene10sttranscriptclusterSYMBOL)
head(ids)
length(unique(ids$symbol))
tail(sort(table(ids$symbol)))

table(sort(table(ids$symbol)))

table(rownames(exp) %in% ids$probe_id)
dim(exp)
exp = exp[rownames(exp) %in% ids$probe_id,]
dim(exp)


ids=ids[match(rownames(exp),ids$probe_id),]
head(ids)
head(exp)

tmp = by(exp,
         ids$symbol,
         function(x) rownames(x)[which.max(rowMeans(x))])

probes = as.character(tmp)
head(tmp)
head(probes)

dim(exp)
exp = exp[rownames(exp) %in% probes,]
dim(exp)
rownames(exp)=ids[match(rownames(exp),ids$probe_id),2]
head(exp)

pd <- pData(eSet[[1]]) # pData函數得到每個樣本的描述信息
head(pd)

save(pd,exp,file = "step1output.Rdata")
save(exp,file = "DEGinput.Rdata")

rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "step1output.Rdata")

#####

#檢查表達矩陣
##畫典型基因表達量的boxplot
exp['GAPDH',] 
exp['ACTB',]
boxplot(exp)
boxplot(exp['GAPDH',])
boxplot(exp['ACTB',])

#各個樣本表達量的boxplot
##準備畫圖所需數據exp_L
library(reshape2)
head(exp)
exp_L = melt(exp)
head(exp_L)
colnames(exp_L)=c('symbol','sample','value')
head(exp_L)
# 獲得分組信息
library(stringr)

group_list = ifelse(str_detect(pd$title,"Control")==TRUE,"contorl","treat")

group_list

exp_L$group = rep(group_list,each=nrow(exp))
head(exp_L)
table(exp_L[,2])
dim(exp_L)
### ggplot2畫圖 
library(ggplot2)
p = ggplot(exp_L,
         aes(x=sample,y=value,fill=group))+geom_boxplot()
print(p)

# 對表達矩陣進行聚類繪圖，并添加樣本的臨床表型數據信息(更改樣本名)

## hclust
# 更改表達矩陣列名
head(exp)
colnames(exp) = paste(group_list,1:6,sep='')
head(exp)
# 定義nodePar
nodePar <- list(lab.cex = 0.6, pch = c(NA, 19), 
                cex = 0.7, col = "blue")
# 聚類
hc=hclust(dist(t(exp)))
par(mar=c(5,5,5,10)) 
# 繪圖
plot(as.dendrogram(hc), nodePar = nodePar,  horiz = TRUE)

## PCA

library(ggfortify)
# 互換行和列，dim一下
head(exp)
df=as.data.frame(t(exp))
# 不要view df，列太多，軟件會崩掉；
dim(df)
dim(exp)

exp[1:6,1:6]
df[1:6,1:6]

df$group=group_list 
autoplot(prcomp( df[,1:(ncol(df)-1)] ), data=df,colour = 'group')

save(exp,group_list,file = "step2output.Rdata")


###################################################
############用limma對芯片數據做差異分析############
###################################################

#差異分析——limma
rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "step2output.Rdata")
dim(exp)

library(limma)
# 做分組矩陣 
design <- model.matrix(~0+factor(group_list))
colnames(design)=levels(factor(group_list))
rownames(design)=colnames(exp)
design  #分組矩陣

# 做比較矩陣

# contrast.matrix<-makeContrasts(paste0(unique(group_list),collapse = "-"),levels = design)
# contrast.matrix ##這個矩陣聲明，我們要把treat組和contorl組進行差異分析比較
# -1和1的意思是contorl是用來被比的，treat是來比的
contrast.matrix<-makeContrasts(paste0(c("treat","contorl"),collapse = "-"),levels = design)
contrast.matrix
#到此，做差異分析所需要的三個矩陣就做好了：表達矩陣、分組矩陣、差異比較矩陣
#我們已經制作好了必要的輸入數據，下面開始講如何使用limma這個包來進行差異分析了！

##step1
fit <- lmFit(exp,design)
##step2
fit2 <- contrasts.fit(fit, contrast.matrix) ##這一步很重要，大家可以自行看看效果
fit2 <- eBayes(fit2)  ## default no trend !!!
##eBayes() with trend=TRUE
##step3
tempOutput = topTable(fit2, coef=1, n=Inf)
nrDEG = na.omit(tempOutput) 
#write.csv(nrDEG2,"limma_notrend.results.csv",quote = F)
head(nrDEG)

save(exp,group_list,nrDEG,file = "DEGoutput.Rdata")

#用limma包得到差異分析表達矩陣后作圖檢查差異基因是否真的很差異
##熱圖
rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "DEGoutput.Rdata")
load(file = "DEGinput.Rdata")

library(pheatmap)
choose_gene = head(rownames(nrDEG),25)
choose_matrix = exp[choose_gene,]
choose_matrix = t(scale(t(choose_matrix)))
pheatmap(choose_matrix)


##火山圖
rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "DEGoutput.Rdata")
colnames(nrDEG)
plot(nrDEG$logFC,-log10(nrDEG$P.Value))

DEG=nrDEG
logFC_cutoff <- with(DEG,mean(abs( logFC)) + 2*sd(abs( logFC)) )
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',])
)
this_tile
head(DEG)
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)

#富集分析

#富集分析準備工作：

##首先對差異表達矩陣nrDEG，進行加工
###1.把行名變成SYMBOL列
rm(list = ls())  ## 魔幻操作，一鍵清空~
options(stringsAsFactors = F)
load(file = "DEGoutput.Rdata")
library(dplyr)
deg = nrDEG
deg <- mutate(deg,symbol = rownames(deg))
head(deg)

###2.加change列：上調或下調，火山圖要用

logFC_t = 1 #不同的閾值，篩選到的差異基因數量就不一樣，后面的超幾何分布檢驗結果就大相徑庭。
change=ifelse(deg$P.Value>0.01,'stable', 
              ifelse( deg$logFC >logFC_t,'up', 
                      ifelse( deg$logFC < -logFC_t,'down','stable') )
)
deg <- mutate(deg,change)
head(deg)
table(deg$change)

###3.加ENTREZID列，后面富集分析要用
library(ggplot2)
library(clusterProfiler)
library(org.Hs.eg.db)
s2e <- bitr(unique(deg$symbol), fromType = "SYMBOL",  #ID轉換核心函數bitr
            toType = c( "ENTREZID"),
            OrgDb = org.Hs.eg.db)
head(s2e)
head(deg)
deg <- inner_join(deg,s2e,by=c("symbol"="SYMBOL"))

head(deg)

save(exp,group_list,deg,file = "enrich_input.Rdata")

#####################
######富集分析#######
#####################

rm(list = ls()) 
options(stringsAsFactors = F)
load(file = 'enrich_input.Rdata')

## 1.KEGG pathway analysis
#上調、下調、差異、所有基因

#clusterProfiler作kegg富集分析：
  library(clusterProfiler)
  gene_up= deg[deg$change == 'up','ENTREZID'] 
  gene_down=deg[deg$change == 'down','ENTREZID'] 
  gene_diff=c(gene_up,gene_down)
  gene_all = deg[,'ENTREZID']
  kk.up <- enrichKEGG(gene         = gene_up,
                      organism     = 'hsa',
                      universe     = gene_all,
                      pvalueCutoff = 0.9,
                      qvalueCutoff =0.9)
  head(kk.up)[,1:6]
  dim(kk.up)
  kk.down <- enrichKEGG(gene         =  gene_down,
                        organism     = 'hsa',
                        universe     = gene_all,
                        pvalueCutoff = 0.9,
                        qvalueCutoff =0.9)
  head(kk.down)[,1:6]
  dim(kk.down)
  kk.diff <- enrichKEGG(gene         = gene_diff,
                        organism     = 'hsa',
                        pvalueCutoff = 0.05)
  head(kk.diff)[,1:6]
  
  class(kk.diff)
  #提取出數據框
  kegg_diff_dt <- kk.diff@result
  
  #根據pvalue來選,用于可視化
  down_kegg <- kk.down@result %>%
    filter(pvalue<0.05) %>%
    mutate(group=-1)
  
  up_kegg <- kk.up@result %>%
    filter(pvalue<0.05) %>%
    mutate(group=1)
  
  #可視化
  kegg_plot <- function(up_kegg,down_kegg){
    dat=rbind(up_kegg,down_kegg)
    colnames(dat)
    dat$pvalue = -log10(dat$pvalue)
    dat$pvalue=dat$pvalue*dat$group 
    
    dat=dat[order(dat$pvalue,decreasing = F),]
    
    g_kegg<- ggplot(dat, aes(x=reorder(Description,order(pvalue, decreasing = F)), y=pvalue, fill=group)) + 
      geom_bar(stat="identity") + 
      scale_fill_gradient(low="blue",high="red",guide = FALSE) + 
      scale_x_discrete(name ="Pathway names") +
      scale_y_continuous(name ="log10P-value") +
      coord_flip() + theme_bw()+theme(plot.title = element_text(hjust = 0.5))+
      ggtitle("Pathway Enrichment") 
  }
  
  g_kegg <- kegg_plot(up_kegg,down_kegg)
  g_kegg
  
  ggsave(g_kegg,filename = 'kegg_up_down.png')


#gsea作kegg富集分析：

  data(geneList, package="DOSE")
  head(geneList)
  length(geneList)
  names(geneList)
  boxplot(geneList)
  boxplot(deg$logFC)
  
  geneList=deg$logFC
  names(geneList)=deg$ENTREZID
  geneList=sort(geneList,decreasing = T)
  
  kk_gse <- gseKEGG(geneList     = geneList,
                    organism     = 'hsa',
                    nPerm        = 1000,
                    minGSSize    = 120,
                    pvalueCutoff = 0.9,
                    verbose      = FALSE)
  head(kk_gse)[,1:6]
  gseaplot(kk_gse, geneSetID = rownames(kk_gse[1,]))
  
  down_kegg<-kk_gse[kk_gse$pvalue<0.05 & kk_gse$enrichmentScore < 0,];down_kegg$group=-1
  up_kegg<-kk_gse[kk_gse$pvalue<0.05 & kk_gse$enrichmentScore > 0,];up_kegg$group=1
  
  gse_kegg=kegg_plot(up_kegg,down_kegg)
  print(gse_kegg)
  ggsave(gse_kegg,filename ='kegg_up_down_gsea.png')


### 2.GO database analysis 

#go富集分析
library(clusterProfiler)
#輸入數據
gene_up= deg[deg$change == 'up','ENTREZID'] 
gene_down=deg[deg$change == 'down','ENTREZID'] 
gene_diff=c(gene_up,gene_down)
head(deg)

  #**GO分析三大塊**
#細胞組分
    ego_CC <- enrichGO(gene = gene_diff,
                       OrgDb= org.Hs.eg.db,
                       ont = "CC",
                       pAdjustMethod = "BH",
                       minGSSize = 1,
                       pvalueCutoff = 0.01,
                       qvalueCutoff = 0.01,
                       readable = TRUE)
    #生物過程
    ego_BP <- enrichGO(gene = gene_diff,
                       OrgDb= org.Hs.eg.db,
                       ont = "BP",
                       pAdjustMethod = "BH",
                       minGSSize = 1,
                       pvalueCutoff = 0.01,
                       qvalueCutoff = 0.01,
                       readable = TRUE)
    #分子功能：
    ego_MF <- enrichGO(gene = gene_diff,
                       OrgDb= org.Hs.eg.db,
                       ont = "MF",
                       pAdjustMethod = "BH",
                       minGSSize = 1,
                       pvalueCutoff = 0.01,
                       qvalueCutoff = 0.01,
                       readable = TRUE)
    save(ego_CC,ego_BP,ego_MF,file = "ego_GPL6244.Rdata")
    rm(list = ls()) 
  load(file = "ego_GPL6244.Rdata")

  #第一種，條帶圖，按p從小到大排的
  barplot(ego_CC, showCategory=20,title="EnrichmentGO_CC")
  barplot(ego_BP, showCategory=20,title="EnrichmentGO_CC")
  #如果運行了沒出圖，就dev.new()
  #第二種，點圖，按富集數從大到小的
  dotplot(ego_CC,title="EnrichmentGO_BP_dot")
  
  #保存
  pdf(file = "dotplot_GPL6244.pdf")
  dotplot(ego_CC,title="EnrichmentGO_BP_dot")
  dev.off()

特別感謝小潔老師激發了我學習GEO數據庫挖掘的興趣；有些圖片還有富集分析的代碼就來自小潔老師的課件哦

最后編輯于 ：
?著作權歸作者所有,轉載或內容合作請聯系作者
平臺聲明：文章內容（如有圖片或視頻亦包括在內）由作者上傳并發布，文章內容僅代表作者本人觀點，簡書系信息發布平臺，僅提供信息存儲服務。
  • 人面猴
    序言：七十年代末，一起剝皮案震驚了整個濱河市，隨后出現的幾起案子，更是在濱河造成了極大的恐慌，老刑警劉巖，帶你破解...
    沈念sama閱讀 227,882評論 6贊 531
  • 死咒
    序言：濱河連續發生了三起死亡事件，死亡現場離奇詭異，居然都是意外死亡，警方通過查閱死者的電腦和手機，發現死者居然都...
    沈念sama閱讀 98,208評論 3贊 414
  • 救了他兩次的神仙讓他今天三更去死
    文/潘曉璐 我一進店門，熙熙樓的掌柜王于貴愁眉苦臉地迎上來，“玉大人，你說我怎么就攤上這事。” “怎么了？”我有些...
    開封第一講書人閱讀 175,746評論 0贊 373
  • 道士緝兇錄：失蹤的賣姜人
    文/不壞的土叔 我叫張陵，是天一觀的道長。 經常有香客問我，道長，這世上最難降的妖魔是什么？ 我笑而不...
    開封第一講書人閱讀 62,666評論 1贊 309
  • ?港島之戀（遺憾婚禮）
    正文 為了忘掉前任，我火速辦了婚禮，結果婚禮上，老公的妹妹穿的比我還像新娘。我一直安慰自己，他們只是感情好，可當我...
    茶點故事閱讀 71,477評論 6贊 407
  • 惡毒庶女頂嫁案：這布局不是一般人想出來的
    文/花漫 我一把揭開白布。 她就那樣靜靜地躺著，像睡著了一般。 火紅的嫁衣襯著肌膚如雪。 梳的紋絲不亂的頭發上，一...
    開封第一講書人閱讀 54,960評論 1贊 321
  • 城市分裂傳說
    那天，我揣著相機與錄音，去河邊找鬼。 笑死，一個胖子當著我的面吹牛，可吹牛的內容都是我干的。 我是一名探鬼主播，決...
    沈念sama閱讀 43,047評論 3贊 440
  • 雙鴛鴦連環套：你想象不到人心有多黑
    文/蒼蘭香墨 我猛地睜開眼，長吁一口氣：“原來是場噩夢啊……” “哼！你這毒婦竟也來了？” 一聲冷哼從身側響起，我...
    開封第一講書人閱讀 42,200評論 0贊 288
  • 萬榮殺人案實錄
    序言：老撾萬榮一對情侶失蹤，失蹤者是張志新（化名）和其女友劉穎，沒想到半個月后，有當地人在樹林里發現了一具尸體，經...
    沈念sama閱讀 48,726評論 1贊 333
  • ?護林員之死
    正文 獨居荒郊野嶺守林人離奇死亡，尸身上長有42處帶血的膿包…… 初始之章·張勛 以下內容為張勛視角 年9月15日...
    茶點故事閱讀 40,617評論 3贊 354
  • ?白月光啟示錄
    正文 我和宋清朗相戀三年，在試婚紗的時候發現自己被綠了。 大學時的朋友給我發了我未婚夫和他白月光在一起吃飯的照片。...
    茶點故事閱讀 42,807評論 1贊 369
  • 活死人
    序言：一個原本活蹦亂跳的男人離奇死亡，死狀恐怖，靈堂內的尸體忽然破棺而出，到底是詐尸還是另有隱情，我是刑警寧澤，帶...
    沈念sama閱讀 38,327評論 5贊 358
  • ?日本核電站爆炸內幕
    正文 年R本政府宣布，位于F島的核電站，受9級特大地震影響，放射性物質發生泄漏。R本人自食惡果不足惜，卻給世界環境...
    茶點故事閱讀 44,049評論 3贊 347
  • 男人毒藥：我在死后第九天來索命
    文/蒙蒙 一、第九天 我趴在偏房一處隱蔽的房頂上張望。 院中可真熱鬧，春花似錦、人聲如沸。這莊子的主人今日做“春日...
    開封第一講書人閱讀 34,425評論 0贊 26
  • 一樁弒父案，背后竟有這般陰謀
    文/蒼蘭香墨 我抬頭看了看天上的太陽。三九已至，卻和暖如春，著一層夾襖步出監牢的瞬間，已是汗流浹背。 一陣腳步聲響...
    開封第一講書人閱讀 35,674評論 1贊 281
  • 情欲美人皮
    我被黑心中介騙來泰國打工， 沒想到剛下飛機就差點兒被人妖公主榨干…… 1. 我叫王不留，地道東北人。 一個月前我還...
    沈念sama閱讀 51,432評論 3贊 390
  • 代替公主和親
    正文 我出身青樓，卻偏偏與公主長得像，于是被迫代替她去往敵國和親。 傳聞我的和親對象是個殘疾皇子，可洞房花燭夜當晚...
    茶點故事閱讀 47,769評論 2贊 372