サンプル（列）方向にスケーリングしたい場合：
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.r <- genescale(data, axis=2, method="R") #スケーリングした結果をdata.rに格納
apply(data.r, 2, range) #各列の最小値と最大値を表示させ、正常に動作しているか確認
tmp <- cbind(rownames(data.r), data.r) #遺伝子IDの列を行列data.rの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
前処理 | スケーリング | シグナル強度を対数（log）変換する
発現データを対数(log)変換してくれます。ほぼ例外なく底は2なので、ここではそのやり方のみ示します。
尚、予め「シグナル強度が1未満のものを1にする」ということを行っていますが、これはlogをとれるようにするためです。実際にWADの原著論文（Kadota et al., 2008)中で以下のような操作を行っています（論文中の記述はTable 1を参照のこと）。
くれぐれもご自身が対数変換しようとしている入力ファイルについて、「シグナル強度の分布を確認し、ダイナミックレンジが4桁程度あることを確認」してください。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. sample2.txtのようなごく一般的な形式のファイルをlog変換したいとき：
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "sample2_log.txt" #出力ファイル名を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
summary(data) #シグナル強度の分布を確認し、ダイナミックレンジが4桁程度あることを確認
data[data < 1] <- 1 #シグナル強度が1未満のものを1にする
data.log <- log(data, base=2) #log2-transformed dataをdata.logに格納
summary(data.log) #対数変換後のシグナル強度の分布を確認
tmp <- cbind(rownames(data.log), data.log) #遺伝子IDの列を行列data.logの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. GDS1096.txtのような"IDENTIFIER"という余分な一列を含むファイルを処理したいとき：
------ ここから ------
in_f <- "GDS1096.txt" #入力ファイル名を指定
out_f <- "GDS1096_log.txt" #出力ファイル名を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data$IDENTIFIER <- NULL #余分なIDENTIFIER列の消去
summary(data) #シグナル強度の分布を確認し、ダイナミックレンジが4桁程度あることを確認
data[data < 1] <- 1 #シグナル強度が1未満のものを1にする
data.log <- log(data, base=2) #log2-transformed dataをdata.logに格納
summary(data.log) #対数変換後のシグナル強度の分布を確認
tmp <- cbind(rownames(data.log), data.log) #遺伝子IDの列を行列data.logの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
前処理 | スケーリング | Quantile normalization
発現データをQuantile normalization（発現強度の順位が同じならその発現強度も同じにする正規化）してくれます。 Jeffery et al., BMC Bioinformatics, 2006の解析で行われた前処理と同じ（RMA-quantified data --> Quantile normalization）です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. GDS1096_rma.txtの場合：
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定
out_f <- "hoge_q1.txt" #出力ファイル名を指定
library(limma) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.q <- normalizeQuantiles(as.matrix(data)) #Quantile normalizationを実行し、結果をdata.qに格納
rownames(data.q) <- rownames(data) #行の名前を追加
colnames(data.q) <- colnames(data) #列の名前を追加
tmp <- cbind(rownames(data.q), data.q) #遺伝子IDの列を行列data.qの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. sample19.txtの場合：
------ ここから ------
in_f <- "sample19.txt" #入力ファイル名を指定
out_f <- "hoge_q2.txt" #出力ファイル名を指定
library(limma) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.q <- normalizeQuantiles(as.matrix(data)) #Quantile normalizationを実行し、結果をdata.qに格納
rownames(data.q) <- rownames(data) #行の名前を追加
colnames(data.q) <- colnames(data) #列の名前を追加
tmp <- cbind(rownames(data.q), data.q) #遺伝子IDの列を行列data.qの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
3. sample19_plus1.txtの場合：
------ ここから ------
in_f <- "sample19_plus1.txt" #入力ファイル名を指定
out_f <- "hoge_q3.txt" #出力ファイル名を指定
library(limma) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.q <- normalizeQuantiles(as.matrix(data)) #Quantile normalizationを実行し、結果をdata.qに格納
rownames(data.q) <- rownames(data) #行の名前を追加
colnames(data.q) <- colnames(data) #列の名前を追加
tmp <- cbind(rownames(data.q), data.q) #遺伝子IDの列を行列data.qの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
参考文献(Jeffery et al., BMC Bioinformatics, 2006)
前処理 | 遺伝子のフィルタリング1
特定の条件を満たす遺伝子のみを抽出（フィルタリング；filtering）してくれる。遺伝子間クラスタリングなどを行いたいときに、
a) メモリが足りない！と文句を言われて計算を実行できない
b) 条件（or サンプル or チップ）間で発現変動していない遺伝子はみてもしょうがない（or 解析データに含める価値がない）ので計算時間を短縮したい
c) 既出論文のデータ解析において実行されたフィルタリング手順を再現して、同じサブセットで解析したい
ような場合に以下のお好みの操作を行います。
注意点としては「フィルタリングしようとしているデータが対数変換（or log変換）されているかどうかをちゃんと把握しておく」ことが大事です。
以下の解析例で用いているsample2.txtは対数変換前のデータなので、解析例1で行っているような「シグナル強度50以上」という条件を満たす遺伝子が存在します。
しかし、もしこれと同じことを対数変換後のデータで行おうとすると、一般にシグナル強度が2^50 (=1.1259e+15)を超えるような途方もなく大きな数値を出すような機器は存在しないので、条件を満たす遺伝子が存在しないことになります。だからその後の解析で何をやってもエラーが出力されるのです。このあたりに注意して利用してください。
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample2.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. 5組織(k=5)以上でシグナル強度50以上(A=50)の遺伝子のみを抽出したい場合：
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 5 #組織数kを指定
param2 <- 50 #シグナル強度Aを指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
f1 <- kOverA(param1, A=param2) #「k組織以上でシグナル強度A以上を持つ遺伝子を抽出」という条件（filter）をf1に格納
ffun <- filterfun(f1) #フィルタリング用の関数(filtering function)を作成しffunに格納
which <- genefilter(data, ffun) #フィルタリングを実行し、結果をwhichに格納
which #whichの中身を表示 (この場合はgene1, 2, 5がTRUEとなる)
sum(which) #条件を満たす遺伝子がいくつあったかを表示 (この場合は3)
data.f <- data[which,] #条件を満たす遺伝子群の発現データをdata.fに格納
data.f #結果を表示
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. シグナル強度>20(A=20)の組織数の割合が>70%(p=0.7)を満たす遺伝子のみを抽出したい場合：
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 0.7 #組織数の割合pを指定
param2 <- 20 #シグナル強度Aを指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
f1 <- pOverA(p=param1, A=param2) #「シグナル強度がAよりも大きい組織数の割合がpよりも大きい遺伝子を抽出」という条件（filter）をf1に格納
ffun <- filterfun(f1) #フィルタリング用の関数(filtering function)を作成しffunに格納
which <- genefilter(data, ffun) #フィルタリングを実行し、結果をwhichに格納
which #whichの中身を表示 (この場合はgene1, 2, 5がTRUEとなる)
sum(which) #条件を満たす遺伝子がいくつあったかを表示 (この場合は3)
data.f <- data[which,] #条件を満たす遺伝子群の発現データをdata.fに格納
data.f #結果を表示
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
3. 少なくとも一つの組織でシグナル強度が92(A=92)以上の遺伝子を抽出したい場合：
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param <- 92 #シグナル強度Aを指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
f1 <- maxA(param) #「少なくとも一つの組織でシグナル強度がparam以上の遺伝子を抽出」という条件（filter）をf1に格納
ffun <- filterfun(f1) #フィルタリング用の関数(filtering function)を作成しffunに格納
which <- genefilter(data, ffun) #フィルタリングを実行し、結果をwhichに格納
which #whichの中身を表示 (この場合はgene2, 5がTRUEとなる)
sum(which) #条件を満たす遺伝子がいくつあったかを表示 (この場合は3)
data.f <- data[which,] #条件を満たす遺伝子群の発現データをdata.fに格納
data.f #結果を表示
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
Bioconductorのgenefilterのwebページ
前処理 | 遺伝子のフィルタリング2
特定の条件を満たす遺伝子のみを抽出（フィルタリング；filtering）してくれる。遺伝子間クラスタリングなどを行いたいときに、
a) メモリが足りない！と文句を言われて計算を実行できない
b) 条件（or サンプル or チップ）間で発現変動していない遺伝子はみてもしょうがない（or 解析データに含める価値がない）ので計算時間を短縮したい
c) 既出論文のデータ解析において実行されたフィルタリング手順を再現して、同じサブセットで解析したい
ような場合に以下のお好みの操作を行います。
注意点としては「フィルタリングしようとしているデータが対数変換（or log変換）されているかどうかをちゃんと把握しておく」ことが大事です。
無用の混乱を避けるために、このページで紹介している（特にAffymetirxの）正規化法を適用した結果の出力データは2009/7/9までに全て対数変換後のデータとなるように変更しましたが、
以下の解析例で用いているsample2.txtは対数変換前のデータなので、以下の条件を満たす遺伝子が存在します。
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample2.txt)を置いてあるディレクトリに移動し、以下をコピペ
1.発現強度が10以下のものを10に、100以上のものを100とし、
「発現強度max/min < 2.9」または「(max-min) < 42」の行(遺伝子)を解析から除く場合：
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 10 #シグナル強度の下限を指定
param2 <- 100 #シグナル強度の上限を指定
param3 <- 2.9 #シグナル強度最大と最小の発現比を指定
param4 <- 42 #シグナル強度最大と最小の差を指定
library(som) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.f <- filtering(data, lt=param1, ut=param2, mmr=param3, mmd=param4)#フィルタリングを実行し、結果をdata.fに格納
data.f #結果を表示
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. 「発現強度max/min < 2.9」の行(遺伝子)だけを解析から除く場合：
以下では、上限値と下限値をそれぞれ「読み込んだ遺伝子発現データの最大値と最小値」として
param1とparam2に自動的に与えているので、結果として入力時に明示的に指定する必要はありません。
発現強度max-minの値は0を条件として与えています。
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param3 <- 2.9 #シグナル強度最大と最小の発現比を指定
library(som) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
param1 <- min(data) #シグナル強度の下限を計算
param2 <- max(data) #シグナル強度の上限を計算
param4 <- 0 #シグナル強度最大と最小の差を0として指定
data.f <- filtering(data, lt=param1, ut=param2, mmr=param3, mmd=param4)#フィルタリングを実行し、結果をdata.fに格納
data.f #結果を表示
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
CRANのsomのwebページ
PDFマニュアル
前処理 | 遺伝子のフィルタリング3 (NAを含むものを削除)
サンプルマイクロアレイデータ12の(two-color) Agilentデータ(sample13_7vs7.txt)をエクセルで開くと多くの"NA" (Not Availableの略)という記述を目にしますが、
このような数値でない情報を含むデータは往々にしてうまくデータを読み込んでくれなかったり、解析できなかったりします...。ここでは全ての要素がNAとなっている行を除くなどのやり方を紹介します。
尚、sample13_7vs7.txtのデータは最初の7列がA群、後の7列がB群の二群間比較用のデータです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 全ての要素がNAとなっている行を除く場合：
------ ここから ------
#やり方1
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
out <- apply(data, 1, allNA) #全ての要素がNAならFALSE, それ以外ならTRUEを返すallNA関数を各行に対して適用し、結果をoutに格納
data.f <- data[out,] #行列dataの中から一つでも要素がNAでない(TRUEに対応)行のみ抽出し、結果をdata.fに格納
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#やり方2
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
out <- t(apply(data, 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行に対して適用し、結果をoutに格納
out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を各行に対して適用し、結果をout2に格納
data.f <- data[out2 < ncol(data),] #行列dataの中から全ての要素がNAである(out2の値がncol(data)未満に相当)行のみ抽出し、結果をdata.fに格納
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. 一つでもNAがある行を除く場合：
------ ここから ------
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
out <- t(apply(data, 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行に対して適用し、結果をoutに格納
out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を各行に対して適用し、結果をout2に格納
data.f <- data[out2 == 0,] #行列dataの中から全ての要素がNAでない(out2の値が0に相当)行のみ抽出し、結果をdata.fに格納
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
3. 「A群はX(=2)個以上且つB群でY(=4)個以上」のNAでない(≒数値)要素を含む行のみ抽出したい場合：
------ ここから ------
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 7 #A群のサンプル数を指定
param2 <- 7 #B群のサンプル数を指定
param3 <- 2 #Xの数を指定
param4 <- 4 #Yの数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
#A群のデータについてNAでない要素数を各行についてカウント
out <- t(apply(data[data.cl == 0], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のA群のみに対して適用し、結果をoutに格納
out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をout2に格納
outA <- param1 - out2 #param1で指定した数からout2の値を引くことで得た「NAでないA群の要素数」をoutAに格納
#B群のデータについてNAでない要素数を各行についてカウント
out <- t(apply(data[data.cl == 1], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のB群のみに対して適用し、結果をoutに格納
out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をout2に格納
outB <- param2 - out2 #param2で指定した数からout2の値を引くことで得た「NAでないB群の要素数」をoutBに格納
data.f <- data[((outA >= param3) & (outB >= param4)),] #行列dataの中から条件を満たす行のみ抽出し、結果をdata.fに格納
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
4. 解析したいファイルがsample13_7vs7_nr.txtで「A群はX(=3)個以上且つB群でY(=3)個以上」のNAやNaNでない(≒数値)要素を含む行のみ抽出したい場合：
------ ここから ------
in_f <- "sample13_7vs7_nr.txt" #入力ファイル名を指定
out_f <- "sample13_7vs7_nr2.txt" #出力ファイル名を指定
param1 <- 7 #A群のサンプル数を指定
param2 <- 7 #B群のサンプル数を指定
param3 <- 3 #Xの数を指定
param4 <- 3 #Yの数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
#A群のデータについてNAでない要素数を各行についてカウント
out <- t(apply(data[data.cl == 0], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のA群のみに対して適用し、結果をoutに格納
outNA <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をoutNAに格納
out <- t(apply(data[data.cl == 0], 1, is.nan)) #各要素がNaNであるかどうか(TRUE or FALSE)を返すis.nan関数を各行のA群のみに対して適用し、結果をoutに格納
outNaN <- apply(out, 1, sum) #TRUEの数(NaNの数)を返すsum関数を適用し、結果をoutNaNに格納
outA <- param1 - outNA - outNaN #param1で指定した数からoutNAとoutNaNの値を引くことで得た「NA or NaNでないA群の要素数」をoutAに格納
#B群のデータについてNAでない要素数を各行についてカウント
out <- t(apply(data[data.cl == 1], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のB群のみに対して適用し、結果をoutに格納
outNA <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をoutNAに格納
out <- t(apply(data[data.cl == 1], 1, is.nan)) #各要素がNaNであるかどうか(TRUE or FALSE)を返すis.nan関数を各行のB群のみに対して適用し、結果をoutに格納
outNaN <- apply(out, 1, sum) #TRUEの数(NaNの数)を返すsum関数を適用し、結果をoutNaNに格納
outB <- param2 - outNA - outNaN #param2で指定した数からoutNAとoutNaNの値を引くことで得た「NA or NaNでないB群の要素数」をoutBに格納
data.f <- data[((outA >= param3) & (outB >= param4)),] #行列dataの中から条件を満たす行のみ抽出し、結果をdata.fに格納
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
前処理 | 遺伝子のフィルタリング4 (CVが小さいものを削除)
変動係数(Coefficient of Variation; CV)がX未満の遺伝子(行)を削除してくれます。
「ファイル」−「ディレクトリの変更」で解析したい対数変換後のファイル(data_GSE7623_rma.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_GSE7623_rma.txt" #入力ファイル名を指定
param <- 0.2 #CV値(X)を指定
out_f <- "data_GSE7623_rma_cv.txt" #出力ファイル名を指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
out <- genefilter(data, cv(param, Inf)) #CV値によるフィルタリングを実行し、結果をoutに格納
data.f <- data[out,] #行列dataの中から一つでも要素がNAでない(TRUEに対応)行のみ抽出し、結果をdata.fに格納
tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
前処理 | 同じ遺伝子名を持つものをまとめる
例えば、「酸化的リン酸化」のパスウェイに関連する遺伝子セットが自分が見ている条件間で全体として動いているかどうかを調べたい場合に、解析 | 機能解析（GSEA周辺）についてで述べている方法を利用しますが、これを実行するための入力ファイルをここで作成する必要があります。
そのため、「酸化的リン酸化」のパスウェイに関連する遺伝子セット中の特定の遺伝子（遺伝子A）が自分が見ている条件間で発現変動していて、しかもチップ上に重複して多数（別のプローブIDとして）搭載されているような場合には、遺伝子Aだけの効果でそのパスウェイが「動いている」などという誤った結果を導きかねません。
このようなチップ上の重複遺伝子の効果を排除すべく、同じ遺伝子名をもつ複数のプローブIDの発現プロファイルに対しては、その代表値(平均値(mean)や中央値(median)など)を出力して、遺伝子名の重複のない（non-redundant）遺伝子発現行列をファイルとして得たいときに以下の作業を行います。
ここでは、以下の4つの解析例を示します：
1. アノテーション情報取得 | GEOからで得られたgene symbolとIDの対応表のファイルを利用
2. アノテーション情報取得 | Rのパッケージから得られた対応表の情報を利用
3. sample18_5vs5.txt（図3）を入力として、4列目で同じ遺伝子のものをまとめる（図4のようにする）場合(同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合にはエラーを吐くように設計)
4. sample18_5vs5.txt（図3）を入力として、4列目で同じ遺伝子のものをまとめる（図4のようにする）場合(同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合には「2」を、そうでない場合には「1」としたベクトルを最初の一列目に追加で出力するように設計)
1 or 2を実行する際、代表値は、平均値(mean)や中央値(median)など好きなものを指定できます。
この作業はGSEA解析でも当然やります。"Collapse dataset to gene symbols"に相当するところです。GSEAでは「最大値(このページ中での関数はmaxでGSEAの"max_probe (default)"に相当)」または「中央値(このページ中での関数はmedianでGSEAの"median_of_probes"に相当)」が選択可能です。(2010/09/01追加)
例えば、1.の例だと、sample13_7vs7.txt中にはABCA10というGene symbolのものが二つ(ID: 7810 and 9681)存在しますが、
この2遺伝子の発現データは図1のようになっていますが、1.をコピペして得られるsample13_7vs7_nr.txt中では図2のようになります。
(NA --> NaNになっているところは本質的な部分ではありません...。)
図1.
図2.
図3.
図4.
1. Agilent Human 1A (V2)チップの発現データ(サンプルマイクロアレイデータの12で得たsample13_7vs7.txt)と
アノテーション情報取得 | GEOからの6までを行って得たGPL887-5640_symbol.txt
の二つのファイルを用いて行う場合：
(sample13_7vs7.txtの一列目のID情報とGPL887-5640_symbol.txtの一列目のID情報の対応がとれる(同じ行の位置でなくてもよい)ことが前提です)
------ ここから ------
in_f1 <- "sample13_7vs7.txt" #入力ファイル1（発現データ）を指定
in_f2 <- "GPL887-5640_symbol.txt" #入力ファイル2（Gene symbolとIDの対応表のデータ）を指定
param <- mean #代表値を指定
out_f <- "sample13_7vs7_nr.txt" #出力ファイル名を指定
#IDとGene symbolとの対応関係を含む情報を入手
sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル2を読み込んでsymに格納。
symbols <- as.vector(sym[,1]) #Gene symbol情報をベクトルに変換し、symbolsに格納
names(symbols) <- rownames(sym) #symbolsをIDで対応づけられるようにしている
unique_sym <- unique(symbols) #symbolsの中からnon-redundantな情報のみを抽出し、unique_symに格納
unique_sym <- unique_sym[unique_sym != ""] #unique_symの中から、Gene symbolがないものを除く
unique_sym <- unique_sym[!is.na(unique_sym)] #unique_symの中から、Gene symbolが"NA"のものを除く
unique_sym <- unique_sym[!is.nan(unique_sym)] #unique_symの中から、Gene symbolが"NaN"のものを除く
#メイン部分
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #入力ファイル1を読み込んでdataに格納
hoge <- NULL #最終的に欲しい情報を格納するためのプレースホルダ
for(i in 1:length(unique_sym)){ #non-redundant gene symbol数分だけループを回す
hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))#dataの中からi番目のgene symbolと同じprobesを全て抽出し、その平均値(mean)をhogeの一番下の行に追加
} #non-redundant gene symbol数分だけループを回す
rownames(hoge) <- unique_sym #non-redundant gene symbolsをhogeの行の名前として利用
tmp <- cbind(rownames(hoge), hoge) #遺伝子IDの列を行列hogeの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. Affymetrix Rat Genome 230 2.0 Arrayを用いて得られた参考文献1の対数変換後(log2変換後)のデータ
(data_GSE7623_rma.txt)を入力として、アノテーション情報取得 | Rのパッケージからの1
を参考にして得られたprobe IDとGene symbolとの対応関係を含む情報を用いて行う場合：
------ ここから ------
in_f <- "data_GSE7623_rma.txt" #入力ファイル名を指定
param <- mean #代表値を指定
out_f <- "data_GSE7623_rma_nr.txt" #出力ファイル名を指定
#probe IDとGene symbolとの対応関係を含む情報を入手
source("http://bioconductor.org/biocLite.R") #おまじない
biocLite("rat2302.db") #アノテーション情報取得
library(rat2302.db) #ライブラリ読み込み
library(help=rat2302.db) #rat2302.db中にどんな情報が含まれているか見る
sym_info <- rat2302SYMBOL #何度も必要箇所を書き換えなくてもいいようにrat2302SYMBOLを以後sym_infoとして取り扱う
symbols <- unlist(as.list(sym_info)) #全31099 probesに対応するGeneSymbol(SYMBOL)情報を抽出し、symbolsに格納
unique_sym <- unique(symbols) #non-redundantなGeneSymbol(SYMBOL)情報を抽出し、unique_symに格納
unique_sym <- unique_sym[unique_sym != ""] #unique_symの中から、Gene symbolがないものを除く
unique_sym <- unique_sym[!is.na(unique_sym)] #unique_symの中から、Gene symbolが"NA"のものを除く
unique_sym <- unique_sym[!is.nan(unique_sym)] #unique_symの中から、Gene symbolが"NaN"のものを除く
#メイン部分
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
hoge <- NULL #最終的に欲しい情報を格納するためのプレースホルダ
for(i in 1:length(unique_sym)){ #non-redundant gene symbol数分だけループを回す
hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))#dataの中からi番目のgene symbolと同じprobesを全て抽出し、その平均値(mean)をhogeの一番下の行に追加
} #non-redundant gene symbol数分だけループを回す
rownames(hoge) <- unique_sym #non-redundant gene symbolsをhogeの行の名前として利用
tmp <- cbind(rownames(hoge), hoge) #遺伝子IDの列を行列hogeの左端に挿入し、結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
3. sample18_5vs5.txt（図3）を入力として、4列目の情報をもとにでエクソンごとに分かれている同じ遺伝子のものをまとめる（図4のようにする）場合：
(同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合にはエラーを吐くように設計)
------ ここから ------
in_f <- "sample18_5vs5.txt" #入力ファイルを指定
out_f <- "sample18_5vs5_nr.txt" #出力ファイル名を指定
#ファイルの読み込み
data <- read.table(in_f, header=TRUE, sep="\t", quote="") #入力ファイルを読み込んでdataに格納
#genenameに相当する4列目の情報を抽出して加工("-ex"よりも左側の文字列のみ抽出)
hoge <- strsplit(as.character(data[,4]), "-ex", fixed=TRUE) #data[,param]を文字列に変換し、"-ex"で区切った結果をリスト形式でhogeに格納
genename <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素("-ex"で区切った左側部分に相当)のみ抽出してgenenameに格納
unique_genename <- unique(genename) #non-redundantなgenename情報を抽出し、unique_genenameに格納
#1,6列目の情報（chrとstrand）はそのまま、5, 7-16列の情報（lengthとカウントデータ）のみsumしたいので、それぞれをサブセットに分ける
sub1 <- data[,c(1,6)] #1,6列目の情報のみ抽出しsub1に格納
sub2 <- data[,c(5,7:16)] #5,7-16列目の情報のみ抽出しsub2に格納
out <- NULL #最終的に欲しい情報を格納するためのプレースホルダ
for(i in 1:length(unique_genename)){ #unique_genenameの要素数分だけループを回す
out_sub1 <- apply(sub1[which(genename == unique_genename[i]),], 2, unique, na.rm=TRUE)#sub1のところは、複数エクソンの場合は同じ情報がエクソン数分だけあることになるので、unique関数を実行した結果をout_sub1に格納
out_sub2 <- apply(sub2[which(genename == unique_genename[i]),], 2, sum, na.rm=TRUE)#sub2のところでは、複数エクソンの場合にsum関数を実行した結果（和をとった結果）をout_sub2に格納
out <- rbind(out, c(out_sub1, unique_genename[i], out_sub2)) #「out_sub1, unique_genename[i], out_sub2」の順番で行列outの下に結果をどんどん追加
}
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
4. sample18_5vs5.txt（図3）を入力として、4列目の情報をもとにでエクソンごとに分かれている同じ遺伝子のものをまとめる（図4のようにする）場合：
(同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合には「2」を、そうでない場合には「1」としたベクトルを最初の一列目に追加で出力するように設計)
------ ここから ------
in_f <- "sample18_5vs5.txt" #入力ファイルを指定
out_f <- "sample18_5vs5_nr.txt" #出力ファイル名を指定
#ファイルの読み込み
data <- read.table(in_f, header=TRUE, sep="\t", quote="") #入力ファイルを読み込んでdataに格納
#genenameに相当する4列目の情報を抽出して加工("-ex"よりも左側の文字列のみ抽出)
hoge <- strsplit(as.character(data[,4]), "-ex", fixed=TRUE) #data[,param]を文字列に変換し、"-ex"で区切った結果をリスト形式でhogeに格納
genename <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素("-ex"で区切った左側部分に相当)のみ抽出してgenenameに格納
unique_genename <- unique(genename) #non-redundantなgenename情報を抽出し、unique_genenameに格納
#1,6列目の情報（chrとstrand）はそのまま、5, 7-16列の情報（lengthとカウントデータ）のみsumしたいので、それぞれをサブセットに分ける
sub1 <- data[,c(1,6)] #1,6列目の情報のみ抽出しsub1に格納
sub2 <- data[,c(5,7:16)] #5,7-16列目の情報のみ抽出しsub2に格納
out <- NULL #最終的に欲しい情報を格納するためのプレースホルダ
for(i in 1:length(unique_genename)){ #unique_genenameの要素数分だけループを回す
tmp <- unlist(apply(sub1[which(genename == unique_genename[i]),], 2, unique, na.rm=TRUE))#sub1のところは、複数エクソンの場合は同じ情報がエクソン数分だけあることになるはずであるが、そうでない可能性があるときに見つけられるようにしている
out_flag <- length(tmp) #ベクトルtmpの要素数をout_flagに格納（通常はtmpの要素数が2だが、3以上のものを検出するのが目的）
out_sub1 <- tmp[1:2] #どんな状況になっていようと、とにかくベクトルtmpの最初の二つの要素を出力すべくout_sub1に格納
out_sub2 <- apply(sub2[which(genename == unique_genename[i]),], 2, sum, na.rm=TRUE)#sub2のところでは、複数エクソンの場合にsum関数を実行した結果（和をとった結果）をout_sub2に格納
out <- rbind(out, c(out_flag, out_sub1, unique_genename[i], out_sub2)) #「out_sub1, unique_genename[i], out_sub2」の順番で行列outの下に結果をどんどん追加
}
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
GSEAの「Run GSEA Page」のところ
参考文献1(Nakai et al., BBB, 2008)
解析 | 似た発現パターンを持つ遺伝子の同定
いわゆるパターンマッチング法（or テンプレートマッチング法; pattern matching; template matching）を適用して、"理想的なパターン" or "指定した遺伝子の発現パターン"に似た発現パターンを持つ遺伝子を検出（ランキング）します。
ここでは、
1. 指定した組織で理想的な特異的発現パターンを示す上位X個を得たい場合
2. 上位X個ではなく似ている順に全遺伝子をソートした結果を得たい場合
3. 指定した遺伝子の発現パターンに似た発現パターンを示す上位X個を得たい場合
の三つのやり方について紹介します。
類似度を計算する際に、
a) 発現データ（遺伝子発現ベクトル）をあらかじめスケーリングするかしない（none）か？するとしたらどのようなスケーリング（range (各遺伝子のシグナル強度の範囲を0-1にする) or zscore (各遺伝子のシグナル強度の平均を0標準偏差を1にする)）を行うか？
b) 距離をどのような方法（euclidean, maximum, manhattan, canberra, correlation, binary）で定義するか？
も指定する必要があります。
私は距離を普段から「1 - 相関係数」で定義しているので、それに相当するcorrelationを頻用します。また、スケーリングはやりません(none)。
「ファイル」−「ディレクトリの変更」で解析したいファイル(GDS1096_rma.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. 指定した組織で選択的（特異的）に発現する遺伝子群の上位10個(X=10)を得たい場合：
ここでは、予め作成した「心臓特異的発現パターン」を示す遺伝子群を抽出するための"理想的なパターン(テンプレート)"
を含むファイルGDS1096_cl_heart.txtを読み込んで、
発現パターンが似ている上位X個を二つのファイルdata_topranked.txt（発現データ含む）と
data_topranked_ID.txt（発現データ含まず遺伝子IDのみ）に保存するやり方を示します。
(発現ベクトルのスケーリングはせず(none)、
類似度は「1 - 相関係数」(correlation)で定義)
------ ここから ------
in_f1 <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定
in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2（テンプレート情報）を指定
out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定
out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定
param1 <- 10 #上位X個のXを指定
param2 <- "none" #類似度計算前の発現データのスケーリング法を指定
param3 <- "correlation" #距離を定義する方法を指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #入力ファイル1を読み込んでdataに格納
data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。（read.tableで読み込んで得られたdataの型は"データフレーム"のため）
data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納
template <- data_cl[,2] #バイナリ（0 or 1）情報（2列目）のみ抽出し、templateに格納
template #バイナリ（0 or 1）情報の確認
tmp <- rbind(data, template) #templateというテンプレートパターンを行列dataの最後の行に追加
template_posi <- which(rownames(tmp) == "template") #行のラベル情報が"template"に相当する行番号をtemplate_posiに格納
closeg <- genefinder(tmp, template_posi, param1, scale=param2, method=param3)#上位"param1"個の情報をclosegに格納
closeg[[1]]$indices #上位"param1"個の行番号を表示
closeg[[1]]$dists #上位"param1"個の類似度を表示
topranked <- tmp[closeg[[1]]$indices,] #上位"param1"個の遺伝子発現データを抽出し、toprankedに格納
tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. 似ている順に全遺伝子をソートした結果を得たい場合：
ここでは、予め作成した「心臓特異的発現パターン」を示す遺伝子群を抽出するための
"理想的なパターン(テンプレート)"を含むファイルGDS1096_cl_heart.txtを読み込んで、
「心臓特異的発現パターン」に似ている順に全遺伝子をソートした二つのファイル
data_topranked.txt（発現データ含む）とdata_topranked_ID.txt（発現データ含まず遺伝子IDのみ）
に保存するやり方を示します。
(発現ベクトルをZスケーリング(zscore)し、類似度は「1 - 相関係数」(correlation)で定義)
------ ここから ------
in_f1 <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定
in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2（テンプレート情報）を指定
out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定
out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定
param2 <- "zscore" #類似度計算前の発現データのスケーリング法を指定
param3 <- "correlation" #距離を定義する方法を指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #入力ファイル1を読み込んでdataに格納
data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。（read.tableで読み込んで得られたdataの型は"データフレーム"のため）
data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納
template <- data_cl[,2] #バイナリ（0 or 1）情報（2列目）のみ抽出し、templateに格納
template #バイナリ（0 or 1）情報の確認
tmp <- rbind(data, template) #templateというテンプレートパターンを行列dataの最後の行に追加
template_posi <- which(rownames(tmp) == "template") #行のラベル情報が"template"に相当する行番号をtemplate_posiに格納
param1 <- nrow(data) #遺伝子数をparam1に格納
closeg <- genefinder(tmp, template_posi, param1, scale=param2, method=param3)#特異的発現の度合いでランキングされた結果をclosegに格納
topranked <- tmp[closeg[[1]]$indices,] #特異的発現の度合いでランキングされた遺伝子発現データをtoprankedに格納
tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。
------ ここまで ------
3. 遺伝子ID: 207003_atの遺伝子発現プロファイルと発現パターンが似ている上位5個をリストアップしたい場合：
(発現ベクトルをRangeスケーリング(range)し、類似度はマンハッタン距離(manhattan)で定義)
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定
out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定
out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定
param1 <- 5 #上位X個のXを指定
param2 <- "range" #類似度計算前の発現データのスケーリング法を指定
param3 <- "manhattan" #距離を定義する方法を指定
param4 <- "207003_at" #遺伝子IDを指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。（read.tableで読み込んで得られたdataの型は"データフレーム"のため）
template_posi <- which(rownames(data) == param4) #param4で指定した遺伝子IDに相当する行番号をtemplate_posiに格納
closeg <- genefinder(data, template_posi, param1, scale=param2, method=param3)#上位"param1"個の情報をclosegに格納
topranked <- data[closeg[[1]]$indices,] #上位"param1"個の遺伝子発現データを抽出し、toprankedに格納
tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。
------ ここまで ------
4. (ヘッダー行を除く)15987行目（ID_REF: "216617_s_at"の行に相当）の遺伝子発現プロファイルと
発現パターンが似ている上位10個をリストアップしたい場合：
(発現ベクトルをZスケーリング(zscore)し、類似度は「1 - 相関係数」(correlation)で定義)
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定
out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定
out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定
param1 <- 10 #上位X個のXを指定
param2 <- "zscore" #類似度計算前の発現データのスケーリング法を指定
param3 <- "correlation" #距離を定義する方法を指定
param4 <- 15987 #目的遺伝子の行番号を指定
library(genefilter) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。（read.tableで読み込んで得られたdataの型は"データフレーム"のため）
closeg <- genefinder(data, param4, param1, scale=param2, method=param3)#上位"param1"個の情報をclosegに格納
topranked <- data[closeg[[1]]$indices,] #上位"param1"個の遺伝子発現データを抽出し、toprankedに格納
tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。
------ ここまで ------
Bioconductorのgenefilterのwebページ
解析 | 似た発現パターンを持つサンプルをデータベースから検索
Blast検索のように、手持ちの（あるいはデータベース中の興味ある）サンプルの発現プロファイルを"query"として、(Gene Expression Omnibus (GEO)などの)マイクロアレイデータベースから似たサンプルを順にソートした結果を得たい場合に利用します。
(Rではありませんので...)CellMontageのwebページに行って、ご利用ください。
アグリバイオインフォマティクス教育研究プログラムの講義の中では応用例をいくつか紹介しましたが、例えば未知サンプルの分類や診断をより高精度に行えるのではと思っています。これは、従来は手持ちのデータセットをクロスバリデーションなどでごちゃごちゃいじって分類精度
がどの程度あるのかなどを研究していましたが、CellMontageを利用すると、GEOデータベース中のデータを全て利用可能なので、圧倒的多数のサンプルの類似度をもとに評価できるという利点があります。
というわけで、個人的には、(Rで)マイクロアレイデータ解析のページ中の「解析 | 分類」で紹介しているやり方よりもCellMontageを使いこなすほうがよいのではと思っています。
こっち方面の研究の方向性としては、Blast-likeな出力結果をもとにして、結果のスコアをどのように重みづけしながら多数決（weighted voting）をとれば分類性能を上げられるのか、をチューニングすることでしょうか。
CellMontageのwebページ
CellMontageの日本語での紹介ページ
「ゲノム解析ツール リンク集」の"類似発現プロファイルを検索する"のwebページ
解析 | 発現変動遺伝子 | 二群間 | 発現変動遺伝子（でないもの）がどの程度あるのかざっくり知りたい (Ploner_2006)
発現変動遺伝子(Differentially Expressed Genes; DEGs)のランキング（検出）を行う際にFDRを計算することで上位の遺伝子ですらFDRが1に近いものだと、
「ああこのデータセット中には発現変動遺伝子はないのね...。」という判断がつきます。
が、そんな回りくどいことをせずとも、以下を実行することで「発現変動遺伝子でないもの（non-DEGs）の割合」が一意に返されます。よって、「1 - その割合」がDEGsの割合ということになるのでざっくりと知ることができるわけです。
以下では（遺伝子名の列を除く）最初の3列(X=3)がA群、残りの3列(Y=3)がB群からなる（すでに対数変換されている）遺伝子発現データファイル（sample14.txt）の二群間比較用データのnon-DEGsの割合を計算する一連の手順を示します。
最後に出力される二つの数値が目的のものです。この場合、約65%がnon-DEGsであることがわかります。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ13中のsample14.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "sample14.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
library(OCplus) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out1 <- fdr1d(data, data.cl, verb=FALSE) #入力データ中の発現変動していない遺伝子(non-DEGs)の割合を調べた結果をout1に格納
out2 <- EOC(data, data.cl) #入力データ中の発現変動していない遺伝子(non-DEGs)の割合を調べた結果をout2に格納
p0(out1) #得られたout1の中から目的のnon-DEGsの割合の数値を表示
p0(out2) #得られたout2の中から目的のnon-DEGsの割合の数値を表示
------ ここまで ------
BioconductorのOCplusのwebページ
参考文献1(Ploner et al., Bioinformatics, 2006)
解析 | 発現変動遺伝子 | 二群間 | 対応なし |について
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します：
-------------------
Aさんの正常サンプル
Bさんの正常サンプル
Cさんの正常サンプル
Dさんの腫瘍サンプル
Eさんの腫瘍サンプル
Fさんの腫瘍サンプル
Gさんの腫瘍サンプル
-------------------
「マーカー遺伝子の検出」が第一目的の場合と「分類精度が高い遺伝子セットを得たい」のが第一目的の場合で用いる方法が違ってきます。もちろん、両者は完全には排他的ではなくかなり密接に関連してはいますが、それぞれの目的に応じた手法が提案されているので使い分けるほうがよろしいかと思います。
「マーカー遺伝子の検出」が第一目的の場合（filter method；発現強度とサンプルクラス間の統計的な相関に基づいて遺伝子を抽出するやり方）：
最近はFold change系とt-statistic系の組み合わせが主流？！になってきていますが、サンプル数（全部で10サンプル程度？！）が比較的少ないときは前者がよくて、比較的多いサンプル数（30サンプルとか？！）の場合には後者がいいと2007年ごろまで思っていました。
また、どのpreprocessing algorithmsを用いてexpression summary scoreを求めたデータに対して適用するかによっても違ってきます。私の2008年の論文(WAD: Kadota et al., 2008)での結論（おすすめ）は以下の通りです：
・「MASアルゴリズム」のときは「WAD」
・「RMAアルゴリズム」のときは「昔ながらのFold Change」
・「DFWアルゴリズム」のときはRank products」
このうちのどれがいいかは分かりませんが、WADはRMAやDFWアルゴリズムでもFold ChangeやRank productsと同程度の成績を保持している一方、Fold ChangeとRank ProductsはMASアルゴリズムのとの相性が非常に悪いので、全体的にはWADが優れているのではという印象です。ちなみにt-statistics系の方法はWAD(Kadota et al., 2008)論文が出る前まではMASアルゴリズムとの相性のよさで存在意義がありましたが...。
WAD論文中にも書いていますが、「なぜ雨後のたけのこのように手法論文が沢山publishされるのか？！」と思っていましたが、これは手法のデータセット依存性がかなりあるからだと思います。つまり、手法論文中では「シミュレーションデータでうまくいって、"a (せいぜい few) real experimental datasets"でうまくいきました」ということで論文として成立するのですが、"(many) other real datasets"でうまくいく保証がないのです（ここがみそ！）。
WAD論文では、アレイのデバイスが同じ計36個のreal experimental datasetsに対して、既知の発現変動遺伝子をどれだけ上位にランキングできるかという評価基準（具体的にはAUC）で、全体的にいいのはどれか?を比較した結果の結論が上記の組み合わせ、ということです（2008/6/26追加）。
その後様々な他のpreprocessing algorithmsとの相性を調べてみました。我々の論文(Kadota et al., 2009)中で提案した推奨ガイドラインは、以下の通りです。（2009/4/24追加）
-------------------------------------------------------------------
感度・特異度の高いpreprocessing algorithmsとgene ranking methodsの組合せ：
・「MASアルゴリズム」のときは「WAD」
・「multi-mgMOSアルゴリズム」のときは「WAD」
・「RMAアルゴリズム」のときは「Rank products」
・「VSNアルゴリズム」のときは「Rank products」
・「GCRMAアルゴリズム」のときは「Rank products」
・「MBEIアルゴリズム」のときは「Rank products」
・「PLIERアルゴリズム」のときは「Rank products」
・「FARMSアルゴリズム」のときは「Rank products」
・「DFWアルゴリズム」のときは「Rank products」
再現性の高いpreprocessing algorithmsとgene ranking methodsの組合せ：
上記nine algorithmsのいずれの場合でも「WAD」
-------------------------------------------------------------------
上記ガイドラインはAffymetrix GeneChipデータのみを対象としたものであり、Agilentなど他のメーカーで測定されたデータに対する評価結果はKadota and Shimizu, 2011で報告しています。
評価用データセットはMAQCのもので、Affymetrix, Agilent, Applied Biosystems, Illumina, GE Healthcareの5つのプラットフォームのデータで行っています。
結論としては、どのプラットフォームでも「再現性が高いのはWAD、感度・特異度が高いのはWAD or Rank products」というものであり、上記ガイドラインはプラットフォーム非依存であるという傍証を報告しています。
「分類精度が高い遺伝子セットを得たい」が第一目的の場合（wrapper method；分類能力の高い遺伝子を抽出するやり方）：
（こちらは私の専門ではないのでまだ知識不足ですのであしからず...）現在このページで紹介しているのはRF（random forest）に基づく方法 (Diaz-Uriarte_2007) だけですが、他にもRで提供されているもの以外でBaker and Kramerの方法などがあります。後者の論文のタイトルを見ればよく分かりますが、ずばり「分類精度が最も高い遺伝子セット」に的を絞って抽出してくれます。
解析 | 発現変動遺伝子 | 二群間 | 対応なし | WAD (Kadota_2008)
Weighted Average Difference (WAD)法を用いて発現変動の度合いでランキング。
「既知発現変動遺伝子のほとんどは平均シグナル強度が高い」という事実に着目して、「一般的なlog ratioの値に対して（log scaleでの）、平均シグナル強度が高い遺伝子ほど1に近い重みをかけることで、上位にランキングされるようにしたもの」がWAD統計量です。
注意点としては、入力データはlog2-scaleのものを前提としているので、例えばRMAやDFWの出力結果ファイルはそのままWADの入力として用いていいですが、対数変換されていないデータファイルの場合は前処理 | スケーリング | シグナル強度を対数（log）変換するを参考にしてlog2変換したものに対してWADを適用してください。
以下Aug 2 2011追加。
WADに対してよく寄せられる質問として、「FDR計算できないんですけど...やWAD統計量ランキングしたときにどこまでを有意だと判断すればいいんでしょうか？」があります。
私が調べた限りでは、確かにFDRを計算できませんし、WAD統計量の閾値をどこに設定すればいいかはわかりません。これは事実です。
この原因としては、WAD統計量によるランキング結果の再現性が非常に高い、という特徴に起因しています。
つまり、例えば二群間(A群vs.B群)比較で、AやBのラベル情報をランダムに入れ替えてFDRを計算しようとしても、ランキング結果の再現性が高いが故に「random permutationで得られた結果は、元のランキング結果とほとんど同じランキング結果になってしまう」からです。
従って、何らかの客観的な閾値が欲しい、という人はSAMなり他の方法で「だいたいFDR < 0.05を満たす遺伝子数はこのくらい」という情報を別に持っておけばいいと思います。
実際問題としては、例えば(t統計量系の方法である)SAMで決めた任意の閾値を満たす遺伝子数やランキング結果と、
それ以外の(Fold change系の方法である)Rank productsで決めた同じ閾値を満たす遺伝子数やランキング結果は結構違います。
ランキング結果の上位x個という風に数を揃えても20%程度の一致しかないのが普通です。
では何を信じればいいのでしょうか？私は発現変動の度合いでランキングをした結果の上位に”本物”がより濃縮されている方法がいいと思います。
しかもそれが様々なプラットフォームや様々な評価基準でも有用性が示されているとしたら、、、WADでいいんじゃないかと思います。
1. 入力ファイルが既にlog2-transformed dataの場合(通常)：
以下では（遺伝子名の列を除く）最初の50列(X=50)が正常サンプル(A群)、残りの52列(Y=52)が腫瘍サンプル(B群)からなる
（すでに対数変換されている）遺伝子発現データファイル（data_Singh_RMA_3274.txt）の二群間比較を例とします。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ9中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
WAD <- function(x, cl, dynamic_r, min_v){ #WAD統計量を計算するための関数
x.class1 <- x[(cl == 0)] #WAD統計量を計算するための関数
x.class2 <- x[(cl == 1)] #WAD統計量を計算するための関数
x_ave <- (mean(x.class1) + mean(x.class2))/2 #WAD統計量を計算するための関数
weight <- (x_ave - min_v)/dynamic_r #WAD統計量を計算するための関数
statistic <- (mean(x.class2) - mean(x.class1))*weight #WAD統計量を計算するための関数
return(statistic) #WAD統計量を計算するための関数
} #WAD統計量を計算するための関数
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
tmp.class1 <- apply(data[,data.cl == 0], 1, mean) #Normalサンプル群の（遺伝子ごとの）平均シグナル強度を計算
tmp.class2 <- apply(data[,data.cl == 1], 1, mean) #Tumourサンプル群の（遺伝子ごとの）平均シグナル強度を計算
ave_vector <- (tmp.class1 + tmp.class2)/2 #全サンプルの（遺伝子ごとの）平均シグナル強度を計算しave_vectorに格納
dr <- max(ave_vector) - min(ave_vector) #全サンプルの（遺伝子ごとの）平均シグナル強度のダイナミックレンジ（最大値-最小値）を計算しdrに格納
stat_wad <- apply(data, 1, WAD, data.cl, dr, min(ave_vector)) #WADを実行し、WAD統計量を計算した結果をstat_wadに格納
rank_wad <- rank(-abs(stat_wad)) #WAD統計量の順位を計算した結果をrank_wadに格納
tmp <- cbind(rownames(data), data, stat_wad, rank_wad) #入力データの右側に、「WAD統計量」と「その順位」を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. 入力ファイルがlogged dataでない場合：
以下では（遺伝子名の列を除く）最初の6列(X=6)がA群、残りの5列(Y=5)がB群からなる（まだ対数変換されていない）
遺伝子発現データファイル（sample2.txt）の二群間比較を例とします。
「ファイル」−「ディレクトリの変更」で解析したいファイル（sample2.txt）を置いてあるディレクトリに移動し、以下をコピペ。
------ ここから ------
in_f <- "sample2.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 6 #A群のサンプル数を指定
param2 <- 5 #B群のサンプル数を指定
WAD <- function(x, cl, dynamic_r, min_v){ #WAD統計量を計算するための関数
x.class1 <- x[(cl == 0)] #WAD統計量を計算するための関数
x.class2 <- x[(cl == 1)] #WAD統計量を計算するための関数
x_ave <- (mean(x.class1) + mean(x.class2))/2 #WAD統計量を計算するための関数
weight <- (x_ave - min_v)/dynamic_r #WAD統計量を計算するための関数
statistic <- (mean(x.class2) - mean(x.class1))*weight #WAD統計量を計算するための関数
return(statistic) #WAD統計量を計算するための関数
} #WAD統計量を計算するための関数
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data[data < 1] <- 1 #1未満のシグナル強度のものを1とする
data <- log(data, 2) #log2スケーリング
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
tmp.class1 <- apply(data[,data.cl == 0], 1, mean) #Normalサンプル群の（遺伝子ごとの）平均シグナル強度を計算
tmp.class2 <- apply(data[,data.cl == 1], 1, mean) #Tumourサンプル群の（遺伝子ごとの）平均シグナル強度を計算
ave_vector <- (tmp.class1 + tmp.class2)/2 #全サンプルの（遺伝子ごとの）平均シグナル強度を計算しave_vectorに格納
dr <- max(ave_vector) - min(ave_vector) #全サンプルの（遺伝子ごとの）平均シグナル強度のダイナミックレンジ（最大値-最小値）を計算しdrに格納
stat_wad <- apply(data, 1, WAD, data.cl, dr, min(ave_vector)) #WADを実行し、WAD統計量を計算した結果をstat_wadに格納
rank_wad <- rank(-abs(stat_wad)) #WAD統計量の順位を計算した結果をrank_wadに格納
tmp <- cbind(rownames(data), data, stat_wad, rank_wad) #入力データの右側に、「WAD統計量」と「その順位」を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
参考文献(Kadota et al., Algorithms Mol. Biol., 2008)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | RF（random forest）に基づく方法 (Diaz-Uriarte_2007)
決定木の一種。日本語では「ランダム森 or ランダムフォレスト」というらしく、分類性能が非常に高いそうです。
以下では（遺伝子名の列を除く）最初の50列(X=50)が正常サンプル(A群)、残りの52列(Y=52)が腫瘍サンプル(B群)からなる（すでに対数変換されている）遺伝子発現データファイル（data_Singh_RMA_3274.txt）の二群間比較を例とします。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
library(varSelRF) #varSelRFパッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- factor(c(rep(1, param1), rep(2, param2))) #A群を1、B群を2としたベクトルdata.clを作成
rf.vs1 <- varSelRF(t(data), data.cl) #RFをデフォルトのパラメータを用いて実行
rf.vs1$selected.vars #最終的に選ばれた遺伝子を表示
------ ここまで ------
CRAN中のvarSelRFパッケージのサイト
PDFマニュアル
参考文献1(R package; Diaz-Uriarte R., BMC Bioinformatics, 2007)
参考文献2(原著論文; Diaz-Uriarte and Andres., BMC Bioinformatics, 2006)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | shrinkage t statistic (Opgen-Rhein and Strimmer_2007)
参考文献1の方法（Distribution-Free Shrinkage Approach）を用いて二群間で発現の異なる遺伝子をランキング。このライブラリ中では、他に参考文献2の方法(t statistic using the 90% rule of Efron et al., 2001)、
経験ベイズ(empirical Bayes; Smyth_2004)、SAM(Tusher_2001)の計算もやってくれるので、ここでは全部の結果を出力します。
以下では（遺伝子名の列を除く）最初の50列(X=50)が正常サンプル(A群)、残りの52列(Y=52)が腫瘍サンプル(B群)からなる（すでに対数変換されている）遺伝子発現データファイル（data_Singh_RMA_3274.txt）の二群間比較を例とします。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
library(st) #shrinkage t statisticを計算するためのパッケージの読み込み
library(samr) #SAMを計算するためのパッケージの読み込み
library(limma) #empirical Bayesを計算するためのパッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成
stat_st <- shrinkt.stat(t(data), data.cl) #Shrinkage t統計量を計算し結果をstat_stに格納
rank_st <- rank(-abs(stat_st)) #Shrinkage t統計量の順位を計算し結果をrankt_stに格納
stat_efron <- efront.stat(t(data), data.cl) #Efron's t統計量を計算し結果をstat_efronに格納
rank_efron <- rank(-abs(stat_efron)) #Efron's t統計量の順位を計算し結果をrank_efronに格納
stat_ebayes <- modt.stat(t(data), data.cl) #Empirical Bayes t統計量を計算し結果をstat_ebayesに格納
rank_ebayes <- rank(-abs(stat_ebayes)) #Empirical Bayes t統計量の順位を計算し結果をrank_ebayesに格納
stat_sam <- sam.stat(t(data), data.cl) #SAM's t統計量を計算し結果をstat_samに格納
rank_sam <- rank(-abs(stat_sam)) #SAM's t統計量の順位を計算し結果をrank_samに格納
tmp <- cbind(rownames(data), data, stat_st, rank_st, stat_efron, rank_efron, stat_ebayes, rank_ebayes, stat_sam, rank_sam)#「それぞれの計算方法で得られた統計量」と「その順位」をShrinkage, Efron, empirical Bayes, SAMの順に右のカラムに結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
CRANのstのwebページ
CRANのstのPDFマニュアル
CRANのsamrのwebページ
CRANのsamrのPDFマニュアル
Bioconductorのlimmaのwebページ
参考文献1(Opgen-Rhein and Strimmer, Stat. Appl. Genet. Mol. Biol., 2007)
参考文献2(Efron et al., J. Amer. Statist. Assoc., 2001)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | layer ranking algorithm (Chen_2007)
参考文献1の方法を用いて二群間で発現の異なる遺伝子をランキング。この論文中では三つのlayer ranking algorithms (point-admissible, line-admissible, and Pareto)を提案しています。
MicroArray Quality Control (MAQC)プロジェクトではより再現性の高い発現変動遺伝子セットを抽出するために「倍率変化（Fold change）によるランキング；Fold-change ranking」と「緩めのp-valueカットオフ；non-stringent p-value cutoff」の両方を用いることをお勧めしています（参考文献2）。
これは最近よく使われる候補遺伝子抽出のための手続きであり、前者（log ratio）を横軸、後者(-log(p-value, base=10)など)を縦軸として得られる図を"volcano plot"といいます。しかしこれでは候補遺伝子セットが得られるだけで、その2つのランキングから得られる総合ランキングをどうやって得るかが問題です。参考文献1でChenらは「複数の候補遺伝子ランキング法→総合ランキング」を得るための三つの方法を提案しています。
一つめはpoint-admissible layer ranking (method="rlfq"で指定), 二つめはline-admissible layer ranking (method="convex"で指定), そして三つめはPareto layer ranking (method="pareto"で指定)です。ここでは、一つの解析例を挙げておきます。
以下では（遺伝子名の列を除く）最初の50列(X=50)が正常サンプル(A群)、残りの52列(Y=52)が腫瘍サンプル(B群)からなる（すでに対数変換されている）遺伝子発現データファイル（data_Singh_RMA_3274.txt）の二群間比較用データを用いて、
1.「log2(幾何平均版のFold change)の絶対値でのランキング」と「SAM統計量の絶対値でのランキング」→ Pareto layer ranking (method="pareto"で指定)で総合ランキング
および
2.「log2(幾何平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」→ Pareto layer ranking (method="pareto"で指定)で総合ランキング
3.「log2(算術平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」→ Pareto layer ranking (method="pareto"で指定)で総合ランキング
を得るやり方を示します。
コピペで動かないままになっていたのを修正しました(2009/11/10, 12:38)。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 「log2(幾何平均版のFold change)の絶対値でのランキング」と「SAM統計量の絶対値でのランキング」の場合：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
param3 <- "pareto" #ランキング法を指定
#source("http://gap.stat.sinica.edu.tw/Software/mvo.R") #layer ranking algorithmのRスクリプトの読み込み
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #layer ranking algorithmのRスクリプトの読み込み
library(samr) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成
data.tmp = list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpという入力データを作成
out <- samr(data.tmp, resp.type="Two class unpaired", nperms=20) #samr関数を実行し、結果をoutに格納
stat_sam <- out$tt #SAM統計量をstat_samに格納
rank_sam <- rank(-abs(stat_sam)) #SAM統計量の順位をrank_samに格納
stat_fc <- log2(out$foldchange) #log(FC)統計量をstat_fcに格納
rank_fc <- rank(-abs(stat_fc)) #log(FC)統計量の順位をrank_fcに格納
ranks <- cbind(stat_sam, stat_fc) #SAM統計量とFC統計量をまとめたものをranksに格納。
ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)#param3で指定した総合ランキングを実行
tmp <- cbind(rownames(data), data, stat_sam, stat_fc, rank_sam, rank_fc, ranks.out)#入力データの右側に「SAM統計量」「log(FC)」「SAM統計量の順位」「log(FC)の順位」「layer ranking」情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
以下の計算を実行すると（結構時間がかかります）一位に"37639_at"と"41468_at"の2つが、二位に"1740_g_at"と"37366_at"が、そして三位に"1890_at"など計三つがランキングされていることが分かります。（hoge.txtをエクセルのタブ区切りテキストで開くとFカラムからこれらの情報が分かります。）
ここではPareto layer ranking (method="pareto"で指定)で総合ランキングを得ているので、同じ順位内の遺伝子群は「log2(Fold change)の絶対値でのランキング」または「SAMのd統計量の絶対値でのランキング」いずれかで、同じ順位内の他の遺伝子に対して勝っています。
例えば、総合ランキング三位の三つの遺伝子は、（総合ランキング一位と二位を除いて）"1890_at"は「log ratioの絶対値での順位」がトップ（4位）です。"32598_at"は「d統計量の絶対値での順位」がトップ（4位）。"38827_at"はそれぞれのランキングはともに5位ですが、「log ratioの絶対値での順位」は"32598_at"に勝っており、「d統計量の絶対値での順位」は"1890_at"に勝っているので、順位的に劣っているとはみなさない、というのがここでのPareto layer rankingの考え方です。
2. 「log2(幾何平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」の場合：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
param3 <- "pareto" #ランキング法を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #layer ranking algorithmのRスクリプトの読み込み
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Welch t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out <- t(apply(data, 1, Welch_ttest, data.cl)) #各（行）遺伝子についてt検定を行った結果のt統計量とp値をoutに格納
stat_t <- out[,1] #t統計量をstat_tに格納
rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納
stat_fc <- apply(data, 1, AD, data.cl) #log(FC)統計量(AD統計量)をstat_fcに格納
rank_fc <- rank(-abs(stat_fc)) #log(FC)統計量の順位をrank_fcに格納
ranks <- cbind(stat_t, stat_fc) #t統計量とFC統計量をまとめたものをranksに格納。
ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)#param3で指定した総合ランキングを実行
tmp <- cbind(rownames(data), data, stat_t, stat_fc, rank_t, rank_fc, ranks.out)#入力データの右側に「t統計量」「log(FC)」「t統計量の順位」「log(FC)の順位」「layer ranking」情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
3. 「log2(算術平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」の場合：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
param3 <- "pareto" #ランキング法を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #layer ranking algorithmのRスクリプトの読み込み
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Welch t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out <- t(apply(data, 1, Welch_ttest, data.cl)) #各（行）遺伝子についてt検定を行った結果のt統計量とp値をoutに格納
stat_t <- out[,1] #t統計量をstat_tに格納
rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納
stat_fc <- apply(data, 1, FC, data.cl) #log(FC)統計量をstat_fcに格納
rank_fc <- rank(-abs(stat_fc)) #log(FC)統計量の順位をrank_fcに格納
ranks <- cbind(stat_t, stat_fc) #t統計量とFC統計量をまとめたものをranksに格納。
ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)#param3で指定した総合ランキングを実行
tmp <- cbind(rownames(data), data, stat_t, stat_fc, rank_t, rank_fc, ranks.out)#入力データの右側に「t統計量」「log(FC)」「t統計量の順位」「log(FC)の順位」「layer ranking」情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
Rスクリプトのある場所
参考文献1(Chen et al., BMC Bioinformatics, 2007)
参考文献2(MAQC Consortium, Nature Biotechnol., 2006)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | fdr2d (Ploner_2006)
一つ上のlayer ranking algorithm (Chen_2007)と同じく、発現変動遺伝子（Differentially Expressed Genes; DEGs）のランキングのために用いた複数の統計量（例えばFold changeとP-value）の結果から総合ランキングを得るとともにそのFDRを計算してくれるようです。
サンプルの並べ替え（permutation）でnon-DEGsの分布を計算し、どうにかしてFDRを計算してくれるみたいです。
以下では（遺伝子名の列を除く）最初の3列(X=3)がA群、残りの3列(Y=3)がB群からなる（すでに対数変換されている）遺伝子発現データファイル（sample14.txt）の二群間比較用データを用いて、
「標準誤差のlog」と「t統計量」で総合FDRを得るやり方を示します。
volcano plot (横軸：fold change, 縦軸：t-testなどで得られたp-value)の総合FDRは下記で利用しているfdr2d関数ではサポートされていないようですね。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ13中のsample14.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "sample14.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
library(OCplus) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
tmpout <- fdr1d(data, data.cl, verb=FALSE) #入力データ中の発現変動していない遺伝子(non-DEGs)の割合を調べた結果をtmpoutに格納
p0(tmpout) #得られたtmpoutの中から目的のnon-DEGsの割合の数値を表示
out <- fdr2d(data, data.cl, p0=p0(tmpout), verb=FALSE) #「標準誤差のlog」と「t統計量」の二つの統計量の値を使って総合FDRを計算
tmp <- cbind(rownames(data), data, out) #入力データの右側に「t統計量(tstat)」「標準誤差のlog(logse)」「総合FDR」情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
BioconductorのOCplusのwebページ
参考文献1(Ploner et al., Bioinformatics, 2006)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | IBMT (Sartor_2006)
参考文献1の方法を用いて二群間で発現の異なる遺伝子をランキング。経験ベイズの改良版という位置づけですね。a novel Bayesian moderated-Tと書いてますし。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
library(limma) #パッケージの読み込み
source("http://eh3.uc.edu/r/ibmtR.R") #IBMTのRスクリプトの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
design <- model.matrix(~data.cl) #おまじない
data <- as.matrix(data) #おまじない
fit <- lmFit(data, design) #おまじない
fit$Amean<-rowMeans(data) #おまじない
fit <- IBMT(fit,2) #IBMTプログラムの実行
stat_ibmt <- fit$IBMT.t #得られた統計量をstat_ibmtに格納
rank_ibmt <- rank(-abs(stat_ibmt)) #統計量の絶対値でランキングした結果をrank_ibmtに格納
tmp <- cbind(rownames(data), data, stat_ibmt, rank_ibmt) #入力データの右側に「IBMT統計量」「その順位」情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
Rスクリプトのある場所
参考文献(Sartor et al., BMC Bioinformatics, 2006)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | PPLR (Liu_2006)
参考文献1の方法を用いて二群間で発現の異なる遺伝子をランキング。
これはmulti-mgMOSなどの前処理法をかけたあとに得られる「発現レベルの不確実性（uncertainty for the expression level）」の情報を使うことで精度向上を目指しているものなので、
ここではmulti-mgMOS/PPLRの組み合わせで発現変動の度合いでランキングする手順を示します。
また、例として、GEOよりダウンロード可能な参考文献2 (GSE7819)のデータ(GSM189708-GSM189713)の解析（3 SVG-A vs. 3 SVGR2）を示します。
つまり、*.CELファイル名とサンプルラベルは以下のような関係にあります。
-------------------------------
GSM189708.CEL SVG-A A群
GSM189709.CEL SVG-A A群
GSM189710.CEL SVG-A A群
GSM189711.CEL SVGR2 B群
GSM189711.CEL SVGR2 B群
GSM189711.CEL SVGR2 B群
-------------------------------
「ファイル」−「ディレクトリの変更」で解析したいファイル（*.CELファイル）を置いてあるディレクトリに移動し、以下をコピペ
1. PPLRの通常のやり方
------ ここから ------
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
library(puma) #パッケージの読み込み
data <- ReadAffy() #*.CELファイルの読み込み
eset_mmgmos <- mmgmos(data) #multi-mgMOSを実行し、結果をeset_mmgmosに保存
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
pData(eset_mmgmos) <- data.frame( #各CELファイルとラベル情報を対応づける
"label" = data.cl, #各CELファイルとラベル情報を対応づける
row.names = list.files(pattern = ".CEL") #各CELファイルとラベル情報を対応づける
eset_mmgmos_normd <- pumaNormalize(eset_mmgmos) #median scalingを行う
eset_comb <- pumaComb(eset_mmgmos_normd) #PPLRの実行1 (6 hrほどかかるもよう...)
eset_DE <- pumaDE(eset_comb) #PPLRの実行2
stat_pplr <- abs(statistic(eset_DE) - 0.5) #PPLRが出力する統計量は[0,1]の範囲で0.5が発現変動なしに相当するので、WADやSAMと同じ枠組みで処理できるように得られた統計量から0.5を引いておく
rank_pplr <- rank(-abs(stat_pplr)) #統計量の絶対値でランキングした結果をrank_pplrに格納
tmp <- cbind(rownames(data), data, stat_pplr, rank_pplr) #入力データの右側に「変換後のPPLR統計量」「その順位」情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. (logスケールで)シグナル強度が0以下のものを0にしてからPPLRを実行するやり方（WADなどの手順とそろえたいとき）
------ ここから ------
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
library(puma) #パッケージの読み込み
data <- ReadAffy() #*.CELファイルの読み込み
eset_mmgmos <- mmgmos(data) #multi-mgMOSを実行し、結果をeset_mmgmosに保存
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
pData(eset_mmgmos) <- data.frame( #各CELファイルとラベル情報を対応づける
"label" = data.cl, #各CELファイルとラベル情報を対応づける
row.names = list.files(pattern = ".CEL") #各CELファイルとラベル情報を対応づける
eset_mmgmos_normd <- pumaNormalize(eset_mmgmos) #median scalingを行う
exprs(eset_mmgmos_normd)[exprs(eset_mmgmos_normd) < 0] <- 0 #シグナル強度が0以下のものを0にする
eset_comb <- pumaComb(eset_mmgmos_normd) #PPLRの実行1 (6 hrほどかかるもよう...)
eset_DE <- pumaDE(eset_comb) #PPLRの実行2
stat_pplr <- abs(statistic(eset_DE) - 0.5) #PPLRが出力する統計量は[0,1]の範囲で0.5が発現変動なしに相当するので、WADやSAMと同じ枠組みで処理できるように得られた統計量から0.5を引いておく
rank_pplr <- rank(-abs(stat_pplr)) #統計量の絶対値でランキングした結果をrank_pplrに格納
tmp <- cbind(rownames(data), data, stat_pplr, rank_pplr) #入力データの右側に「変換後のPPLR統計量」「その順位」情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
Bioconductorの(PPLRとmulti-mgMOSを含むパッケージ)pumaのwebページ
参考文献1(Liu et al., Bioinformatics, 2006)
参考文献2(Manley et al., Virology, 2007)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | Rank products (package: RankProd)
参考文献1の方法を用いて二群間で発現の異なる遺伝子をランキング。非常によく用いられているSAMよりも成績がいいとのこと。
実際、最近の様々な方法を比較した論文（参考文献3）中でも高い評価を受けているようだ。
この方法を使って遺伝子のランキングをした結果はt検定やSAMなどとは”かなり”違います（参考文献4）。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
param3 <- 20 #FDR計算のための並べ替え回数を指定（ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう）
library(RankProd) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out <- RP(data, data.cl, num.perm = param3, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 123)#Rank Product (RP)の実行。
stat_RP <- apply(out$RPs, 1, min) #総合RP統計量を計算(20090527追加)
rank_RP <- as.matrix(rank(stat_RP, ties.method = "min")) #総合順位を計算(20090527追加)
stat_fc <- -out$AveFC #総合log(FC)統計量を計算
rank_fc <- rank(-abs(stat_fc)) #総合log(FC)統計量の順位を計算
colnames(out$pfp) <- c("FDR(A群 < B群)","FDR(A群 > B群)") #列名を変更(20090527追加)
colnames(out$RPs) <- c("stat(A群 < B群)","stat(A群 > B群)") #列名を変更(20090527追加)
colnames(out$RPrank) <- c("rank(A群 < B群)","rank(A群 > B群)") #列名を変更(20090527追加)
tmp <- cbind(rownames(data), data, out$pfp, out$RPs, out$RPrank, stat_fc, rank_fc, stat_RP, rank_RP)#入力データの右側にFDR値, 各統計量, 各順位, 総合log(FC)統計量, その順位, 総合RP統計量, その順位の情報を付加したtmpを用意。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
plotRP(out, cutoff = 0.05) #FDRを5%に設定したときのB群(この場合Tumourサンプル)で高発現（2つの図の上）および低発現（2つの図の下）のdifferentially expressed genesが赤色で示される。この場合だとそれぞれ500個程度あることが分かる。
topGene(out, cutoff = 0.0001, gene.names = rownames(data)) #FDR0.01%を満たす遺伝子をリストアップ。（いっぱいあることが分かります。）尚、オプションのgene.namesはrownames(data)とちゃんと指定してあげないと遺伝子名のところがシリアル番号？！(gene.indexカラムの数字と同じ)になってしまいます。
topGene(out, num.gene = 10, gene.names = rownames(data)) #上位10遺伝子をリストアップしたいとき
summary(out) #outからどのような情報を抽出できるか調べる。
------ ここまで ------
得られるhoge.txtについて。
FDR列：pfp (percentage of false positive predictionの略；FDRそのもの)値。この列で昇順にソートして0.05未満のもののリストなどをゲットしたりする。
stat列：RPs (RP or RPadvance関数を使ったときはrank product；RSadvance関数を使ったときはrank sum)値。統計量そのものです。低いほど発現変動の度合いが高いことを意味する。
rank列：順位
stat_fc列：log比（Bの算術平均 - A群の算術平均)値。
rank_fc列：stat_fc値の絶対値が大きい順に並べた順位。
stat_RP列：二つある"stat"列の統計量のうち、小さいほうの値。この値が小さいほど発現変動の度合いが大きいと解釈する。
rank_RP列：総合順位。Rank列は、「A群 < B群での順位」と「A群 > B群での順位」が独立に出てくるので、WADの順位との比較を行いたいなどの場合には、この総合順位を用いて行います。
BioconductorのRankProdのwebページ
参考文献1(Breitling et al., FEBS Lett., 2004)
参考文献2(Hong et al., Bioinformatics, 2006)
参考文献3(Jeffery et al., BMC Bioinformatics, 2006)
参考文献4(Kadota et al., Algorithms Mol. Biol., 2008)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | Empirical bayes statistic
この方法は、最近の様々な方法を比較した論文（参考文献2）中でも高い評価を受けている。
基本がt検定なので、SAMなどときわめて似た遺伝子のランキング結果を示す。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
library(st) #shrinkage t statisticを計算するためのパッケージの読み込み
library(limma) #empirical Bayesを計算するためのパッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成
stat_ebayes <- modt.stat(t(data), data.cl) #Empirical Bayes t統計量を計算し結果をstat_ebayesに格納
rank_ebayes <- rank(-abs(stat_ebayes)) #Empirical Bayes t統計量の順位を計算し結果をrank_ebayesに格納
tmp <- cbind(rownames(data), data, stat_ebayes, rank_ebayes) #入力データの右側に「統計量」と「その順位」を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
Bioconductorのlimmaのwebページ
参考文献1(Smyth, GK, Stat Appl Genet Mol Biol., 2004)
参考文献2(Jeffery et al., BMC Bioinformatics, 2006)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | samroc (Broberg_2003)
参考文献1の方法を用いて二群間で発現の異なる遺伝子をランキング。ROC curveに基づいてSAM統計量を計算したもの。よく用いられているSAMよりも成績がいいとのこと（参考文献2）。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
library(SAGx) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out <- samrocNboot(data=data, formula=~as.factor(data.cl)) #samrocを実行
show(out) #結果を表示
stat_samroc <- out@d #samroc統計量をstat_samrocに格納
rank_samroc <- rank(-abs(stat_samroc)) #samroc統計量の順位をrank_samrocに格納
p_samroc <- out@pvalues #p値をp_samrocに格納
tmp <- cbind(rownames(data), data, stat_samroc, p_samroc, rank_samroc)#入力データの右側に統計量、p値、順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
BioconductorのSAGxのwebページ
参考文献1(Broberg P., Genome Biol., 2003)
参考文献2(Choe et al., Genome Biol., 2005)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | SAM
Significance Analysis of Microarrays (SAM)法。改良版t-statisticを用いて発現強度依存の偏りを補正すべく、従来のt-statisticの数式の分母に補正項(fudge factor)を付加しているところがポイント。
ここでは、「SAM統計量とその順位」および「log(FC)統計量とその順位」を出力結果として得るやり方を示します。また、入力データは対数変換後のものを想定（logged2=TRUE）しています。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ9中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
param3 <- 20 #FDR計算のための並べ替え回数を指定（ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう）
library(samr) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成
data.tmp = list(x=as.matrix(data), y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpを作成
out <- samr(data.tmp, resp.type="Two class unpaired", nperms=param3)#samr関数を実行し、結果をoutに格納。
summary(out) #outからどのような情報が抜き出せるか調べる。
stat_sam <- out$tt #SAM統計量をstat_samに格納
rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納
stat_fc <- log2(out$foldchange) #log(FC)統計量をstat_fcに格納
rank_fc <- rank(-abs(stat_fc)) #統計量の絶対値でランキングした結果をrank_fcに格納
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, stat_fc, rank_fc)#入力データの右側に「SAM統計量」「その順位」「log(FC)統計量」「その順位」を結合した結果をtmpに格納。ここでのFold changeの値はunlogged dataのaverage fold change（B群/A群）が計算されています。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
CRANのsamrのwebページ
CRANのsamrのPDFマニュアル
参考文献1(Tusher et al., PNAS, 2001)
解析 | 発現変動遺伝子 | 二群間 | 対応なし | Student's t-test
等分散性を仮定したt検定を用いて、二群間での発現変動遺伝子の同定を行う。また、入力データは対数変換(log2変換)後のものを想定しています。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ9中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
1. やり方1：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
#等分散性を仮定（var.equal=T）してt.testを行い、t統計量とp-valueの値を返す関数Students_ttestを作成。
Students_ttest <- function(x, cl){
x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納
x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納
if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので...
stat <- 0 #統計量を0
pval <- 1 #p値を1
return(c(stat, pval)) #として結果を返す
}
else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は
hoge <- t.test(x.class1, x.class0, var.equal=T) #通常のt検定を行って、
return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す
}
}
out <- t(apply(data, 1, Students_ttest, data.cl)) #各（行）遺伝子についてt検定を行った結果のt統計量とp値をoutに格納
stat_t <- out[,1] #t統計量をstat_tに格納
rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納
p_t <- out[,2] #p値をp_tに格納
tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合：
param3 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
2. やり方2(関数の定義の部分が少し違うだけです)：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Student's t-testを行うStudents_ttest関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out <- t(apply(data, 1, Students_ttest, data.cl)) #各（行）遺伝子についてt検定を行った結果のt統計量とp値をoutに格納
stat_t <- out[,1] #t統計量をstat_tに格納
rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納
p_t <- out[,2] #p値をp_tに格納
tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合：
param3 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmpに格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
解析 | 発現変動遺伝子 | 二群間 | 対応なし | Welch t-test
不等分散性を仮定したt検定を用いて、二群間での発現変動遺伝子の同定を行う。また、入力データは対数変換(log2変換)後のものを想定しています。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ9中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
1. やり方1：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
#不等分散性を仮定（var.equal=T）してt.testを行い、t統計量とp-valueの値を返す関数Welch_ttestを作成。
Welch_ttest <- function(x, cl){
x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納
x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納
if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので...
stat <- 0 #統計量を0
pval <- 1 #p値を1
return(c(stat, pval)) #として結果を返す
}
else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は
hoge <- t.test(x.class1, x.class0, var.equal=F) #通常のt検定を行って、
return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す
}
}
out <- t(apply(data, 1, Welch_ttest, data.cl)) #各（行）遺伝子についてt検定を行った結果のt統計量とp値をoutに格納
stat_t <- out[,1] #t統計量をstat_tに格納
rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納
p_t <- out[,2] #p値をp_tに格納
tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合：
param3 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
2. やり方2(関数の定義の部分が少し違うだけです)：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Welch t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out <- t(apply(data, 1, Welch_ttest, data.cl)) #各（行）遺伝子についてt検定を行った結果のt統計量とp値をoutに格納
stat_t <- out[,1] #t統計量をstat_tに格納
rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納
p_t <- out[,2] #p値をp_tに格納
tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合：
param3 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmpに格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
解析 | 発現変動遺伝子 | 二群間 | 対応なし | Mann-Whitney U-test
Mann-Whitney（マンホイットニー; MW） U検定を用いて、二群間での発現変動遺伝子の同定を行う。入力データは対数変換(log2変換)後のものを例として使用してはいますが、この方法はノンパラメトリックな方法なので、対数変換していようがいまいが同じ結果を返すので、特に気にする必要はありません。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ9中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
1. やり方1：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
#MWのU検定を行い、t統計量とp-valueの値を返す関数MW_Utestを作成。
MW_Utest <- function(x, cl){
x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納
x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納
hoge <- wilcox.test(x.class1, x.class0) #MWのU検定を行って、
return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す
}
out <- t(apply(data, 1, MW_Utest, data.cl)) #各（行）遺伝子についてMWのU検定を行った結果の統計量とp値をoutに格納
stat_u <- out[,1] #統計量をstat_uに格納
rank_u <- rank(-abs(stat_u)) #統計量の順位をrank_uに格納
p_u <- out[,2] #p値をp_uに格納
tmp <- cbind(rownames(data), data, stat_u, p_u, rank_u) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#(A群 vs. B群) MWのU検定でp<0.05を満たす遺伝子群のみを抽出したい場合：
param3 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_u < param3) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_u < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_u),] #順位(rank_u)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
2. やり方2(関数の定義の部分が少し違うだけです)：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 50 #A群のサンプル数を指定
param2 <- 52 #B群のサンプル数を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Student's t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
out <- t(apply(data, 1, MW_Utest, data.cl)) #各（行）遺伝子についてMWのU検定を行った結果の統計量とp値をoutに格納
stat_u <- out[,1] #統計量をstat_uに格納
rank_u <- rank(-abs(stat_u)) #統計量の順位をrank_uに格納
p_u <- out[,2] #p値をp_uに格納
tmp <- cbind(rownames(data), data, stat_u, p_u, rank_u) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#(A群 vs. B群) MWのU検定でp<0.05を満たす遺伝子群のみを抽出したい場合：
param3 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_u < param3) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_u < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_u),] #順位(rank_u)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
解析 | 発現変動遺伝子 | 二群間 | 対応なし | パターンマッチング法
パターンマッチング法を用いて、二群間での発現変動遺伝子の同定を行うやり方を紹介します。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ15中のsample16.txtファイル（遺伝子発現データ）とsample16_cl.txtファイル（クラスラベルデータ）を置いてあるディレクトリに移動し、以下をコピペ
1. クラスラベル情報ファイル（sample16_cl.txt）を読み込んでテンプレートパターン情報を得る場合：
------ ここから ------
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定
in_f2 <- "sample16_cl.txt" #入力ファイル名2（テンプレート情報）を指定
out_f <- "hoge.txt" #出力ファイル名を指定
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納
hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納
data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成
r <- apply(data, 1, cor, y=data.cl) #各（行）遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納
tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
2. クラスラベル情報ファイル（sample16_cl.txt）を読み込まずにテンプレートパターン情報を得る場合：
------ ここから ------
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 6 #A群のサンプル数を指定
param2 <- 5 #B群のサンプル数を指定
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
r <- apply(data, 1, cor, y=data.cl) #各（行）遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納
tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
解析 | 発現変動遺伝子 | 二群間 | 対応あり | について
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します（当然比較する二群のサンプル数は同じであるべき！）：
-------------------
Aさんの正常サンプル
Bさんの正常サンプル
Cさんの正常サンプル
...
Aさんの癌サンプル
Bさんの癌サンプル
Cさんの癌サンプル
...
-------------------
ここでは二つの方法を紹介しています。
一つは有名なSAM（参考文献1）のやりかたです。
もう一つはSAMで得られた統計量を基本としつつ、シグナル強度が高い遺伝子を上位にランキングするように重みをかけた統計量を返すやり方です。
これは参考文献2のWAD統計量の重みの項だけをSAM統計量にかけた、いわばweighted SAM統計量です。
WAD統計量はAD統計量×weightで得られるものですが、the weighted SAM統計量 = SAM統計量×weightとして計算しています。
このweightの計算はいたってシンプルです。例えば計5遺伝子しかないとして、「gene1の対数変換後の平均シグナル強度が8, gene2の〜5, gene3の〜7, gene4の〜11, gene5の〜2」だったとすると、最も平均シグナル強度が高い遺伝子のweight=1, 最も低い遺伝子のweight=0のように規格化しているだけです。
つまり、
gene1のweight = (8 - min(8, 5, 7, 11, 2))/(max(8, 5, 7, 11, 2) - min(8, 5, 7, 11, 2)) = (8 - 2)/(11 - 2) = 0.6666...
gene2のweight = (5 - 2)/(11 - 2) = 0.3333...
gene3のweight = (7 - 2)/(11 - 2) = 0.5555...
gene4のweight = (11 - 2)/(11 - 2) = 1
gene5のweight = (2 - 2)/(11 - 2) = 0
です。相対平均シグナル強度をweightとしているだけです。
ただし、A群, B群のサンプル数の違いを考慮する必要はあるので「平均シグナル強度= (mean(A) + mean(B))/2」です。
参考文献1(Tusher et al., PNAS, 2001)
参考文献2(Kadota et al., Algorithms Mol. Biol., 2008)
解析 | 発現変動遺伝子 | 二群間 | 対応あり | SAM (Tusher_2001)
Significance Analysis of Microarrays (SAM)法で「対応ありの二群間比較（two-class paired）」を行う。
ここでは例題として用いた102サンプルからなるファイル（data_Singh_RMA_3274.txt）のラベル情報が以下のようになっていると仮定します：
------------------------
症例 1さんの正常サンプル
症例 2さんの正常サンプル
...
症例51さんの正常サンプル
症例 1さんの腫瘍サンプル
症例 2さんの腫瘍サンプル
...
症例51さんの腫瘍サンプル
------------------------
また、このファイルはすでに底が2でlog変換されているものとします（logged2=TRUE）。
「ファイル」−「ディレクトリの変更」で解析したいファイル（data_Singh_RMA_3274.txt）を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 51 #症例数を指定
param3 <- 60 #FDR計算のための並べ替え回数を指定（ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう）
library(samr) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(-(1:param1), 1:param1) #症例の正常と腫瘍サンプルを対にして情報を与えたベクトルdata.clを作成（症例1の正常が-1、腫瘍が1などという感じで同じ数字のプラスとマイナスで対になっていることを認識させている）
data.tmp = list(x=as.matrix(data), y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpを作成
out <- samr(data.tmp, resp.type="Two class paired", nperms=param3)#samr関数を実行し、結果をoutに格納。
summary(out) #outからどのような情報が抜き出せるか調べる。
stat_sam <- out$tt #SAM統計量をstat_samに格納
rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納
stat_fc <- log2(out$foldchange) #log(FC)統計量をstat_fcに格納
rank_fc <- rank(-abs(stat_fc)) #統計量の絶対値でランキングした結果をrank_fcに格納
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, stat_fc, rank_fc)#入力データの右側に「SAM統計量」「その順位」「log(FC)統計量」「その順位」を結合した結果をtmpに格納。ここでのFold changeの値はunlogged dataのaverage fold change（B群/A群）が計算されています。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
CRANのsamrのwebページ
CRANのsamrのPDFマニュアル
参考文献1(Tusher et al., PNAS, 2001)
解析 | 発現変動遺伝子 | 二群間 | 対応あり | SAM (Tusher_2001)にWADのようなシグナル強度による重みをかけたい
Significance Analysis of Microarrays (SAM)法で「対応ありの二群間比較（two-class paired）」を行う。
が、WAD (Kadota_2008)を知っている人は「シグナル強度が高い遺伝子を上位に来るようにランキングしたい」と思います。
そこで、上記SAM統計量にWADの重みの項(weight)をかけた統計量を返すやり方をここでは紹介しています。
下記を行って得られるhoge.txt中のweight列がWADの重みの項になります。結果として得たい統計量およびランキング結果はstat_sam_wadおよびrank_sam_wadの列になります。
確かに全体としてシグナル強度が高い遺伝子が上位にランクされていることがおわかりいただけると思います。
ここでは例題として用いた102サンプルからなるファイル（data_Singh_RMA_3274.txt）のラベル情報が以下のようになっていると仮定します：
------------------------
症例 1さんの正常サンプル
症例 2さんの正常サンプル
...
症例51さんの正常サンプル
症例 1さんの腫瘍サンプル
症例 2さんの腫瘍サンプル
...
症例51さんの腫瘍サンプル
------------------------
また、このファイルはすでに底が2でlog変換されているものとします（logged2=TRUE）。
「ファイル」−「ディレクトリの変更」で解析したいファイル（data_Singh_RMA_3274.txt）を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 51 #症例数を指定
param3 <- 60 #FDR計算のための並べ替え回数を指定（ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう）
library(samr) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(-(1:param1), 1:param1) #症例の正常と腫瘍サンプルを対にして情報を与えたベクトルdata.clを作成（症例1の正常が-1、腫瘍が1などという感じで同じ数字のプラスとマイナスで対になっていることを認識させている）
data.tmp = list(x=as.matrix(data), y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpを作成
out <- samr(data.tmp, resp.type="Two class paired", nperms=param3)#samr関数を実行し、結果をoutに格納。
stat_sam <- out$tt #SAM統計量をstat_samに格納
rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納
data.cl <- c(rep(0, param1), rep(1, param1)) #A群を0、B群を1としたベクトルdata.clを作成
tmp.class1 <- apply(data[,data.cl == 0], 1, mean) #A群の（遺伝子ごとの）平均シグナル強度を計算
tmp.class2 <- apply(data[,data.cl == 1], 1, mean) #B群の（遺伝子ごとの）平均シグナル強度を計算
ave_vector <- (tmp.class1 + tmp.class2)/2 #全サンプルの（遺伝子ごとの）平均シグナル強度を計算しave_vectorに格納
dr <- max(ave_vector) - min(ave_vector) #全サンプルの（遺伝子ごとの）平均シグナル強度のダイナミックレンジ（最大値-最小値）を計算しdrに格納
weight <- (ave_vector - min(ave_vector))/dr #WADの重みの項を計算しweightに格納
stat_sam_wad <- stat_sam*weight #SAM統計量にWADの重みの項をかけたもの(stat_sam*weight)を計算しstat_sam_wadに格納
rank_sam_wad <- rank(-abs(stat_sam_wad)) #the weighted SAM統計量(stat_sam_wad)の絶対値でランキングした結果をrank_sam_wadに格納
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, weight, stat_sam_wad, rank_sam_wad)#入力データの右側に「SAM統計量」「その順位」「weight」「weighted SAM統計量(=SAM*weitht)」「その順位」を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
CRANのsamrのwebページ
CRANのsamrのPDFマニュアル
参考文献1(Tusher et al., PNAS, 2001)
解析 | 発現変動遺伝子 | 二群間 | 対応あり | 時系列 | について
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します：
-------------------
サンプルAの薬剤投与0h後
サンプルAの薬剤投与2h後
サンプルAの薬剤投与4h後
サンプルBの薬剤投与0h後
サンプルBの薬剤投与2h後
サンプルBの薬剤投与4h後
-------------------
解析 | 発現変動遺伝子 | 二群間 | 対応あり | 時系列 | Di Camillo's method 2 (Di Camillo_2007)
De Camilloらの提案したMethod 2の方法(Di Camillo et al., BMC Bioinformatics, 2007)を用いて
「Controlの時系列データ(例えばControl_0h, Control_2h, Control_6h)」と
「目的サンプルの時系列データ（例えばTarget_0h, Target_2h, Target_6h）」
といった二群の時系列データに対して、二群間で発現の異なるプロファイルを検出したい場合に用います。
参考文献(Di Camillo et al., BMC Bioinformatics, 2007)
R codeのあるウェブページ
解析 | 発現変動遺伝子 | 二群間 | 対応あり | 時系列 | maSigPro (Conesa_2006)
maSigPro(Conesa et al., Bioinformatics, 2006)法を用いて時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。おそらく以下のコマンドで抽出するやり方でいいと思います。
サンプルマイクロアレイデータの10bで示すような「Control (A)の時系列データ」と「Cold (B)の時系列データ」が手元にあり、「A vs. Bで発現の異なる遺伝子」を検出したいときに利用します。
「ファイル」−「ディレクトリの変更」で解析したい時系列遺伝子発現データのファイル(sample10_2groups.txt)とその実験デザイン情報に関するファイル(sample10_2groups_cl.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "sample10_2groups.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "sample10_2groups_cl.txt" #入力ファイル名(実験デザインファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 0.1 #閾値(FDR; "発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合)を指定
library(maSigPro) #パッケージの読み込み
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み
edesign <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="") #実験デザインファイルの読み込み
design <- make.design.matrix(edesign, degree=2) #regression（回帰）行列の作成。degree=2は、2次の回帰モデルで考えることを意味する
fit <- p.vector(data, design, Q=param1) #発現変動遺伝子の同定。
tstep <- T.fit(fit) #得られた発現変動遺伝子群の各々について最もよい回帰モデルを決める
out <- get.siggenes(tstep, rsq=0.7, vars="groups") #回帰モデルのRsquaredの値が0.7(この値がデフォルト)よりも大きいものを抽出し、outに格納
gene_id <- out$summary$BvsA[1:out$sig.genes$BvsA$g] #発現変動遺伝子のIDをgene_idに格納。
gene_profile <- out$sig.genes$BvsA$sig.profiles #発現変動遺伝子の発現プロファイルをgene_profileに格納。
p_masigpro <- out$sig.genes$BvsA$sig.pvalues[,1] #p値をp_masigproに格納。
rank_masigpro <- rank(abs(p_masigpro)) #p値の順位をrank_masigproに格納。
tmp <- cbind(gene_id, gene_profile, p_masigpro, rank_masigpro) #発現変動遺伝子についてのみ、その遺伝子ID、発現データ、p値、その順位を結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#発現変動の度合いでソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_masigpro),] #順位(rank_masigpro)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
BioconductorのmaSigProのwebページ
参考文献(Conesa et al., Bioinformatics, 2006)
解析 | 発現変動遺伝子 | 多群間 | 対応なし |について
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します：
-------------------
AさんのControlサンプル
BさんのControlサンプル
CさんのControlサンプル
Dさんの薬剤X刺激後サンプル
Eさんの薬剤X刺激後サンプル
Fさんの薬剤X刺激後サンプル
Gさんの薬剤X刺激後サンプル
Hさんの薬剤Y刺激後サンプル
Iさんの薬剤Y刺激後サンプル
Jさんの薬剤Y刺激後サンプル
-------------------
三群以上の比較は、どの群間で差があるのかまではANOVAなどだけでは分かりません。Rではありませんがpost hoc pattern matching (PPM) algorithm (Hulshizer and Blalock, BMC Bioinformatics, 2007）という方法が最近提唱されているのを発見しましたので、興味ある方は試してみてください。Excel (Visual Basic program)だそうです。
ちなみにこの方法は4つのステップからなります（頭では理解できているつもりですが、うまく日本語で表現できていません、あしからず）：
1. 1-way ANOVAをやり、post hoc(その後の) testとして全てのペアワイズ比較を全遺伝子についてやる
2. ANOVAでsignificantとされた遺伝子群の一つ一つに対して、Fisher's Protected Least Significant Difference (PLSD) testingで全てのペアワイズ比較を行った結果にユニークなパターンIDナンバーをふり、各パターンに含まれる遺伝子数を'actual'な数とする
3. モンテカルロシミュレーションでランダムデータに対して同様のことを行い、得られた各パターンに含まれる遺伝子数を'random'な遺伝子パターンの数とする
4. 'actual'な数の'random'な数に対するZ-scoreを計算
...まあ、お約束的なやり方で何の変哲もありませんね。
他に2008/3/10に発見した論文として、ranking analysis of F-statistics (RAF) (Tan et al, BMC Bioinformatics, 2008）を紹介しておきます。サンプルサイズが小さい場合に特に有効らしいです。Availabilityについては言及していなかった（たぶん）ですが、問い合わせればプログラムはもらえるかもしれません。
解析 | 発現変動遺伝子 | 多群間 | 対応なし | 一元配置分散分析（One-way ANOVA）
一元配置分散分析（One-way ANOVA）を用いて、多群間での発現変動遺伝子の同定を行う。ここでは対応のない3群（A, B, C群）の解析例を示しています。が、この解析結果を受けて「”どこかの群間で差がある”とされた遺伝子に対して、ではどの群間で発現に差があるのか？」を調べるpost-hoc test（ポストホック検定；）を行うのは大変そうですね。
ちなみに一元配置分散分析に対するポストホック検定として用いられるのは「Tukey検定（総当り比較の場合）」や「Dunnet検定（コントロール群のみとの比較の場合）」らしいです。
マイクロアレイの場合、普通は「”どこかの群間で差がある”として絞り込まれた遺伝子群」に対して行う”その後の解析”はクラスタリングだろうと思っていましたが、結構真面目にpost hoc testをやっている人もいますね。
例えば参考文献1では、ANOVA p-value < 0.01でoverall statistical testをやっておいて、その後の検定（post hoc test）としてScheffe's post hoc testでp-value < 0.05を満たす、という基準を用いています（参考文献5も同じ流れ）。
また、参考文献2では、ANOVA p-value < 0.05でoverall statistical testをやっておいて、その後の検定（post hoc test）としてTukey’s multiple comparison procedure を採用しています。
その後の解析でクラスタリングを行っている論文としては参考文献3や参考文献4（これらは2-way ANOVAですが...）が挙げられます。
ここでは例題として用いた「A群6サンプル、B群5サンプル」の計11サンプルからなる対数変換(log2変換)後のファイル(sample2_log.txt)のラベル情報が「A群3サンプル、B群3サンプル、C群5サンプル」になっていると仮定します：
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample2_log.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. やり方1：
------ ここから ------
in_f <- "sample2_log.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
param3 <- 5 #C群のサンプル数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成
#Oneway ANOVAを行い、F統計量とp値を返す関数Oneway_anovaを作成。
Oneway_anova <- function(x, cl){
hoge <- oneway.test(x ~ cl, var=T) #Oneway ANOVA (一元配置分散分析)を行って、
return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す
}
out <- t(apply(data, 1, Oneway_anova, data.cl)) #各（行）遺伝子についてOneway ANOVAを行った結果の統計量とp値をoutに格納
stat_f <- out[,1] #統計量をstat_fに格納
rank_f <- rank(-abs(stat_f)) #統計量の順位をrank_fに格納
p_f <- out[,2] #p値をp_fに格納
tmp <- cbind(rownames(data), data, stat_f, p_f, rank_f) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#Oneway ANOVA (一元配置分散分析)でp<0.05を満たす遺伝子群のみを抽出したい場合：
param4 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_f < param4) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_f < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_f),] #順位(rank_f)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
2. やり方2(関数の定義の部分が少し違うだけです)：
------ ここから ------
in_f <- "sample2_log.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
param3 <- 5 #C群のサンプル数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Oneway ANOVAを行い、F統計量とp値を返す関数Oneway_anova関数を含むファイルをあらかじめ読み込む
out <- t(apply(data, 1, Oneway_anova, data.cl)) #各（行）遺伝子についてOneway ANOVAを行った結果の統計量とp値をoutに格納
stat_f <- out[,1] #統計量をstat_fに格納
rank_f <- rank(-abs(stat_f)) #統計量の順位をrank_fに格納
p_f <- out[,2] #p値をp_fに格納
tmp <- cbind(rownames(data), data, stat_f, p_f, rank_f) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#Oneway ANOVA (一元配置分散分析)でp<0.05を満たす遺伝子群のみを抽出したい場合：
param4 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_f < param4) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_f < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_f),] #順位(rank_f)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
参考文献1(Norris et al., J. Neurosci., 2005)
参考文献2(Wu et al., BBRC., 2007)
参考文献3(Yagil et al., Circ. Res., 2005)
参考文献4(Poulsen et al., J. Neurochem., 2005)
参考文献5(Mougeot et al., J. Mol. Biol., 2006)
解析 | 発現変動遺伝子 | 多群間 | 対応なし | Kruskal-Wallis（クラスカル-ウォリス）検定
Kruskal-Wallis (KW)検定を用いて、多群間での発現変動遺伝子の同定を行う。ここでは対応のない3群（A, B, C群）の解析例を示しています。が、この解析結果を受けて「”どこかの群間で差がある”とされた遺伝子に対して、ではどの群間で発現に差があるのか？」を調べるpost-hoc test（ポストホック検定；）を行うのは大変そうですね。ちなみにKruskal-Wallis検定に対するポストホック検定として用いられるのは「Nemenyi検定」や「ボンフェローニ補正Mann-Whitney検定」らしいです。
この方法はPubMedで調べても、実際にはほとんど使われていないようですね。ANOVAのほうは非常に頻繁に用いられるようですが...。
ここでは例題として用いた「A群6サンプル、B群5サンプル」の計11サンプルからなる対数変換(log2変換)後のファイル(sample2_log.txt)のラベル情報が「A群3サンプル、B群3サンプル、C群5サンプル」になっていると仮定します：
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample2_log.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. やり方1：
------ ここから ------
in_f <- "sample2_log.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
param3 <- 5 #C群のサンプル数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成
#KW検定を行い、統計量とp値を返す関数Kruskal_wallisを作成。
Kruskal_wallis <- function(x, cl){
hoge <- kruskal.test(x ~ cl) #KW検定を行って、
return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す
}
out <- t(apply(data, 1, Kruskal_wallis, data.cl)) #各（行）遺伝子についてKW検定検定を行った結果の統計量とp値をoutに格納
stat_kw <- out[,1] #統計量をstat_kwに格納
rank_kw <- rank(-abs(stat_kw)) #統計量の順位をrank_kwに格納
p_kw <- out[,2] #p値をp_kwに格納
tmp <- cbind(rownames(data), data, stat_kw, p_kw, rank_kw) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#KW検定でp<0.05を満たす遺伝子群のみを抽出したい場合：
param4 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_kw < param4) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_kw < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_kw),] #順位(rank_kw)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
2. やり方2(関数の定義の部分が少し違うだけです)：
------ ここから ------
in_f <- "sample2_log.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #A群のサンプル数を指定
param2 <- 3 #B群のサンプル数を指定
param3 <- 5 #C群のサンプル数を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #KW検定を行い、統計量とp値を返す関数Kruskal_wallis関数を含むファイルをあらかじめ読み込む
out <- t(apply(data, 1, Kruskal_wallis, data.cl)) #各（行）遺伝子についてKW検定検定を行った結果の統計量とp値をoutに格納
stat_kw <- out[,1] #統計量をstat_kwに格納
rank_kw <- rank(-abs(stat_kw)) #統計量の順位をrank_kwに格納
p_kw <- out[,2] #p値をp_kwに格納
tmp <- cbind(rownames(data), data, stat_kw, p_kw, rank_kw) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#KW検定でp<0.05を満たす遺伝子群のみを抽出したい場合：
param4 <- 0.05 #閾値を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
sum(p_kw < param4) #条件を満たす遺伝子がいくつあったかを表示
tmp2 <- tmp[p_kw < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
#発現変動の度合いでソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_kw),] #順位(rank_kw)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
解析 | 発現変動遺伝子 | 組織特異的（選択的）パターンについて
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します（色々な種類のサンプルが沢山ある場合）：
-------------------
サンプルA
サンプルB
サンプルC
サンプルD
サンプルE
サンプルF
サンプルG
サンプルH
サンプルI
サンプルJ
サンプルK
サンプルL
サンプルM
...
-------------------
私はROKUを使います。
ROKUは二つの方法を組み合わせたものです。
1. 「全体的な組織特異性の度合い」で遺伝子をランキング（エントロピーの低いものほどより組織特異的）
このとき、予めデータ変換したものに対してエントロピーを計算することで、組織特異的高発現だけでなく、
特異的低発現パターンなども検出可能という点でデータ変換せずにそのままエントロピーを計算するSchug's H(x) statisticよりも優れていることがROKU（Kadota et al., 2006）論文中で示されています。
2. 「特異的なパターンを示す組織の検出」のために赤池情報量規準（AIC）に基づく方法で、特異的組織を外れ値として検出
単にエントロピーでランキングしただけでは、どこかの組織で特異的な遺伝子が上位にランキングされるだけで、どの組織で特異的なのかという情報は与えてくれません。そのために2番目の手順が必要になります。
ROKU論文（Kadota et al., 2006）中では単に「ここではAICに基づく方法を用いる」と書いており、同じ枠組みで結果を返す他の方法（Sprent's non-parametric method）が優れている可能性がROKU（Kadota et al., 2006）論文発表時にはまだ残されていました。
しかし、両者の比較解析論文（Kadota et al., 2007）で、「AICに基づく方法」が「Sprent's non-parametric method」よりも優れていることを結論づけています。
それゆえ→最初の文章に戻る
しかし、この方法にも欠点があります。
一つは「遺伝子ごとにROKU法によって得られたエントロピー値を計算してるが、全体のダイナミックレンジを考慮していない」です。
これは例えば10000genes×10samplesの遺伝子発現行列データがあったとして、その中の数値の最大値が23000, 最小値が1だったとします。
ある遺伝子の発現ベクトル(1,1,1,1,1,2,1,1,1,1)のエントロピーはROKU法では0となり、左から6番目の組織特異的高発現という判断が下され(てしまい)ますが、同じエントロピーが0の遺伝子ベクトルでも例えば(10000,5,5,5,5,5,5,5,5,5)のほうがより確からしいですよね。
もう一つは、ROKU法では、単にエントロピーの低い順にランキングするだけで、どの程度低ければいいのか？という指標は与えられていません...。
(組織特異的遺伝子検出を目的としたものではありませんが...)QDMR法 (Zhang et al., Nucleic Acids Res., 2011)という方法が最近提案されています。
論文自体は、ゲノム中のサンプル間でDNAメチル化の程度が異なる領域(differentially methylated regions; DMRs)を定量化しようという試みの論文ですが、
regionをgeneと読み替えれば、組織特異的遺伝子検出法ROKUの改良版そのもの、ですよね?!
解析 | 発現変動遺伝子 | 組織特異的（選択的）発現遺伝子 | ROKU
ROKU(Kadota et al., BMC Bioinformatics, 7, 294, 2006)を用いて、遺伝子発現行列中の遺伝子を全体的な組織特異性の度合いでランキングします。
ROKUは、“組織特異的低発現パターンなど様々な特異的発現パターンを統一的にランキング可能である”という点において、Schug's H(x) statisticの改良版という位置づけになります。
遺伝子ベクトル中の要素が全て同じ値のときにエラーが出るバグを修正しました(2007/10/1追加)。
以下を実行して得られる「ファイル（hoge.txt）中の“最後の列(entropy_score列)”の数値」が、「ROKU論文中のAdditional file 1（Suppl.xls）の“H(x')列”の数値」と対応しています。
このentropy_score列で昇順にソートすることで、全体的な組織特異性の度合いでランキングしていることになります。つまり、上位が「（どの組織で特異的かはこのスコアだけでは分からないが）組織特異性が高い遺伝子」ということになります。
ファイル（hoge.txt）中の残りの結果は「1：特異的高発現、-1：特異的低発現、0：その他」からなる「外れ値行列」なので、
例えば、組織A and Bで1, それ以外の組織で0を示す遺伝子(群)は「AとB特異的高発現遺伝子」ということになります。
「ファイル」−「ディレクトリの変更」で解析したいファイル(遺伝子発現データ：GDS1096_rma.txt、テンプレートパターン：GDS1096_cl_heart.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #ROKUを実行するkadota_2006_bmc_bioinformatics関数を含むファイルをあらかじめ読み込む
library(affy) #Tukey's Biweightを計算するためのtukey.biweight関数が含まれているパッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
library(som) #各遺伝子発現ベクトルを正規化（平均=0, 標準偏差=1）するためのnormalize関数が含まれているパッケージの読み込み
data.z <- normalize(data, byrow=TRUE) #正規化を実行し、結果をdata.zに格納
out <- t(apply(data.z, 1, kadota_2003_physiol_genomics_0.25)) #各遺伝子発現ベクトルについて、Ueda's AIC-based methodを適用し、「特異的高発現=1, 低発現=-1, それ以外=0」の三状態の結果を返す
colnames(out) <- colnames(data) #outの列名をdataの列名で置換する
entropy_score <- apply(data, 1, kadota_2006_bmc_bioinformatics) #一行（一遺伝子）づつ、遺伝子発現ベクトルxを変換（x' = |x - Tbw|> ）してからエントロピーH(x')を計算し、entropy_scoreに格納
tmp <- cbind(rownames(data), out, entropy_score) #左端の列が遺伝子ID, 次にサンプル数分だけの列からなる「外れ値行列情報」、そして最後の列にエントロピー値H(x')からなる行列としてtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#心臓特異的高発現遺伝子群のみのサブセットをentropy_scoreの低い順に得たい場合：
in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(心臓で1、それ以外で0のテンプレートパターンファイル)を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
library(genefilter) #似た発現パターンを示す遺伝子をランキングするためのgenefinder関数が含まれているパッケージの読み込み
data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納
template <- data_cl[,2] #バイナリ（0 or 1）情報（2列目）のみ抽出し、templateに格納
tmp <- rbind(out, template) #templateというテンプレートパターンを得られたはずれ値行列outの最後の行に追加した結果をtmpに格納
closeg <- genefinder(tmp, nrow(out)+1, nrow(out)) #特異的発現の度合いでランキングされた結果をclosegに格納
obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0] #テンプレートと完全に同じ遺伝子の行番号情報をobjに格納
length(obj) #目的の特異的発現遺伝子がいくつあったかを表示
tmp <- cbind(rownames(data), data, entropy_score) #入力データの右側にエントロピー値H(x')を結合した結果をtmpに格納
tmp2 <- tmp[obj,] #行列tmpの中からobjで示された行番号に相当する行のみ抽出してtmp2に格納
tmp3 <- tmp2[order(tmp2$entropy_score),] #目的の特異的発現遺伝子群をエントロピーの低い順にソートしてtmp3に格納
write.table(tmp3, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp3の中身をout_f2で指定したファイル名で保存。
#全遺伝子をentropy_scoreの低い順にソートした結果を得たい場合：
out_f3 <- "hoge3.txt" #出力ファイル名を指定
tmp <- cbind(rownames(data), out, entropy_score) #左端の列が遺伝子ID, 次にサンプル数分だけの列からなる「外れ値行列情報」、そして最後の列にエントロピー値H(x')からなる行列としてtmpに格納
tmp2 <- tmp[order(entropy_score),] #順位(entropy_score)でソートした結果をtmp2に格納
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
------ ここまで ------
おまけまでやって得られるhoge2.txtをエクセルなどで開くと、心臓特異的高発現遺伝子が231個検出されていることがわかります。ここまで(231個のうちのどれが一番特異的な遺伝子かなどはわからないということ)しかできなかったのがUeda's AIC-based methodですが、ROKUではエントロピーH(x')も計算するので、得られたサブセット内のランキング（hoge.txt中の“最後の列”H(x')の低い順にソート）が可能になりました。
CRANのsomのwebページ
CRANのsomのPDFマニュアル
Bioconductorのgenefilterのwebページ
参考文献(Kadota et al., BMC Bioinformatics, 2006)
解析 | 発現変動遺伝子 | 組織特異的（選択的）発現遺伝子 | Sprent's non-parametric method
Ge et al., Genomics, 86(2), 127-141, 2005で用いられた方法です。一つ一つの遺伝子の発現パターン（遺伝子発現ベクトルx）に対して、特異的高（and/or 低）発現組織の有無を一意的に返してくれるという点でUeda's AIC-based methodと同じです。
ちなみにこの方法よりもUeda's AIC-based methodのほうが優れていることが参考文献1で示されています。
やっていることは非常にシンプルで、
1. 各遺伝子発現ベクトルを独立に中央値を=0、MAD=1になるようにスケーリング
2. データ変換後の値の絶対値がXより大きい組織を"特異的組織"とする
を行っているだけです。
ちなみにこのやり方を採用した原著論文(Ge et al., Genomics, 2005)ではX=5としているので、ここではX=5とした場合の解析例を示します。
以下を実行して得られるファイル（hoge.txt）中の結果は「1：特異的高発現、-1：特異的低発現、0：その他」からなる「外れ値行列」なので、
例えば、組織A and Bで1, それ以外の組織で0を示す遺伝子(群)は「AとB特異的高発現遺伝子」ということになります。
「ファイル」−「ディレクトリの変更」で解析したいファイル(遺伝子発現データ：GDS1096_rma.txt、テンプレートパターン：GDS1096_cl_heart.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 5 #Xの値を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
data.t <- t(data) #行列の転置（この後に使うscale関数が列ごとの操作を行うため、scale関数をそのまま使えるように予め行列を入れ替えておく必要があるため）
data.t.m.mad <- scale(data.t, apply(data.t, 2, median), apply(data.t, 2, mad, constant=1))#各列のmedian=0, MAD=1になるようにスケーリングし、結果をdata.t.m.madに格納
data.m.mad <- t(data.t.m.mad) #scale関数の適用が終わったので、もう一度行列の転置を行って元に戻し、結果をdata.m.madに格納
out <- data.m.mad #out.m.madをoutにコピー
out[(out <= param1) & (out >= -param1)] <- 0 #スケーリング後の値で"-param1"以上"param1"以下の値を0に置換
out[out < -param1] <- -1 #スケーリング後の値で-param1未満の値を-1に置換
out[out > param1] <- 1 #スケーリング後の値でparam1より大きい値を1に置換
colnames(out) <- colnames(data) #outの列名をdataの列名で置換する
tmp <- cbind(rownames(data), out) #遺伝子IDの右側に, サンプル数分だけの「外れ値行列」を結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#心臓特異的高発現遺伝子群のみのサブセットを得たい場合：
in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(心臓で1、それ以外で0のテンプレートパターンファイル)を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
library(genefilter) #似た発現パターンを示す遺伝子をランキングするためのgenefinder関数が含まれているパッケージの読み込み
data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納
template <- data_cl[,2] #バイナリ（0 or 1）情報（2列目）のみ抽出し、templateに格納
tmp <- rbind(out, template) #templateというテンプレートパターンを得られたはずれ値行列outの最後の行に追加した結果をtmpに格納
closeg <- genefinder(tmp, nrow(out)+1, nrow(out)) #特異的発現の度合いでランキングされた結果をclosegに格納
obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0] #テンプレートと完全に同じ遺伝子の行番号情報をobjに格納
length(obj) #目的の特異的発現遺伝子がいくつあったかを表示
tmp <- cbind(rownames(data[obj,]), data[obj,]) #dataの中からobjで示された行番号に相当する行のみの遺伝子IDと発現データを結合してtmpに格納
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献1(Kadota et al., GRSB, 2007)
解析 | 発現変動遺伝子 | 組織特異的（選択的）発現遺伝子 | Schug's H(x) statistic
一つ一つの遺伝子の発現パターン（遺伝子発現ベクトルx）に対して、そのエントロピーH(x)を計算します。エントロピーが低い（最小値は0）ほど、その遺伝子の組織特異性の度合いが高いことを意味します。また逆に、エントロピーが高い（最大値はlog2(組織数); 例えば解析組織数が16の場合はlog2(16)=4が最大値となる）ほど、その遺伝子の組織特異性の度合いが低いことを意味します。
したがって、ここでは各遺伝子についてエントロピーH(x)を計算したのち、H(x)で昇順にソートした結果を出力するところまで行います。但し、エントロピーが低いからといって、どの組織で特異的発現を示すかまでは教えてくれないという弱点があるため、目的組織を指定することは原理的（数式的）に不可能です。
使い方としては、様々な実験条件のデータが手元にあった場合などで、「どの条件でもいいから特異的な発現パターンを示す遺伝子を上位からソートしたい」ような場合に使えますが、この方法の改良版ROKUのほうが、“組織特異的低発現パターンなど様々な特異的発現パターンを統一的にランキング可能である”という点において理論的にも実際上も優れているので、この目的においてはROKUを利用することをお勧めします。
「ファイル」−「ディレクトリの変更」で解析したい遺伝子発現行列のファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 入力ファイルがGDS1096_rma.txtの場合：
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #エントロピーを計算するshannon.entropy関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
entropy_score <- apply(data, 1, shannon.entropy) #エントロピーを計算した結果をentropy_scoreに格納
tmp <- cbind(rownames(data), data, entropy_score) #入力データの右側に計算したentropy_scoreを結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#全遺伝子をentropy_scoreの低い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(entropy_score),] #順位(entropy_score)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
2. 入力ファイルがsample15.txtの場合：
------ ここから ------
in_f <- "sample15.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #エントロピーを計算するshannon.entropy関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
entropy_score <- apply(data, 1, shannon.entropy) #エントロピーを計算した結果をentropy_scoreに格納
tmp <- cbind(rownames(data), data, entropy_score) #入力データの右側に計算したentropy_scoreを結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#全遺伝子をentropy_scoreの低い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(entropy_score),] #順位(entropy_score)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献 (Schug et al., Genome Biol., 2005)
解析 | 発現変動遺伝子 | 組織特異的（選択的）発現遺伝子 | Schug's Q statistic
Schugらの方法（Entropy-based Q-statistic）を用いて、任意の1組織（と他の少数の組織）で特異的に発現している遺伝子をランキングします。Schug's H(x) statisticの方法は「どの組織で特異的発現を示すかまでは教えてくれない」という弱点がありました。
その1つの解決策としてSchugらが提案している「指定した目的組織（と他の少数の組織）」で特異的な発現パターンを示す遺伝子を上位からランキングする統計量Qを計算します。
最終的に得られるhoge.txtファイルをエクセルなどで開いて、目的組織に相当するカラムでQ-statisticを昇順にソートすれば、目的組織特異的遺伝子をランキングすることができます。
しかし、この方法は目的組織以外の組織でも発現しているようなパターンが上位に来てしまう場合があるという弱点があります。この弱点を改善した方法がROKUです。
「ファイル」−「ディレクトリの変更」で解析したい遺伝子発現行列のファイル(GDS1096_rma.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Schug's Q statisticを計算するshannon.entropy.q関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
entropy_score <- apply(data, 1, shannon.entropy) #エントロピーを計算した結果をentropy_scoreに格納
q_score <- t(apply(data, 1, shannon.entropy.q)) #Schug's Q statisticを計算した結果をq_scoreに格納
tmp <- cbind(rownames(data), q_score, entropy_score) #遺伝子IDの右側に計算したQスコアの行列とentropy_scoreを結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#入力データの左からX番目の組織について特異性の度合いの高い順(その列のQスコアの低い順)にソートした結果を得たい場合：
#(X=2の場合は"Amygdala"に相当します)
out_f2 <- "hoge2.txt" #出力ファイル名を指定
param1 <- 2 #Xの値を指定
tmp2 <- tmp[order(q_score[,param1]),] #行列q_scoreを"param1"列でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献（Schug et al., Genome Biol., 2005）
解析 | 発現変動遺伝子 | 組織特異的（選択的）発現遺伝子 | Ueda's AIC-based method
Kadota et al., Physiol. Genomics, 12(3), 251-259, 2003で提案された方法です。一つ一つの遺伝子の発現パターン（遺伝子発現ベクトルx）に対して、特異的高（and/or 低）発現組織の有無を一意的に返してくれます。
この方法は、ROKUの要素技術として使われており、実際の解析にはROKUの利用をお勧めします。
尚、用いている関数（"kadota_2003_physiol_genomics_0.50" for Ueda's AIC-based method; "kadota_2003_physiol_genomics_0.25" for ROKU）が両者で微妙に違いますが、
これは論文との整合性（Kadota et al., Physiol. Genomics, 12(3), 251-259, 2003論文中では探索する最大外れ値候補数を全サンプル数の50%に設定；ROKU(Kadota et al., BMC Bioinformatics, 7, 294, 2006)論文中では25%に設定）をとっているためです。
競合する方法にSprent's non-parametric methodがありますが、それよりも優れていることが参考文献1で示されています。
以下を実行して得られるファイル（hoge.txt）中の結果は「1：特異的高発現、-1：特異的低発現、0：その他」からなる「外れ値行列」なので、
例えば、組織A and Bで1, それ以外の組織で0を示す遺伝子(群)は「AとB特異的高発現遺伝子」ということになります。
「ファイル」−「ディレクトリの変更」で解析したいファイル(遺伝子発現データ：GDS1096_rma.txt、テンプレートパターン：GDS1096_cl_heart.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Ueda's AIC-based methodを実行するkadota_2003_physiol_genomics_0.50関数を含むファイルをあらかじめ読み込む
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
library(som) #各遺伝子発現ベクトルを正規化（平均=0, 標準偏差=1）するためのnormalize関数が含まれているパッケージの読み込み
data.z <- normalize(data, byrow=TRUE) #正規化を実行し、結果をdata.zに格納
out <- t(apply(data.z, 1, kadota_2003_physiol_genomics_0.50)) #各遺伝子発現ベクトルについて、Ueda's AIC-based methodを適用し、「特異的高発現=1, 低発現=-1, それ以外=0」の三状態の結果を返す
colnames(out) <- colnames(data) #outの列名をdataの列名で置換する
tmp <- cbind(rownames(data), out) #左端の列が遺伝子IDとサンプル数分だけの列からなる「外れ値行列」を結合してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#心臓特異的高発現遺伝子群のみのサブセットを得たい場合：
in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(心臓で1、それ以外で0のテンプレートパターンファイル)を指定
out_f2 <- "hoge2.txt" #出力ファイル名を指定
library(genefilter) #似た発現パターンを示す遺伝子をランキングするためのgenefinder関数が含まれているパッケージの読み込み
data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納
template <- data_cl[,2] #バイナリ（0 or 1）情報（2列目）のみ抽出し、templateに格納
tmp <- rbind(out, template) #templateというテンプレートパターンを得られたはずれ値行列outの最後の行に追加した結果をtmpに格納
closeg <- genefinder(tmp, nrow(out)+1, nrow(out)) #特異的発現の度合いでランキングされた結果をclosegに格納
obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0] #テンプレートと完全に同じ遺伝子の行番号情報をobjに格納
length(obj) #目的の特異的発現遺伝子がいくつあったかを表示
tmp <- cbind(rownames(data[obj,]), data[obj,]) #dataの中からobjで示された行番号に相当する行のみの遺伝子IDと発現データを結合してtmpに格納
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f2で指定したファイル名で保存。
------ ここまで ------
CRANのsomのwebページ
CRANのsomのPDFマニュアル
参考文献1（Kadota et al., GRSB, 2007）
解析 | 発現変動遺伝子 | 組織特異的（選択的）発現遺伝子 | パターンマッチング法（テンプレートマッチング法）
（基本的には、解析 | 似た発現パターンを持つ遺伝子の同定をご覧ください。）
パターンマッチング法を用いて、指定した理想的なパターンとの類似度が高い遺伝子の同定を行うやり方を紹介します。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ14中のsample15.txtファイル（遺伝子発現データ）とsample15_cl.txtファイル（sample4で特異的高発現パターンを検出するためのテンプレートパターンのデータ）を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "sample15.txt" #入力ファイル名1(発現データ)を指定
in_f2 <- "sample15_cl.txt" #入力ファイル名2（テンプレート情報）を指定
out_f <- "hoge.txt" #出力ファイル名を指定
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納
hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納
data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成
r <- apply(data, 1, cor, y=data.cl) #各（行）遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納
tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
解析 | 発現変動遺伝子の同定 | 時系列データ | Periodic genes | Lomb-Scargle periodogram (Glynn_2006)
周期性解析によく用いられる方法としてはFast Fourier Transform (FFT) アルゴリズムがありますが、この方法は1) time-pointの間隔が等しくなければいけない, 2) 欠損値があってはいけない、という制約がありました。
Lomb-Scargle periodogram(Glynn et al., Bioinformatics, 2006)を用いることで上記2つの条件を満たさない場合でもうまく取り扱ってくれるようです。もちろん、False Discovery Rate (FDR)をコントロールして有意なperiodicな発現パターンを検出してくれます。
1. LombScargle.zipファイルをデスクトップにダウンロード
2. R上ではなく（つまり、「パッケージ」-「ローカルにあるzipファイルからのパッケージのインストール」ではない！！ということ）、普通にLombScargle.zipファイルを解凍
3. Step-by-Step Instructionsを参考にしながら、自分の時系列データを解析
参考文献(Glynn et al., Bioinformatics, 2006)
著者らの(Lomb-Scargle)ウェブページ
解析 | 発現変動遺伝子の同定 | 時系列データ | Periodic genes | GeneCycle (Ahdesmaki_2005)
参考文献1, 2の方法を実装したものです。
ここでは、参考文献3(Laub et al., Science, 2000)の0, 15, 30, 45, 60, 75, 90, 105, 120, 135, 150minの計11 time points×1,444 genes (ORFs)からなる時系列データ(sample12.txt)解析を例示します。
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample12.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "sample12.txt" #入力ファイル名を指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(GeneCycle) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納
out1 <- avgp(t(data)) #平均のピリオドグラムを計算し周波数(frequency)成分ごとの平均パワースペクトル密度(average power spectral density)の結果をout1に格納
out2 <- t(dominant.freqs(t(data),3)) #dominantな周波数(frequency)成分の上位3つをout2に格納
tmp_p <- fisher.g.test(t(data)) #Fisher’s Exact g Testを行って得たp値をtmp_pに格納
tmp_fdr <- fdrtool(tmp_p, statistic="pvalue") #False Discovery Rate (FDR)を計算した結果をtmp_fdrに格納
tmp_robust_p <- robust.g.test(robust.spectrum(t(data))) #Fisher’s Exact g Testのa robust nonparametric versionでp値を計算した結果をtmp_robust_pに格納
p_gc <- tmp_fdr$pval #p値をp_gcに格納
lfdr_gc <- tmp_fdr$lfdr #local FDR値をlfdr_gcに格納
tmp <- cbind(rownames(data), data, p_gc, lfdr_gc) #入力データの右側にp値、local FDRを結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#(local)FDRがX未満(たとえば0.1を指定するとこの閾値を満たす遺伝子数のうち本当は発現変動遺伝子でないものが含まれる割合を0.1)の遺伝子数を表示したい場合：
param1 <- 0.1 #Xの値を指定
sum(fdr_gc$lfdr < param1) #条件を満たす遺伝子数を表示
#平均のピリオドグラムを得たい場合：
avgp(t(data)) #平均のピリオドグラムを計算し周波数(frequency)成分ごとの平均パワースペクトル密度(average power spectral density)の結果をout1に格納
#dominantな周波数(frequency)成分の上位3つを得たい場合：
out2 <- t(dominant.freqs(t(data),3)) #dominantな周波数(frequency)成分の上位3つをout2に格納
dim(out2) #out2の行数と列数を表示(1441遺伝子の一つにつき上位3つの周波数成分が格納されているので1441行3列になる)
------ ここまで ------
GeneCycleのウェブページ
CRANのGeneCycleのwebページ
CRANのGeneCycleのPDFマニュアル
参考文献1(Ahdesmaki et al., BMC Bioinformatics, 2005)
参考文献2(Wichert et al., Bioinformatics, 2004)
参考文献3(Laub et al., Science, 2000)
解析 | 発現変動遺伝子 | 時系列データ | non-periodic genes | について
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します（いわゆる「経時変化遺伝子」を検出したいとき）：
-------------------
サンプルAの刺激後 0Hのデータ
サンプルAの刺激後 1Hのデータ
サンプルAの刺激後 6Hのデータ
サンプルAの刺激後24Hのデータ
-------------------
解析 | 発現変動遺伝子 | 時系列データ | non-periodic genes | maSigPro (Conesa_2006)
maSigPro(Conesa et al., Bioinformatics, 2006)法を用いて時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。
サンプルマイクロアレイデータの10.3で示すような「あるサンプル(A)に刺激を与えて3h, 9h, and 27h後に測定した時系列データ」が手元にあり、「経時的に発現の異なる遺伝子」を検出したい場合に行います。
ここではFDR("発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合; 0 < FDR <= 1)を0.5として計算した結果を示してありますが、その閾値を満たす遺伝子数があまりにも少なくて困るような場合には最大で1.0まで設定することが可能です。もちろん最初からFDRを1.0に設定しておいて、（解析可能な）全遺伝子の結果を眺めるという戦略でもいいと思います。
「ファイル」−「ディレクトリの変更」で解析したい時系列遺伝子発現データのファイルとその実験デザイン情報に関するファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 発現データファイル: sample10_1group.txt, 実験デザインファイル: sample10_1group_cl.txtの場合：
------ ここから ------
in_f1 <- "sample10_1group.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "sample10_1group_cl.txt" #入力ファイル名(実験デザインファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 0.5 #閾値(FDR; "発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合)を指定
library(maSigPro) #パッケージの読み込み
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み
edesign <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="") #実験デザインファイルの読み込み
design <- make.design.matrix(edesign, degree=2) #regression（回帰）行列の作成。degree=2は、2次の回帰モデルで考えることを意味する
fit <- p.vector(data, design, Q=param1) #発現変動遺伝子の同定。
tstep <- T.fit(fit) #得られた発現変動遺伝子群の各々について最もよい回帰モデルを決める
gene_profile <- tstep$sig.profiles #発現変動遺伝子の発現プロファイルをgene_profileに格納。
gene_id <- rownames(gene_profile) #発現変動遺伝子のIDをgene_idに格納。
p_masigpro <- tstep$sol[,1] #p値をp_masigproに格納。
rank_masigpro <- rank(abs(p_masigpro)) #p値の順位をrank_masigproに格納。
tmp <- cbind(gene_id, gene_profile, p_masigpro, rank_masigpro) #発現変動遺伝子についてのみ、その遺伝子ID、発現データ、p値、その順位を結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#発現変動の度合いでソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_masigpro),] #順位(rank_masigpro)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
2. 発現データファイル: sample11_1group.txt, 実験デザインファイル: sample11_1group_cl.txtの場合：
------ ここから ------
in_f1 <- "sample11_1group.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "sample11_1group_cl.txt" #入力ファイル名(実験デザインファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 0.5 #閾値(FDR; "発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合)を指定
library(maSigPro) #パッケージの読み込み
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み
edesign <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="") #実験デザインファイルの読み込み
design <- make.design.matrix(edesign, degree=2) #regression（回帰）行列の作成。degree=2は、2次の回帰モデルで考えることを意味する
fit <- p.vector(data, design, Q=param1) #発現変動遺伝子の同定。
tstep <- T.fit(fit) #得られた発現変動遺伝子群の各々について最もよい回帰モデルを決める
gene_profile <- tstep$sig.profiles #発現変動遺伝子の発現プロファイルをgene_profileに格納。
gene_id <- rownames(gene_profile) #発現変動遺伝子のIDをgene_idに格納。
p_masigpro <- tstep$sol[,1] #p値をp_masigproに格納。
rank_masigpro <- rank(abs(p_masigpro)) #p値の順位をrank_masigproに格納。
tmp <- cbind(gene_id, gene_profile, p_masigpro, rank_masigpro) #発現変動遺伝子についてのみ、その遺伝子ID、発現データ、p値、その順位を結合した結果をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#発現変動の度合いでソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_masigpro),] #順位(rank_masigpro)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
BioconductorのmaSigProのwebページ
参考文献(Conesa et al., Bioinformatics, 2006)
著者らの(maSigPro)ウェブページ
解析 | 発現変動遺伝子 | 時系列データ | non-periodic genes | SAM (Tusher_2001)
Significance Analysis of Microarrays (SAM)法で「経時的に発現の変化する遺伝子」のランキングを行う。
注意点：例で用いているsample11_1group.txtの一行目のラベル情報(すなわち、"Time0.5","Time2","Time5","Time12.3","Time24")と同じ形式にしてください。"T_0.5"とか"Time_0.5"などとしてはいけません！
「ファイル」−「ディレクトリの変更」で解析したい対数変換(log2変換)後のファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 発現データファイル: sample10_1group.txtの場合：
------ ここから ------
in_f <- "sample10_1group.txt" #入力ファイル名(発現データファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(samr) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み
data <- as.matrix(data) #データの型を変換
cl.tmp <- strsplit(colnames(data), "_") #ラベル情報を"One class timecourse"用に変更1
data.cl <- NULL #ラベル情報を"One class timecourse"用に変更2
for(i in 1:ncol(data)){ data.cl[i] <- cl.tmp[[i]][1] } #ラベル情報を"One class timecourse"用に変更3
data.cl <- paste(1, data.cl, sep="") #ラベル情報を"One class timecourse"用に変更4
data.cl[1] <- paste(data.cl[1], "Start", sep="") #ラベル情報を"One class timecourse"用に変更5
data.cl[ncol(data)] <- paste(data.cl[ncol(data)], "End", sep="") #ラベル情報を"One class timecourse"用に変更6
data.tmp <- list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE) #SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpという入力データを作成
out <- samr(data.tmp, resp.type="One class timecourse", nperms=30, time.summary.type="slope") #samr関数を実行し、結果をsamr.objに格納。
stat_sam <- out$tt #統計量をstat_samに格納。
rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納。
delta.table <- samr.compute.delta.table(out, min.foldchange=0, dels=NULL, nvals=100) #FDRの計算1
out2 <- samr.compute.siggenes.table(out, del, data.tmp, delta.table, min.foldchange=0, all.genes=T)#FDRの計算2
fdr.tmp <- as.numeric(c(out2$genes.up[,7], out2$genes.lo[,7])) #up-regulated側とdown-regulated側の%FDR値をfdr.tmpに格納
fdr.tmp <- fdr.tmp/100 #%FDR値を100で割る
names(fdr.tmp) <- c(out2$genes.up[,2], out2$genes.lo[,2]) #fdr.tmpはup側とdown側で発現変動の度合いでランキングされているので、遺伝子名との対応づけを行っている
fdr_sam <- fdr.tmp[rownames(data)] #もとの入力データの遺伝子名の並びに変更した結果をfdr_samに格納
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, fdr_sam) #読み込んだ元データの右側に統計量、その順位、FDRを追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#発現変動の度合いでソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_sam),] #順位(rank_sam)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
2. 発現データファイル: sample11_1group.txt, 実験デザインファイル: sample11_1group_cl.txtの場合：
------ ここから ------
in_f <- "sample11_1group.txt" #入力ファイル名(発現データファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(samr) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み
data <- as.matrix(data) #データの型を変換
data.cl <- paste(1, colnames(data), sep="") #ラベル情報を"One class timecourse"用に変更1
data.cl[1] <- paste(data.cl[1], "Start", sep="") #ラベル情報を"One class timecourse"用に変更2
data.cl[ncol(data)] <- paste(data.cl[ncol(data)], "End", sep="") #ラベル情報を"One class timecourse"用に変更3
data.tmp <- list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE) #SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpという入力データを作成
out <- samr(data.tmp, resp.type="One class timecourse", nperms=30, time.summary.type="slope") #samr関数を実行し、結果をsamr.objに格納。
stat_sam <- out$tt #統計量をstat_samに格納。
rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納。
delta.table <- samr.compute.delta.table(out, min.foldchange=0, dels=NULL, nvals=100) #FDRの計算1
out2 <- samr.compute.siggenes.table(out, del, data.tmp, delta.table, min.foldchange=0, all.genes=T)#FDRの計算2
fdr.tmp <- as.numeric(c(out2$genes.up[,7], out2$genes.lo[,7])) #up-regulated側とdown-regulated側の%FDR値をfdr.tmpに格納
fdr.tmp <- fdr.tmp/100 #%FDR値を100で割る
names(fdr.tmp) <- c(out2$genes.up[,2], out2$genes.lo[,2]) #fdr.tmpはup側とdown側で発現変動の度合いでランキングされているので、遺伝子名との対応づけを行っている
fdr_sam <- fdr.tmp[rownames(data)] #もとの入力データの遺伝子名の並びに変更した結果をfdr_samに格納
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, fdr_sam) #読み込んだ元データの右側に統計量、その順位、FDRを追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#発現変動の度合いでソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(rank_sam),] #順位(rank_sam)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
sample11の解析結果のhoge2.txtにおいて、rank_samのランキング結果とFDR値(fdr_sam)の対応がちゃんととれていないのは、up-regulated側とdown-regulated側がごちゃまぜになっているためです。
例えば、stat_sam列でソートすると、FDR値の分布がきれい?!になります。fdr_sam列でソートすると、例えばFDR <=0.33...を満たすのは上位3個(gene713, 781, and 492)ですが、このうちの33.3...%(i.e., 3分の1個)は"偽物"という風に解釈します。
CRANのsamrのwebページ
CRANのsamrのPDFマニュアル
参考文献1(Tusher et al., PNAS, 2001)
解析 | 機能解析（GSEA周辺）について
ある程度遺伝子機能が分かっている生物種に対して行う解析手段です。GSEAはGene Set Enrichment Analysisの略です。
基本的に”二群間比較データ”用の解析なのかも...。
例えば、従来の二群間比較（例. 癌 vs. 正常）のような場合で発現変動遺伝子を検出したい場合には、発現変動の度合いで全遺伝子をランキングし、FDRやp値の閾値を満たす上位x個を抽出してそれらがどのような機能をもつものが多いか（例えば「pathway関連遺伝子群が多い」など）などを調べて論文にしていました。
最近では、「代謝パスウェイに関連している遺伝子セット」や「同じGene Ontologyカテゴリに属する遺伝子セット」などが予め（a priori）分かっている場合が多いので、その情報を用いてFold changeやt統計量などの手段で発現変動の度合いで全遺伝子をランキングした結果に対して、例えば「代謝パスウェイに関連している遺伝子セット」が比較しているサンプル間で”動いている”かどうかを偏りの程度から判断するのがGSEA（遺伝子セットの濃縮度解析？！）の基本的な考え方です。
当然a priori defined setの偏りの程度を調べるための手段はいくらでも多くのやり方が考えられるので、GSEA法(Subramanian et al., PNAS, 2005)が出て以来、様々な改良版が報告されています。
実際、Rプログラムが提供されているものだけでも、以下の方法が提案されています：
・PAGE(Kim and Volsky, BMC Bioinformatics, 2005)：この論文中に書かれている方法を門田が自作してみたもの。
・PGSEA(Kim and Volsky, BMC Bioinformatics, 2005)：PAGEのR版だと書いてはいるが、原著論文に書かれているやり方とは違うと思います...。
・GSEA(Subramanian et al., PNAS, 2005)：GSEAのR版ということだが、初心者には非常に扱いづらいので、JAVA版をお勧めします...。
・GSA(Efron and Tibshirani, Ann. Appl. Stat., 2007)：20090603現在、まだ項目のみ...。
他にも
・GeneTrail（Backes et al., NAR, 2007）
・Jiang and Gentlemanらによる拡張法 (Bioinformatics, 2007)
・SAM-GS (Dinu et al., BMC Bioinformatics, 2007)
・GSEA-P (Subramanian et al., Bioinformatics, 2007)
など様々な手法が提案されているようです。
これは、入力となる(log2変換後の)遺伝子発現データが与えられてから以下の多くのステップを経てGSEA系解析を行うわけですが、各ステップで様々な選択肢があるためです：
-----------------------------------
step1（二群間比較用の様々な統計量の中から一つを選択；gene-level statistics）
t統計量、WAD、SAM、Rank productsなど
step2（得られた統計量の変換；transformation）
変換なし、統計量をrankに変換、統計量の絶対値に変換、統計量の二乗に変換など
step3（遺伝子セットの統計量；gene-set statistics）
（特定の遺伝子セットに含まれる遺伝子群の変換後の統計量の）平均(mean)、中央値(median)、Wilcoxonの順位和統計量、改良版Kolmogorov-Smirnov統計量など
step4（帰無仮説；Null hypothesis）
Q1（競合帰無仮説；competitive null hypothesis）：「特定の遺伝子セットに含まれる遺伝子群のgene-set statistic」と「その遺伝子群の以外のgene-set statistic」は同じ
Q1（完全帰無仮説；complete null hypothesis）：「特定の遺伝子セットに含まれる遺伝子群のgene-set statistic」と「（その遺伝子群を含む）全遺伝子セットに含まれる遺伝子のgene-set statistic」は同じ
Q2（自己充足型帰無仮説；self-contained null hypothesis）：「特定の遺伝子セットに含まれる遺伝子群のgene-set statistic」と「sample label permutation（ランダムなラベル情報という意味）によって得られた特定の遺伝子セットに含まれる遺伝子群のgene-set statistic」は同じ
Q2（グローバル帰無仮説；global null hypothesis）：発現変動遺伝子はない、と仮定
-----------------------------------
この中で、特にstep2での選択は結果に大きな影響を与える（Ackermann and Strimmer, BMC Bioinformatics, 2009）ので違いをよく認識したうえで利用することをお勧めします。
例えばオリジナルのPAGE法(Kim_2005)は、「step1:AD統計量（Average Difference）、step2:変換なし、step3:mean、step4:Q1?!」ですので、
ある遺伝子セットに含まれる遺伝子メンバーの半分がA群>>B群、もう半分がA群<
ゆえに下記の三つのやり方はオリジナルのPAGE法(Kim_2005)に基づいたものなので、上記問題が起こりうることを認識したうえでご利用ください。
・PAGE法(Kim_2005)の考え方について
・PAGE法(Kim_2005;統計量の変換なし)を用いてGene Ontology解析
・PAGE法(Kim_2005;統計量の変換なし)を用いてPathway解析
ただし、上記のやり方は「遺伝子メンバーの半分がA群>>B群、もう半分がその逆」のような遺伝子セットAの検出はできないものの、全体としてA群（あるいはB群）で高発現側に偏っているような他の大部分の遺伝子セットは普通に検出できますし、そのような両方向でなく一方向。
遺伝子セットAのようなものも検出するための一つの手段としては、step2で「統計量の絶対値」あるいは「統計量の二乗」に変換することです。これの前者（統計量の絶対値）を実装したのが下記のものです。
・PAGE法(Kim_2005;統計量の変換あり)を用いてGene Ontology解析
・PAGE法(Kim_2005;統計量の変換あり)を用いてPathway解析
2009/10/23現在、このページで最後まで解析ができるのはPAGE法(Kim_2005)のみです。
・PAGE法(Kim_2005;統計量の変換なし)の考え方についてでは、原著論文中で実際に解析したデータの追試を行うことで、解析の概略、結果の解釈の仕方などを述べています。
入力データは、前処理 | 同じ遺伝子名を持つものをまとめるを利用して得られた同じGene Symbolを持たない遺伝子発現データですのでご注意ください。
参考文献(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
参考文献(Ackermann and Strimmer, BMC Bioinformatics, 2009)
解析 | 機能解析 | PAGE法(Kim_2005;統計量の変換なし)の考え方について
PAGE法の参考文献1に書かれているPAGE法で遺伝子セット濃縮度解析(GSEA)解析を行うべく、解析の概略、結果の解釈の仕方などを述べます。
ここでは、 参考文献1のTable1で示された"OXPHOS_HG-U133A"という遺伝子セット（Gene set）のZ scoreの計算結果がどのようにして得られるのかを示します。
得られた結果は、若干原著論文（参考文献1）中のTable1の数値とは違いますが、これは参考文献2からとってきたOXPHOS_HG-U133A_probesの遺伝子リストを用いたためかもしれません。
つまり、原著論文では参考文献2から得られた遺伝子リストをそのまま使ったかどうかには言及していないために、その後アップデートされた遺伝子リストを使っていれば結果は異なりうるということです。ですので、細かい違いは気にしなくてもいいと思います。
ここでは、対数変換前のデータのダウンロードから、発現データファイル中の余分な行や列の除去、前処理や対数変換、サンプル名が長いので文字列の最初の1-8文字分のみをサンプル名とするなどの細かい作業をやってから
17 NGT samples vs. 18 DM2 samplesのPAGE解析を行っています。reannotate_select_cal.eis中のどの列が目的のサンプルに相当するかは、クラスラベル情報を含むファイル(Phenotype_Data.xls)から、全43サンプルのうち、「1-17列がNGTサンプル」、「26-43列がDM2サンプル」のデータであることが分かっているとします。
a. 「参考文献1のTable1」の解析は参考文献2のデータについて行ったものです。
まずは必要な情報（発現情報や遺伝子セットの情報）をここからゲットします。
・発現データファイル（Human diabetes expression data）をダウンロード。
・クラスラベル情報を含むファイル（Phenotype data）をダウンロード。
・遺伝子セット情報を含むファイル（Probe sets corresponding to gene sets）をダウンロード。
b. ダウンロードした圧縮ファイルを解凍すると以下のファイルが得られます。
・発現データファイル（reannotate_select_cal.eis; 対数変換されていないpreprocessing前のデータ）
・クラスラベル情報を含むファイル（Phenotype_Data.xls）
・「all_pathways」というディレクトリ中にある”酸化的リン酸化に関係する遺伝子のリスト”ファイル（OXPHOS_HG-U133A_probes）
c. 実際にRで読み込むのはreannotate_select_cal.eisとOXPHOS_HG-U133A_probesの二つ。
これをデスクトップなりどこか同じディレクトリ内に置く。
d. Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "reannotate_select_cal.eis" #入力ファイル名(発現データファイル)を指定
in_f2 <- "OXPHOS_HG-U133A_probes" #入力ファイル名(遺伝子リストファイル)を指定
param1 <- 1:17 #遺伝子発現行列中のA群(NGTサンプルに相当)の位置(X-Y列)のXとYを指定
param2 <- 26:43 #遺伝子発現行列中のB群(DM2サンプルに相当)の位置(X-Y列)のXとYを指定
param3 <- 1:8 #列名(サンプル名)の文字列のX-Y文字目のXとYを指定
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み
data$NAME <- NULL #余分な列（NAMEという名前の列に相当）の削除
data <- data[-1,] #余分な行（EWEIGHTという名前の行に相当）の削除
#参考文献1に記載されている通りのデータの前処理（preprocessing）を実行
mean_value <- 1000 #各サンプルの平均発現強度を1000にすべく、mean_valueに格納
floor_value <- 100 #シグナル強度が100未満のものを100にすべく、floor_valueに格納
tmp_mean <- apply(data, 2, mean, na.rm=TRUE) #各サンプル（列）の平均シグナル強度を計算した結果をtmp_meanに格納
data.tmp <- sweep(data, 2, mean_value/tmp_mean, "*") #各列中の全てのシグナル値にmean_value/tmp_meanを掛け、その結果をdata.tmpに格納
data.tmp[data.tmp < floor_value] <- floor_value #シグナル強度がfloor_value未満のものをfloor_valueにする
data.tmp <- log(data.tmp, base=2) #log(底は2)をとる
rownames(data.tmp) <- rownames(data) #data_tmpの行の名前をdataの行の名前として利用する
colnames(data.tmp) <- substr(colnames(data),param3[1],param3[length(param3)])#data_tmpの列の名前が長いのでparam3で指定した領域をdata.tmpの列の名前にする
#全遺伝子(母集団)の倍率変化の平均(myu)と標準偏差(sigma)をまずは求める
dim(data.tmp) #行数と列数を確認
logratio <- apply(data.tmp[,param2], 1, mean, na.rm=TRUE) - apply(data.tmp[,param1], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(DM2/NGT; logスケールデータなのでこの場合引き算となっている)を計算し、logratioに格納
mean_set <- mean(logratio) #全遺伝子の倍率変化の平均を計算し、mean_setに格納
sd_set <- sd(logratio) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納
#"in_f2"で指定した中の遺伝子セット（標本）のみの倍率変化の平均(mean_sample)と遺伝子数（標本サイズ）nを求める
probe_OXPHOS <- read.table(in_f2, row.names=1, quote="") #遺伝子リストファイルの読み込み
mean_sample <- mean(logratio[rownames(probe_OXPHOS)]) #rownames(probe_OXPHOS)で見られる遺伝子セットのみの倍率変化の平均を計算し、mean_sampleに格納
n <- nrow(probe_OXPHOS) #rownames(probe_OXPHOS)で見られる遺伝子数をnに格納
#Z-score算出式を参考にして、「mean_set, sd_set, mean_sample, n」をもとにZ-scoreおよびそのp値を求める
zscore <- (mean_sample - mean_set)*sqrt(n)/sd_set #zscoreを計算
pvalue <- (1 - pnorm(abs(zscore)))*2 #pvalueを計算
zscore #zscoreを表示
pvalue #pvalueを表示
------ ここまで ------
参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
参考文献2(GSEA法のpreliminary versionを提案した論文: Mootha et al., Nature Genet., 2003)
参考文献3(Nakai et al., BBB, 2008)
解析 | 機能解析 | PAGE法(Kim_2005;統計量の変換なし)を用いてGene Ontology解析
参考文献2(Nakai et al., BBB, 2008)（「Affymetrix Rat Genome 230 2.0 Array」を利用）のデータを遺伝子名重複を前処理 | 同じ遺伝子名を持つものをまとめることにより排除して得られた「24 samples×14026 genesからなる遺伝子発現行列ファイルdata_GSE7623_rma_nr.txtを入力として、Gene Ontology解析を行う。
このときGSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
ちなみに、ここではlogratioをmean(B)-mean(A)で定義しているので、「logratioが正の値の遺伝子は、B群で発現が上昇した」ということを意味するので、B群で発現が上昇した遺伝子が多数を占める遺伝子セットのZスコア(hoge.txt中のz_page列に相当)は負の大きな値を示します。
注意点としては、「"Member_num_thischip"列の数値が10未満のものは怪しい」ので、できればリストからは除外しておいたほうがいいです。理由は、原著論文中にも書いていますが、この方法は中心極限定理
（母集団の分布がどんな分布であっても"ある遺伝子セットのメンバーのFold changeの平均（標本平均に相当）"と"チップ上の全遺伝子のFold changeの平均（母平均に相当）"の間の誤差はサンプルサイズ（その遺伝子セットのメンバー数に相当）を大きくしたときに近似的に正規分布に従うという定理）を論拠としており、
"Member_num_thischip(サンプルのサイズに相当)"があまりに小さいと正規分布に従うという前提が成り立たないためです。それで、原著論文では、「PAGE法を利用可能な最低限必要な遺伝子セットを構成するメンバー数（the minimal gene set size）は10程度必要だ。」としています。ここでは、混乱をきたさないように「"Member_num_thischip"列の数値が10未満のものは最初から排除」してもよかったのですが、
8 or 9個しかなくp値が非常に低い場合でも、その遺伝子セットが動いていないと言い切れるわけではないと思うので、一応全ての情報を出力するようにしています。したがって、"p_page"列(p値)で低い順にソートした結果を眺めるのを基本としつつも"Member_num_thischip"列の数値が小さいかどうかにも注意を払うことをお勧めします。
以下を実行すると、最もよく動いていたGene Ontology IDはGO:0006631であったことが分かります。
解析例で示す24 samples×14026 genesからなる遺伝子発現行列データ(data_GSE7623_rma_nr.txt)のサンプルラベル情報は以下の通りです。
ここではLIVサンプルの「fed vs. 24h-fasted」のGene Ontology解析を例示します。LIVのfedサンプル(A群)は17-20列目、24h-fastedサンプル(B群)は21-24列目のデータに相当します。
----------------------------------------------------------
GSM184414-184417: Brown adipose tissue (BAT), fed
GSM184418-184421: Brown adipose tissue (BAT), 24 h-fasted
GSM184422-184425: White adipose tissue (WAT), fed
GSM184426-184429: White adipose tissue (WAT), 24 h-fasted
GSM184430-184433: Liver tissue (LIV), fed
GSM184434-184437: Liver tissue (LIV), 24 h-fasted
----------------------------------------------------------
1. Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
2. Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
3. これでMSigDBのダウンロードページに行けるので、
とりあえず「c5: gene ontology gene sets」の「GO biological process gene sets file」を解析すべく、
c5.bp.v2.5.symbols.gmtファイルを(data_GSE7623_rma_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
4. Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "data_GSE7623_rma_nr.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "c5.bp.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定
param1 <- 17:20 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定
param2 <- 21:24 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(PGSEA) #PGSEAパッケージ（ライブラリ）の読み込み
gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納（不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい）
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
colnames(data) #dataの列名を表示。GSM184414-184437まで順番に並んでいることを確認
#Zスコアを算出する関数calc_zを作成
calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成
return(hoge) #Zスコアを算出する関数calc_zを作成
} #Zスコアを算出する関数calc_zを作成
#PAGE解析のメイン部分
AD <- apply(data[,param2], 1, mean, na.rm=TRUE) - apply(data[,param1], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納
names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する
mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納
sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納
z_page <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納
} #length(gmt)回だけループを回す
p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納
#結果をまとめてファイルに保存
out <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納
GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納
Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納
} #length(gmt)回だけループを回す
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更
tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#p値の低い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
参考文献2(Nakai et al., BBB, 2008)
解析 | 機能解析 | PAGE法(Kim_2005;統計量の変換あり)を用いてGene Ontology解析
参考文献2(Nakai et al., BBB, 2008)（「Affymetrix Rat Genome 230 2.0 Array」を利用）のデータを遺伝子名重複を前処理 | 同じ遺伝子名を持つものをまとめることにより排除して得られた「24 samples×14026 genesからなる遺伝子発現行列ファイルdata_GSE7623_rma_nr.txtを入力として、Gene Ontology解析を行う。
このときGSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
以下を実行すると、最もよく動いていたGene Ontology IDはGO:0006805であったことが分かりますが、この遺伝子セットを構成する遺伝子数は11個でそのうちこのチップ（Affymetrix Rat Genome 230 2.0 Array）に搭載されているのは4個しかないことが分かります。
PAGE法(Kim_2005;統計量の変換なし)を用いてGene Ontology解析に書いているように、"Member_num_thischip"列の数値（この場合4）があまりに少ないと偶然に有意であると判断される可能性が上昇しますので、XENOBIOTIC_METABOLIC_PROCESSが動いたと判断するのはまずいと思います。
また、統計量の変換（この場合AD統計量の”絶対値”を採用しているということ）を行っており、Z検定も行っていないので、もはやPAGE法とはいえないと思います...。
解析例で示す24 samples×14026 genesからなる遺伝子発現行列データ(data_GSE7623_rma_nr.txt)のサンプルラベル情報は以下の通りです。
ここではLIVサンプルの「fed vs. 24h-fasted」のGene Ontology解析を例示します。LIVのfedサンプル(A群)は17-20列目、24h-fastedサンプル(B群)は21-24列目のデータに相当します。
----------------------------------------------------------
GSM184414-184417: Brown adipose tissue (BAT), fed
GSM184418-184421: Brown adipose tissue (BAT), 24 h-fasted
GSM184422-184425: White adipose tissue (WAT), fed
GSM184426-184429: White adipose tissue (WAT), 24 h-fasted
GSM184430-184433: Liver tissue (LIV), fed
GSM184434-184437: Liver tissue (LIV), 24 h-fasted
----------------------------------------------------------
1. Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
2. Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
3. これでMSigDBのダウンロードページに行けるので、
とりあえず「c5: gene ontology gene sets」の「GO biological process gene sets file」を解析すべく、
c5.bp.v2.5.symbols.gmtファイルを(data_GSE7623_rma_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
4. Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "data_GSE7623_rma_nr.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "c5.bp.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定
param1 <- 17:20 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定
param2 <- 21:24 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(PGSEA) #PGSEAパッケージ（ライブラリ）の読み込み
gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納（不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい）
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
colnames(data) #dataの列名を表示。GSM184414-184437まで順番に並んでいることを確認
#PAGE解析のメイン部分
AD <- apply(data[,param2], 1, mean, na.rm=TRUE) - apply(data[,param1], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納
names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する
stat_page <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
genenames <- intersect(names(AD), gmt[[i]]@ids) #i番目の遺伝子セット中の遺伝子リストの中からチップに搭載されている遺伝子のみのGene symbolsをgenenamesに格納
stat_page <- c(stat_page, mean(abs(AD[genenames]))) #genenamesで表された遺伝子リストのAD統計量の絶対値の平均を計算し、stat_pageに格納
} #length(gmt)回だけループを回す
#結果をまとめてファイルに保存
out <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納
GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納
Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納
} #length(gmt)回だけループを回す
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更
tmp <- cbind(out, stat_page) #outの右側にPAGE解析結果のAD統計量の絶対値の平均を追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#AD統計量の絶対値の平均が高い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(-stat_page),] #stat_pageでソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
参考文献2(Nakai et al., BBB, 2008)
解析 | 機能解析 | PAGE法(Kim_2005)を用いてGene Ontology解析した結果をQuickGOにかける
PAGE法(Kim_2005)を用いてGene Ontology解析では、hoge.txtをエクセルなどで開き、どのGene Ontology IDのものが動いたかをp値でソートすることによりTableを作成することまでが可能です。
解析例（LIVサンプルの「fed vs. 24h-fasted」のGene Ontology解析）で得られた上位10個の結果は以下の通りです。
------------------------------------------------------------------------------------------------------------
Geneset_name GO_ID Member_num Member_num_thischip z_page p_page
FATTY_ACID_METABOLIC_PROCESS GO:0006631 63 52 -7.799532229 6.22E-15
FATTY_ACID_BETA_OXIDATION GO:0006635 11 11 -6.203282697 5.53E-10
CELLULAR_RESPONSE_TO_NUTRIENT_LEVELS GO:0031669 10 10 6.154781714 7.52E-10
CELLULAR_RESPONSE_TO_STRESS GO:0033554 10 10 5.904066843 3.55E-09
CELLULAR_RESPONSE_TO_EXTRACELLULAR_STIMULUS GO:0031668 12 12 5.594950084 2.21E-08
FATTY_ACID_OXIDATION GO:0019395 18 18 -5.167180532 2.38E-07
MONOCARBOXYLIC_ACID_METABOLIC_PROCESS GO:0032787 88 75 -4.879088895 1.07E-06
BIOSYNTHETIC_PROCESS GO:0009058 470 383 4.869245113 1.12E-06
CELLULAR_BIOSYNTHETIC_PROCESS GO:0044249 321 265 4.577997388 4.69E-06
RESPONSE_TO_NUTRIENT_LEVELS GO:0031667 29 29 4.487353561 7.21E-06
------------------------------------------------------------------------------------------------------------
この結果から、Zスコアの低い4つ（B群で発現が上昇した遺伝子が多数を占める遺伝子セットを意味する）は"FATTY_ACID"や"METABOLIC"などの記述がかぶっているので、
Gene Ontology階層構造の親子関係になっていることが想像できます。この親子関係になっている様子を図で表したいときに以下を行います。
1. エクセルで開いたhoge.txtをp値の低い順にソートして得られた状態で、上位10個のGene Ontology IDsに相当するセルをコピー
2. QuickGOのウェブページを開き、「Your selection (0 terms)」の部分をクリック
もし「Your selection (0 terms)」となってない場合は「Empty」の部分をクリックして、以前の作業で残っていた情報を消す
3. 四角のボックス部分に1.でコピーしておいたGO IDsをペーストし、「Add」ボタンを押す
「Your selection (0 terms)」だったのが、「Your selection (10 terms)」となります
4. 「Your selection (10 terms)」の部分をクリックして、「View selected terms」をクリック
5. 「Select all」の部分をクリックし、「chart」をクリック
6. 以下のようなチャート図が得られるので、図上を右クリックで「名前を付けて画像を保存」とすれば図の完成です
参考文献(QuickGO; Binns et al., Bioinformatics, 2009)
QuickGOのウェブページ
解析 | 機能解析 | PAGE法(Kim_2005;統計量の変換なし)を用いてPathway解析
PAGE法を用いて、どのパスウェイが動いていたかを調べたいときに用います。
前処理 | 遺伝子のフィルタリング3の4を適用することによって得られた、各群で少なくとも一つ以上の数値の要素を含むものの、
NAやNaNの要素を含むsample13_7vs7_nr2.txtのようなAgilent two-colorデータの解析例を示します。
この例では、GSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードしたKEGG gene sets fileファイル(c2.kegg.v2.5.symbols.gmt)を読み込んで解析を行います。
この例で示す遺伝子発現行列データ(sample13_7vs7_nr2.txt)のサンプルラベル情報はサンプルマイクロアレイデータの12のものと同じです。つまり、最初の7 samplesが面白い話を聞いた患者(A群)で、残りの7 samplesが退屈な講義を聞いた患者(B群)です。
ちなみに、ここではlogratioをmean(B)-mean(A)で定義しているので、「logratioが正の値の遺伝子は、面白い話(A)を聞いたときに発現が減少し、退屈な話(B)を聞いて発現が上昇した」ということを意味します。よって、logratio > 0を満たす遺伝子が多数を占める遺伝子セットのZスコア(hoge.txt中のz_page列に相当)は負の大きな値を示します。
得られたhoge.txtファイルをエクセルなどで開き、"p_page"列(p値)で低い順にソートすれば、「A群 vs. B群」の二つの状態間で”動いているパスウェイ”順にソートされたことになる。論文の表とかで示す場合には「p値 < 0.05を満たすものだけ」とか「上位10個だけ」を表示することになります。
注意点としては、「"Member_num_thischip"列の数値が10未満のものは怪しい」ので、できればリストからは除外しておいたほうがいいです。理由は、原著論文中にも書いていますが、この方法は中心極限定理
（母集団の分布がどんな分布であっても"ある遺伝子セットのメンバーのFold changeの平均（標本平均に相当）"と"チップ上の全遺伝子のFold changeの平均（母平均に相当）"の間の誤差はサンプルサイズ（その遺伝子セットのメンバー数に相当）を大きくしたときに近似的に正規分布に従うという定理）を論拠としており、
"Member_num_thischip(サンプルのサイズに相当)"があまりに小さいと正規分布に従うという前提が成り立たないためです。それで、原著論文では、「PAGE法を利用可能な最低限必要な遺伝子セットを構成するメンバー数（the minimal gene set size）は10程度必要だ。」としています。ここでは、混乱をきたさないように「"Member_num_thischip"列の数値が10未満のものは最初から排除」してもよかったのですが、
8 or 9個しかなくp値が非常に低い場合でも、そのパスウェイが動いていないと言い切れるわけではないと思うので、一応全ての情報を出力するようにしています。したがって、"p_page"列(p値)で低い順にソートした結果を眺めるのを基本としつつも"Member_num_thischip"列の数値が小さいかどうかにも注意を払うことをお勧めします。
解析例を行って得られたhoge.txtの10未満しかないがp値がそこそこ低いものの一例としては、28番目の"HSA00791_ATRAZINE_DEGRADATION"です。
1. Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
2. Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
3. これでMSigDBのダウンロードページに行けるので、
とりあえず「c2: curated gene sets」の「KEGG gene sets file」を解析すべく、
c2.kegg.v2.5.symbols.gmtファイルを(sample13_7vs7_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
4. Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "sample13_7vs7_nr2.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "c2.kegg.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定
param1 <- 7 #A群のサンプル数を指定
param2 <- 7 #B群のサンプル数を指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(PGSEA) #PGSEAパッケージ（ライブラリ）の読み込み
gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納（不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい）
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
#Zスコアを算出する関数calc_zを作成
calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成
return(hoge) #Zスコアを算出する関数calc_zを作成
} #Zスコアを算出する関数calc_zを作成
#PAGE解析のメイン部分
AD <- apply(data[,data.cl == 1], 1, mean, na.rm=TRUE) - apply(data[,data.cl == 0], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納
names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する
mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納
sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納
z_page <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納
} #length(gmt)回だけループを回す
p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納
#結果をまとめてファイルに保存
out <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納
Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納
out <- rbind(out, c(Geneset_name, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納
} #length(gmt)回だけループを回す
colnames(out) <- c("Geneset_name", "Member_num", "Member_num_thischip") #outの列名をGeneset_name, Member_num, Member_num_thischipに変更
tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#p値の低い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
解析 | 機能解析 | PAGE法(Kim_2005;統計量の変換あり)を用いてPathway解析
PAGE法を用いて、どのパスウェイが動いていたかを調べたいときに用います。
前処理 | 遺伝子のフィルタリング3の4を適用することによって得られた、各群で少なくとも一つ以上の数値の要素を含むものの、
NAやNaNの要素を含むsample13_7vs7_nr2.txtのようなAgilent two-colorデータの解析例を示します。
この例では、GSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードしたKEGG gene sets fileファイル(c2.kegg.v2.5.symbols.gmt)を読み込んで解析を行います。
この例で示す遺伝子発現行列データ(sample13_7vs7_nr2.txt)のサンプルラベル情報はサンプルマイクロアレイデータの12のものと同じです。つまり、最初の7 samplesが面白い話を聞いた患者(A群)で、残りの7 samplesが退屈な講義を聞いた患者(B群)です。
ちなみに、ここではAD統計量をmean(B)-mean(A)で定義しているので、「ADが正の値の遺伝子は、面白い話(A)を聞いたときに発現が減少し、退屈な話(B)を聞いて発現が上昇した」ということを意味します。。
得られたhoge2.txtファイルは、「A群 vs. B群」の二つの状態間で”動いているパスウェイ”順にソートされた結果です。この場合、論文の表とかで示す場合には「上位10個だけ」などを表示することになります。
注意点としては、「"Member_num_thischip"列の数値が10未満のものは怪しい」ので、できればリストからは除外しておいたほうがいいです。一般的にメンバー数が10以上とか15以上の遺伝子セットのみ解析というのが多いというのも理由の一つです。例えば参考文献2では、メンバー数が15-500 genesの範囲の遺伝子セットのみを解析対象としています。
1. Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
2. Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
3. これでMSigDBのダウンロードページに行けるので、
とりあえず「c2: curated gene sets」の「KEGG gene sets file」を解析すべく、
c2.kegg.v2.5.symbols.gmtファイルを(sample13_7vs7_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
4. Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "sample13_7vs7_nr2.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "c2.kegg.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定
param1 <- 7 #A群のサンプル数を指定
param2 <- 7 #B群のサンプル数を指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(PGSEA) #PGSEAパッケージ（ライブラリ）の読み込み
gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納（不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい）
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
#AD統計量を計算
AD <- apply(data[,data.cl == 1], 1, mean, na.rm=TRUE) - apply(data[,data.cl == 0], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納
names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する
stat_page <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
genenames <- intersect(names(AD), gmt[[i]]@ids) #i番目の遺伝子セット中の遺伝子リストの中からチップに搭載されている遺伝子のみのGene symbolsをgenenamesに格納
stat_page <- c(stat_page, mean(abs(AD[genenames]))) #genenamesで表された遺伝子リストのAD統計量の絶対値の平均を計算し、stat_pageに格納
} #length(gmt)回だけループを回す
#結果をまとめてファイルに保存
out <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納
Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納
out <- rbind(out, c(Geneset_name, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納
} #length(gmt)回だけループを回す
colnames(out) <- c("Geneset_name", "Member_num", "Member_num_thischip") #outの列名をGeneset_name, Member_num, Member_num_thischipに変更
tmp <- cbind(out, stat_page) #outの右側にPAGE解析結果のAD統計量の絶対値の平均を追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#AD統計量の絶対値の平均が高い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(-stat_page),] #stat_pageでソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
参考文献2(Ackermann and Strimmer, BMC Bioinformatics, 2009)
解析 | 機能解析 | PAGE法(Kim_2005)を用いてPathway解析した後
まだ作成途中です...
PAGE法(Kim_2005;統計量の変換なし)を用いてPathway解析では、hoge2.txtをエクセルなどで開き、動いたKEGG Pathwayの上位10個やp値<0.01のものなどをリストアップすることまでが可能です。
解析例（「面白い話(A) vs. 退屈な話(B)」のPathway解析）で得られた上位10個の結果は以下の通りです。
------------------------------------------------------------------------------------------------------------
Geneset_name Member_num Member_num_thischip z_page p_page
HSA04612_ANTIGEN_PROCESSING_AND_PRESENTATION 83 75 -7.417644043 1.19E-13
HSA04650_NATURAL_KILLER_CELL_MEDIATED_CYTOTOXICITY 132 120 -6.455612947 1.08E-10
HSA04660_T_CELL_RECEPTOR_SIGNALING_PATHWAY 93 85 -6.10536501 1.03E-09
HSA04940_TYPE_I_DIABETES_MELLITUS 45 41 -5.127354084 2.94E-07
HSA05221_ACUTE_MYELOID_LEUKEMIA 53 49 -5.043817499 4.56E-07
HSA04720_LONG_TERM_POTENTIATION 69 67 -4.934603559 8.03E-07
HSA04540_GAP_JUNCTION 98 80 -4.240373448 2.23E-05
HSA05220_CHRONIC_MYELOID_LEUKEMIA 76 71 -4.047010307 5.19E-05
HSA04912_GNRH_SIGNALING_PATHWAY 97 93 -3.984577112 6.76E-05
HSA04810_REGULATION_OF_ACTIN_CYTOSKELETON 212 185 -3.852884301 0.000116735
------------------------------------------------------------------------------------------------------------
この結果から、最も比較した二群間で動いているパスウェイは「HSA04612_ANTIGEN_PROCESSING_AND_PRESENTATION」であり、
遺伝子発現データ取得に用いたチップ上には75個の遺伝子が搭載されていることが分かりますが、
そのパスウェイ構成メンバーのどの遺伝子の発現がどちら向き（A群 > B群 or A群 < B群）に変化したのかまでをパスウェイ上に色でマップしたいときに以下を行います。
1. 知りたいパスウェイIDHSA04612を構成する遺伝子セットのAD統計量情報から対応する色の16進数値を入手すべく、以下をコピペ
・AD統計量が負の値のもの（A群で発現上昇）を水色、AD統計量が正の値のもの（B群で発現上昇）をピンク色で図示したい場合
------ ここから ------
param <- "HSA04612" #解析したいパスウェイIDを指定
param1 <- "#FF00FF" #AD > 0（B群で発現上昇）のものの色（ピンク色）を指定
param2 <- "#0099FF" #AD < 0（A群で発現上昇）のものの色（水色）を指定
out_f3 <- "hoge_detail.txt" #元となるAD統計量情報を含む出力ファイル名を指定
out_f4 <- "hoge_kegg.txt" #KEGG Pathway用出力ファイル名を指定
calc_color <- function(x){ #AD統計量から色の16進数値を返す関数calc_colorを作成
if(x > 0){ tmp_color <- param1 } #AD統計量>0のときはparam1で指定した色を返すべくtmp_colorに格納
if(x < 0){ tmp_color <- param2 } #AD統計量<0のときはparam2で指定した色を返すべくtmp_colorに格納
return(tmp_color) #tmp_colorの中身を結果として返す
} #AD統計量から色の16進数値を返す関数calc_colorを作成
posi <- pmatch(param, tmp[,1]) #paramで指定したパスウェイIDのgmtファイル中での位置を同定しposiに格納
genenames <- intersect(names(AD), gmt[[posi]]@ids) #チップに搭載されている遺伝子のGene symbolsをgenenamesに格納
tmpAD <- AD[genenames]
out <- apply(as.matrix(tmpAD), 1, calc_color)
tmp3 <- cbind(genenames, tmpAD) #genenamesの右側にAD統計量情報を追加してtmp3に格納
write.table(tmp3, out_f3, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f3で指定したファイル名で保存。
tmp4 <- cbind(genenames, out) #genenamesの右側に色の16進数値情報を追加してtmp4に格納
write.table(tmp4, out_f4, sep=" ", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f4で指定したファイル名で保存。
------ ここまで ------
・上記の色使いを基本としつつ、AD <= -1を水色、-1 < AD < 0を薄水色、0 < AD < 1を薄ピンク色、AD >= 1をピンク色の4諧調で図示したい場合
（ちなみにAD統計量は「log2 scaleでの各群の算術平均値の差」なので、
AD <= -1は「A群で2倍以上発現上昇」に相当し、AD >= 1は「B群で2倍以上発現上昇」に相当します。）
------ ここから ------
param <- "HSA04612" #解析したいパスウェイIDを指定
param1 <- "#FF00FF" #AD >= 1（B群で2倍以上発現上昇）のものの色（ピンク色）を指定
param2 <- "#FFCCFF" #0 < AD < 1（B群で2倍未満発現上昇）のものの色（薄ピンク色）を指定
param3 <- "#CCFFFF" #-1 < AD< 0（A群で2倍未満発現上昇）のものの色（薄水色）を指定
param4 <- "#0099FF" #AD <= -1（A群で2倍以上発現上昇）のものの色（水色）を指定
out_f3 <- "hoge_detail.txt" #元となるAD統計量情報を含む出力ファイル名を指定
out_f4 <- "hoge_kegg.txt" #KEGG Pathway用出力ファイル名を指定
calc_color <- function(x){ #AD統計量から色の16進数値を返す関数calc_colorを作成
if(x >= 1){ tmp_color <- param1 } #AD >= 1のときはparam1で指定した色を返すべくtmp_colorに格納
if((0 < x) & (x < 1)){ tmp_color <- param2 } #0 < AD < 1のときはparam2で指定した色を返すべくtmp_colorに格納
if((-1 < x) & (x < 0)){ tmp_color <- param3 } #-1 < AD < 0のときはparam3で指定した色を返すべくtmp_colorに格納
if(x <= -1){ tmp_color <- param4 } #AD <= -1のときはparam4で指定した色を返すべくtmp_colorに格納
return(tmp_color) #tmp_colorの中身を結果として返す
} #AD統計量から色の16進数値を返す関数calc_colorを作成
posi <- pmatch(param, tmp[,1]) #paramで指定したパスウェイIDのgmtファイル中での位置を同定しposiに格納
genenames <- intersect(names(AD), gmt[[posi]]@ids) #チップに搭載されている遺伝子のGene symbolsをgenenamesに格納
tmpAD <- AD[genenames]
out <- apply(as.matrix(tmpAD), 1, calc_color)
tmp3 <- cbind(genenames, tmpAD) #genenamesの右側にAD統計量情報を追加してtmp3に格納
write.table(tmp3, out_f3, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f3で指定したファイル名で保存。
tmp4 <- cbind(genenames, out) #genenamesの右側に色の16進数値情報を追加してtmp4に格納
write.table(tmp4, out_f4, sep=" ", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f4で指定したファイル名で保存。
------ ここまで ------
2. Color Objects in KEGG Pathwaysのページを開き、以下を実行
・「Search against:」のところを自分がマップしたい生物種（この場合は「Homo Sapiens (Human)」）を選択
・「Alternatively, enter the file name containing the data:」のところの
”参照”ボタンをクリックして、KEGG Pathway用出力ファイル（out_f4で指定したファイル名：この場合はhoge_kegg.txt）
を読み込ませ、Execボタンを押す
・”Pathway Search Result”のページに切り替わるので、
paramで指定した解析したいパスウェイID（候補リストのトップのほうに位置している場合がほとんど：この場合HSA04612）のものをクリック
参考文献(KEGG; Kanehisa et al., Nucleic Acids Res, 2008)
KEGG PATHWAYのウェブページ
解析 | 機能解析 | PAGE(Z-score)法(Kim_2005;統計量の変換なし)を用いてGene Ontology解析
デフォルトのPAGE法は遺伝子のランキングにAD法を採用していましたが、Z-score変換するやり方(参考文献3)もあります。
参考文献3ではlog10変換したものを取り扱っているので、(a)ではunlogged data(sample17_unlog.txt)を読み込んでlog10変換してますが、log2変換後のデータ(sample17.txt)を取り扱うのが一般的だと思うので、(b)ではlog2変換後のデータを読み込んでそのまま解析しています。
解析例で示す8 samples×14026 genesからなる遺伝子発現行列データ(sample17_unlog.txt or sample17.txt)は、最初の4サンプルがA群、残りの4サンプルがB群です。
1. Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
2. Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
3. これでMSigDBのダウンロードページに行けるので、
とりあえず「c5: gene ontology gene sets」の「GO biological process gene sets file」を解析すべく、
c5.bp.v3.0.symbols.gmtファイルを(data_GSE7623_unlog_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
4. Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
(a) log変換されていないデータ(sample17_unlog.txt)を読み込んでlog10変換して解析する場合：
------ ここから ------
in_f1 <- "sample17_unlog.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "c5.bp.v3.0.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定
param1 <- 4 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定
param2 <- 4 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(PGSEA) #PGSEAパッケージ（ライブラリ）の読み込み
gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納（不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい）
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
colnames(data) #dataの列名を表示させてるだけ
#列（サンプル）ごとにZスコアを算出
data_log10 <- log10(data) #log10変換した結果をdata_log10に格納
zscore <- scale(data_log10) #Z-score化した結果をzscoreに格納
apply(zscore, 2, sd) #Z-score化した結果の各列の標準偏差がちゃんと1になっているか確認している
apply(zscore, 2, mean) #Z-score化した結果の各列の平均がちゃんと0になっているか確認している
#比較する二群間のZ ratioを算出
mean_zscore_A <- apply(zscore[,data.cl == 0], 1, mean) #A群の行（遺伝子）ごとのzscoreの平均値を計算した結果をmean_zscore_Aに格納
mean_zscore_B <- apply(zscore[,data.cl == 1], 1, mean) #B群の行（遺伝子）ごとのzscoreの平均値を計算した結果をmean_zscore_Bに格納
zratio <- (mean_zscore_B - mean_zscore_A)/sd(mean_zscore_B - mean_zscore_A)#Z ratioを計算した結果をzratioに格納
#Zスコアを算出する関数calc_zを作成
calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成
return(hoge) #Zスコアを算出する関数calc_zを作成
} #Zスコアを算出する関数calc_zを作成
#PAGE解析のメイン部分
AD <- zratio #この行以下の記述を他のPAGE法のものと統一すべくzratioをADとして取り扱う
names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する
mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納
sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納
z_page <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納
} #length(gmt)回だけループを回す
p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納
#結果をまとめてファイルに保存
out <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納
GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納
Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納
} #length(gmt)回だけループを回す
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更
tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#p値の低い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
(b) log2変換されたデータ(sample17.txt)を読み込んでそのまま解析する場合：
------ ここから ------
in_f1 <- "sample17.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "c5.bp.v3.0.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定
param1 <- 4 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定
param2 <- 4 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(PGSEA) #PGSEAパッケージ（ライブラリ）の読み込み
gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納（不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい）
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成
colnames(data) #dataの列名を表示させてるだけ
#列（サンプル）ごとにZスコアを算出
zscore <- scale(data) #Z-score化した結果をzscoreに格納
apply(zscore, 2, sd) #Z-score化した結果の各列の標準偏差がちゃんと1になっているか確認している
apply(zscore, 2, mean) #Z-score化した結果の各列の平均がちゃんと0になっているか確認している
#比較する二群間のZ ratioを算出
mean_zscore_A <- apply(zscore[,data.cl == 0], 1, mean) #A群の行（遺伝子）ごとのzscoreの平均値を計算した結果をmean_zscore_Aに格納
mean_zscore_B <- apply(zscore[,data.cl == 1], 1, mean) #B群の行（遺伝子）ごとのzscoreの平均値を計算した結果をmean_zscore_Bに格納
zratio <- (mean_zscore_B - mean_zscore_A)/sd(mean_zscore_B - mean_zscore_A)#Z ratioを計算した結果をzratioに格納
#Zスコアを算出する関数calc_zを作成
calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成
return(hoge) #Zスコアを算出する関数calc_zを作成
} #Zスコアを算出する関数calc_zを作成
#PAGE解析のメイン部分
AD <- zratio #この行以下の記述を他のPAGE法のものと統一すべくzratioをADとして取り扱う
names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する
mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納
sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納
z_page <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納
} #length(gmt)回だけループを回す
p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納
#結果をまとめてファイルに保存
out <- NULL #おまじない
for(i in 1:length(gmt)){ #length(gmt)回だけループを回す
Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納
GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納
Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納
} #length(gmt)回だけループを回す
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更
tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#p値の低い順にソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
参考文献2(Nakai et al., BBB, 2008)
参考文献3(Cheadle et al., J. Mol. Diagn., 2003)
解析 | 機能解析 | Parametric Gene Set Enrichment Analysis (PGSEA) (Kim_2005)
解析 | 機能解析（GSEA周辺）についてでも書きましたが、原著論文(Kim and Volsky, BMC Bioinformatics, 2005)と似て非なるものです...。
------ ここから ------
library(PGSEA) #パッケージの読み込み
library(GSEABase) #パッケージの読み込み
library(org.Hs.eg.db) #パッケージの読み込み
------ ここまで ------
BioconductorのPGSEAのwebページ
参考文献(Kim and Volsky, BMC Bioinformatics, 2005)
解析 | 機能解析 | Gene Set Enrichment Analysis (GSEA) (Subramanian_2005)
t統計量などでランキングした結果に対して、例えばx染色体上の遺伝子群が上位に偏っているかどうかを解析したいときに用いる。a modified Kolmogorov-Smirnov統計量を用いて偏りを調べます。
1. ソフトウェアダウンロードページから（予め登録が必要）R-GSEAをダウンロード
2. ダウンロードしたGSEA-P-R.1.0.zipファイルを解凍し、得られたGSEA-P-Rフォルダを「C:/Program Files/R/R-2.9.0/library/」に移動。
3.
参考文献(Subramanian et al., PNAS, 2005)
GSEAのウェブページ
GSEAのユーザーガイド
解析 | 機能解析 | Gene set analysis (GSA) (Efron_2007)
（GSEAと違って）maxmean統計量を用いて偏りを調べます。(現状では解析結果情報の抽出まではたどりつけてはいませんが概ねこんな感じです。。。)
参考文献2(Nakai et al., BBB, 2008)（「Affymetrix Rat Genome 230 2.0 Array」を利用）のデータを遺伝子名重複を前処理 | 同じ遺伝子名を持つものをまとめることにより排除して得られた「24 samples×14026 genesからなる遺伝子発現行列ファイルdata_GSE7623_rma_nr.txtを入力として、Gene Ontology解析を行うやり方を示します。
このときGSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
解析例で示す24 samples×14026 genesからなる遺伝子発現行列データ(data_GSE7623_rma_nr.txt)のサンプルラベル情報は以下の通りです。
ここではLIVサンプルの「fed vs. 24h-fasted」のGene Ontology解析を例示します。LIVのfedサンプル(A群)は17-20列目、24h-fastedサンプル(B群)は21-24列目のデータに相当します。
----------------------------------------------------------
GSM184414-184417: Brown adipose tissue (BAT), fed
GSM184418-184421: Brown adipose tissue (BAT), 24 h-fasted
GSM184422-184425: White adipose tissue (WAT), fed
GSM184426-184429: White adipose tissue (WAT), 24 h-fasted
GSM184430-184433: Liver tissue (LIV), fed
GSM184434-184437: Liver tissue (LIV), 24 h-fasted
----------------------------------------------------------
1. Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
2. Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
3. これでMSigDBのダウンロードページに行けるので、
とりあえず「c5: gene ontology gene sets」の「GO biological process gene sets file」を解析すべく、
c5.bp.v2.5.symbols.gmtファイルを(data_GSE7623_rma_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
4. Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
------ ここから ------
in_f1 <- "data_GSE7623_rma_nr.txt" #入力ファイル名(発現データファイル)を指定
in_f2 <- "c5.bp.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定
param1 <- 17:20 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定
param2 <- 21:24 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定
out_f <- "hoge.txt" #出力ファイル名を指定
library(GSA) #GSAパッケージ（ライブラリ）の読み込み
gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納（不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい）
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
colnames(data) #dataの列名を表示。GSM184414-184437まで順番に並んでいることを確認
rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している（gmtファイルに合わせるためです）
data <- data[,c(param1, param2)] #発現データの中から、ここで比較するLIVサンプルの列のみを抽出した結果をdataに格納。
data.cl <- c(rep(1, length(param1)), rep(2, length(param2))) #A群を1、B群を2としたベクトルdata.clを作成。
out <- GSA(data, data.cl, genesets=gmt$genesets, genenames=rownames(data), resp.type="Two class unpaired")
------ ここまで ------
CRANのGSAのwebページ
CRANのGSAのPDFマニュアル
参考文献(Efron and Tibshirani, Ann. Appl. Stat., 2007)
GSAのウェブページ
解析 | 機能解析 | Gene Ontlogy解析 | topGO (Alexa_2006) (last modified 2011/12/14) NEW
解析 | 機能解析 | Gene Ontlogy解析 | topGO (Alexa_2006)
------ ここから ------
library(topGO) #パッケージの読み込み
------ ここまで ------
BioconductorのtopGOのwebページ
参考文献(Alexa et al., Bioinformatics, 2006)
解析 | クラスタリング | 階層的 | について
- 階層的クラスタリングは大きく二つの方法に分類可能です(参考文献1)：
1. agglomerative nesting method
2. divisive analysis method
日本語だと1. 凝集法と2. 分割法、でしょうか。おそらくなじみ深いのは1.のagglomerative nesting methodのほうでしょう。
例えばn個の組織からなるマイクロアレイデータに対する組織間(サンプル間)クラスタリングの場合だと、以下のような感じになります。
1. agglomerative nesting method：初期状態はn個の(各クラスターの構成要素が一つのサンプルしかない)クラスター(n singleton clusters)からスタート
a. 全てのクラスター間の総当たりの距離行列を作成
b. 最も距離が近い二つのクラスターを一つにまとめる
c. 最終的に一つのクラスターになるまでa,bを繰り返す
2. divisive analysis method：初期状態は全nサンプルをまとめた一つのクラスターからスタート
a. クラスターの中で、最も他のサンプル群から距離が離れたサンプルを分離し、"分裂グループ(splinter group)"に入れる
b. オリジナルクラスター中の残りのサンプルに対して、新たに形成された分裂グループに近いものは入れる
(結果として二つのクラスターが形成される)
c. 各クラスターの直径(同じクラスター内の総当たりのサンプル間距離を計算し、最も遠い距離に相当)を計算し、どちらが大きいかを調べる
d. 直径のより大きいほうのクラスターに対して、a-cを繰り返す
e. a-dをn singleton clustersになるまで繰り返す
20090812現在、1.のAgglomerative nesting methodのやり方しかこのページにはありませんが、必要に応じて追加していく予定です。
- (階層的)クラスタリングはこれまで、癌のサブタイプの発見などに威力を発揮してきました(参考文献2)。
しかし、クラスタリングの一番の問題は興味あるクラスターが偶然では形成されない(されにくい)信頼できるクラスターかどうかの判断が難しいことだと思います。
p値のようなものがない、という理解でも差し支えありません。
それゆえ、このページでは、特に信頼できるクラスターがどれかを調べるためのやり方(pvclust)や、
適切なクラスター数および得られたクラスターの安定性を知るための方法(最適なクラスター数を見積る)の紹介を行っています。
この二つのやり方はいずれも基本的にサンプル間クラスタリングを例として挙げています。これはやはり、数百程度のサンプルのクラスタリングだとメモリ4GB程度でどうにかなるからです。
- 個人的には遺伝子間クラスタリングをやる意味はないと思っています。現実問題として、信頼できる遺伝子クラスターを得ることができないためです。
従来一つにまとめられていた癌のサブタイプの発見などを目的とするならば、
まずはpvclustか最適なクラスター数を見積るを行って、サブタイプがありそうかどうかを判断し、
例えば二つのサブタイプに分かれそうだという感じであれば、解析 | 発現変動遺伝子 | 二群間 | 対応なし |についてなどで紹介している方法を適用して、候補サブタイプ間で発現の異なる遺伝子群の検出を行います。
当然、一連の作業中に遺伝子間クラスタリングを行うphaseはありません。
- また、このページの項目名でいうところの"正規化"や"前処理"のどれを行うかによっても、得られるクラスタリングの結果(樹形図)が異なることにも注意が必要です。
これはクラスタリングの欠点の一つとも言えるのかもしれませんが、本来クラスタリングというのは"何の予断も持たずにとにかく似たものをどんどんまとめていく"ものなのですが、
多くの場合、例えば癌サンプル数十例と正常サンプル数十例のサンプル間クラスタリングを行う際、実際には、癌と正常組織が二群に分かれるのではないだろうかと事前に無意識のうちに期待します。
それゆえ、はっきりと二群に分かれない結果が得られるとがっかり...します。それでデータを取りなおしたり、都合の悪いサンプルの結果を難癖つけて排除...したがります。これ以外の行動パターンとしては、
正規化法Aを用いて得られた遺伝子発現行列のクラスタリング結果と正規化法Bの結果を眺めて、"都合のいいほう"を採用します(しがちです or する人もいます or ...)。
つまり、癌と正常組織が二群に分かれるのではないだろうかと事前に期待したことが、無意識(or意識的)に癌と正常がはっきりと二群に分かれる正規化法を探す行動に向かわせ、結果として二群にはっきりと分かれた結果が得られた、
という現実をつくる自己成就予言(self-fulfilling prophecy)に(私を含め)ほとんどの人がなっているのだろうと思います。
これがいいことか悪いことかは...なんとも言えませんが、いずれにせよ正規化や前処理次第で結果が変わりうるという事実だけは知ってて損はないと思います。
参考文献1(Smolkin and Ghosh, BMC Bioinformatics, 2003)
参考文献2(Bittner et al., Nature, 2000)
参考文献3(Ben-Hur et al., Pac. Symp. Biocomput., 2002)
参考文献4(Jonnalagadda and Srinivasan, BMC Bioinformatics, 2009)
解析 | クラスタリング | 階層的 | pvclust (Suzuki_2006)
最も一般的なクラスタリング手法。
このパッケージはさらに、二つのブートストラップ法により得られたクラスターのp値を表示してくれます。具体的には、
一般的なブートストラップ法によって得られるブートストラップ確率BP（Bootstrap Probability; 多数のサンプリングから特定のクラスターが形成される確率；樹形図上で緑色の数値）とともに、
より高精度なブートストラップ法であるmultiscale bootstrap resamplingにより得られた"近似的に偏りのない（Approximately Unbiased；樹形図上で赤色の数値）" 確率（%）を示してくれます。
（デフォルトでは）後者の方法により得られたp値が95%以上の確率で頑健なクラスターを四角く囲ってくれるところがこのパッケージの特徴です。
(今は解消されているのかもしれませんが、また私の理解が間違っているのかもしれませんが...)ブートストラップ回数を変えて結果を眺めると、
大元のクラスタリング結果は変わらずに枝に付加されるブートストラップ確率の値が微妙に変わるだけなはず（←この私の理解がまちがっていなければ）なのですが、"同じデータでも"樹形図の形が微妙に変わってしまうという経験をしました（ほかのユーザーからも同様のコメントをいただいたことがあります）。
2010/8/5にあらためて、例題のサンプルデータでリサンプリング回数を10,20,30回の場合でやってみると、ちゃんと樹形図の形が変わらずにブートストラップ確率の数値だけが変わっていたので、私からのバグレポートはできませんでした。どなたかこういう経験をなさったかたは下平先生（と私）までお願いいたします。
pvclustを行う際には
・発現ベクトル間の類似度(method.dist): correlation (デフォルト; 1-相関係数に相当),uncentered, abscorなど
および
・クラスターをまとめる方法(method.hclust): average (デフォルト), single, complete, ward, mcquitty, median, centroid
を指定してやる必要があります。
数式などの詳細は参考PDFをごらんください。
また、ブートストラップ確率を計算するためのresampling回数も指定する必要があります。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 36 sample×22,283 genesからなるGDS1096_rma.txtのサンプル間クラスタリングを行う場合：
------ ここから ------
in_f <- "GDS1096_rma.txt" #入力ファイル名(発現データファイル)を指定
param1 <- "correlation" #類似度(method.dist)を指定
param2 <- "average" #方法(method.hclust)を指定
param3 <- 20 #resampling回数を指定（この値が大きいほどより正確にブートストラップ確率を求めることができる。実際には100とか500とか...）
library(pvclust) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
out <- pvclust(data, method.hclust=param2, method.dist=param1, nboot=param3)#クラスタリングの実行
plot(out) #樹形図（デンドログラム）の表示
#以下は（こんなこともできますという）おまけ
#Approximately Unbiased (au) probability > 0.95を満たす頑健なクラスターを四角で囲み、その条件を満たすクラスターのメンバーをリストアップしたい場合：
param4 <- "au" #ブートストラップ確率計算手段を指定
param5 <- 0.95 #ブートストラップ確率の閾値を指定
pvrect(out, alpha=param5, pv=param4) #条件を満たすクラスターを四角で囲む
pvpick(out, alpha=param5, pv=param4) #条件を満たすクラスターのメンバーをリストアップする
------ ここまで ------
2. 10 sample×45 genesからなるsample3.txtのサンプル間クラスタリングを特に何も考えずデフォルト設定(resampling回数が1000となるのですごく時間がかかります...)で行う場合：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
library(pvclust) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
out <- pvclust(data) #クラスタリングの実行
plot(out) #樹形図（デンドログラム）の表示
------ ここまで ------
3. 10 sample×45 genesからなるsample3.txtの遺伝子間クラスタリングをやる場合(pvclustでの遺伝子間クラスタリングは時間がかかりすぎるのでお勧めできません...)：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param1 <- "correlation" #類似度(method.dist)を指定
param2 <- "average" #方法(method.hclust)を指定
param3 <- 30 #resampling回数を指定（この値が大きいほどより正確にブートストラップ確率を求めることができる。実際には100とか500とか...）
library(pvclust) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
out <- pvclust(t(data), method.hclust=param2, method.dist=param1, nboot=param3)#クラスタリングの実行
plot(out) #樹形図（デンドログラム）の表示
------ ここまで ------
CRANのpvclustのwebページ
CRANのpvclustのPDFマニュアル
参考文献(Suzuki and Shimodaira, Bioinformatics, 2006)
解析 | クラスタリング | 階層的 | hclust
最も一般的なクラスタリング手法。
・発現ベクトル間の類似度(dist): euclidean (デフォルト),maximum, manhattan, canberra, binary, minkowski
および
・クラスターをまとめる方法(method): complete (デフォルト), ward, single, average, mcquitty, median, centroid
を指定してやる必要があります。
ただし、類似度として一般的?!な「1-相関係数」に相当するものは上記では指定できないので、2.のところで「1-相関係数」を類似度として定義するやり方を紹介しておきます。
サンプル間クラスタリング程度なら、以下のやり方で得られる樹形図を眺めていろいろ考察することはできるでしょうが、数万遺伝子の遺伝子間クラスタリング結果だと不可能ですので、
特に遺伝子間クラスタリング結果の詳細な解析を行いたい場合には解析 | クラスタリング | 階層的 | hclust後の詳細な解析を参考にしてください(もちろんサンプル間クラスタリング結果の詳細な解析にも利用可能です。)。
得られる樹形図をそのままpng形式のファイルに保存するやり方に変更しました（2010/1/29追加）。
「ファイル」−「ディレクトリの変更」で解析したい(sample3.txt)ファイルを置いてあるディレクトリに移動し、以下をコピペ
1. サンプル間クラスタリングの場合(類似度：ユークリッド距離(euclidean)、方法：平均連結法(average))：
・R Graphics画面上に表示したい場合：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param1 <- "euclidean" #類似度(dist)を指定
param2 <- "average" #方法(method)を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.dist <- dist(t(data), method=param1) #サンプル間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
plot(out) #樹形図（デンドログラム）の表示
------ ここまで ------
・png形式のファイルで図の大きさを指定して得たい場合：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param1 <- "euclidean" #類似度(dist)を指定
param2 <- "average" #方法(method)を指定
out_f <- "hoge.png" #出力ファイル名(クラスタリング結果ファイル)を指定
param3 <- 500 #クラスタリング結果の横幅（width; 単位はピクセル）を指定
param4 <- 400 #クラスタリング結果の縦幅（height; 単位はピクセル）を指定
param5 <- 14 #クラスタリング結果の文字の大きさ（単位はpoint）を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.dist <- dist(t(data), method=param1) #サンプル間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定
plot(out) #樹形図（デンドログラム）の表示
dev.off() #おまじない
------ ここまで ------
2. サンプル間クラスタリングの場合(類似度：「1-相関係数」、方法：平均連結法(average))：
・R Graphics画面上に表示したい場合：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param2 <- "average" #方法(method)を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.dist <- as.dist(1 - cor(data)) #サンプル間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
plot(out) #樹形図（デンドログラム）の表示
------ ここまで ------
・png形式のファイルで図の大きさを指定して得たい場合(Pearson相関係数)：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param2 <- "average" #方法(method)を指定
out_f <- "hoge.png" #出力ファイル名(クラスタリング結果ファイル)を指定
param3 <- 500 #クラスタリング結果の横幅（width; 単位はピクセル）を指定
param4 <- 400 #クラスタリング結果の縦幅（height; 単位はピクセル）を指定
param5 <- 14 #クラスタリング結果の文字の大きさ（単位はpoint）を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.dist <- as.dist(1 - cor(data, method="pearson")) #サンプル間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定
plot(out) #樹形図（デンドログラム）の表示
dev.off() #おまじない
------ ここまで ------
・png形式のファイルで図の大きさを指定して得たい場合(Spearman相関係数)：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param2 <- "average" #方法(method)を指定
out_f <- "hoge.png" #出力ファイル名(クラスタリング結果ファイル)を指定
param3 <- 500 #クラスタリング結果の横幅（width; 単位はピクセル）を指定
param4 <- 400 #クラスタリング結果の縦幅（height; 単位はピクセル）を指定
param5 <- 14 #クラスタリング結果の文字の大きさ（単位はpoint）を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.dist <- as.dist(1 - cor(data, method="spearman")) #サンプル間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定
plot(out) #樹形図（デンドログラム）の表示
dev.off() #おまじない
------ ここまで ------
3. 遺伝子間クラスタリングの場合(類似度：ユークリッド距離(euclidean)、方法：平均連結法(average))：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param1 <- "euclidean" #類似度(dist)を指定
param2 <- "average" #方法(method)を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.dist <- dist(data, method=param1) #遺伝子間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
plot(out) #樹形図（デンドログラム）の表示
------ ここまで ------
4. 遺伝子間クラスタリングの場合(類似度：1 - 相関係数、方法：平均連結法(average))：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
param2 <- "average" #方法(method)を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data.dist <- as.dist(1 - cor(t(data))) #遺伝子間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
plot(out) #樹形図（デンドログラム）の表示
------ ここまで ------
解析 | クラスタリング | 階層的 | hclust後の詳細な解析
解析 | クラスタリング | 階層的 | hclustで得られる情報は樹形図(デンドログラム)だけです。
サンプル間クラスタリング程度なら得られる樹形図を眺めていろいろ考察することはできるでしょうが、数万遺伝子の遺伝子間クラスタリング結果だと不可能ですので、
特に遺伝子間クラスタリング結果の詳細な解析を行いたい場合(もちろんサンプル間クラスタリング結果の詳細な解析にも利用可能です)にここで紹介するやり方を利用します。
ここでは、1. 「102 sample×3,274 genes」からなるdata_Singh_RMA_3274.txtや2. 「10 sample×45 genes」からなるsample3.txtの遺伝子間クラスタリングを行った後、
任意のK個のクラスターに分割した場合にどの遺伝子(or サンプル)がどのクラスターに属するかを知るやり方を紹介します。当然のことながら、Kの最大値は1. の遺伝子間クラスタリングの結果だと3,274で、2.の遺伝子間クラスタリングの結果だと45となります。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. data_Singh_RMA_3274.txtの遺伝子間クラスタリングの場合(類似度：1 - 相関係数、方法：平均連結法(average))：
------ ここから ------
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名(発現データファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 10 #K個のクラスターに分割のKを指定
param2 <- "average" #方法(method)を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
#まずはクラスタリングを実行
data.dist <- as.dist(1 - cor(t(data))) #遺伝子間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
#param1で指定した数に分割しファイルに保存
cluster <- cutree(out, k=param1) #param1個のクラスターに分割し、結果をclusterに格納
tmp <- cbind(rownames(data), data, cluster) #入力データの右側にclusterの情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#クラスターごとにソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(cluster),] #cluster列の値でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
2. sample3.txt遺伝子間クラスタリングの場合(類似度：ユークリッド距離(euclidean)、方法：平均連結法(average))：
------ ここから ------
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 3 #K個のクラスターに分割のKを指定
param2 <- "euclidean" #類似度(dist)を指定
param3 <- "average" #方法(method)を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
#まずはクラスタリングを実行
data.dist <- dist(data, method=param2) #遺伝子間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param3) #階層的クラスタリングを実行し、結果をoutに格納
#param1で指定した数に分割しファイルに保存
cluster <- cutree(out, k=param1) #param1個のクラスターに分割し、結果をclusterに格納
tmp <- cbind(rownames(data), data, cluster) #入力データの右側にclusterの情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#以下は（こんなこともできますという）おまけ
#クラスターごとにソートした結果を得たい場合：
out_f2 <- "hoge2.txt" #出力ファイル名を指定
tmp2 <- tmp[order(cluster),] #cluster列の値でソートした結果をtmp2に格納
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
------ ここまで ------
3. data_GSE7623_rma.txtのサンプル間クラスタリングの場合(類似度：1 - 相関係数、方法：平均連結法(average))：
------ ここから ------
in_f <- "data_GSE7623_rma.txt" #入力ファイル名(発現データファイル)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
param1 <- 2:10 #K個のクラスターに分割のKを指定(ここでは2-10を一度に指定←こんなこともできます)
param2 <- "average" #方法(method)を指定
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
colnames(data) <- c( #サンプル名を変更している
"BAT_fed1", "BAT_fed2", "BAT_fed3", "BAT_fed4", #サンプル名を変更している
"BAT_fasted1", "BAT_fasted2", "BAT_fasted3", "BAT_fasted4", #サンプル名を変更している
"WAT_fed1", "WAT_fed2", "WAT_fed3", "WAT_fed4", #サンプル名を変更している
"WAT_fasted1", "WAT_fasted2", "WAT_fasted3", "WAT_fasted4", #サンプル名を変更している
"LIV_fed1", "LIV_fed2", "LIV_fed3", "LIV_fed4", #サンプル名を変更している
"LIV_fasted1", "LIV_fasted2", "LIV_fasted3", "LIV_fasted4") #サンプル名を変更している
#まずはクラスタリングを実行
data.dist <- as.dist(1 - cor(data)) #遺伝子間の距離を計算し、結果をdata.distに格納
out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納
#param1で指定した数に分割しファイルに保存
cluster <- cutree(out, k=param1) #param1個のクラスターに分割し、結果をclusterに格納
tmp <- cbind(colnames(data), cluster) #サンプル名の右側にk個に分割した(例ではk=2,3,...,10)場合のclusterの情報を追加してtmpに格納。
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
解析 | クラスタリング | 階層的 | 最適なクラスター数を見積る
参考文献1の方法を用いてクラスター数を見積ります。
もしご自身のデータを実行したときに「メモリが足りない！」などと文句を言われたら、前処理 | 遺伝子のフィルタリング4 (CVが小さいものを削除)を参考にして遺伝子数を減らしてから行ってください。
以下では、前処理 | 遺伝子のフィルタリング4 (CVが小さいものを削除)の例題を実行して得られたAffymetrix Rat Genome 230 2.0 Arrayの対数変換後(log2変換後)の24 samples×2,127遺伝子からなる遺伝子発現データ(data_GSE7623_rma_cv.txt; 参考文献2)のサンプル間クラスタリングにおいて、最適なクラスター数kを見積り、各サンプルがどのクラスターに属しているかの結果を返すところまでを示します。
解析例で示す24 samples×2,127 genesからなる遺伝子発現行列データのサンプルラベル情報は以下の通りです。
----------------------------------------------------------
GSM184414-184417: Brown adipose tissue (BAT), fed
GSM184418-184421: Brown adipose tissue (BAT), 24 h-fasted
GSM184422-184425: White adipose tissue (WAT), fed
GSM184426-184429: White adipose tissue (WAT), 24 h-fasted
GSM184430-184433: Liver tissue (LIV), fed
GSM184434-184437: Liver tissue (LIV), 24 h-fasted
----------------------------------------------------------
「ファイル」−「ディレクトリの変更」で解析したいファイル(data_GSE7623_rma_cv.txt)を置いてあるディレクトリに移動し、以下をコピペ
------ ここから ------
in_f <- "data_GSE7623_rma_cv.txt" #入力ファイル名を指定
param1 <- 9 #クラスター数の探索範囲の上限
param2 <- "average" #方法(method)を指定
param3 <- 100 #ランダムサンプリング回数を指定（できれば1000くらいを指定したほうがよいと思います）
library(clusterStab) #パッケージの読み込み
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。
data <- as.matrix(data) #dataのデータ形式をmatrix型に変更
out <- benhur(data, 0.7, param1, seednum=12345, iterations=param3, linkmeth=param2)#最適クラスター数の探索を実行し、結果をoutに格納
hist(out) #候補クラスター数ごと(2, 3, ..., param)のJaccard係数分布を表示
------ ここまで ------
解説：
ここでやっていることは、候補クラスター数k個について、2, 3, ..., param個の可能性について調べています。(間違っていたらすいません)
1. まずはk=2の場合について調べます。
2. もともとのサンプル数(この場合24サンプル)のデータについて階層的クラスタリングを行います。
3. 得られた樹形図をもとにk個のクラスターに分けます。
4. もともとのサンプル数のの70%のサンプル(subsamples)をランダムに抽出し階層的クラスタリングを行い、k個のクラスターに分けます。
5. 3.のsubsamplesと4.のsubsamplesのクラスター間のJaccard係数?!を計算します。
6. 4と5を"param3"回行い、Jaccard係数?!の分布を調べた結果がk=2のヒストグラムです。
7. k=3, 4, ..., paramの場合についても同様の計算を行います。
したがって、Jaccard係数?!が1になった回数が"param3"回であれば一番理想的な結果となるわけです。
ですので、ヒストグラムの見方は、横軸のfrequencyが1.0のところに棒が集中、あるいはできるだけ1.0の近くにmajorityがあるようなヒストグラムを示すkの値が最適なクラスター数、という結論になります。解析例の場合はk=2 or 3が採用されるべきと判断します。
「以下にエラー plot.new() : 図の余白が大きす...」などとエラーメッセージが出る場合は、Rの画面を広げて、もう一度コマンドを実行してみてください。
ご自身のデータでヒストグラムの結果ではどのkを採用すればいいか判断がつきづらい場合には、以下をコピペしてみてください。これも見せ方を少し変えているだけで、解析例の場合だと、k=2がもっともよくて、二番目がk=5、三番目がk=6というような見方をします。
------ ここから ------
ecdf(out)
------ ここまで ------
ここまでで、最適なクラスター数が2 or 3個であることがわかりました。次に参考文献3の方法を用いて各クラスターがどれだけ安定なのかをclusterComp関数を用いて調べるとともに、各サンプルがどのクラスターに属しているかの結果を指定した出力ファイル名で保存します。
------ ここから ------
param3 <- 2 #得られた最適なクラスター数(例では2)を指定
out_f <- "hoge.txt" #出力ファイル名を指定
out2 <- clusterComp(data, param3, method=param2) #各クラスターの安定性を見積る
out2 #out2の中身を表示(cluster1,2ともに100%の安定性であることが分かる)
str(out2) #out2というオブジェクトの内容を情報付きで表示
out2@clusters #各サンプルがどのクラスターに属するのかを表示
tmp <- cbind(names(out2@clusters), out2@clusters) #サンプル名とクラスター番号との対応関係をtmpに格納
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
------ ここまで ------
BioconductorのclusterStabのwebページ
参考文献1(Ben-Hur et al., Pac. Symp. Biocomput., 2002)
参考文献2(Nakai et al., BBB, 2008)
参考文献3(Smolkin and Ghosh, BMC Bioinformatics, 2003)
解析 | クラスタリング | 非階層的 | K-means
何個のクラスター(Kの数)にするのがよいか？（cluster validity問題）を探すために提案された指標(選択可)を用いて適切なクラスター数を計算する機能もついている。
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample3.txt)を置いてあるディレクトリに移動。
------ ここから ------
library(cclust) #パッケージの読み込み
sample3 <- read.table("sample3.txt", header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み
sample3_matrix <- as.matrix(sample3) #データ構造の変換
#まずはKをいろいろ変えて得られるクラスターを眺める
sample3_k2 <- cclust(sample3_matrix, 2, 20, verbose=TRUE, method="kmeans")#K=2として遺伝子のクラスタリングを実行
sample3_k3 <- cclust(sample3_matrix, 3, 20, verbose=TRUE, method="kmeans")#K=3として遺伝子のクラスタリングを実行
sample3_k4 <- cclust(sample3_matrix, 4, 20, verbose=TRUE, method="kmeans")#K=4として遺伝子のクラスタリングを実行
sample3_k5 <- cclust(sample3_matrix, 5, 20, verbose=TRUE, method="kmeans")#K=5として遺伝子のクラスタリングを実行
sample3_k2
sample3_k3
sample3_k4
sample3_k5
#Cluster validity Indexの一つであるDB(Davies-Bouldin) Indexを用いて、K=2, 3, 4, 5として得られたクラスターを評価する
clustIndex(sample3_k2, sample3_matrix, index="db")
clustIndex(sample3_k3, sample3_matrix, index="db")
clustIndex(sample3_k4, sample3_matrix, index="db")
clustIndex(sample3_k5, sample3_matrix, index="db")
#K=3でクラスタリングした結果(sample3_k3)から詳細な情報を入手したい場合。(2005.6.6追加)
names(sample3_k3) #sample3_k3からどのような情報を入手できるのか調べる。
sample3_k3$cluster #遺伝子の並び順に、どのクラスに属するかをざっと表示
for(i in 1:nrow(sample3)) cat(rownames(sample3[i,])," ",sample3_k3$cluster[i],"\n")#遺伝子の並び順に、どの遺伝子がどのクラスに属するか全体を表示
------ ここまで ------
DB Indexは、その値が低いものほど分割数が妥当であることを意味する。したがって、いろいろ調べた中で最も値の低かったものを採用(この場合、おそらくK=3)する。
(特にK=5とした場合に、Sizes of Clustersが1になるクラスターがときどき出現する。このような場合clustIndexで調べたときにエラーとなるようだ)
CRANのcclustのwebページ
CRANのcclustのPDFマニュアル
解析 | クラスタリング | 非階層的 | Self-Organizing Maps (SOM)
マイクロアレイデータ解析で似た発現パターンを示す遺伝子(or 組織)を自己組織化マップ(Self-Organizing Map; SOM)によりクラスタリングしたいときに用います。
「ファイル」−「ディレクトリの変更」で解析したい(sample2.txt)ファイルを置いてあるディレクトリに移動。
- 組織(tissue)間クラスタリングの場合:
------ ここから ------
library(som) #パッケージの読み込み
sample2 <- read.table("sample2.txt", header=TRUE, row.names=1, sep="\t", quote="")#ファイルの読み込み
sample2.f <- filtering(sample2, lt=10, ut=100, mmr=2.9, mmd=42) #解析に用いる遺伝子のフィルタリング(発現強度が10以下のものを10に、100以上のものを100に、「発現強度max/min < 2.9」または「(max-min) < 42」の行(遺伝子)を解析から除く)
sample2.f.n <- normalize(sample2.f, byrow=TRUE) #行(row)方向の正規化(平均=0,分散=1); (列方向にしたいときはcolにする)
foo <- som(t(sample2.f.n), xdim=3, ydim=5) #SOMの実行(「x軸方向3分割×y軸方向5分割」にする場合)
plot(foo) #結果のプロット
------ ここまで ------
- 遺伝子(gene)間クラスタリングの場合:
------ ここから ------
library(som) #パッケージの読み込み
sample2 <- read.table("sample2.txt", header=TRUE, row.names=1, sep="\t", quote="")#ファイルの読み込み
sample2.f <- filtering(sample2, lt=10, ut=100, mmr=2.9, mmd=42) #解析に用いる遺伝子のフィルタリング(発現強度が10以下のものを10に、100以上のものを100に、「発現強度max/min < 2.9」または「(max-min) < 42」の行(遺伝子)を解析から除く)
sample2.f.n <- normalize(sample2.f, byrow=TRUE) #行(row)方向の正規化(平均=0,分散=1); (列方向にしたいときはcolにする)
foo <- som(sample2.f.n, xdim=3, ydim=5) #SOMの実行(「x軸方向3分割×y軸方向5分割」にする場合)
plot(foo) #結果のプロット
------ ここまで ------
CRANのsomのwebページ
CRANのsomのPDFマニュアル
解析 | クラスタリング | 非階層的 | 主成分分析（PCA）
マイクロアレイデータ解析で似た発現パターンを示す遺伝子(or 組織)を主成分分析(principal components analysis; PCA)によりクラスタリングしたいときに用います。
「ファイル」−「ディレクトリの変更」で解析したい(sample3.txt)ファイルを置いてあるディレクトリに移動。
------ ここから ------
data <- read.table("sample3.txt", header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み
data.pca <- prcomp(t(data))
names(data.pca)
plot(data.pca$sdev, type="h", main="PCA s.d.")
data.pca.sample <- t(data) %*% data.pca$rotation[,1:2] #第一、二主成分を抽出
plot(data.pca.sample, main="PCA") #第一、二主成分を抽出した結果をプロット
text(data.pca.sample, colnames(data), col = c(rep("red", 7), rep("black", 3)))#tissue1-7を赤、残りの3つの組織を黒で表示。
------ ここまで ------
解析 | 分類 | k-Nearest Neighbor (k-NN)
k-Nearest Neighbor (k-NN) 法を用いて分類します。ここではk=3とする場合について示します（距離の計算は"ユークリッド距離(Euclidean distance)"だけでしか行えないようです）。分類に用いる遺伝子セットの選択（Feature selection）を不等分散性を仮定したt統計量（Welch t statistic）で行う場合の例を紹介します。また、ここでは分類精度を交差検証法の一種であるLeave-one-out cross validation（LOOCV）を用いて行っています。
分類精度は用いる遺伝子数によって変わりますので、ここでは上位2, 3, ..., 15個を分類に用いた場合の結果を出力するようにしています。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動。
- Feature selectionを不等分散性を仮定したt統計量（Welch t statistic）で行う場合:
------ ここから ------
library(class) #パッケージの読み込み
#ラベルが「0の群」と「1の群」間で不等分散性を仮定（var.equal=F）してt.testを行い、t統計量の値を返す関数Welch_tstatを作成。
Welch_tstat <- function(x, cl){
x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納
x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納
if((sd(x.class0)+sd(x.class1)) == 0){#両方の群の標準偏差が共に0の場合はt統計量を計算できない（無限大になる）ので、この場合の統計量を0にする
statistic <- 0
return(statistic)
}
else{
hoge <- t.test(x.class1, x.class0, var.equal=F)
return(hoge$statistic)
}
}
data <- read.table("data_Singh_RMA_3274.txt", header=TRUE, row.names=1, sep="\t", quote="")#data_Singh_RMA_3274.txtファイルの読み込み
colnames(data) #サンプルのラベル情報を表示（Normalが50サンプル、Tumourが52サンプルあることが分かる）
data.cl <- c(rep(0, 50), rep(1, 52)) #Normalを0、Tumourを1としてラベルしなおしたベクトルdata.clを作成
rank.matrix <- rownames(data) #おまじない（出力ファイルの一列目にrownames(data)情報（つまり遺伝子名に関する情報）を付加するため
for (i in 1:length(data.cl)){ #LOOCVなので、length(data.cl)回数分だけループを回す
data.tmp <- data[,-i] #i番目の列データを削除した結果をdata.tmpに格納
data.cl.tmp <- data.cl[-i] #i番目の列データに対応するラベル情報を削除した結果をdata.cl.tmpに格納
tmpall <- apply(data.tmp, 1, Welch_tstat, data.cl.tmp) #i番目の列データがないサブセットに対してWelch t-statisticを計算し、結果をtmpallに格納
rank.matrix <- cbind(rank.matrix, rank(-abs(tmpall))) #i番目の列データがないサブセットに対してWelch t-statisticを計算して得られたランキング結果をrank.matrixの右側の列に追加
}
write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F)#LOOCV用の「leave-one-outで得られたi番目の列（サンプル）データを削除した場合のランキング結果」をhoge_loocv.txtに出力
result <- c("No. of genes", "Accuracy", "MCC") #おまじない（出力ファイルの一行目に左記情報を付加するため）
data.tmp <- read.table("hoge_loocv.txt", header=TRUE, row.names=1, sep="\t", quote="") #上記出力ファイルの読み込み
for(g_num in 2:15){ #ランキング上位2, 3, ..., 15個を分類に用いた場合の精度を調べるためのループ
pred.vector <- NULL #おまじない
for(j in 1:ncol(data.tmp)){ #LOOCV用のループ（サンプル数分だけループが回る）
data.rank <- data.tmp[,j] #j番目のカラム中のランキング情報をdata.rankに格納
data.s <- data[order(data.rank),] #もとの遺伝子発現行列data中の並びをdata.rankの並びでソートし直し、その結果をdata.sに格納
data.sub.train <- data.s[1:g_num,-j] #data.sに対して上位g_num個分までのj列目を除く遺伝子発現データをdata.sub.trainに格納（トレーニングデータ）
data.sub.test <- data.s[1:g_num,j] #data.sに対して上位g_num個分までのj列目の遺伝子発現データをdata.sub.testに格納（テストデータ）
data.cl.train <- data.cl[-j] #data.cl中のj番目を除くラベルデータをdata.cl.trainに格納（トレーニングデータ）
data.cl.test <- data.cl[j] #data.cl中のj番目のラベルデータをdata.cl.testに格納（テストデータ）
predicted <- knn(t(data.sub.train), t(data.sub.test), k=3, factor(data.cl.train))#k-Nearest Neighbor（k=3）の実行
pred.vector <- c(pred.vector, as.vector(predicted)) #j番目のテストデータの結果をどんどんpred.vectorに格納していく
}
CrossTable <- table(true = data.cl, pred = pred.vector) #当たり外れのクロス集計表を作成
TN <- CrossTable[1,1] #True Negative（実際のラベルが0のものを正しく0と予測できた数）をTNに格納
FP <- CrossTable[1,2] #False Positive（実際のラベルが0のものを誤って1と予測してしまった数）をFPに格納
FN <- CrossTable[2,1] #False Positive（実際のラベルが1のものを誤って0と予測してしまった数）をFNに格納
TP <- CrossTable[2,2] #True Positive（実際のラベルが1のものを正しく1と予測できた数）をTPに格納
accuracy = (TP+TN)/(TP+FP+FN+TN) #Accuracyの計算
MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN)) #Matthews correlation coefficient（マシュー相関係数）の計算
result <- rbind(result, c(g_num, accuracy, MCC)) #g_num, accuracy, MCCの値をベクトル化して、ベクトルresultの下の行に追加
}
write.table(result, "result_loocv.txt", sep = "\t", append=F, quote=F, row.names=F)#結果をresult_loocv.txtに出力
------ ここまで ------
解析 | 分類 | Self-Organizing Maps (SOM)
Self-Organizing Maps (SOM) 法を用いて分類します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
------ ここから ------
library(class) #パッケージの読み込み
------ ここまで ------
解析 | 分類 | Support Vector Machine (SVM)
Support Vector Machine (SVM) 法を用いて分類します。分類に用いる遺伝子セットの選択（Feature selection）をRank product (RankProd; Breitling et al., FEBS Lett., 2004))で行う場合とEmpirical bayes statistic (経験ベイズ; Smyth GK, Stat. Appl, Genet. Mol. Biol., 2004))で行う場合の二通りの例を紹介します。また、ここでは分類精度を交差検証法の一種であるLeave-one-out cross validation（LOOCV）を用いて行っています。
分類精度は用いる遺伝子数によって変わりますので、ここでは上位2, 3, ..., 100個を分類に用いた場合の結果を出力するようにしています。
「ファイル」−「ディレクトリの変更」で解析したいサンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動。
- Feature selectionをRank product (RankProd; Breitling et al., FEBS Lett., 2004))で行う場合:
------ ここから ------
library(e1071) #パッケージの読み込み
data <- read.table("data_Singh_RMA_3274.txt", header=TRUE, row.names=1, sep="\t", quote="")#data_Singh_RMA_3274.txtファイルの読み込み
colnames(data) #サンプルのラベル情報を表示（Normalが50サンプル、Tumourが52サンプルあることが分かる）
data.cl <- c(rep(0, 50), rep(1, 52)) #Normalを0、Tumourを1としてラベルしなおしたベクトルdata.clを作成
rank.matrix <- rownames(data) #おまじない（出力ファイルの一列目にrownames(data)情報（つまり遺伝子名に関する情報）を付加するため
for (i in 1:length(data.cl)){ #LOOCVなので、length(data.cl)回数分だけループを回す
data.tmp <- data[,-i] #i番目の列データを削除した結果をdata.tmpに格納
data.cl.tmp <- data.cl[-i] #i番目の列データに対応するラベル情報を削除した結果をdata.cl.tmpに格納
tmpall <- RP(data.tmp, data.cl.tmp, num.perm=1, logged=TRUE, na.rm = FALSE, plot = FALSE, rand = 123)#i番目の列データがないサブセットに対してRank productを実行し、結果をtmpallに格納
tmprankall <- rank(apply(tmpall$RPs, 1, min)) #Rank productは(1) Normal > Tumorの統計量RPと(2) Normal < Tumorの統計量RPの2つを別々の列として結果を返すため、各遺伝子（各行）に対して2つの値の低いほうの値をその遺伝子の統計量とした結果をtmprankallとして返す
rank.matrix <- cbind(rank.matrix, tmprankall) #i番目の列データがないサブセットに対してRank productを実行して得られたランキング結果をrank.matrixの右側の列に追加
}
write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F) #LOOCV用の「leave-one-outで得られたi番目の列（サンプル）データを削除した場合のランキング結果」をhoge_loocv.txtに出力
result <- c("No. of genes", "Accuracy", "MCC") #おまじない（出力ファイルの一行目に左記情報を付加するため）
data.tmp <- read.table("hoge_loocv.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記出力ファイルの読み込み
for(g_num in 2:100){ #ランキング上位2, 3, ..., 100個を分類に用いた場合の精度を調べるためのループ
pred.vector <- NULL #おまじない
for(j in 1:ncol(data.tmp)){ #LOOCV用のループ（サンプル数分だけループが回る）
data.rank <- data.tmp[,j] #j番目のカラム中のランキング情報をdata.rankに格納
data.s <- data[order(data.rank),] #もとの遺伝子発現行列data中の並びをdata.rankの並びでソートし直し、その結果をdata.sに格納
data.sub.train <- data.s[1:g_num,-j] #data.sに対して上位g_num個分までのj列目を除く遺伝子発現データをdata.sub.trainに格納（トレーニングデータ）
data.sub.test <- data.s[1:g_num,j] #data.sに対して上位g_num個分までのj列目の遺伝子発現データをdata.sub.testに格納（テストデータ）
data.cl.train <- data.cl[-j] #data.cl中のj番目を除くラベルデータをdata.cl.trainに格納（トレーニングデータ）
data.cl.test <- data.cl[j] #data.cl中のj番目のラベルデータをdata.cl.testに格納（テストデータ）
svm.model <- svm(x=t(data.sub.train), y=factor(data.cl.train), scale=T, type="C-classification", kernel="linear")#トレーニングデータでsvmの実行
predicted <- predict(svm.model, t(data.sub.test)) #得られたsvm.modelを用いてj番目のテストデータの予測を行い、結果をpredictedに格納
pred.vector <- c(pred.vector, as.vector(predicted)) #j番目のテストデータの結果をどんどんpred.vectorに格納していく
}
CrossTable <- table(true = data.cl, pred = pred.vector) #当たり外れのクロス集計表を作成
TN <- CrossTable[1,1] #True Negative（実際のラベルが0のものを正しく0と予測できた数）をTNに格納
FP <- CrossTable[1,2] #False Positive（実際のラベルが0のものを誤って1と予測してしまった数）をFPに格納
FN <- CrossTable[2,1] #False Positive（実際のラベルが1のものを誤って0と予測してしまった数）をFNに格納
TP <- CrossTable[2,2] #True Positive（実際のラベルが1のものを正しく1と予測できた数）をTPに格納
accuracy = (TP+TN)/(TP+FP+FN+TN) #Accuracyの計算
MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN))#Matthews correlation coefficient（マシュー相関係数）の計算
result <- rbind(result, c(g_num, accuracy, MCC)) #g_num, accuracy, MCCの値をベクトル化して、ベクトルresultの下の行に追加
}
write.table(result, "result_loocv.txt", sep = "\t", append=F, quote=F, row.names=F)#結果をresult_loocv.txtに出力
------ ここまで ------
- Feature selectionをEmpirical bayes statistic (経験ベイズ; Smyth GK, Stat. Appl, Genet. Mol. Biol., 2004))で行う場合:
------ ここから ------
library(e1071) #パッケージの読み込み
data <- read.table("data_Singh_RMA_3274.txt", header=TRUE, row.names=1, sep="\t", quote="")#data_Singh_RMA_3274.txtファイルの読み込み
dim(data) #行列dataの行数と列数を表示
colnames(data) #サンプルのラベル情報を表示（Normalが50サンプル、Tumourが52サンプルあることが分かる）
data.cl <- c(rep(0, 50), rep(1, 52)) #Normalを0、Tumourを1としてラベルしなおしたベクトルdata.clを作成
rank.matrix <- rownames(data) #おまじない（出力ファイルの一列目にrownames(data)情報（つまり遺伝子名に関する情報）を付加するため
for (i in 1:length(data.cl)){ #LOOCVなので、length(data.cl)回数分だけループを回す
data.tmp <- data[,-i] #i番目の列データを削除した結果をdata.tmpに格納
data.cl.tmp <- data.cl[-i] #i番目の列データに対応するラベル情報を削除した結果をdata.cl.tmpに格納
design <- model.matrix(~data.cl.tmp) #おまじない
fit <- lmFit(data.tmp, design) #おまじない
eb2 <- eBayes(fit) #おまじない
tmp.out <- topTable(eb2, coef=2, number=(length(row.names(data))),adjust="fdr")#おまじない
tmpall <- tmp.out[order(tmp.out[,1]),] #おまじない
rank.matrix <- cbind(rank.matrix, rank(-abs(tmpall$t))) #i番目の列データがないサブセットに対してEmpirical bayesを実行して得られたランキング結果をrank.matrixの右側の列に追加
}
write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F) #LOOCV用の「leave-one-outで得られたi番目の列（サンプル）データを削除した場合のランキング結果」をhoge_loocv.txtに出力
result <- c("No. of genes", "Accuracy", "MCC") #おまじない（出力ファイルの一行目に左記情報を付加するため）
data.tmp <- read.table("hoge_loocv.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記出力ファイルの読み込み
for(g_num in 2:100){ #ランキング上位2, 3, ..., 100個を分類に用いた場合の精度を調べるためのループ
pred.vector <- NULL #おまじない
for(j in 1:ncol(data.tmp)){ #LOOCV用のループ（サンプル数分だけループが回る）
data.rank <- data.tmp[,j] #j番目のカラム中のランキング情報をdata.rankに格納
data.s <- data[order(data.rank),] #もとの遺伝子発現行列data中の並びをdata.rankの並びでソートし直し、その結果をdata.sに格納
data.sub.train <- data.s[1:g_num,-j] #data.sに対して上位g_num個分までのj列目を除く遺伝子発現データをdata.sub.trainに格納（トレーニングデータ）
data.sub.test <- data.s[1:g_num,j] #data.sに対して上位g_num個分までのj列目の遺伝子発現データをdata.sub.testに格納（テストデータ）
data.cl.train <- data.cl[-j] #data.cl中のj番目を除くラベルデータをdata.cl.trainに格納（トレーニングデータ）
data.cl.test <- data.cl[j] #data.cl中のj番目のラベルデータをdata.cl.testに格納（テストデータ）
svm.model <- svm(x=t(data.sub.train), y=factor(data.cl.train), scale=T, type="C-classification", kernel="linear") #トレーニングデータでsvmの実行
predicted <- predict(svm.model, t(data.sub.test)) #得られたsvm.modelを用いてj番目のテストデータの予測を行い、結果をpredictedに格納
pred.vector <- c(pred.vector, as.vector(predicted)) #j番目のテストデータの結果をどんどんpred.vectorに格納していく
}
CrossTable <- table(true = data.cl, pred = pred.vector) #当たり外れのクロス集計表を作成
TN <- CrossTable[1,1] #True Negative（実際のラベルが0のものを正しく0と予測できた数）をTNに格納
FP <- CrossTable[1,2] #False Positive（実際のラベルが0のものを誤って1と予測してしまった数）をFPに格納
FN <- CrossTable[2,1] #False Positive（実際のラベルが1のものを誤って0と予測してしまった数）をFNに格納
TP <- CrossTable[2,2] #True Positive（実際のラベルが1のものを正しく1と予測できた数）をTPに格納
accuracy = (TP+TN)/(TP+FP+FN+TN) #Accuracyの計算
MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN))#Matthews correlation coefficient（マシュー相関係数）の計算
result <- rbind(result, c(g_num, accuracy, MCC)) #g_num, accuracy, MCCの値をベクトル化して、ベクトルresultの下の行に追加
}
write.table(result, "result_loocv.txt", sep = "\t", append=F, quote=F, row.names=F) #結果をresult_loocv.txtに出力
------ ここまで ------
CRANのe1071のwebページ
CRANのe1071のPDFマニュアル
解析 | 分類 | Naive Bayesian (NB)
Naive Bayesian (NB) 法を用いて分類します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
------ ここから ------
library(e1071) #パッケージの読み込み
------ ここまで ------
CRANのe1071のwebページ
CRANのe1071のPDFマニュアル
解析 | アレイCGH(DNAコピー数)解析 | について
アレイCGH(Comparative Genomic Hybridization)法は、もともとは腫瘍組織で染色体に異常が生じている領域を正常組織との比較により同定することを目的とした解析技術です。
二色法のマイクロアレイと本質的に同じ。
目的がDNAコピー数が変化している領域を同定（アレイCGH；この意味において、”DNAコピー数解析”などとも呼ばれます）するか、発現変動遺伝子の同定（従来型の二色法マイクロアレイの利用）などかという程度の違いです。
昔はBACクローンなどがアレイに搭載されていて解像度がそれほど高くありませんでしたが、最近ではタイリングアレイのような感じでかなり高い解像度のデータが得られるようになっているようです。
したがって得られるデータのイメージ図は、「横軸：ゲノム上の位置、縦軸：比較二つのサンプルのlog比」です。
ここで紹介する各種解析手法は、「比較二つのサンプルのlog比のデータ」を入力として与えて、「”連続してlog比の絶対値が高い領域”のリストやそれの図」を出力として返してくれます。
ここで紹介している方法は以下の三つです：
・ADaCGH (Diaz-Uriarte_2007)
・GLAD (Hupe_2004)
・DNAcopy (Olshen_2004)
（2009/12/14現在、DNAcopy (Olshen_2004)の方法しかちゃんと書いてません。）
解析 | アレイCGH(DNAコピー数)解析 | ADaCGH (Diaz-Uriarte_2007)
参考文献の方法を用いて解析を行う。
CRANのADaCGHのwebページ
CRANのADaCGHのPDFマニュアル
参考文献(Diaz-Uriarte and Rueda, PLoS ONE, 2007)
解析 | アレイCGH(DNAコピー数)解析 | GLAD (Hupe_2004)
参考文献の方法を用いて解析を行う。
BioconductorのGLADのwebページ
参考文献(Hupe et al., Bioinformatics, 2004)
解析 | アレイCGH(DNAコピー数)解析 | DNAcopy (Olshen_2004)
参考文献の方法を用いて解析を行う。
BioconductorのDNAcopyのwebページ
参考文献(Olshen et al., Biostatistics, 2004)
作図 | ヒートマップ（pseudo-color image）
論文中でよく見かけるpseudo-color imageを作成してくれます（例えばKadota et al., Physiol. Genomics, 2003の図2を作成してくれます）。
注意点：色盲の方にも分かるようカラーバリアフリープレゼンテーションを心がけましょう。（上の図は緑と赤を使っているのでよくない例です）
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
- （「解析 | 似た発現パターンを持つ遺伝子の同定」などで得た）手持ちのファイル（GDS1096_best10_heart.txt）を読み込ませて、ヒートマップを描きたい場合。
条件1：行（遺伝子; row）方向にZ scalingした数値（the rows are scaled to have mean zero and standard deviation one）情報を用いて作図（参考：Golub et al., Science, 1999の図3）。
条件2：色は、「cm.colors」の100段階で表す。
------ ここから ------
library(stats) #パッケージの読み込み
data <- read.table("GDS1096_best10_heart.txt", header=TRUE, row.names=1, sep="\t", quote="")#ファイルの読み込み
colnames(data) <- substring(colnames(data), 8, nchar(colnames(data))) #列ラベル中の最初の8文字分（つまり "Normal_"）を削除
heatmap(as.matrix(data), Rowv =NA, Colv=NA, scale="row", col = cm.colors(100), main="Heart-specific genes (Best 10)", xlab="Tissue", ylab="Clone ID", margin=c(8,10))
------ ここまで ------
- （「解析 | 似た発現パターンを持つ遺伝子の同定」などで得た）手持ちのファイル（GDS1096_best10_heart.txt）を読み込ませて、ヒートマップを描きたい場合。
条件1：読み込んだそのままの数値情報を用いて作図。
条件2：色は、「heat.colors」の20段階で表す。
------ ここから ------
library(stats) #パッケージの読み込み
data <- read.table("GDS1096_best10_heart.txt", header=TRUE, row.names=1, sep="\t", quote="")#ファイルの読み込み
colnames(data) <- substring(colnames(data), 8, nchar(colnames(data))) #列ラベル中の最初の8文字分（つまり "Normal_"）を削除
heatmap(as.matrix(data), Rowv =NA, Colv=NA, scale="none", col = heat.colors(20), main="Heart-specific genes (Best 10)", xlab="Tissue", ylab="Clone ID", margin=c(8,10)) #pseudo-color imageの作成
------ ここまで ------
- 手持ちのファイル（GDS1096.txt）を読み込ませて、ヒートマップを描きたい場合。
条件1：行（遺伝子; row）方向にZ scalingした数値（the rows are scaled to have mean zero and standard deviation one）情報を用いて作図（参考：Golub et al., Science, 1999の図3）。
条件2：色は、「heat.colors」の20段階で表す。
------ ここから ------
library(stats) #パッケージの読み込み
GDS1096 <- read.table("GDS1096.txt", header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み
GDS1096$IDENTIFIER <- NULL #おまじない（余分なカラム「IDENTIFIER」の消去）
colnames(GDS1096) <- substring(colnames(GDS1096), 8, nchar(colnames(GDS1096))) #列ラベル中の最初の8文字分（つまり "Normal_"）を削除
heatmap(as.matrix(GDS1096), Rowv =NA, Colv=NA, scale="row", col = heat.colors(100), main="GDS1096", xlab="Tissue", ylab="Clone ID", margin=c(8,6))
------ ここまで ------
- 「解析 | 似た発現パターンを持つ遺伝子の同定」の解析で得られた（GDS1096を心臓得意的パターン順にソートした）GDS1096_sort_by_heartを読み込ませて、ヒートマップを描きたい場合。
条件1：行（遺伝子; row）方向にZ scalingした数値（the rows are scaled to have mean zero and standard deviation one）情報を用いて作図（参考：Golub et al., Science, 1999の図3）。
条件2：色は、「heat.colors」の20段階で表す。
------ ここから ------
library(genefilter) #パッケージの読み込み
GDS1096_tmp <- read.table("GDS1096.txt", header=TRUE, row.names=1, sep="\t", quote="") #GDS1096.txtファイルを読み込んでGDS1096_tmpに格納（これをそのまま使うわけではないので"_tmp"を付加している）
GDS1096_tmp$IDENTIFIER <- NULL #おまじない（余分なカラム「IDENTIFIER」の消去）
GDS1096 <- as.matrix(GDS1096_tmp) #as.matrixの意味は、「データの型を"行列として(as matrix)"GDS1096に格納せよ」です。（read.tableで読み込んで得られたGDS1096_tmpのデータの型は"データフレーム"なので、そのままではこの場合は使用不可なのでやる必要があります）
GDS1096_cl_heart <- read.table("GDS1096_cl_heart.txt", sep="\t", quote="") #GDS1096_cl_heart.txtファイルを読み込んでGDS1096_cl_heartに格納
template_heart <- GDS1096_cl_heart[,2] #ラベル情報（2列目）のみ抽出し、template_heartに格納
tmp <- rbind(GDS1096, template_heart) #template_heartというテンプレートパターンを行列GDS1096の最後の行に追加
ID_REF <- rownames(tmp) #行のラベル情報（つまり遺伝子IDに関する情報）をID_REFに格納
template_posi <- which(ID_REF == "template_heart") #行のラベル情報が"template_heart"に相当する行情報をtemplate_posiに格納
gene_num <- nrow(GDS1096) #行数をgene_numに格納
closeg <- genefinder(tmp, template_posi, gene_num, scale="none", method="correlation")#結果をclosegに格納
GDS1096_sort_by_heart <- tmp[closeg[[1]]$indices,] #heart-specificな順に並べられている遺伝子発現データを抽出し、GDS1096_sort_by_heartに格納
colnames(GDS1096_sort_by_heart) <- substring(colnames(GDS1096_sort_by_heart), 8, nchar(colnames(GDS1096_sort_by_heart)))#列ラベル中の最初の8文字分（つまり "Normal_"）を削除
heatmap(as.matrix(GDS1096_sort_by_heart), Rowv =NA, Colv=NA, scale="row", col = heat.colors(100), main="GDS1096_sort_by_heart", xlab="Tissue", ylab="Clone ID", margin=c(8,6))
------ ここまで ------
使える色に関する参考URL
作図 | ROC曲線（ROC curve）
ROC (Receiver Operating Characteristic)曲線は、横軸が偽陽性率（1-特異度；false positive rate）、縦軸が真陽性率（感度；true positive rate）としてプロットをしたものです。
例えばWAD (Kadota et al., AMB, 2008)は感度・特異度高く発現変動遺伝子をランキングできる方法だなどと書いていますが、
これはアレイ中の全遺伝子のWADでのランキング結果に対し”真の発現変動遺伝子”をマッピングしてROC曲線を描くと、このROC曲線の下部面積（Area Under the Curve; AUC）の値が大きい（最大値は1）ということを意味します。
もう少し具体的なイメージはこちらの32ページ目をご覧ください。
RでどうやってAUC値を得るかについてはこちらの33ページ目をご覧ください。
一応、以下にも例を示しておきます。
1. x個の遺伝子をWADなどでランキングして、”真の発現変動遺伝子(DEG)”3個が1, 3, 4位だった。このAUC値：
------ ここから ------
param1 <- c(1,3,4) #真のDEGの順位情報を指定
param2 <- 10 #xの値（全遺伝子数のこと、ここでは例として10としてるだけ）を入力
library(ROC) #パッケージの読み込み
DEG_posi <- rep(0,param2) #DEGの位置情報の初期値（0）を指定
DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納
AUC(out) #AUC値を計算
------ ここまで ------
2. このROC曲線の図：
------ ここから ------
param1 <- c(1,3,4) #真のDEGの順位情報を指定
param2 <- 10 #xの値（全遺伝子数のこと、ここでは例として10としてるだけ）を入力
library(ROC) #パッケージの読み込み
DEG_posi <- rep(0,param2) #DEGの位置情報の初期値（0）を指定
DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納
plot(out) #ROC曲線をプロット
------ ここまで ------
3. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合：
------ ここから ------
param1 <- c(1,3,4) #真のDEGの順位情報を指定
param2 <- 10 #xの値（全遺伝子数のこと、ここでは例として10としてるだけ）を入力
param3 <- 400 #横幅（width; 単位はピクセル）を指定
param4 <- 400 #縦幅（height; 単位はピクセル）を指定
param5 <- 14 #文字の大きさ（単位はpoint）を指定
out_f <- "hoge.png" #出力ファイル名を指定
library(ROC) #パッケージの読み込み
DEG_posi <- rep(0,param2) #DEGの位置情報の初期値（0）を指定
DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納
png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定
plot(out) #ROC曲線をプロット
dev.off() #おまじない
------ ここまで ------
4. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合(x,y軸の文字も指定)：
------ ここから ------
param1 <- c(1,3,4) #真のDEGの順位情報を指定
param2 <- 10 #xの値（全遺伝子数のこと、ここでは例として10としてるだけ）を入力
param3 <- 400 #横幅（width; 単位はピクセル）を指定
param4 <- 400 #縦幅（height; 単位はピクセル）を指定
param5 <- 14 #文字の大きさ（単位はpoint）を指定
param6 <- "1 - specificity" #x軸のラベルを指定
param7 <- "sensitivity" #y軸のラベルを指定
out_f <- "hoge.png" #出力ファイル名を指定
library(ROC) #パッケージの読み込み
DEG_posi <- rep(0,param2) #DEGの位置情報の初期値（0）を指定
DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納
png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定
plot(out, xlab=param6, ylab=param7) #ROC曲線をプロット
dev.off() #おまじない
5. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合(x,y軸のラベルを描かないようにしたい)：
------ ここから ------
param1 <- c(1,3,4) #真のDEGの順位情報を指定
param2 <- 10 #xの値（全遺伝子数のこと、ここでは例として10としてるだけ）を入力
param3 <- 400 #横幅（width; 単位はピクセル）を指定
param4 <- 400 #縦幅（height; 単位はピクセル）を指定
param5 <- 14 #文字の大きさ（単位はpoint）を指定
param6 <- "1 - specificity" #x軸のラベルを指定
param7 <- "sensitivity" #y軸のラベルを指定
out_f <- "hoge.png" #出力ファイル名を指定
library(ROC) #パッケージの読み込み
DEG_posi <- rep(0,param2) #DEGの位置情報の初期値（0）を指定
DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納
png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定
plot(out, xlab="", ylab="") #ROC曲線をプロット
dev.off() #おまじない
------ ここまで ------
BioconductorのROCのwebページ
解析 | サンプル群間比較 | 二群間 | 対応なし | 並べ替え検定 (package: permtest)
二種類のサンプル群間の全体的なばらつきをランダムパーミュテーションテスト（Random permutation; 並べ替え検定）で調べたい場合に利用します。ちなみにこれは、差がある遺伝子の抽出を目的としたものではありません。サンプル群間の比較（等分散性などの検定）ですので予めご承知おきください。
注意点1：解析データ中にはNA(Not Available; データがない)やNaN(Not a Number; 数値でない)があってはいけません。
注意点2：サンプル（列）数が24以下の場合には、可能な全ての並べ替えの組み合わせを計算するので、並べ替え回数(デフォルトは1000)をnpermsでいくつに設定しようが結果は変わりません。
注意点3：サンプル間の距離(distance)を任意に定義できません。このパッケージで使えるのはeuclid(squared Euclidean distance)とlogr(-log(Pearson相関係数))だけです。
注意点4：クラスラベルは一方の群に"1"、そしてもう片方の群には"2"になります。（0 or 1ではありません！！）
注意点5：クラスラベルを指し示しているファイル（sample1_designmatrix.txt）中の3列目の情報はpaird modeかblocked modeのときにのみ使われます。詳しくは参考PDFをごらんください。
解析結果の解釈の仕方は以下のとおり：
「1 variability test(one sided)」のPVALUEが低ければ、帰無仮説（群1と群2はばらつきが同じである）が棄却され、以下のどちらかになる：
STAT of d11-d22 > 0の場合：対立仮説（群1のばらつきは群2のばらつきよりも大きい）を支持。
STAT of d11-d22 < 0の場合：対立仮説（群1のばらつきは群2のばらつきよりも小さい）を支持。
「2 variability test(two sided)」のPVALUEが低ければ、帰無仮説（群1と群2はばらつきが同じである）が棄却され、対立仮説（群1と群2のばらつきは等しくない）が支持される。
「3 location test」のPVALUEが低ければ、帰無仮説（群1と群2は同じ位置にある）が棄却され、対立仮説（群1と群2は同じ位置にはない）が支持される。
「4 equivalence test」のPVALUEが低ければ、帰無仮説（群1を基準として、群2は群1と同じばらつき・同じ位置にある）が棄却され、対立仮説（二群は同じ位置にない or 群2はより大きなばらつきをもつ）が支持される。
「ファイル」−「ディレクトリの変更」で解析したい(sample1.txtとsample1_designmatrix.txt)ファイルを置いてあるディレクトリに移動。
- デフォルトの設定(サンプル間の距離=euclid(squared Euclidean distance)；並べ替え回数=1000)で解析したい場合：
------ ここから ------
library(permtest) #パッケージの読み込み
sample1 <- read.table("sample1.txt", header=TRUE, row.names=1, sep="\t", quote="")#sample1.txtファイルの読み込み
sample1 <- as.matrix(sample1) #as.matrixの意味は、「データの型を"行列として(as matrix)"sample1に格納せよ」です。
sample1_designmatrix <- read.table("sample1_designmatrix.txt", sep="\t", quote="")#sample1_designmatrix.txtファイルの読み込み
sample1_designmatrix <- as.matrix(sample1_designmatrix) #as.matrixの意味は、「データの型を"行列として(as matrix)"sample1_designmatrixに格納せよ」です。
permtest(sample1, sample1_designmatrix) #permtestの実行
------ ここまで ------
実行結果
DESCRIPTION COMPUTED STAT COUNT PVALUE
1 variability test(one sided) : d11-d22 0.06816153 127 0.127
2 variability test(two sided) : abs(d11-d22) 0.06816153 262 0.262
3 location test : d12-((d22+d11)/2) 0.17494049 0 0.000
4 equivalence test : d12-d11 0.14085972 0 0.000
5 mean within group 1 distance : d11 0.62895085 NA NA
6 mean within group 2 distance : d22 0.56078932 NA NA
7 mean between group distance : d12 0.76981058 NA NA
8 number of permutations : 1000 NA NA NA
9 distance type : euclid NA NA NA
10 design type : random NA NA NA
- サンプル間の距離=logr(-log(Pearson相関係数))；並べ替え回数=10000の条件でで解析したい場合：
1. パッケージのインストール（最初の一回のみ）
------ ここから ------
install.packages("permtest") #パッケージのインストール(最初の一回のみやればOK)
------ ここまで ------
2. permtestの実行
------ ここから ------
library(permtest) #パッケージの読み込み
sample1 <- read.table("sample1.txt", header=TRUE, row.names=1, sep="\t", quote="")#sample1.txtファイルの読み込み
sample1 <- as.matrix(sample1) #as.matrixの意味は、「データの型を"行列として(as matrix)"sample1に格納せよ」です。
sample1_designmatrix <- read.table("sample1_designmatrix.txt", sep="\t", quote="")#sample1_designmatrix.txtファイルの読み込み
sample1_designmatrix <- as.matrix(sample1_designmatrix) #as.matrixの意味は、「データの型を"行列として(as matrix)"sample1_designmatrixに格納せよ」です。
permtest(sample1, sample1_designmatrix, distance="logr", nperms=10000) #permtestの実行
------ ここまで ------
実行結果
DESCRIPTION COMPUTED STAT COUNT PVALUE
1 variability test(one sided) : d11-d22 0.05200024 1365 0.1365
2 variability test(two sided) : abs(d11-d22) 0.05200024 2852 0.2852
3 location test : d12-((d22+d11)/2) 0.13662895 0 0.0000
4 equivalence test : d12-d11 0.11062883 0 0.0000
5 mean within group 1 distance : d11 0.38363515 NA NA
6 mean within group 2 distance : d22 0.33163491 NA NA
7 mean between group distance : d12 0.49426398 NA NA
8 number of permutations : 10000 NA NA NA
9 distance type : logr NA NA NA
10 design type : random NA NA NA
CRANのpermtestのwebページ
CRANのpermtestのPDFマニュアル
Links
R
R Tips(竹澤様)
R Tips(間瀬様)
Rによる統計処理(青木様)
R言語クイックリファレンス
「Rでプログラミング」のページ
Rのcol()の番号と色の対応関係
RjpWiki
Bioconductor
RStudio
Subio Platform
）をいただければ幸いです。
特にアグリバイオインフォマティクス教育研究プログラム被養成者からのリクエストは優先的に対応します。
2. 画面の一番下のほうにDownloadボタンがあるので、（どれでもいいが私はftpボタンをいつも押してるので...）「ftp」をクリックしてダウンロード
3. ダウンロード先にGSE7623_RAW.tarという圧縮ファイルがあるので、それを（私の場合ダブルクリックで）解凍
4. 解凍後のGSE7623_RAWフォルダを眺めると*CEL.gz, *CHP.gz, *EXP.gzという三種類のファイルがあることが分かるが、
私はいつもCELファイルのみしか利用しないので、それ以外のファイルを削除する
5. *CEL.gzのみにした24個のファイルができる（以下の図のようになる）ので、個別のファイルをまた解凍する
6. 以下の図のようにできたらOK（ここではGSE7623_RAWフォルダに解凍後のCELファイルを置いて、圧縮ファイルの削除を行っている）
2. 「FIND PLATFORM」をクリック
3. アノテーションを得たいメーカーおよび生物種などを指定してもう一度「FIND PLATFORM」をクリック
4. いくつかリストアップされる候補の中から目的のチップ(例ではAgilent Human 1A (V2))
につけられているPlatform ID (GPLXXX; 例ではGPL887)をクリック
5. 表示されたページの一番したのほうで「Download full table」
(または「Annotation SOFT table」)をクリックして得られるファイル(GPL887-5640.txt)を保存
6. 機能解析（GSEA周辺）を行いたいときには、以下の作業を行っておいてください。
( i)エクセルでGPL887-5640.txtを開き
(ii)最終的にIDとGene symbolだけからなるGPL887-5640_symbol.txtのようなファイルを作成
しておけば、前処理 | 同じ遺伝子名を持つものをまとめる用の読み込みファイルとして利用可能です。