サンプルデータ13の(two-color) Agilentデータ(sample13_7vs7.txt)をエクセルで開くと多くの"NA" (Not Availableの略)という記述を目にしますが、
このような数値でない情報を含むデータは往々にしてうまくデータを読み込んでくれなかったり、解析できなかったりします...。ここでは全ての要素がNAとなっている行を除くなどのやり方を紹介します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
22,575 genes×14 samplesからなる二群の遺伝子発現データ。最初の7列がG1群、後の7列がG2群の2群間比較用のデータです。
全ての要素がNAとなっている行を除くやり方1です。
in_f <- "sample13_7vs7.txt"
out_f <- "hoge1.txt"
library(genefilter)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
obj <- apply(data, 1, allNA)
data <- data[obj,]
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
22,575 genes×14 samplesからなる二群の遺伝子発現データ。最初の7列がG1群、後の7列がG2群の2群間比較用のデータです。
全ての要素がNAとなっている行を除くやり方2です。
in_f <- "sample13_7vs7.txt"
out_f <- "hoge2.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- t(apply(data, 1, is.na))
hoge2 <- apply(hoge, 1, sum)
obj <- hoge2 < ncol(data)
data <- data[obj,]
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
22,575 genes×14 samplesからなる二群の遺伝子発現データ。最初の7列がG1群、後の7列がG2群の2群間比較用のデータです。
一つでもNAがある行を除くやり方です。
in_f <- "sample13_7vs7.txt"
out_f <- "hoge3.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- t(apply(data, 1, is.na))
hoge2 <- apply(hoge, 1, sum)
obj <- (hoge2 == 0)
data <- data[obj,]
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
22,575 genes×14 samplesからなる二群の遺伝子発現データ。最初の7列がG1群、後の7列がG2群の2群間比較用のデータです。
「G1群で5個以上且つG2群で3個以上」のNAを含む行を除去するやり方です。
in_f <- "sample13_7vs7.txt"
out_f <- "hoge4.txt"
param_G1 <- 7
param_G2 <- 7
param1 <- 5
param2 <- 3
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
hoge <- t(apply(data[data.cl==1],1,is.na))
obj1 <- apply(hoge,1,sum) < param1
hoge <- t(apply(data[data.cl==2],1,is.na))
obj2 <- apply(hoge,1,sum) < param2
obj <- (obj1 & obj2)
data <- data[obj,]
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
変動係数(Coefficient of Variation; CV)が閾値未満の遺伝子(行)を削除するやり方を示します。
変動係数は「標準偏差/平均」のことです。この値が大きい遺伝子(行)ほどバラツキ(正確には平均値に対する相対的なばらつき)がほうが大きいことを表すので、
全体的に発現変動していないものをフィルタリングする手段としておそらく誰かが利用していると思います。(利用している原著論文みつけたらPubmed ID教えてください。)
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
22,283 genes×6 samplesからなる二群の遺伝子発現データ。最初の3サンプルがG1群、残りの3サンプルがG2群のデータです。
対数変換後(base=2; 底は2)のデータです。genefilterパッケージを利用するやり方です。
CVが0.2未満の遺伝子を除去するやり方です。
in_f <- "sample14.txt"
out_f <- "hoge1.txt"
param <- 0.2
library(genefilter)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
obj <- genefilter(data, cv(param, Inf))
data <- data[obj,]
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
22,283 genes×6 samplesからなる二群の遺伝子発現データ。最初の3サンプルがG1群、残りの3サンプルがG2群のデータです。
対数変換後(base=2; 底は2)のデータです。genefilterパッケージを利用しないやり方です。
CVが0.2未満の遺伝子を除去するやり方です。
in_f <- "sample14.txt"
out_f <- "hoge2.txt"
param <- 0.2
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- apply(data,1,sd)/apply(data,1,mean)
obj <- (hoge >= param)
data <- data[obj,]
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
22,283 genes×6 samplesからなる二群の遺伝子発現データ。最初の3サンプルがG1群、残りの3サンプルがG2群のデータです。
対数変換後(base=2; 底は2)のデータです。genefilterパッケージを利用しないやり方です。
CV値が下位10%未満の遺伝子を除去するやり方です。
in_f <- "sample14.txt"
out_f <- "hoge3.txt"
param <- 0.1
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- apply(data,1,sd)/apply(data,1,mean)
hoge2 <- quantile(hoge, probs=param)
obj <- (hoge >= hoge2)
data <- data[obj,]
summary(hoge)
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
分散(Variance)が閾値未満の遺伝子(行)を削除するやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
22,283 genes×6 samplesからなる二群の遺伝子発現データ。最初の3サンプルがG1群、残りの3サンプルがG2群のデータです。
分散が0.2未満の遺伝子を除去するやり方です。
in_f <- "sample14.txt"
out_f <- "hoge1.txt"
param <- 0.2
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- apply(data, 1, var)
obj <- (hoge >= param)
data <- data[obj,]
summary(hoge)
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
22,283 genes×6 samplesからなる二群の遺伝子発現データ。最初の3サンプルがG1群、残りの3サンプルがG2群のデータです。
分散が下位10%未満の遺伝子を除去するやり方です。
Bourgon et al., 2010のFig. 1A (Filtering on overall variance)のtheta = 10%に相当するフィルタリングです。
in_f <- "sample14.txt"
out_f <- "hoge2.txt"
param <- 0.1
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- apply(data, 1, var)
hoge2 <- quantile(hoge, probs=param)
obj <- (hoge >= hoge2)
data <- data[obj,]
summary(hoge)
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
31,099 probesets×8 samplesからなる二群の遺伝子発現データ。最初の4サンプルがG1群、残りの4サンプルがG2群のデータです。
分散が下位20%未満の遺伝子を除去するやり方です。
Bourgon et al., 2010のFig. 1A (Filtering on overall variance)のtheta = 20%に相当するフィルタリングです。
in_f <- "data_rma_2_BAT.txt"
out_f <- "hoge3.txt"
param <- 0.2
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- apply(data, 1, var)
hoge2 <- quantile(hoge, probs=param)
obj <- (hoge >= hoge2)
data <- data[obj,]
summary(hoge)
dim(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
例えば、「酸化的リン酸化」のパスウェイに関連する遺伝子セットが自分が見ている条件間で全体として動いているかどうかを調べたい場合に、
解析 | 機能解析 | 遺伝子オントロジー(GO)解析 | についてや解析 | 機能解析 | パスウェイ(Pathway)解析 | について
で述べている方法を利用しますが、これを実行するための入力ファイルを作成する必要があります。
そのため、「酸化的リン酸化」のパスウェイに関連する遺伝子セット中の特定の遺伝子(遺伝子A)が自分が見ている条件間で発現変動していて、
しかもチップ上に重複して多数(別のプローブIDとして)搭載されているような場合には、遺伝子Aだけの効果でそのパスウェイが「動いている」などという誤った結果を導きかねません。
このようなチップ上の重複遺伝子の効果を排除すべく、同じ遺伝子名(gene symbolやEntrez ID)をもつ複数のプローブIDの発現プロファイルに対しては、
その代表値(平均値(mean)や中央値(median)など)を出力して、
遺伝子名の重複のない(non-redundant)遺伝子発現行列で解析を行うのが一般的です。
non-redundantにするためには、プローブIDとgene symbolやEntrez Gene IDなどの対応表(アノテーション情報)が必要になります。
この情報はイントロ | アノテーション情報取得 | GEOquery(Davis_2007)の3を行って得られた
hoge3_GPL1355.txtのような形式の対応表ファイルを利用する戦略や、
Pathviewパッケージ(Luo et al., 2013)中のID変換用関数などを利用する戦略があります。
これらは内部的にアノテーションパッケージを利用します。Affymetrix, Agilent, Illumina製など数多くの製品(約200 chips)があります。
利用可能なパッケージ名については、全パッケージリスト(All Packages)中の
ChipNameをご覧ください。
例えばNakai et al., BBB, 2008で用いられた
「Affymetrix Rat Genome 230 2.0 Array」のアノテーション情報はrat2302.dbパッケージから取得可能です。
これらのアノテーションパッケージはデフォルトではインストールされていません。そのため下記のようにしてインストールする必要があります。
param1 <- "rat2302.db"
source("http://bioconductor.org/biocLite.R")
biocLite(param1, suppressUpdates=TRUE)
また、パッケージごとに利用可能なアノテーション情報は異なります。param2で指定可能なアノテーション情報は、keytypes関数実行結果で表示されているもののみとなりますのでご注意ください。
概ね、SYMBOL", "ENTREZID",
"ACCNUM", "REFSEQ", "UNIGENE",
"ENSEMBL", "ENSEMBLPROT", "ENSEMBLTRANS",
"GENENAME", "PFAM", "PROSITE"などは利用可能です。
私の経験上、"REFSEQ"は非常に時間がかかる(数時間というレベル)ので覚悟しておいたほうがいいです。
Gene symbol ("SYMBOL") やEntrez ID ("ENTREZID")は比較的利用頻度が高いのでそれぞれ独立した項目として示しています。
param1 <- "rat2302.db"
library(param1, character.only=T)
keytypes(eval(parse(text=param1)))
代表値(要約統計量)は、平均値(mean)、中央値(median)、最大値(max)など好きなものを指定できます。
この作業はGSEA解析でも当然やります。"Collapse dataset to gene symbols"に相当するところです。
GSEAでは「最大値(このページ中での関数はmaxでGSEAの"max_probe (default)"に相当)」または
「中央値(このページ中での関数はmedianでGSEAの"median_of_probes"に相当)」が選択可能です。
GAGEパッケージ(Luo et al., 2009)
のProbe set ID conversionの項目で書いているものと同じことをやっているだけ、という理解で差支えありません。
probe IDの遺伝子発現行列を入力として、gene symbolの遺伝子発現行列を出力するやり方を示します。
probe IDとgene symbolの対応関係情報が必要ですので、様々なやり方を示しています。
同じgene symbolをもつ複数のprobe IDsが存在する場合にはparamで指定した方法で要約統計量を計算します。
代表値(要約統計量)は、平均値(mean)、中央値(median)、
最大値(max)など好きなものを指定できます。
「hoge3_GPL1355.txtの1列目のID情報の対応がとれる(同じ行の位置でなくてもよい)」と書いていましたが、
実際には同じ行の位置にしておかねばならなかったことが判明しました。大変失礼しましたm(_ _)m。
2017年9月22に修正しましたので、例題2以降は言葉通りになっているはずです(2017.09.22追加)。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | GEOquery(Davis_2007)の3を行って得られたhoge3_GPL1355.txtの情報も利用しています。
data_rma_2.txtの1列目のID情報とhoge3_GPL1355.txtの1列目のID情報の対応がとれる(同じ行の位置でなければならない)ことが前提です。
1分程度で終わります。
in_f1 <- "data_rma_2.txt"
in_f2 <- "hoge3_GPL1355.txt"
out_f <- "hoge1.txt"
param <- mean
sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
IDs <- as.vector(sym[,1])
names(IDs) <- rownames(sym)
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- t(apply(as.matrix(uniqID), 1, function(i, d = data, s = IDs, p = param) {
apply(d[which(s == i), ], 2, p, na.rm = TRUE)
}, data, IDs, param))
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | GEOquery(Davis_2007)の3を行って得られたhoge3_GPL1355.txtの情報も利用しています。
data_rma_2.txtの1列目のID情報とhoge3_GPL1355.txtの1列目のID情報の対応がとれる(同じ行の位置でなくてもよい)ことが前提です。
2分程度で終わります。
in_f1 <- "data_rma_2.txt"
in_f2 <- "hoge3_GPL1355.txt"
out_f <- "hoge2.txt"
param <- mean
sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
IDs <- as.vector(sym[,1])
names(IDs) <- rownames(sym)
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
obj <- is.element(IDs, uniqID[i])
hoge <- rbind(hoge, apply(data[names(IDs[obj]),], 2, param, na.rm=TRUE))
#hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Agilent-012097 Human 1A Microarray (V2) G4110B (Feature Number version)を用いて得られたデータです。
イントロ | アノテーション情報取得 | GEOquery(Davis_2007)の6を行って得られたhoge6_GPL887.txtの情報も利用しています。
sample13_7vs7.txtの1列目のID情報とhoge6_GPL887.txtの1列目のID情報の対応がとれる(同じ行の位置でなくてもよい)ことが前提です。
2分程度で終わります。以下は、入力ファイル中の7810と9681というIDが同じGene symbol(ABCA10)にまとめられる(collapsing)イメージです。(NA --> NaNになっているところは本質的な部分ではありません...。)
入力:
出力:
in_f1 <- "sample13_7vs7.txt"
in_f2 <- "hoge6_GPL887.txt"
out_f <- "hoge3.txt"
param <- mean
sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
IDs <- as.vector(sym[,1])
names(IDs) <- rownames(sym)
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
obj <- is.element(IDs, uniqID[i])
hoge <- rbind(hoge, apply(data[names(IDs[obj]),], 2, param, na.rm=TRUE))
#hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
4. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとGene symbolとの対応関係を含む情報を利用するやり方です。
パッケージのダウンロードで時間がかかるかもしれません。1や2の結果と出力ファイルの行数や数値が若干違うのは、おそらくアノテーションのバージョンの違いによるものだろうと思っています。
in_f <- "data_rma_2.txt"
out_f <- "hoge4.txt"
param <- mean
param1 <- "rat2302.db"
param2 <- "SYMBOL"
#source("http://bioconductor.org/biocLite.R")
#biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
IDs <- unlist(as.list(hoge))
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
obj <- is.element(IDs, uniqID[i])
hoge <- rbind(hoge, apply(data[names(IDs[obj]),], 2, param, na.rm=TRUE))
#hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
5. サンプルデータ5の22,283 probesets×36 samplesのRMA-preprocessedデータ(sample5.txt)の場合:
Affymetrix Human Genome U133A Array (GPL96)を用いて得られたGe et al., Genomics, 2005のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとGene symbolとの対応関係を含む情報を利用するやり方です。
in_f <- "sample5.txt"
out_f <- "hoge5.txt"
param <- mean
param1 <- "hgu133a.db"
param2 <- "SYMBOL"
#source("http://bioconductor.org/biocLite.R")
#biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
IDs <- unlist(as.list(hoge))
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
obj <- is.element(IDs, uniqID[i])
hoge <- rbind(hoge, apply(data[names(IDs[obj]),], 2, param, na.rm=TRUE))
#hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
probe IDの遺伝子発現行列を入力として、Entrez IDの遺伝子発現行列を出力するやり方を示します。
probe IDとEntrez IDの対応関係情報が必要ですので、様々なやり方を示しています。
同じEntrez IDをもつ複数のprobe IDsが存在する場合にはparamで指定した方法で要約統計量を計算します。
代表値(要約統計量)は、平均値(mean)、中央値(median)、
最大値(max)など好きなものを指定できます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとEntrez IDとの対応関係を含む情報を利用するやり方です。
in_f <- "data_rma_2.txt"
out_f <- "hoge1.txt"
param <- mean
param1 <- "rat2302.db"
param2 <- "ENTREZID"
#source("http://bioconductor.org/biocLite.R")
#biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
IDs <- unlist(as.list(hoge))
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ5の22,283 probesets×36 samplesのRMA-preprocessedデータ(sample5.txt)の場合:
Affymetrix Human Genome U133A Array (GPL96)を用いて得られたGe et al., Genomics, 2005のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとEntrez IDとの対応関係を含む情報を利用するやり方です。
in_f <- "sample5.txt"
out_f <- "hoge2.txt"
param <- mean
param1 <- "hgu133a.db"
param2 <- "ENTREZID"
#source("http://bioconductor.org/biocLite.R")
#biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
IDs <- unlist(as.list(hoge))
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
probe IDの遺伝子発現行列を入力として、(gene symbolとEntrez ID以外の)ENSEMBLやUNIGENEの遺伝子発現行列を出力するやり方を示します。
probe IDと指定したIDの対応関係情報が必要ですので、様々なやり方を示しています。
同じIDをもつ複数のprobe IDsが存在する場合にはparamで指定した方法で要約統計量を計算します。
代表値(要約統計量)は、平均値(mean)、中央値(median)、
最大値(max)など好きなものを指定できます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
probeset IDから下記で示すようなIDに変換することができます:
"ACCNUM", "REFSEQ", "UNIGENE",
"ENSEMBL", "ENSEMBLPROT", "ENSEMBLTRANS",
"GENENAME", "PFAM", "PROSITE"。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとENSEMBL IDとの対応関係を含む情報を利用するやり方です。
in_f <- "data_rma_2.txt"
out_f <- "hoge1.txt"
param <- mean
param1 <- "rat2302.db"
param2 <- "ENSEMBL"
#source("http://bioconductor.org/biocLite.R")
#biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
IDs <- unlist(as.list(hoge))
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ5の22,283 probesets×36 samplesのRMA-preprocessedデータ(sample5.txt)の場合:
Affymetrix Human Genome U133A Array (GPL96)を用いて得られたGe et al., Genomics, 2005のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとUNIGENE IDとの対応関係を含む情報を利用するやり方です。
in_f <- "sample5.txt"
out_f <- "hoge2.txt"
param <- mean
param1 <- "hgu133a.db"
param2 <- "UNIGENE"
#source("http://bioconductor.org/biocLite.R")
#biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
IDs <- unlist(as.list(hoge))
uniqID <- unique(IDs)
uniqID <- uniqID[uniqID != ""]
uniqID <- uniqID[!is.na(uniqID)]
uniqID <- uniqID[!is.nan(uniqID)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(uniqID)){
hoge <- rbind(hoge, apply(data[which(IDs == uniqID[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- uniqID
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
例えば、「酸化的リン酸化」のパスウェイに関連する遺伝子セットが自分が見ている条件間で全体として動いているかどうかを調べたい場合に、
解析 | 機能解析 | 遺伝子オントロジー(GO)解析 | についてや解析 | 機能解析 | パスウェイ(Pathway)解析 | について
で述べている方法を利用しますが、これを実行するための入力ファイルをここで作成する必要があります。
そのため、「酸化的リン酸化」のパスウェイに関連する遺伝子セット中の特定の遺伝子(遺伝子A)が自分が見ている条件間で発現変動していて、
しかもチップ上に重複して多数(別のプローブIDとして)搭載されているような場合には、遺伝子Aだけの効果でそのパスウェイが「動いている」などという誤った結果を導きかねません。
このようなチップ上の重複遺伝子の効果を排除すべく、同じ遺伝子名をもつ複数のプローブIDの発現プロファイルに対しては、
その代表値(平均値(mean)や中央値(median)など)を出力して、
遺伝子名の重複のない(non-redundant)遺伝子発現行列をファイルとして得たいときに以下の作業を行います。
non-redundantにするためには、プローブIDとgene symbolやEntrez Gene IDとの対応表が必要になります。
この情報はイントロ | アノテーション情報取得 | 公共DB(GEO)からの6までを行うことで、
GPL1355-14795_symbol.txtのような形式の対応表ファイルとして入力時に読み込ませる戦略や、
Pathviewパッケージ(Luo et al., 2013)中のID変換用関数などを利用する戦略があります。
代表値(要約統計量)は、平均値(mean)、中央値(median)、最大値(max)など好きなものを指定できます。
この作業はGSEA解析でも当然やります。"Collapse dataset to gene symbols"に相当するところです。
GSEAでは「最大値(このページ中での関数はmaxでGSEAの"max_probe (default)"に相当)」または
「中央値(このページ中での関数はmedianでGSEAの"median_of_probes"に相当)」が選択可能です。
例題の多くは、probeset IDからgene symbolへの変換ですが、Entrez IDへの変換なども同じ枠組みでできます。
ここでやっているのは異なるIDの変換(ID converter)です。GAGEパッケージ(Luo et al., 2009)
のProbe set ID conversionの項目で書いているものと同じことをやっているだけ、という理解で差支えありません。
1. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | 公共DB(GEO)からの6までを行って得たGPL1355-14795_symbol.txtの情報も利用しています。
data_rma_2.txtの1列目のID情報とGPL1355-14795_symbol.txtの1列目のID情報の対応がとれる(同じ行の位置でなくてもよい)ことが前提です。
1分程度で終わります。
data_rma_2_nr.txtはこのコードを実行して得られたものです。
in_f1 <- "data_rma_2.txt"
in_f2 <- "GPL1355-14795_symbol.txt"
out_f <- "hoge1.txt"
param <- mean
sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
symbols <- as.vector(sym[,1])
names(symbols) <- rownames(sym)
unique_sym <- unique(symbols)
unique_sym <- unique_sym[unique_sym != ""]
unique_sym <- unique_sym[!is.na(unique_sym)]
unique_sym <- unique_sym[!is.nan(unique_sym)]
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- t(apply(as.matrix(unique_sym), 1, function(i, d = data, s = symbols, p = param) {
apply(d[which(s == i), ], 2, p, na.rm = TRUE)
}, data, symbols, param))
rownames(hoge) <- unique_sym
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | 公共DB(GEO)からの6までを行って得たGPL1355-14795_symbol.txtの情報も利用しています。
data_rma_2.txtの1列目のID情報とGPL1355-14795_symbol.txtの1列目のID情報の対応がとれる(同じ行の位置でなくてもよい)ことが前提です。
2分程度で終わります。
data_rma_2_nr.txtはこのコードを実行して得られたものです。
in_f1 <- "data_rma_2.txt"
in_f2 <- "GPL1355-14795_symbol.txt"
out_f <- "hoge2.txt"
param <- mean
sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
symbols <- as.vector(sym[,1])
names(symbols) <- rownames(sym)
unique_sym <- unique(symbols)
unique_sym <- unique_sym[unique_sym != ""]
unique_sym <- unique_sym[!is.na(unique_sym)]
unique_sym <- unique_sym[!is.nan(unique_sym)]
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(unique_sym)){
hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- unique_sym
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Agilent-012097 Human 1A Microarray (V2) G4110B (Feature Number version)を用いて得られたデータです。
イントロ | アノテーション情報取得 | 公共DB(GEO)からの6までを行って得たGPL887-5640_symbol.txtの情報も利用しています。
sample13_7vs7.txtの1列目のID情報とGPL887-5640_symbol.txtの1列目のID情報の対応がとれる(同じ行の位置でなくてもよい)ことが前提です。
2分程度で終わります。以下は、入力ファイル中の7810と9681というIDが同じGene symbol(ABCA10)にまとめられる(collapsing)イメージです。(NA --> NaNになっているところは本質的な部分ではありません...。)
入力:
出力:
in_f1 <- "sample13_7vs7.txt"
in_f2 <- "GPL887-5640_symbol.txt"
out_f <- "hoge3.txt"
param <- mean
sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
symbols <- as.vector(sym[,1])
names(symbols) <- rownames(sym)
unique_sym <- unique(symbols)
unique_sym <- unique_sym[unique_sym != ""]
unique_sym <- unique_sym[!is.na(unique_sym)]
unique_sym <- unique_sym[!is.nan(unique_sym)]
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(unique_sym)){
hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- unique_sym
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
4. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとGene symbolとの対応関係を含む情報を利用するやり方です。
パッケージのダウンロードで時間がかかるかもしれません。1や2の結果と出力ファイルの行数や数値が若干違うのは、おそらくアノテーションのバージョンの違いによるものだろうと思っています。
in_f <- "data_rma_2.txt"
out_f <- "hoge4.txt"
param <- mean
param1 <- "rat2302.db"
param2 <- "SYMBOL"
source("http://bioconductor.org/biocLite.R")
biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
symbols <- unlist(as.list(hoge))
unique_sym <- unique(symbols)
unique_sym <- unique_sym[unique_sym != ""]
unique_sym <- unique_sym[!is.na(unique_sym)]
unique_sym <- unique_sym[!is.nan(unique_sym)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(unique_sym)){
hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- unique_sym
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
入力ファイル中の4列目の情報をもとに、エクソンごとに分かれている同じ遺伝子のものをまとめています。
同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合にはエラーを吐くようにしています。以下は入力と出力のイメージです。
入力:
出力:
in_f <- "sample18_5vs5.txt"
out_f <- "hoge5.txt"
data <- read.table(in_f, header=TRUE, sep="\t", quote="")
hoge <- strsplit(as.character(data[,4]), "-ex", fixed=TRUE)
genename <- unlist(lapply(hoge, "[[", 1))
unique_genename <- unique(genename)
sub1 <- data[,c(1,6)]
sub2 <- data[,c(5,7:16)]
out <- NULL
for(i in 1:length(unique_genename)){
out_sub1 <- apply(sub1[which(genename == unique_genename[i]),], 2, unique, na.rm=TRUE)
out_sub2 <- apply(sub2[which(genename == unique_genename[i]),], 2, sum, na.rm=TRUE)
out <- rbind(out, c(out_sub1, unique_genename[i], out_sub2))
}
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)
入力ファイル中の4列目の情報をもとに、エクソンごとに分かれている同じ遺伝子のものをまとめています。
同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合には「2」を、そうでない場合には「1」としたベクトルを最初の一列目に追加で出力するようにしています。
以下は入力と出力のイメージです。
入力:
出力:
in_f <- "sample18_5vs5.txt"
out_f <- "hoge6.txt"
data <- read.table(in_f, header=TRUE, sep="\t", quote="")
hoge <- strsplit(as.character(data[,4]), "-ex", fixed=TRUE)
genename <- unlist(lapply(hoge, "[[", 1))
unique_genename <- unique(genename)
sub1 <- data[,c(1,6)]
sub2 <- data[,c(5,7:16)]
out <- NULL
for(i in 1:length(unique_genename)){
tmp <- unlist(apply(sub1[which(genename == unique_genename[i]),], 2, unique, na.rm=TRUE))
out_flag <- length(tmp)
out_sub1 <- tmp[1:2]
out_sub2 <- apply(sub2[which(genename == unique_genename[i]),], 2, sum, na.rm=TRUE)
out <- rbind(out, c(out_flag, out_sub1, unique_genename[i], out_sub2))
}
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)
7. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとEntrez IDとの対応関係を含む情報を利用するやり方です。
パッケージのダウンロードで時間がかかるかもしれません。"SYMBOL"や"ENTREZID"以外には、
"ACCNUM", "REFSEQ", "UNIGENE",
"ENSEMBL", "ENSEMBLPROT", "ENSEMBLTRANS",
"GENENAME", "PFAM", "PROSITE"などが指定可能です。
in_f <- "data_rma_2.txt"
out_f <- "hoge7.txt"
param <- mean
param1 <- "rat2302.db"
param2 <- "ENTREZID"
source("http://bioconductor.org/biocLite.R")
biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
symbols <- unlist(as.list(hoge))
unique_sym <- unique(symbols)
unique_sym <- unique_sym[unique_sym != ""]
unique_sym <- unique_sym[!is.na(unique_sym)]
unique_sym <- unique_sym[!is.nan(unique_sym)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(unique_sym)){
hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- unique_sym
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
8. サンプルデータ5の22,283 probesets×36 samplesのRMA-preprocessedデータ(sample5.txt)の場合:
Affymetrix Human Genome U133A Array (GPL96)を用いて得られたGe et al., Genomics, 2005のデータです。
イントロ | アノテーション情報取得 | Rのパッケージ*.dbからを参考にして得られたprobe IDとEntrez IDとの対応関係を含む情報を利用するやり方です。
パッケージのダウンロードで時間がかかるかもしれません。"SYMBOL"や"ENTREZID"以外には、
"ACCNUM", "REFSEQ", "UNIGENE",
"ENSEMBL", "ENSEMBLPROT", "ENSEMBLTRANS",
"GENENAME", "PFAM", "PROSITE"などが指定可能です。
in_f <- "sample5.txt"
out_f <- "hoge8.txt"
param <- mean
param1 <- "hgu133a.db"
param2 <- "ENTREZID"
source("http://bioconductor.org/biocLite.R")
biocLite(param1, suppressUpdates=TRUE)
library(param1, character.only=T)
hoge <- sub(".db", param2, param1)
hoge <- eval(parse(text=hoge))
symbols <- unlist(as.list(hoge))
unique_sym <- unique(symbols)
unique_sym <- unique_sym[unique_sym != ""]
unique_sym <- unique_sym[!is.na(unique_sym)]
unique_sym <- unique_sym[!is.nan(unique_sym)]
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- NULL
for(i in 1:length(unique_sym)){
hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))
}
rownames(hoge) <- unique_sym
tmp <- cbind(rownames(hoge), hoge)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「1列目:遺伝子名、2列目:数値」からなる二つのファイル(genelist_A.txtとgenelist_B.txt;いずれもヘッダー行を含む)があったとします。
そして、同じ遺伝子名のところの数値は同じだったとします。このような前提で二つのファイルで共通して含まれる遺伝子の情報のみ抽出したいときに利用します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f1 <- "genelist_A.txt"
in_f2 <- "genelist_B.txt"
out_f <- "hoge.txt"
data1 <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data2 <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
common <- intersect(rownames(data1), rownames(data2))
obj <- is.element(rownames(data1), common)
out <- data1[obj,]
names(out) <- rownames(data1)[obj]
tmp <- cbind(names(out), out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
二つのベクトル間の距離を定義する方法は多数存在します。ここでは10 genes ×2 samplesのデータファイル(sample19.txt)を読み込んで二つのサンプル間の距離をいくつかの方法で算出します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 10 genes ×2 samplesのデータファイル(sample19.txt)の場合:
in_f <- "sample19.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dist(t(data), method="euclidean")
dist(t(data), method="manhattan")
dist(t(data), method="maximum")
dist(t(data), method="canberra")
1 - cor(data, method="pearson")
dist(t(data), method="binary")
dist(t(data), method="minkowski")
1 - cor(data, method="spearman")
遺伝子発現行列に対して、一つ一つの遺伝子(行)に対して、様々な基本的な情報を得たい場合に利用します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 6 genes × 11 samplesのデータファイル(sample2.txt)の場合:
平均発現量を調べるやり方です。
in_f <- "sample2.txt"
out_f <- "hoge1.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out <- apply(data, 1, mean)
tmp <- cbind(rownames(data), data, out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. 6 genes × 11 samplesのデータファイル(sample2.txt)の場合:
中央値(median)を調べるやり方です。
in_f <- "sample2.txt"
out_f <- "hoge2.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out <- apply(data, 1, median)
tmp <- cbind(rownames(data), data, out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3. 6 genes × 11 samplesのデータファイル(sample2.txt)の場合:
重みつき平均(Tukey biweighted mean)を調べるやり方です。
in_f <- "sample2.txt"
out_f <- "hoge3.txt"
library(affy)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out <- apply(data, 1, tukey.biweight)
tmp <- cbind(rownames(data), data, out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
遺伝子発現行列に対して、一つ一つの遺伝子(行)に対して、様々な基本的な情報を得たい場合に利用します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 6 genes × 11 samplesのデータファイル(sample2.txt)の場合:
遺伝子ごとに最大発現量を示す組織名をリストアップするやり方です。
in_f <- "sample2.txt"
out_f <- "hoge1.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out <- colnames(data)[max.col(data)]
tmp <- cbind(rownames(data), data, out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. 6 genes × 11 samplesのデータファイル(sample2.txt)の場合:
遺伝子ごとに最大発現量を示す組織名を組織順にソートするやり方です。
in_f <- "sample2.txt"
out_f <- "hoge2.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out <- colnames(data)[max.col(data)]
tmp <- cbind(rownames(data), data, out)
tmp2 <- tmp[order(max.col(data)),]
write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F)
いわゆるパターンマッチング法(or テンプレートマッチング法; pattern matching; template matching)を適用して、"理想的なパターン" or "指定した遺伝子の発現パターン"に似た発現パターンを持つ遺伝子を検出(ランキング)します。ここでは、
- 指定した組織で理想的な特異的発現パターンを示す上位X個を得たい場合
- 上位X個ではなく似ている順に全遺伝子をソートした結果を得たい場合
- 指定した遺伝子の発現パターンに似た発現パターンを示す上位X個を得たい場合
の三つのやり方について紹介します。
類似度を計算する際に、
- 発現データ(遺伝子発現ベクトル)をあらかじめスケーリングするかしない(none)か?するとしたらどのようなスケーリング(range (各遺伝子のシグナル強度の範囲を0-1にする) or zscore (各遺伝子のシグナル強度の平均を0標準偏差を1にする))を行うか?
- 距離をどのような方法(euclidean, maximum, manhattan, canberra, correlation, binary)で定義するか?
も指定する必要があります。私は距離を普段から「1 - 相関係数」で定義しているので、それに相当するcorrelationを頻用します。また、スケーリングはやりません(none)。
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample5.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. 指定した組織で選択的(特異的)に発現する遺伝子群の上位10個(X=10)を得たい場合:
ここでは、予め作成した「心臓特異的発現パターン」を示す遺伝子群を抽出するための"理想的なパターン(テンプレート)"
を含むファイルGDS1096_cl_heart.txtを読み込んで、
発現パターンが似ている上位X個を二つのファイルdata_topranked.txt(発現データ含む)と
data_topranked_ID.txt(発現データ含まず遺伝子IDのみ)に保存するやり方を示します。
(発現ベクトルのスケーリングはせず(none)、
類似度は「1 - 相関係数」(correlation)で定義)
in_f1 <- "sample5.txt"
in_f2 <- "GDS1096_cl_heart.txt"
out_f1 <- "data_torranded.txt"
out_f2 <- "data_topranked_ID.txt"
param1 <- 10
param2 <- "none"
param3 <- "correlation"
library(genefilter)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data_cl <- read.table(in_f2, sep="\t", quote="")
template <- data_cl[,2]
template
tmp <- rbind(data, template)
template_posi <- which(rownames(tmp) == "template")
closeg <- genefinder(tmp, template_posi, param1, scale=param2, method=param3)
closeg[[1]]$indices
closeg[[1]]$dists
topranked <- tmp[closeg[[1]]$indices,]
tmp2 <- cbind(rownames(topranked), topranked)
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. 似ている順に全遺伝子をソートした結果を得たい場合:
ここでは、予め作成した「心臓特異的発現パターン」を示す遺伝子群を抽出するための
"理想的なパターン(テンプレート)"を含むファイルGDS1096_cl_heart.txtを読み込んで、
「心臓特異的発現パターン」に似ている順に全遺伝子をソートした二つのファイル
data_topranked.txt(発現データ含む)とdata_topranked_ID.txt(発現データ含まず遺伝子IDのみ)
に保存するやり方を示します。
(発現ベクトルをZスケーリング(zscore)し、類似度は「1 - 相関係数」(correlation)で定義)
in_f1 <- "sample5.txt"
in_f2 <- "GDS1096_cl_heart.txt"
out_f1 <- "data_torranded.txt"
out_f2 <- "data_topranked_ID.txt"
param2 <- "zscore"
param3 <- "correlation"
library(genefilter)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data_cl <- read.table(in_f2, sep="\t", quote="")
template <- data_cl[,2]
template
tmp <- rbind(data, template)
template_posi <- which(rownames(tmp) == "template")
param1 <- nrow(data)
closeg <- genefinder(tmp, template_posi, param1, scale=param2, method=param3)
topranked <- tmp[closeg[[1]]$indices,]
tmp2 <- cbind(rownames(topranked), topranked)
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)
3. 遺伝子ID: 207003_atの遺伝子発現プロファイルと発現パターンが似ている上位5個をリストアップしたい場合:
(発現ベクトルをRangeスケーリング(range)し、類似度はマンハッタン距離(manhattan)で定義)
in_f <- "sample5.txt"
out_f1 <- "data_torranded.txt"
out_f2 <- "data_topranked_ID.txt"
param1 <- 5
param2 <- "range"
param3 <- "manhattan"
param4 <- "207003_at"
library(genefilter)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
template_posi <- which(rownames(data) == param4)
closeg <- genefinder(data, template_posi, param1, scale=param2, method=param3)
topranked <- data[closeg[[1]]$indices,]
tmp2 <- cbind(rownames(topranked), topranked)
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)
4. (ヘッダー行を除く)15987行目(ID_REF: "216617_s_at"の行に相当)の遺伝子発現プロファイルと
発現パターンが似ている上位10個をリストアップしたい場合:
(発現ベクトルをZスケーリング(zscore)し、類似度は「1 - 相関係数」(correlation)で定義)
in_f <- "sample5.txt"
out_f1 <- "data_torranded.txt"
out_f2 <- "data_topranked_ID.txt"
param1 <- 10
param2 <- "zscore"
param3 <- "correlation"
param4 <- 15987
library(genefilter)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
closeg <- genefinder(data, param4, param1, scale=param2, method=param3)
topranked <- data[closeg[[1]]$indices,]
tmp2 <- cbind(rownames(topranked), topranked)
write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)
RNA-seqのカウントデータはTechnical replicatesのデータがポアソン分布(Poisson distribution)に、そしてBiological replicatesのデータが負の二項分布に従うことを報告しています。
そして、マイクロアレイデータも似たような平均-分散の形状を示すという報告もあります(Subramaniam and Hsiao, 2012)。
ここでは、マイクロアレイデータを読み込んで平均-分散プロットを作成します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. サンプルデータ24の31,099 probesets×10 samplesのMAS5-preprocessedデータ(data_GSE30533_mas.txt)の場合:
Kamei et al., PLoS One, 2013のデータです。
in_f <- "data_GSE30533_mas.txt"
out_f1 <- "hoge1_G1.txt"
out_f2 <- "hoge1_G1.png"
out_f3 <- "hoge1_G2.txt"
out_f4 <- "hoge1_G2.png"
out_f5 <- "hoge1_all.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(380, 420)
param_range <- c(1e-02, 1e+08)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- 2^data
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
G1 <- data[,data.cl==1]
G2 <- data[,data.cl==2]
hoge <- G1
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), data[,data.cl==1], hoge, MEAN, VARIANCE)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="blue")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", "G1", col="blue", pch=20)
hoge <- hoge[apply(hoge, 1, var) > 0,]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
hoge <- as.data.frame(cbind(MEAN, VARIANCE))
out <- lm(VARIANCE~MEAN, data=log10(hoge))
abline(out, col="black")
out
summary(out)
dev.off()
hoge <- G2
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), data[,data.cl==1], hoge, MEAN, VARIANCE)
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
png(out_f4, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", "G2", col="red", pch=20)
hoge <- hoge[apply(hoge, 1, var) > 0,]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
hoge <- as.data.frame(cbind(MEAN, VARIANCE))
out <- lm(VARIANCE~MEAN, data=log10(hoge))
abline(out, col="black")
out
summary(out)
dev.off()
hoge <- G1
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
png(out_f5, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1, ann=F,
xlim=param_range, ylim=param_range, col="blue")
par(new=T)
hoge <- G2
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", c("G1", "G2"), col=c("blue", "red"), pch=20)
dev.off()
2. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Nakai et al., BBB, 2008のデータです。
(データを読み込んだ後に、最初の8列分(Brown adopise tissue)のみ抽出して
4 fed samples vs. 4 fasted samplesの2群間比較データとして取り扱っています)
in_f <- "data_rma_2.txt"
out_f1 <- "hoge2_G1.txt"
out_f2 <- "hoge2_G1.png"
out_f3 <- "hoge2_G2.txt"
out_f4 <- "hoge2_G2.png"
out_f5 <- "hoge2_all.png"
param_G1 <- 4
param_G2 <- 4
param_fig <- c(380, 420)
param_range <- c(1e-02, 1e+08)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data <- 2^data
data <- data[,1:8]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
G1 <- data[,data.cl==1]
colSums(G1)
G2 <- data[,data.cl==2]
colSums(G2)
hoge <- G1
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), data[,data.cl==1], hoge, MEAN, VARIANCE)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="blue")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", "G1", col="blue", pch=20)
hoge <- hoge[apply(hoge, 1, var) > 0,]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
hoge <- as.data.frame(cbind(MEAN, VARIANCE))
out <- lm(VARIANCE~MEAN, data=log10(hoge))
abline(out, col="black")
out
summary(out)
dev.off()
hoge <- G2
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), data[,data.cl==1], hoge, MEAN, VARIANCE)
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
png(out_f4, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", "G2", col="red", pch=20)
hoge <- hoge[apply(hoge, 1, var) > 0,]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
hoge <- as.data.frame(cbind(MEAN, VARIANCE))
out <- lm(VARIANCE~MEAN, data=log10(hoge))
abline(out, col="black")
out
summary(out)
dev.off()
hoge <- G1
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
png(out_f5, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1, ann=F,
xlim=param_range, ylim=param_range, col="blue")
par(new=T)
hoge <- G2
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", c("G1", "G2"), col=c("blue", "red"), pch=20)
dev.off()
3. サンプルデータ20の31,099 probesets×24 samplesのMAS5-preprocessedデータ(data_mas.txt)の場合:
Nakai et al., BBB, 2008のデータです。
(データを読み込んだ後に、最初の8列分(Brown adopise tissue)のみ抽出して
4 fed samples vs. 4 fasted samplesの2群間比較データとして取り扱っています)
in_f <- "data_mas.txt"
out_f1 <- "hoge3_G1.txt"
out_f2 <- "hoge3_G1.png"
out_f3 <- "hoge3_G2.txt"
out_f4 <- "hoge3_G2.png"
out_f5 <- "hoge3_all.png"
param_G1 <- 4
param_G2 <- 4
param_fig <- c(380, 420)
param_range <- c(1e-02, 1e+08)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data <- 2^data
data <- data[,1:8]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
G1 <- data[,data.cl==1]
colSums(G1)
G2 <- data[,data.cl==2]
colSums(G2)
hoge <- G1
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), data[,data.cl==1], hoge, MEAN, VARIANCE)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="blue")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", "G1", col="blue", pch=20)
hoge <- hoge[apply(hoge, 1, var) > 0,]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
hoge <- as.data.frame(cbind(MEAN, VARIANCE))
out <- lm(VARIANCE~MEAN, data=log10(hoge))
abline(out, col="black")
out
summary(out)
dev.off()
hoge <- G2
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), data[,data.cl==1], hoge, MEAN, VARIANCE)
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
png(out_f4, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", "G2", col="red", pch=20)
hoge <- hoge[apply(hoge, 1, var) > 0,]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
hoge <- as.data.frame(cbind(MEAN, VARIANCE))
out <- lm(VARIANCE~MEAN, data=log10(hoge))
abline(out, col="black")
out
summary(out)
dev.off()
hoge <- G1
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
png(out_f5, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1, ann=F,
xlim=param_range, ylim=param_range, col="blue")
par(new=T)
hoge <- G2
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=param_range, ylim=param_range, col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", c("G1", "G2"), col=c("blue", "red"), pch=20)
dev.off()
クラスタリング全般について、階層的・非階層的に分類できないものをまとめておきます。
とりあえず枠組みのみ。
以下は2009年頃書いた非常に古い記述内容なので、参考程度。
-
階層的クラスタリングは大きく二つの方法に分類可能です(Smolkin and Ghosh, 2003):
- agglomerative nesting method
- divisive analysis method
日本語だと1. 凝集法と2. 分割法、でしょうか。おそらくなじみ深いのは1.のagglomerative nesting methodのほうでしょう。
例えばn個の組織からなるマイクロアレイデータに対する組織間(サンプル間)クラスタリングの場合だと、以下のような感じになります。
- agglomerative nesting method:初期状態はn個の(各クラスターの構成要素が一つのサンプルしかない)クラスター(n singleton clusters)からスタート
- 全てのクラスター間の総当たりの距離行列を作成
- 最も距離が近い二つのクラスターを一つにまとめる
- 最終的に一つのクラスターになるまでa,bを繰り返す
- 2. divisive analysis method:初期状態は全nサンプルをまとめた一つのクラスターからスタート
- クラスターの中で、最も他のサンプル群から距離が離れたサンプルを分離し、"分裂グループ(splinter group)"に入れる
- オリジナルクラスター中の残りのサンプルに対して、新たに形成された分裂グループに近いものは入れる
(結果として二つのクラスターが形成される)
- 各クラスターの直径(同じクラスター内の総当たりのサンプル間距離を計算し、最も遠い距離に相当)を計算し、どちらが大きいかを調べる
- 直径のより大きいほうのクラスターに対して、a-cを繰り返す
- a-dをn singleton clustersになるまで繰り返す
20090812現在、1.のAgglomerative nesting methodのやり方しかこのページにはありませんが、必要に応じて追加していく予定です。
-
(階層的)クラスタリングはこれまで、癌のサブタイプの発見などに威力を発揮してきました(Bittner et al., 2000)。
しかし、クラスタリングの一番の問題は興味あるクラスターが偶然では形成されない(されにくい)信頼できるクラスターかどうかの判断が難しいことだと思います。
p値のようなものがない、という理解でも差し支えありません。
それゆえ、このページでは、特に信頼できるクラスターがどれかを調べるためのやり方(pvclust)や、
適切なクラスター数および得られたクラスターの安定性を知るための方法(最適なクラスター数を見積る)の紹介を行っています。
この二つのやり方はいずれも基本的にサンプル間クラスタリングを例として挙げています。これはやはり、数百程度のサンプルのクラスタリングだとメモリ4GB程度でどうにかなるからです。
-
個人的には遺伝子間クラスタリングをやる意味はないと思っています。現実問題として、信頼できる遺伝子クラスターを得ることができないためです。
従来一つにまとめられていた癌のサブタイプの発見などを目的とするならば、
まずはpvclustか最適なクラスター数を見積るを行って、サブタイプがありそうかどうかを判断し、
例えば二つのサブタイプに分かれそうだという感じであれば、解析 | 発現変動 | 2群間 | 対応なし |についてなどで紹介している方法を適用して、候補サブタイプ間で発現の異なる遺伝子群の検出を行います。
当然、一連の作業中に遺伝子間クラスタリングを行うphaseはありません。
-
また、このページの項目名でいうところの"正規化"や"前処理"のどれを行うかによっても、得られるクラスタリングの結果(樹形図)が異なることにも注意が必要です。
これはクラスタリングの欠点の一つとも言えるのかもしれませんが、本来クラスタリングというのは"何の予断も持たずにとにかく似たものをどんどんまとめていく"ものなのですが、
多くの場合、例えば癌サンプル数十例と正常サンプル数十例のサンプル間クラスタリングを行う際、実際には、癌と正常組織が二群に分かれるのではないだろうかと事前に無意識のうちに期待します。
それゆえ、はっきりと二群に分かれない結果が得られるとがっかり...します。それでデータを取りなおしたり、都合の悪いサンプルの結果を難癖つけて排除...したがります。
これ以外の行動パターンとしては、正規化法Aを用いて得られた遺伝子発現行列のクラスタリング結果と正規化法Bの結果を眺めて、"都合のいいほう"を採用します(しがちです or する人もいます or ...)。
つまり、癌と正常組織が二群に分かれるのではないだろうかと事前に期待したことが、無意識(or意識的)に癌と正常がはっきりと二群に分かれる正規化法を探す行動に向かわせ、
結果として二群にはっきりと分かれた結果が得られた、という現実をつくる
自己成就予言(self-fulfilling prophecy)に(私を含め)ほとんどの人がなっているのだろうと思います。
これがいいことか悪いことかは...なんとも言えませんが、いずれにせよ正規化や前処理次第で結果が変わりうるという事実だけは知ってて損はないと思います。
最も一般的なクラスタリング手法。
このパッケージはさらに、二つのブートストラップ法により得られたクラスターの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からなるsample5.txtのサンプル間クラスタリングを行う場合:
in_f <- "sample5.txt"
param1 <- "correlation"
param2 <- "average"
param3 <- 20
library(pvclust)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out <- pvclust(data, method.hclust=param2, method.dist=param1, nboot=param3)
plot(out)
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="")
out <- pvclust(data) plot(out)
3. 10 sample×45 genesからなるsample3.txtの遺伝子間クラスタリングをやる場合(pvclustでの遺伝子間クラスタリングは時間がかかりすぎるのでお勧めできません...):
in_f <- "sample3.txt"
param1 <- "correlation"
param2 <- "average"
param3 <- 30
library(pvclust)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out <- pvclust(t(data), method.hclust=param2, method.dist=param1, nboot=param3)
plot(out)
階層的クラスタリングのやり方を示します。1.用いた前処理法(MAS5やRMAなど)、2.スケーリング方法(対数変換やZ-scoreなど)、
3.距離(または非類似度)を定義する方法(ユークリッド距離など)、4.クラスターをまとめる方法(平均連結法やウォード法など)でどの方法を採用するかで結果が変わってきます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
サンプル間クラスタリング(距離:1-Pearson相関係数、方法:平均連結法(average))でR Graphics画面上に表示するやり方です。
in_f <- "sample3.txt"
param <- "average"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- as.dist(1 - cor(data, method="pearson"))
out <- hclust(data.dist, method=param)
plot(out)
サンプル間クラスタリング(距離:1-Pearson相関係数、方法:平均連結法(average))で図の大きさを指定してpng形式ファイルで保存するやり方です。
in_f <- "sample3.txt"
out_f <- "hoge2.png"
param <- "average"
param_fig <- c(500, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- as.dist(1 - cor(data, method="pearson"))
out <- hclust(data.dist, method=param)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
サンプル間クラスタリング(距離:1-Spearman相関係数、方法:平均連結法(average))で図の大きさを指定してpng形式ファイルで保存するやり方です。
in_f <- "sample3.txt"
out_f <- "hoge3.png"
param <- "average"
param_fig <- c(500, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method=param)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
サンプル間クラスタリング(距離:ユークリッド距離(euclidean)、方法:平均連結法(average))でR Graphics画面上に表示するやり方です。
in_f <- "sample3.txt"
param1 <- "euclidean"
param2 <- "average"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- dist(t(data), method=param1)
out <- hclust(data.dist, method=param2)
plot(out)
サンプル間クラスタリング(距離:ユークリッド距離(euclidean)、方法:平均連結法(average))で図の大きさを指定してpng形式ファイルで保存するやり方です。
in_f <- "sample3.txt"
out_f <- "hoge5.png"
param1 <- "euclidean"
param2 <- "average"
param_fig <- c(500, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- dist(t(data), method=param1)
out <- hclust(data.dist, method=param2)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
遺伝子間クラスタリング(距離:ユークリッド距離(euclidean)、方法:平均連結法(average))でR Graphics画面上に表示するやり方です。
in_f <- "sample3.txt"
param1 <- "euclidean"
param2 <- "average"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- dist(data, method=param1)
out <- hclust(data.dist, method=param2)
plot(out)
遺伝子間クラスタリング(距離:1 - Spearman相関係数、方法:平均連結法(average))でR Graphics画面上に表示するやり方です。
in_f <- "sample3.txt"
param <- "average"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- as.dist(1 - cor(t(data), method="spearman"))
out <- hclust(data.dist, method=param)
plot(out)
解析 | クラスタリング | 階層的 | 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
param2 <- "average"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- as.dist(1 - cor(t(data)))
out <- hclust(data.dist, method=param2)
cluster <- cutree(out, k=param1)
tmp <- cbind(rownames(data), data, cluster)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(cluster),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
2. sample3.txt遺伝子間クラスタリングの場合(類似度:ユークリッド距離(euclidean)、方法:平均連結法(average)):
in_f <- "sample3.txt"
out_f <- "hoge.txt"
param1 <- 3
param2 <- "euclidean"
param3 <- "average"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.dist <- dist(data, method=param2)
out <- hclust(data.dist, method=param3)
cluster <- cutree(out, k=param1)
tmp <- cbind(rownames(data), data, cluster)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(cluster),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
3. data_GSE7623_rma.txtのサンプル間クラスタリングの場合(類似度:1 - 相関係数、方法:平均連結法(average)):
in_f <- "data_GSE7623_rma.txt"
out_f <- "hoge.txt"
param1 <- 2:10
param2 <- "average"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
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))
out <- hclust(data.dist, method=param2)
cluster <- cutree(out, k=param1)
tmp <- cbind(colnames(data), cluster)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
参考文献1の方法を用いてクラスター数を見積ります。
もしご自身のデータを実行したときに「メモリが足りない!」などと文句を言われたら、前処理 | フィルタリング | CVが小さいものを除去を参考にして遺伝子数を減らしてから行ってください。
以下では、前処理 | フィルタリング | 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"
param3 <- 100
library(clusterStab)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
out <- benhur(data, 0.7, param1, seednum=12345, iterations=param3, linkmeth=param2)
hist(out)
解説:
ここでやっていることは、候補クラスター数k個について、2, 3, ..., param個の可能性について調べています。(間違っていたらすいません)
- まずはk=2の場合について調べます。
- もともとのサンプル数(この場合24サンプル)のデータについて階層的クラスタリングを行います。
- 得られた樹形図をもとにk個のクラスターに分けます。
- もともとのサンプル数のの70%のサンプル(subsamples)をランダムに抽出し階層的クラスタリングを行い、k個のクラスターに分けます。
- 3.のsubsamplesと4.のsubsamplesのクラスター間のJaccard係数?!を計算します。
- 4と5を"param3"回行い、Jaccard係数?!の分布を調べた結果がk=2のヒストグラムです。
- 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というような見方をします。
ここまでで、最適なクラスター数が2 or 3個であることがわかりました。次に参考文献3の方法を用いて各クラスターがどれだけ安定なのかをclusterComp関数を用いて調べるとともに、各サンプルがどのクラスターに属しているかの結果を指定した出力ファイル名で保存します。
param3 <- 2
out_f <- "hoge.txt"
out2 <- clusterComp(data, param3, method=param2)
out2
str(out2)
out2@clusters
tmp <- cbind(names(out2@clusters), out2@clusters)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
何個のクラスター(Kの数)にするのがよいか?(cluster validity問題)を探すために提案された指標(選択可)を用いて適切なクラスター数を計算する機能もついている。
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample3.txt)を置いてあるディレクトリに移動。
in_f <- "sample3.txt"
library(cclust)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
sample3_k2 <- cclust(data, 2, 20, verbose=TRUE, method="kmeans")
sample3_k3 <- cclust(data, 3, 20, verbose=TRUE, method="kmeans")
sample3_k4 <- cclust(data, 4, 20, verbose=TRUE, method="kmeans")
sample3_k5 <- cclust(data, 5, 20, verbose=TRUE, method="kmeans")
sample3_k2
sample3_k3
sample3_k4
sample3_k5
clustIndex(sample3_k2, data, index="db")
clustIndex(sample3_k3, data, index="db")
clustIndex(sample3_k4, data, index="db")
clustIndex(sample3_k5, data, index="db")
names(sample3_k3)
sample3_k3$cluster
for(i in 1:nrow(sample3)) cat(rownames(data[i,])," ",sample3_k3$cluster[i],"\n")
DB Indexは、その値が低いものほど分割数が妥当であることを意味する。したがって、いろいろ調べた中で最も値の低かったものを採用(この場合、おそらくK=3)する。
(特にK=5とした場合に、Sizes of Clustersが1になるクラスターがときどき出現する。このような場合clustIndexで調べたときにエラーとなるようだ)
マイクロアレイデータ解析で似た発現パターンを示す遺伝子(or 組織)を自己組織化マップ(Self-Organizing Map; SOM)によりクラスタリングしたいときに用います。
「ファイル」−「ディレクトリの変更」で解析したい(sample2.txt)ファイルを置いてあるディレクトリに移動。
1. 組織(tissue)間クラスタリングの場合:
in_f <- "sample2.txt"
library(som)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
sample2.f <- filtering(data, lt=10, ut=100, mmr=2.9, mmd=42)
sample2.f.n <- normalize(sample2.f, byrow=TRUE)
foo <- som(t(sample2.f.n), xdim=3, ydim=5)
plot(foo)
2. 遺伝子(gene)間クラスタリングの場合:
in_f <- "sample2.txt"
library(som)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
sample2.f <- filtering(data, lt=10, ut=100, mmr=2.9, mmd=42)
sample2.f.n <- normalize(sample2.f, byrow=TRUE)
foo <- som(sample2.f.n, xdim=3, ydim=5)
plot(foo)
主成分分析(principal components analysis; PCA)によりクラスタリングしたいときに用います。
「ファイル」−「ディレクトリの変更」で解析したい(sample3.txt)ファイルを置いてあるディレクトリに移動。
in_f <- "sample3.txt"
data <- read.table(in_f, 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)))
OCplusパッケージを用いて調べる方法を示します。
発現変動遺伝子(Differentially Expressed Genes; DEGs)のランキング(検出)を行う際にFDRを計算することで上位の遺伝子ですらFDRが1に近いものだと、
「ああこのデータセット中には発現変動遺伝子はないのね...。」という判断がつきます。
が、そんな回りくどいことをせずとも、以下を実行することで「発現変動遺伝子でないもの(non-DEGs)の割合」が一意に返されます。よって、「1 - その割合」がDEGsの割合ということになるのでざっくりと知ることができるわけです。
以下では(遺伝子名の列を除く)最初の3列(X=3)がG1群、残りの3列(Y=3)がG2群からなる(すでに対数変換されている)遺伝子発現データファイル(sample14.txt)の2群間比較用データのnon-DEGsの割合を計算する一連の手順を示します。
最後に出力される二つの数値が目的のものです。この場合、約65%がnon-DEGsであることがわかります。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f <- "sample14.txt"
out_f <- "hoge.txt"
param_G1 <- 3
param_G2 <- 3
library(OCplus)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out1 <- fdr1d(data, data.cl, verb=FALSE)
out2 <- EOC(data, data.cl)
p0(out1)
p0(out2)
実験デザインが以下のような場合にこのカテゴリーに属す方法を適用します:
Aさんの正常サンプル
Bさんの正常サンプル
Cさんの正常サンプル
Dさんの腫瘍サンプル
Eさんの腫瘍サンプル
Fさんの腫瘍サンプル
Gさんの腫瘍サンプル
2015年11月にざっと枠組みだけ作りました。
以下は相当古い(2011年頃の記述)ので参考まで。
「マーカー遺伝子の検出」が第一目的の場合と「分類精度が高い遺伝子セットを得たい」のが第一目的の場合で用いる方法が違ってきます。もちろん、両者は完全には排他的ではなくかなり密接に関連してはいますが、それぞれの目的に応じた手法が提案されているので使い分けるほうがよろしいかと思います。
「マーカー遺伝子の検出」が第一目的の場合(filter method;発現強度とサンプルクラス間の統計的な相関に基づいて遺伝子を抽出するやり方):
最近はFold change系とt-statistic系の組み合わせが主流?!になってきていますが、サンプル数(全部で10サンプル程度?!)が比較的少ないときは前者がよくて、比較的多いサンプル数(30サンプルとか?!)の場合には後者がいいと2007年ごろまで思っていました。
また、どのpreprocessing algorithmsを用いてexpression summary scoreを求めたデータに対して適用するかによっても違ってきます。私の2008年の論文(WAD: Kadota et al., 2008)での結論(おすすめ)は以下の通りです:
このうちのどれがいいかは分かりませんが、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の組合せ:
再現性の高い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;分類能力の高い遺伝子を抽出するやり方):
RankProd 2.0パッケージを用いるやり方を示します。
この原著論文(Del Carratore et al., 2017)中にも明記されていますが、
Rank productsの一番最初の論文(Breitling et al., FEBS Lett., 2004)とはもはや別物のようです。
そのため、「解析 | 発現変動 | 2群間 | 対応なし | Rank products (Breitling_2004)」
とは別の項目として新設しました。ぱっと見妥当な結果になっているのでここで示したやり方でよいのではと思っておりますが、もし「何かオカシイ」
結果に遭遇しましたらお知らせください。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
RMA-preprocessed data (G1群:4 samples vs. G2群:4 samples)です。
in_f <- "data_rma_2_BAT.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
library(RankProd)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(0, param_G1), rep(1, param_G2))
out <- RankProducts(data, data.cl, logged=T, na.rm=F, plot=F, rand=123)
stat_RP <- apply(out$RPs, 1, min)
rank_RP <- as.matrix(rank(stat_RP, ties.method = "min"))
stat_fc <- -out$AveFC
rank_fc <- rank(-abs(stat_fc))
colnames(out$pfp) <- c("FDR(G1 < G2)","FDR(G1 > G2)")
colnames(out$RPs) <- c("stat(G1 < G2)","stat(G1 > G2)")
colnames(out$RPrank) <- c("rank(G1 < G2)","rank(G1 > G2)")
colnames(stat_fc) <- "log2(G2/G1)"
tmp <- cbind(rownames(data), data, out$pfp, out$RPs, out$RPrank, stat_fc, rank_fc, stat_RP, rank_RP)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
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統計量によるランキング結果の再現性が非常に高い、という特徴に起因しています。
つまり、例えば2群間(G1群vs.G2群)比較で、AやBのラベル情報をランダムに入れ替えてFDRを計算しようとしても、ランキング結果の再現性が高いが故に「random permutationで得られた結果は、元のランキング結果とほとんど同じランキング結果になってしまう」からです。
従って、何らかの客観的な閾値が欲しい、という人はSAMなり他の方法で「だいたいFDR < 0.05を満たす遺伝子数はこのくらい」という情報を別に持っておけばいいと思います。
実際問題としては、例えば(t統計量系の方法である)SAMで決めた任意の閾値を満たす遺伝子数やランキング結果と、
それ以外の(Fold change系の方法である)Rank productsで決めた同じ閾値を満たす遺伝子数やランキング結果は結構違います。
ランキング結果の上位x個という風に数を揃えても20%程度の一致しかないのが普通です。
では何を信じればいいのでしょうか?私は発現変動の度合いでランキングをした結果の上位に”本物”がより濃縮されている方法がいいと思います。
しかもそれが様々なプラットフォームや様々な評価基準でも有用性が示されているとしたら、、、WADでいいんじゃないかと思います。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
以下では(遺伝子名の列を除く)最初の50列(X=50)が正常サンプル(G1群)、残りの52列(Y=52)が腫瘍サンプル(G2群)からなる
(すでに対数変換されている)遺伝子発現データファイル(data_Singh_RMA_3274.txt)の2群間比較を例とします。
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge1.txt"
param_G1 <- 50
param_G2 <- 52
WAD <- function(data=NULL, data.cl=NULL){
x <- data
cl <- data.cl
mean1 <- rowMeans(as.matrix(x[, cl==1]))
mean2 <- rowMeans(as.matrix(x[, cl==2]))
x_ave <- (mean1 + mean2)/2
weight <- (x_ave - min(x_ave))/(max(x_ave) - min(x_ave))
statistic <- (mean2 - mean1)*weight
return(statistic)
}
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
stat_wad <- WAD(data=data, data.cl=data.cl)
rank_wad <- rank(-abs(stat_wad))
tmp <- cbind(rownames(data), data, stat_wad, rank_wad)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. 入力ファイルがlogged dataでない場合(sample2.txt):
(遺伝子名の列を除く)最初の6列がG1群、残りの5列がG2群からなる(まだ対数変換されていない)
発現データです。
in_f <- "sample2.txt"
out_f <- "hoge2.txt"
param_G1 <- 6
param_G2 <- 5
WAD <- function(data=NULL, data.cl=NULL){
x <- data
cl <- data.cl
mean1 <- rowMeans(as.matrix(x[, cl==1]))
mean2 <- rowMeans(as.matrix(x[, cl==2]))
x_ave <- (mean1 + mean2)/2
weight <- (x_ave - min(x_ave))/(max(x_ave) - min(x_ave))
statistic <- (mean2 - mean1)*weight
return(statistic)
}
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data[data < 1] <- 1
data <- log(data, 2)
stat_wad <- WAD(data=data, data.cl=data.cl)
rank_wad <- rank(-abs(stat_wad))
tmp <- cbind(rownames(data), data, stat_wad, rank_wad)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3. 入力ファイルがlogged dataでない場合(sample2.txt):
(遺伝子名の列を除く)最初の6列がG1群、残りの5列がG2群からなる(まだ対数変換されていない)
発現データです。TCCパッケージ中のWAD関数を用いるやり方です。
出力ファイル中のwad列がWAD統計量、rank列が発現変動順にソートした順位情報です。
WAD法はlog2変換後のデータを入力とすることを前提としており、発現レベルに相当する数値が1未満のものを1に変換してからlogをとっています。
in_f <- "sample2.txt"
out_f <- "hoge3.txt"
param_G1 <- 6
param_G2 <- 5
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- WAD(data, data.cl, logged=F, floor=1)
tmp <- cbind(rownames(data), data, out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
決定木の一種。日本語では「ランダム森 or ランダムフォレスト」というらしく、分類性能が非常に高いそうです。
以下では(遺伝子名の列を除く)最初の50列(X=50)が正常サンプル(G1群)、残りの52列(Y=52)が腫瘍サンプル(G2群)からなる(すでに対数変換されている)遺伝子発現データファイル(data_Singh_RMA_3274.txt)の2群間比較を例とします。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f <- "data_Singh_RMA_3274.txt"
param_G1 <- 50
param_G2 <- 52
library(varSelRF)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
rf.vs1 <- varSelRF(t(data), factor(data.cl))
rf.vs1$selected.vars
参考文献1の方法(Distribution-Free Shrinkage Approach)を用いて2群間で発現の異なる遺伝子をランキング。
このライブラリ中では、他に参考文献2の方法(t statistic using the 90% rule of Efron et al., 2001)、
empirical Bayes (Smyth_2004)、SAM(Tusher_2001)の計算もやってくれるので、ここでは全部の結果を出力します。
以下では(遺伝子名の列を除く)最初の50列(X=50)が正常サンプル(G1群)、残りの52列(Y=52)が腫瘍サンプル(G2群)からなる(すでに対数変換されている)遺伝子発現データファイル(data_Singh_RMA_3274.txt)の2群間比較を例とします。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge.txt"
param_G1 <- 50
param_G2 <- 52
library(st)
library(samr)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
stat_st <- shrinkt.stat(t(data), data.cl)
rank_st <- rank(-abs(stat_st))
stat_efron <- efront.stat(t(data), data.cl)
rank_efron <- rank(-abs(stat_efron))
stat_ebayes <- modt.stat(t(data), data.cl)
rank_ebayes <- rank(-abs(stat_ebayes))
stat_sam <- sam.stat(t(data), data.cl)
rank_sam <- rank(-abs(stat_sam))
tmp <- cbind(rownames(data), data, stat_st, rank_st, stat_efron, rank_efron, stat_ebayes, rank_ebayes, stat_sam, rank_sam)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
参考文献1の方法を用いて2群間で発現の異なる遺伝子をランキング。この論文中では三つの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)が正常サンプル(G1群)、残りの52列(Y=52)が腫瘍サンプル(G2群)からなる(すでに対数変換されている)遺伝子発現データファイル(data_Singh_RMA_3274.txt)の2群間比較用データを用いて、
- 「log2(幾何平均版のFold change)の絶対値でのランキング」と「SAM統計量の絶対値でのランキング」→ Pareto layer ranking (method="pareto"で指定)で総合ランキング
- 「log2(幾何平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」→ Pareto layer ranking (method="pareto"で指定)で総合ランキング
- 「log2(算術平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」→ Pareto layer ranking (method="pareto"で指定)で総合ランキング
を得るやり方を示します。
コピペで動かないままになっていたのを修正しました(2009/11/10, 12:38)。
「ファイル」−「ディレクトリの変更」で解析したいサンプルデータのdata_Singh_RMA_3274.txtファイルを置いてあるディレクトリに移動し、以下をコピペ
1. 「log2(幾何平均版のFold change)の絶対値でのランキング」と「SAM統計量の絶対値でのランキング」の場合:
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge.txt"
param_G1 <- 50
param_G2 <- 52
param3 <- "pareto"
#source("http://gap.stat.sinica.edu.tw/Software/mvo.R")
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R")
library(samr)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data.tmp = list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)
out <- samr(data.tmp, resp.type="Two class unpaired", nperms=20)
stat_sam <- out$tt
rank_sam <- rank(-abs(stat_sam))
stat_fc <- log2(out$foldchange)
rank_fc <- rank(-abs(stat_fc))
ranks <- cbind(stat_sam, stat_fc)
ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)
tmp <- cbind(rownames(data), data, stat_sam, stat_fc, rank_sam, rank_fc, ranks.out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=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"
param_G1 <- 50
param_G2 <- 52
param3 <- "pareto"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R")
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- t(apply(data, 1, Welch_ttest, data.cl))
stat_t <- out[,1]
rank_t <- rank(-abs(stat_t))
stat_fc <- apply(data, 1, AD, data.cl)
rank_fc <- rank(-abs(stat_fc))
ranks <- cbind(stat_t, stat_fc)
ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)
tmp <- cbind(rownames(data), data, stat_t, stat_fc, rank_t, rank_fc, ranks.out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3. 「log2(算術平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」の場合:
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge.txt"
param_G1 <- 50
param_G2 <- 52
param3 <- "pareto"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R")
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- t(apply(data, 1, Welch_ttest, data.cl))
stat_t <- out[,1]
rank_t <- rank(-abs(stat_t))
stat_fc <- apply(data, 1, FC, data.cl)
rank_fc <- rank(-abs(stat_fc))
ranks <- cbind(stat_t, stat_fc)
ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)
tmp <- cbind(rownames(data), data, stat_t, stat_fc, rank_t, rank_fc, ranks.out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
一つ上のlayer ranking algorithm (Chen_2007)と同じく、発現変動遺伝子(Differentially Expressed Genes; DEGs)のランキングのために用いた複数の統計量(例えばFold changeとP-value)の結果から総合ランキングを得るとともにそのFDRを計算してくれるようです。
サンプルの並べ替え(permutation)でnon-DEGsの分布を計算し、どうにかしてFDRを計算してくれるみたいです。
以下では(遺伝子名の列を除く)最初の3列(X=3)がG1群、残りの3列(Y=3)がG2群からなる(すでに対数変換されている)遺伝子発現データファイル(sample14.txt)の2群間比較用データを用いて、
「標準誤差のlog」と「t統計量」で総合FDRを得るやり方を示します。
volcano plot (横軸:fold change, 縦軸:t-testなどで得られたp-value)の総合FDRは下記で利用しているfdr2d関数ではサポートされていないようですね。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f <- "sample14.txt"
out_f <- "hoge.txt"
param_G1 <- 3
param_G2 <- 3
library(OCplus)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tmpout <- fdr1d(data, data.cl, verb=FALSE)
p0(tmpout)
out <- fdr2d(data, data.cl, p0=p0(tmpout), verb=FALSE)
tmp <- cbind(rownames(data), data, out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
IBMT法 (Sartor et al., 2006)の方法を用いて2群間で発現の異なる遺伝子をランキング。
empirical Bayes (Smyth_2004)の改良版という位置づけですね。a novel Bayesian moderated-Tと書いてますし。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. サンプルデータ20の31,099 probesets×8 samplesのdata_rma_2_LIV.txt(G1群4サンプル vs. G2群4サンプル)の場合:
in_f <- "data_rma_2_LIV.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
library(limma)
source("http://eh3.uc.edu/r/ibmtR.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
fit$Amean<-rowMeans(data)
fit <- IBMT(fit,2)
p.value <- fit$IBMT.p
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ24の31,099 probesets×10 samplesのdata_GSE30533_rma.txt(G1群5サンプル vs. G2群5サンプル)の場合:
in_f <- "data_GSE30533_rma.txt"
out_f <- "hoge2.txt"
param_G1 <- 5
param_G2 <- 5
library(limma)
source("http://eh3.uc.edu/r/ibmtR.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
fit$Amean<-rowMeans(data)
fit <- IBMT(fit,2)
p.value <- fit$IBMT.p
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「解析 | 発現変動 | 2群間 | 対応なし | RankProd 2.0 (Del Carratore_2017)」をご利用下さい!(2019年3月16日追加)
Rank products法 (Breitling et al., 2004)を用いて2群間で発現の異なる遺伝子をランキング。
非常によく用いられているSAMよりも成績がいいとのこと。
実際、手法比較論文(Jeffery et al., BMC Bioinformatics, 2006)中でも高い評価を受けているようだ。
この方法を使って遺伝子のランキングをした結果はt検定やSAMなどとは"かなり"違います(Kadota et al., Algorithms Mol. Biol., 2008)。
出力ファイル中の「log/unlog(class1/class2)」列の名前を「log(G2/G1)」に変更しました。
G2/G1はG2群とG1群の平均発現レベルのfold change (FC)です。それゆえ、log(G2/G1)はいわゆる"log ratio"とか"log比"と呼ばれるものです。
その右側の「rank_fc」列は、このlog比の絶対値が大きい順にランキングした結果です。(2015/02/12追加)。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
RMA-preprocessed data (G1群:4 samples vs. G2群:4 samples)です。
in_f <- "data_rma_2_BAT.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
param_perm <- 100
library(RankProd)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- RP(data, data.cl, num.perm = param_perm, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 123)
stat_RP <- apply(out$RPs, 1, min)
rank_RP <- as.matrix(rank(stat_RP, ties.method = "min"))
stat_fc <- -out$AveFC
rank_fc <- rank(-abs(stat_fc))
colnames(out$pfp) <- c("FDR(G1 < G2)","FDR(G1 > G2)")
colnames(out$RPs) <- c("stat(G1 < G2)","stat(G1 > G2)")
colnames(out$RPrank) <- c("rank(G1 < G2)","rank(G1 > G2)")
colnames(stat_fc) <- "log2(G2/G1)"
tmp <- cbind(rownames(data), data, out$pfp, out$RPs, out$RPrank, stat_fc, rank_fc, stat_RP, rank_RP)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
RMA-preprocessed data (G1群:4 samples vs. G2群:4 samples)でFDR < 0.05を満たすprobesetIDの情報のみ抽出するやり方です。
若干IDの数に変動はあると思いますが概ね1800 IDsが得られると思います。
result_rankprod_BAT_id.txtのような感じの結果が得られるはずです。
in_f <- "data_rma_2_BAT.txt"
out_f <- "hoge2.txt"
param_G1 <- 4
param_G2 <- 4
param_perm <- 100
param_FDR <- 0.05
library(RankProd)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- RP(data, data.cl, num.perm = param_perm, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 123)
hoge_upG2 <- rownames(data)[out$pfp[1] < param_FDR]
hoge_upG1 <- rownames(data)[out$pfp[2] < param_FDR]
tmp <- union(hoge_upG1, hoge_upG2)
writeLines(tmp, out_f)
RMA-preprocessed data (G1群:50 samples vs. G2群:52 samples)です。
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge3.txt"
param_G1 <- 50
param_G2 <- 52
param_perm <- 20
library(RankProd)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- RP(data, data.cl, num.perm = param_perm, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 123)
stat_RP <- apply(out$RPs, 1, min)
rank_RP <- as.matrix(rank(stat_RP, ties.method = "min"))
stat_fc <- -out$AveFC
rank_fc <- rank(-abs(stat_fc))
colnames(out$pfp) <- c("FDR(G1 < G2)","FDR(G1 > G2)")
colnames(out$RPs) <- c("stat(G1 < G2)","stat(G1 > G2)")
colnames(out$RPrank) <- c("rank(G1 < G2)","rank(G1 > G2)")
colnames(stat_fc) <- "log2(G2/G1)"
tmp <- cbind(rownames(data), data, out$pfp, out$RPs, out$RPrank, stat_fc, rank_fc, stat_RP, rank_RP)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plotRP(out, cutoff = 0.05)
topGene(out, cutoff = 0.0001, gene.names = rownames(data))
topGene(out, num.gene = 10, gene.names = rownames(data))
summary(out)
得られるhoge3.txtについて。
- FDR列:pfp (percentage of false positive predictionの略;FDRそのもの)値。この列で昇順にソートして0.05未満のもののリストなどをゲットしたりする。
- stat列:RPs (RP or RPadvance関数を使ったときはrank product;RSadvance関数を使ったときはrank sum)値。統計量そのものです。低いほど発現変動の度合いが高いことを意味する。
- rank列:順位
- log(G2/G1)列:log比(G2の算術平均 - G1の算術平均)値。
- rank_fc列:stat_fc値の絶対値が大きい順に並べた順位。
- stat_RP列:二つある"stat"列の統計量のうち、小さいほうの値。この値が小さいほど発現変動の度合いが大きいと解釈する。
- rank_RP列:総合順位。Rank列は、「G1 < G2での順位」と「G1 > G2での順位」が独立に出てくるので、WADの順位との比較を行いたいなどの場合には、この総合順位を用いて行います。
注釈(2016/08/30追加)。「log(G2/G1)列:log比(G2の算術平均 - G1の算術平均)値」は一見間違いのようですが、
間違いではありません。理由は、入力が対数変換後のデータだからです。
これだと(G2の算術平均 - G1の算術平均)という実際の計算手順で定義したlog比の値は、対数変換前の世界では幾何平均になるのでは?
という指摘もあるかもしれませんが、平均であることには変わりありません。
正確にいえば、入力が対数変換後のデータなのでよく理解できているヒトは、「log2(G2/G1)」という記載方法が間違っているという指摘になるでしょうが、
この記載法は一般的なものであり、(G2/G1)の中身は対数変換前の数値であるという暗黙の意味を含みます。
正確には「対数変換後のG2の算術平均 - 対数変換後のG2の算術平均 」と書けばいいのでしょうが、エンドユーザの多くはこう書かれるほうが混乱しますので。。。
- RankProd:Hong et al., Bioinformatics, 2006
- Rank products:Breitling et al., FEBS Lett., 2004
- Jeffery et al., BMC Bioinformatics, 2006
- WAD:Kadota et al., Algorithms Mol. Biol., 2008
- Nakai et al., BBB, 2008
limmaパッケージを用いて2群間比較を行うやり方を示します。
この方法は経験ベイズと表現されたり、moderated t statisticと表現されたりしているようです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
31,099 probesets×8 samples(G1群4サンプル vs. G2群4サンプル)のデータです。
in_f <- "data_rma_2_LIV.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
p.value <- out$p.value[,ncol(design)]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
31,099 probesets×10 samples(G1群5サンプル vs. G2群5サンプル)のデータです。
in_f <- "data_GSE30533_rma.txt"
out_f <- "hoge2.txt"
param_G1 <- 5
param_G2 <- 5
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
p.value <- out$p.value[,ncol(design)]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
31,099 probesets×8 samples(G1群4サンプル vs. G2群4サンプル)のデータです。M-A plotのpngファイルを生成しています。
in_f <- "data_rma_2_LIV.txt"
out_f1 <- "hoge3.txt"
out_f2 <- "hoge3.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.05
param_fig <- c(400, 380)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
p.value <- out$p.value[,ncol(design)]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
mean_G1 <- apply(as.matrix(data[,data.cl==1]), 1, mean)
mean_G2 <- apply(as.matrix(data[,data.cl==2]), 1, mean)
M <- mean_G2 - mean_G1
A <- (mean_G1 + mean_G2)/2
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(A, M, xlab="A = (G2 + G1)/2", ylab="M = G2 - G1", cex=.1, pch=20)
grid(col="gray", lty="dotted")
obj <- as.logical(q.value < param_FDR)
points(A[obj], M[obj], col="magenta", cex=0.1, pch=20)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
31,099 probesets×8 samples(G1群4サンプル vs. G2群4サンプル)のデータです。
M-A plotのpngファイルを生成しています。limmaパッケージ中のplotMA関数を用いるやり方です。
in_f <- "data_rma_2_LIV.txt"
out_f1 <- "hoge4.txt"
out_f2 <- "hoge4.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.05
param_fig <- c(400, 380)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
p.value <- out$p.value[,ncol(design)]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plotMA(fit, cex=0.1, pch=20)
grid(col="gray", lty="dotted")
obj <- as.logical(q.value < param_FDR)
points(fit$Amean[obj], fit$coef[obj,ncol(design)], col="magenta", cex=0.1, pch=20)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
31,099 probesets×8 samples(G1群4サンプル vs. G2群4サンプル)のデータです。
M-A plotのpngファイルを生成しています。シリーズ Useful R 第7巻 トランスクリプトーム解析のp170のコードに似せた記述形式です。
in_f <- "data_rma_2_LIV.txt"
out_f1 <- "hoge5.txt"
out_f2 <- "hoge5.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.05
param_fig <- c(400, 380)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
p.value <- out$p.value[,ncol(design)]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
hoge <- topTable(out,coef=colnames(design)[ncol(design)], adjust="BH",number= nrow(data))
M <- hoge$logFC
A <- hoge$AveExpr
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(A, M, xlab="AveExpr", ylab="logFC", cex=.1, pch=20)
grid(col="gray", lty="dotted")
obj <- as.logical(hoge$adj.P.Val < param_FDR)
points(A[obj], M[obj], col="magenta", cex=0.1, pch=20)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
31,099 probesets×8 samples(G1群4サンプル vs. G2群4サンプル)のデータです。
M-A plotのpngファイルを生成しています。シリーズ Useful R 第7巻 トランスクリプトーム解析
のp170のコードに似せた記述形式です。テキストファイルのほうの出力結果をtopTable関数の出力結果にしています。
in_f <- "data_rma_2_LIV.txt"
out_f1 <- "hoge6.txt"
out_f2 <- "hoge6.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.05
param_fig <- c(400, 380)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
hoge <- topTable(out,coef=colnames(design)[ncol(design)], adjust="BH",number= nrow(data))
sum(hoge$adj.P.Val < 0.05)
tmp <- cbind(rownames(hoge), data[rownames(hoge),], hoge)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
M <- hoge$logFC
A <- hoge$AveExpr
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(A, M, xlab="AveExpr", ylab="logFC", cex=.1, pch=20)
grid(col="gray", lty="dotted")
obj <- as.logical(hoge$adj.P.Val < param_FDR)
points(A[obj], M[obj], col="magenta", cex=0.1, pch=20)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
31,099 probesets×8 samples(G1群4サンプル vs. G2群4サンプル)のデータです。
M-A plotのpngファイルを生成しています。limmaパッケージ中のtopTable関数やplotMA関数を使わないやり方です。
テキストファイルのほうは、M-A plotのM値とA値も出力させるようにしています。
in_f <- "data_rma_2_LIV.txt"
out_f1 <- "hoge7.txt"
out_f2 <- "hoge7.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.05
param_fig <- c(400, 380)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
p.value <- out$p.value[,ncol(design)]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
mean_G1 <- apply(as.matrix(data[,data.cl==1]), 1, mean)
mean_G2 <- apply(as.matrix(data[,data.cl==2]), 1, mean)
M <- mean_G2 - mean_G1
A <- (mean_G1 + mean_G2)/2
tmp <- cbind(rownames(data), data, M, A, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(A, M, xlab="A = (G2 + G1)/2", ylab="M = G2 - G1", cex=.1, pch=20)
grid(col="gray", lty="dotted")
obj <- as.logical(q.value < param_FDR)
points(A[obj], M[obj], col="magenta", cex=0.1, pch=20)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
31,099 probesets×8 samples(G1群4サンプル vs. G2群4サンプル)のデータです。
M-A plotのpngファイルを生成しています。limmaパッケージ中のtopTable関数やplotMA関数を使わないやり方です。
7.を基本としつつ、テキストファイルのほうは発現変動順にソートしたものを出力しています。
また、param_FCで指定した倍率変化に相当するM-A plot上のMの閾値を水平線で引いています。
in_f <- "data_rma_2_LIV.txt"
out_f1 <- "hoge8.txt"
out_f2 <- "hoge8.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.05
param_FC <- 2
param_fig <- c(400, 380)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
#design <- model.matrix(~ as.factor(data.cl))
design <- model.matrix(~data.cl)
fit <- lmFit(data, design)
out <- eBayes(fit)
p.value <- out$p.value[,ncol(design)]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.05)
mean_G1 <- apply(as.matrix(data[,data.cl==1]), 1, mean)
mean_G2 <- apply(as.matrix(data[,data.cl==2]), 1, mean)
M <- mean_G2 - mean_G1
A <- (mean_G1 + mean_G2)/2
tmp <- cbind(rownames(data), data, M, A, p.value, q.value, ranking)
tmp <- tmp[order(ranking),]
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(A, M, xlab="A = (G2 + G1)/2", ylab="M = G2 - G1", cex=.1, pch=20)
grid(col="gray", lty="dotted")
obj <- as.logical(q.value < param_FDR)
points(A[obj], M[obj], col="magenta", cex=0.1, pch=20)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
abline(h=log2(param_FC), col="red")
abline(h=-log2(param_FC), col="red")
dev.off()
参考文献1の方法を用いて2群間で発現の異なる遺伝子をランキング。ROC curveに基づいてSAM統計量を計算したもの。
よく用いられているSAMよりも成績がいいとのこと(Choe et al., Genome Biol., 2005)。
余談ですが、samroc著者のBrobergさんは発現変動遺伝子(DEG)でないものnon-DEG (or nonDEG)の割合を見積もる方法についての論文も出してます(Broberg P, BMC Bioinformatics, 2005)。
出力ファイルの「p.value」列がp値、「ranking」列がp値に基づく順位、「q.value」列が任意のFDR閾値を満たすものを調べるときに用いるものです。
実用上はq.value = FDRという理解で差し支えありません。例えば、「FDR < 0.05」を満たすものはq.valueが0.05未満のものに相当します。
p値を閾値とする際には有意水準5%などというという用語を用いますが、事実上「p < 0.05」などという表現を用いるのと同じです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. サンプルデータ20の31,099 probesets×8 samplesのdata_rma_2_LIV.txt(G1群4サンプル vs. G2群4サンプル)の場合:
in_f <- "data_rma_2_LIV.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
param1 <- 2000
library(SAGx)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- samrocNboot(data=data, formula=~as.factor(data.cl), B=param1)
show(out)
p.value <- out@pvalues
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ24の31,099 probesets×10 samplesのdata_GSE30533_rma.txt(G1群5サンプル vs. G2群5サンプル)の場合:
in_f <- "data_GSE30533_rma.txt"
out_f <- "hoge2.txt"
param_G1 <- 50
param_G2 <- 52
param1 <- 2000
library(SAGx)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- samrocNboot(data=data, formula=~as.factor(data.cl), B=param1)
show(out)
p.value <- out@pvalues
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Significance Analysis of Microarrays (SAM)法。改良版t-statisticを用いて発現強度依存の偏りを補正すべく、従来のt-statisticの数式の分母に補正項(fudge factor)を付加しているところがポイント。
ここでは、「SAM統計量とその順位」および「log(FC)統計量とその順位」を出力結果として得るやり方を示します。また、入力データは対数変換後のものを想定(logged2=TRUE)しています。
出力ファイルの「p.value」列がp値、「ranking」列がp値に基づく順位、「q.value」列が任意のFDR閾値を満たすものを調べるときに用いるものです。
実用上はq.value = FDRという理解で差し支えありません。例えば、「FDR < 0.05」を満たすものはq.valueが0.05未満のものに相当します。
p値を閾値とする際には有意水準5%などというという用語を用いますが、事実上「p < 0.05」などという表現を用いるのと同じです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. サンプルデータ20の31,099 probesets×8 samplesのdata_rma_2_LIV.txt(G1群4サンプル vs. G2群4サンプル)の場合:
in_f <- "data_rma_2_LIV.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
param_perm <- 100
library(samr)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data.tmp <- list(x=as.matrix(data),
y=data.cl,
geneid=rownames(data),
genenames=rownames(data),
logged2=TRUE)
out <- samr(data.tmp, resp.type="Two class unpaired", nperms=param_perm)
summary(out)
p.value <- samr.pvalues.from.perms(out$tt, out$ttstar)
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
stat_fc <- log2(out$foldchange)
rank_fc <- rank(-abs(stat_fc))
tmp <- cbind(rownames(data), data, p.value, q.value, ranking, stat_fc, rank_fc)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ24の31,099 probesets×10 samplesのdata_GSE30533_rma.txt(G1群5サンプル vs. G2群5サンプル)の場合:
in_f <- "data_GSE30533_rma.txt"
out_f <- "hoge2.txt"
param_G1 <- 50
param_G2 <- 52
param_perm <- 20
library(samr)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data.tmp <- list(x=as.matrix(data),
y=data.cl,
geneid=rownames(data),
genenames=rownames(data),
logged2=TRUE)
out <- samr(data.tmp, resp.type="Two class unpaired", nperms=param_perm)
summary(out)
p.value <- samr.pvalues.from.perms(out$tt, out$ttstar)
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
stat_fc <- log2(out$foldchange)
rank_fc <- rank(-abs(stat_fc))
tmp <- cbind(rownames(data), data, p.value, q.value, ranking, stat_fc, rank_fc)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
等分散性を仮定したt検定を用いて、2群間での発現変動遺伝子の同定を行うやり方を示します。
出力ファイルの「p.value」列がp値、「ranking」列がp値に基づく順位、「q.value」列が任意のFDR閾値を満たすものを調べるときに用いるものです。
実用上はq.value = FDRという理解で差し支えありません。例えば、「FDR < 0.05」を満たすものはq.valueが0.05未満のものに相当します。
p値を閾値とする際には有意水準5%などというという用語を用いますが、事実上「p < 0.05」などという表現を用いるのと同じです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
クラスラベル情報ファイル(sample16_cl.txt)を利用するやり方です。
in_f1 <- "sample16_log.txt"
in_f2 <- "sample16_cl.txt"
out_f <- "hoge1.txt"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- read.table(in_f2, sep="\t", quote="")
data.cl <- hoge[,2] + 1
Students_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=T)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Students_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
クラスラベル情報ファイル(sample16_cl.txt)を利用しないやり方です。
in_f <- "sample16_log.txt"
out_f <- "hoge2.txt"
param_G1 <- 6
param_G2 <- 5
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
Students_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=T)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Students_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(p.value < 0.0015)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
10000行×6列分の標準正規分布に従う乱数です。G1群3サンプル vs. G2群3サンプルの2群間比較として解析を行っています。
乱数を発生させただけのデータなので、発現変動遺伝子(DEG)がない全てがnon-DEGのデータです。
in_f <- "sample22.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
Students_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=T)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Students_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
最初の3サンプルがG1群、残りの3サンプルがG2群の標準正規分布に従う乱数からなるシミュレーションデータです。
乱数発生後に、さらに最初の10% 分についてG1群に相当するところのみ数値を+3している(つまり10% がG1群で高発現というシミュレーションデータを作成している)
in_f <- "sample23.txt"
out_f <- "hoge4.txt"
param_G1 <- 3
param_G2 <- 3
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
Students_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=T)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Students_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param4 <- 0.05
sum(p.value < param4)
sum(q.value < 0.05)
sum(q.value < 0.10)
sum(q.value < 0.15)
sum(q.value < 0.20)
sum(q.value < 0.25)
4.と同じですが、関数の定義の仕方が異なります。
in_f <- "sample23.txt"
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- t(apply(data, 1, Students_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param4 <- 0.05
sum(p.value < param4)
sum(q.value < 0.05)
sum(q.value < 0.10)
sum(q.value < 0.15)
sum(q.value < 0.20)
sum(q.value < 0.25)
5.とほぼ同じですが、作業ディレクトリ中にStudents_ttest関数を含むR_functions.Rという名前のファイルが存在するという前提です。
in_f <- "sample23.txt"
out_f <- "hoge6.txt"
param_G1 <- 3
param_G2 <- 3
source("R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- t(apply(data, 1, Students_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param4 <- 0.05
sum(p.value < param4)
sum(q.value < 0.05)
sum(q.value < 0.10)
sum(q.value < 0.15)
sum(q.value < 0.20)
sum(q.value < 0.25)
10000行×6列分の標準正規分布に従う乱数です。G1群3サンプル vs. G2群3サンプルの2群間比較として解析を行っています。
乱数を発生させただけのデータなので、発現変動遺伝子(DEG)がない全てがnon-DEGのデータです。
genefilterパッケージ中のrowttests関数を用いるやり方です。
in_f <- "sample22.txt"
out_f <- "hoge7.txt"
param_G1 <- 3
param_G2 <- 3
library(genefilter)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- rowttests(data, as.factor(data.cl))
p.value <- out$p.value
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
不等分散性を仮定したt検定を用いて、2群間での発現変動遺伝子の同定を行うやり方を示します。
出力ファイルの「p.value」列がp値、「ranking」列がp値に基づく順位、「q.value」列が任意のFDR閾値を満たすものを調べるときに用いるものです。
実用上はq.value = FDRという理解で差し支えありません。例えば、「FDR < 0.05」を満たすものはq.valueが0.05未満のものに相当します。
p値を閾値とする際には有意水準5%などというという用語を用いますが、事実上「p < 0.05」などという表現を用いるのと同じです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
クラスラベル情報ファイル(sample16_cl.txt)を利用するやり方です。
in_f1 <- "sample16_log.txt"
in_f2 <- "sample16_cl.txt"
out_f <- "hoge1.txt"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- read.table(in_f2, sep="\t", quote="")
data.cl <- hoge[,2] + 1
Welch_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=F)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Welch_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(p.value < 0.0015)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
tmp[order(ranking),]
クラスラベル情報ファイル(sample16_cl.txt)を利用しないやり方です。
in_f <- "sample16_log.txt"
out_f <- "hoge2.txt"
param_G1 <- 6
param_G2 <- 5
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
Welch_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=F)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Welch_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
10000行×6列分の標準正規分布に従う乱数です。G1群3サンプル vs. G2群3サンプルの2群間比較として解析を行っています。
乱数を発生させただけのデータなので、発現変動遺伝子(DEG)がない全てがnon-DEGのデータです。
in_f <- "sample22.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
Welch_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=F)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Welch_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge4.txt"
param_G1 <- 50
param_G2 <- 52
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
Welch_ttest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
stat <- 0
pval <- 1
return(c(stat, pval))
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=F)
return(c(hoge$statistic, hoge$p.value))
}
}
out <- t(apply(data, 1, Welch_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge5.txt"
param_G1 <- 50
param_G2 <- 52
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- t(apply(data, 1, Welch_ttest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Mann-Whitney(マンホイットニー; MW) U検定を用いて、2群間での発現変動遺伝子の同定を行う。入力データは対数変換(log2変換)後のものを例として使用してはいますが、この方法はノンパラメトリックな方法なので、対数変換していようがいまいが同じ結果を返すので、特に気にする必要はありません。
出力ファイルの「p.value」列がp値、「ranking」列がp値に基づく順位、「q.value」列が任意のFDR閾値を満たすものを調べるときに用いるものです。
実用上はq.value = FDRという理解で差し支えありません。例えば、「FDR < 0.05」を満たすものはq.valueが0.05未満のものに相当します。
p値を閾値とする際には有意水準5%などというという用語を用いますが、事実上「p < 0.05」などという表現を用いるのと同じです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge1.txt"
param_G1 <- 50
param_G2 <- 52
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
MW_Utest <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
hoge <- wilcox.test(x.class1, x.class2)
return(c(hoge$statistic, hoge$p.value))
}
out <- t(apply(data, 1, MW_Utest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(p.value < 0.0015)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
head(tmp[order(ranking),])
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge2.txt"
param_G1 <- 50
param_G2 <- 52
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- t(apply(data, 1, MW_Utest, data.cl))
p.value <- out[,2]
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
パターンマッチング法を用いて、2群間での発現変動遺伝子の同定を行うやり方を紹介します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
クラスラベル情報ファイル(sample16_cl.txt)を利用するやり方です。
in_f1 <- "sample16_log.txt"
in_f2 <- "sample16_cl.txt"
out_f <- "hoge1.txt"
param <- "pearson"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- read.table(in_f2, sep="\t", quote="")
data.cl <- hoge[,2]
r <- apply(data, 1, cor, y=data.cl, method=param)
tmp <- cbind(rownames(data), data, r)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
クラスラベル情報ファイル(sample16_cl.txt)を利用しないやり方です。
in_f <- "sample16_log.txt"
out_f <- "hoge2.txt"
param_G1 <- 6
param_G2 <- 5
param <- "pearson"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
r <- apply(data, 1, cor, y=data.cl, method=param)
tmp <- cbind(rownames(data), data, r)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します(当然比較する二群のサンプル数は同じであるべき!):
Aさんの正常サンプル
Bさんの正常サンプル
Cさんの正常サンプル
...
Aさんの癌サンプル
Bさんの癌サンプル
Cさんの癌サンプル
...
ここでは二つの方法を紹介しています。
一つは有名なSAM(Tusher et al., 2001)のやりかたです。
もう一つはSAMで得られた統計量を基本としつつ、シグナル強度が高い遺伝子を上位にランキングするように重みをかけた統計量を返すやり方です。
これはWAD統計量(Kadota et al., 2008)の重みの項だけを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としているだけです。
ただし、G1群, G2群のサンプル数の違いを考慮する必要はあるので「平均シグナル強度= (mean(A) + mean(B))/2」です。
Significance Analysis of Microarrays (SAM)法で「対応ありの2群間比較(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
param_perm <- 60
library(samr)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(-(1:param1), 1:param1)
data.tmp <- list(x=as.matrix(data),
y=data.cl,
geneid=rownames(data),
genenames=rownames(data),
logged2=TRUE)
out <- samr(data.tmp, resp.type="Two class paired", nperms=param_perm)
summary(out)
p.value <- samr.pvalues.from.perms(out$tt, out$ttstar)
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
stat_fc <- log2(out$foldchange)
rank_fc <- rank(-abs(stat_fc))
tmp <- cbind(rownames(data), data, p.value, q.value, ranking, stat_fc, rank_fc)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Significance Analysis of Microarrays (SAM)法で「対応ありの2群間比較(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
param_perm <- 60
library(samr)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(-(1:param1), 1:param1)
data.tmp = list(x=as.matrix(data), y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)
out <- samr(data.tmp, resp.type="Two class paired", nperms=param_perm)
stat_sam <- out$tt
rank_sam <- rank(-abs(stat_sam))
data.cl <- c(rep(1, param1), rep(2, param1))
tmp.class1 <- apply(data[,data.cl == 1], 1, mean)
tmp.class2 <- apply(data[,data.cl == 2], 1, mean)
ave_vector <- (tmp.class1 + tmp.class2)/2
dr <- max(ave_vector) - min(ave_vector)
weight <- (ave_vector - min(ave_vector))/dr
stat_sam_wad <- stat_sam*weight
rank_sam_wad <- rank(-abs(stat_sam_wad))
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, weight, stat_sam_wad, rank_sam_wad)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します:
サンプルAの薬剤投与0h後
サンプルAの薬剤投与2h後
サンプルAの薬剤投与4h後
サンプルBの薬剤投与0h後
サンプルBの薬剤投与2h後
サンプルBの薬剤投与4h後
2013年6月に調査した結果をリストアップします。
解析 | 発現変動 | 時系列 | についてにリストアップした方法の中にも、このカテゴリーに属する解析が可能なものがあるかもしれません:
maSigProパッケージ(Conesa et al., 2006)を用いて
時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。おそらく以下のコマンドで抽出するやり方でいいと思います。
サンプルデータで示すような「Control (A)の時系列データ」と
「Cold (B)の時系列データ」が手元にあり、「A vs. Bで発現の異なる遺伝子」を検出したいときに利用します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f1 <- "sample10_2groups.txt"
in_f2 <- "sample10_2groups_cl.txt"
out_f <- "hoge.txt"
param_FDR <- 0.05
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,
time.col=1,
repl.col=2,
group.cols=c(3:ncol(edesign)))
fit <- p.vector(data, design, Q=param_FDR)
fit$i
fit$BH.alfa
fit$SELEC
hoge <- T.fit(fit, alfa=param_FDR)
hoge$sol
out <- get.siggenes(hoge, rsq=0.7, vars="groups")
gene_id <- out$summary$BvsA[1:out$sig.genes$BvsA$g]
gene_profile <- out$sig.genes$BvsA$sig.profiles
p.value <- out$sig.genes$BvsA$sig.pvalues[,1]
ranking <- rank(abs(p.value))
tmp <- cbind(gene_id, gene_profile, p.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(ranking),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します:
AさんのControlサンプル
BさんのControlサンプル
CさんのControlサンプル
Dさんの薬剤X刺激後サンプル
Eさんの薬剤X刺激後サンプル
Fさんの薬剤X刺激後サンプル
Gさんの薬剤X刺激後サンプル
Hさんの薬剤Y刺激後サンプル
Iさんの薬剤Y刺激後サンプル
Jさんの薬剤Y刺激後サンプル
Mulcomパッケージを用いて3群間比較を行うやり方を示します。とりあえず項目のみ。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
1. :
in_f <- "sample2_log.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 5
library(Mulcom)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
limmaパッケージを用いて3群間比較を行うやり方を示します。
ここでやっていることはANOVAのような「どこかの群間で発現に差がある遺伝子を検出」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で高発現、gene_1001〜gene_2000がG2群で高発現、gene_001〜gene_3000がG3群で高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
FDR閾値を満たす遺伝子数は、5%で2,892個、1%で2,450個と妥当な結果が得られています。
in_f <- "sample25.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ as.factor(data.cl))
fit <- lmFit(data, design)
out <- eBayes(fit)
hoge <- topTable(out, coef=2:3, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ20の31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
Affymetrix Rat Genome 230 2.0 Arrayを用いて得られたNakai et al., BBB, 2008のデータです。
8 褐色脂肪(BAT) vs. 8 白色脂肪(WAT) vs. 8 肝臓(LIV)の3群間比較用データとして取り扱います。
FDR 1%閾値を満たす遺伝子数は19,485個と非常に多いことが分かります。
in_f <- "data_rma_2.txt"
out_f <- "hoge2.txt"
param_G1 <- 8
param_G2 <- 8
param_G3 <- 8
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ as.factor(data.cl))
fit <- lmFit(data, design)
out <- eBayes(fit)
hoge <- topTable(out, coef=2:3, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
limmaパッケージを用いて3群間比較を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で高発現、gene_1001〜gene_2000がG2群で高発現、gene_001〜gene_3000がG3群で高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
ANOVAと同じく、どこかの群間で発現変動しているものを検出するやり方(帰無仮説: G1 = G2 = G3)です。
出力ファイルのq.value列を眺めると、DEGに相当する最初の1行目から3000行目のところのほとんどのq.valueが0.1程度未満、
それ以外の3001から10000行のほとんどのq.valueが比較的大きな数値なっていることからparam_coefでの指定方法が妥当であることが分かります。
in_f <- "sample25.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_coef <- c(2, 3)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ as.factor(data.cl))
fit <- lmFit(data, design)
out <- eBayes(fit)
hoge <- topTable(out, coef=param_coef, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G2群」の比較を行いたいときの指定方法(帰無仮説: G1 = G2)です。
出力ファイルのq.value列を眺めると、DEGに相当する最初の1行目から2000行目のところのほとんどのq.valueが0.1程度未満、
それ以外の2001から10000行のほとんどのq.valueが比較的大きな数値なっていることからparam_coefでの指定方法が妥当であることが分かります。
「full modelに相当するデザイン行列designの2列目のパラメータを除いたものをreduced modelとする」という指定に相当します。
in_f <- "sample25.txt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_coef <- 2
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ as.factor(data.cl))
fit <- lmFit(data, design)
out <- eBayes(fit)
hoge <- topTable(out, coef=param_coef, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G3群」の比較を行いたいときの指定方法(帰無仮説: G1 = G3)です。
出力ファイルのq.value列を眺めると、DEGに相当する最初の1-1000行目および2001-3000行目のところのほとんどのq.valueが0.1程度未満、
G2群で高発現DEGの1001から2000行目のほとんどのq.valueが比較的大きな数値になっていることからparam_coefでの指定方法が妥当であることが分かります。
「full modelに相当するデザイン行列designの3列目のパラメータを除いたものをreduced modelとする」という指定に相当します。
in_f <- "sample25.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_coef <- 3
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ as.factor(data.cl))
fit <- lmFit(data, design)
out <- eBayes(fit)
hoge <- topTable(out, coef=param_coef, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G2群 vs. G3群」の比較を行いたいときの指定方法(帰無仮説: G2 = G3)です。
出力ファイルのq.value列を眺めると、DEGに相当する最初の1001-3000行目のところのほとんどのq.valueが0.1程度未満である一方、
G1群で高発現DEGの1から1000行目のほとんどq.valueが比較的大きな数値となっていることから、param_contrastでの指定方法が妥当であることが分かります。
1-3.のようにparam_coefの枠組みではうまくG2 vs. G3をうまく表現できないので、コントラストという別の枠組みで指定しています。
思考回路としては、「a1*G1 + a2*G2 + a3*G3 = 0」として、この場合の目的である「G2 = G3という帰無仮説」を作成できるように、係数a1, a2, a3に適切な数値を代入することです。
ここではa1 = 0、a2 = -1, a3 = 1にすることで目的の帰無仮説を作成できます。
以下ではc(0, -1, 1)と指定していますが、
c(0, 1, -1)でも構いません。
理由はどちらでもG2 = G3を表現できているからです。
尚、full modelに相当するデザイン行列の作成手順も若干異なります。具体的には、model.matrix関数実行時に「0 + 」を追加しています。
これによって、最初の1列目が全て1になるようなG1群を基準にして作成したデザイン行列ではなく、各群が各列になるようにしています。
in_f <- "sample25.txt"
out_f <- "hoge4.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_contrast <- c(0, -1, 1)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ 0 + as.factor(data.cl))
fit <- lmFit(data, design)
fit2 <- contrasts.fit(fit, contrasts=param_contrast)
out <- eBayes(fit2)
hoge <- topTable(out, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G2群」の比較を行いたいときの指定方法(帰無仮説: G1 = G2)です。
出力ファイルのq.value列を眺めると、DEGに相当する最初の1-2000行目のところのほとんどのq.valueが0.1程度未満である一方、
G3群で高発現DEGの2001から3000行目のほとんどq.valueが比較的大きな数値となっていることから、param_contrastでの指定方法が妥当であることが分かります。
1-3.のようにparam_coefの枠組みではうまくG2 vs. G3をうまく表現できないので、コントラストという別の枠組みで指定しています。
思考回路としては、「a1*G1 + a2*G2 + a3*G3 = 0」として、この場合の目的である「G1 = G2という帰無仮説」を作成できるように、係数a1, a2, a3に適切な数値を代入することです。
ここではa1 = 1、a2 = -1, a3 = 0にすることで目的の帰無仮説を作成できます。
以下ではc(1, -1, 0)と指定していますが、
c(-1, 1, 0)でも構いません。理由はどちらでもG1 = G2を表現できているからです。
in_f <- "sample25.txt"
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_contrast <- c(1, -1, 0)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ 0 + as.factor(data.cl))
fit <- lmFit(data, design)
fit2 <- contrasts.fit(fit, contrasts=param_contrast)
out <- eBayes(fit2)
hoge <- topTable(out, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G3群」の比較を行いたいときの指定方法(帰無仮説: G1 = G3)です。
出力ファイルのq.value列を眺めると、DEGに相当する最初の1-1000行目および2001-3000行目のところのほとんどのq.valueが0.1程度未満である一方、
G2群で高発現DEGの1001から2000行目のほとんどq.valueが比較的大きな数値となっていることから、param_contrastでの指定方法が妥当であることが分かります。
1-3.のようにparam_coefの枠組みではうまくG2 vs. G3をうまく表現できないので、コントラストという別の枠組みで指定しています。
思考回路としては、「a1*G1 + a2*G2 + a3*G3 = 0」として、この場合の目的である「G1 = G3という帰無仮説」を作成できるように、係数a1, a2, a3に適切な数値を代入することです。
ここではa1 = 1、a2 = 0, a3 = -1にすることで目的の帰無仮説を作成できます。
以下ではc(1, 0, -1)と指定していますが、
c(-1, 0, 1)でも構いません。理由はどちらでもG1 = G3を表現できているからです。
in_f <- "sample25.txt"
out_f <- "hoge6.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_contrast <- c(1, 0, -1)
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
design <- model.matrix(~ 0 + as.factor(data.cl))
fit <- lmFit(data, design)
fit2 <- contrasts.fit(fit, contrasts=param_contrast)
out <- eBayes(fit2)
hoge <- topTable(out, n=nrow(data), sort.by="none")
p.value <- hoge$P.Value
q.value <- hoge$adj.P.Val
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
limmaパッケージを用いて3群間比較用データで、
総当たりの2群間比較を一気に行うやり方を示します。
トランスクリプトーム解析本の4.2.2節の記述形式に準拠しています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
Affymetrix Rat Genome 230 2.0 Array (GPL1355)を用いて得られた、
2群間比較用のデータGSE30533 (Kamei et al., PLoS One, 2013)です。
オリジナルは「G1群5サンプル vs. G2群5サンプル」ですが、ここでは、「G1群4サンプル vs. G2群3サンプル vs. G3群3サンプル」とみなして、
全ての組合せ(G1vsG2, G1vsG3, and G2vsG3)の2群間比較を一気に行い、それらのp値(3列分)、q値(3列分)、および順位情報(3列分)を出力するやり方です。
in_f <- "data_GSE30533_rma.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 3
param_G3 <- 3
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
cl <- as.factor(c(rep("G1",param_G1), rep("G2",param_G2), rep("G3",param_G3)))
design <- model.matrix(~ 0 + cl)
colnames(design) <- levels(cl)
fit <- lmFit(data, design)
contrast <- makeContrasts(
G1vsG2 = G1 - G2,
G1vsG3 = G1 - G3,
G2vsG3 = G2 - G3,
levels = design)
fit2 <- contrasts.fit(fit, contrast)
out <- eBayes(fit2)
p.value <- out$p.value
q.value <- apply(p.value, MARGIN=2, p.adjust, method="BH")
ranking <- apply(p.value, MARGIN=2, rank)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Affymetrix Rat Genome 230 2.0 Array (GPL1355)を用いて得られた、
2群間比較用のデータGSE30533 (Kamei et al., PLoS One, 2013)です。
オリジナルは「G1群5サンプル vs. G2群5サンプル」ですが、ここでは、「G1群4サンプル vs. G2群3サンプル vs. G3群3サンプル」とみなして、
全ての組合せ(G1vsG2, G1vsG3, and G2vsG3)の2群間比較を一気に行い、それらのp値(3列分)、q値(3列分)、および順位情報(3列分)を出力するやり方です。
上記に加え、param_FDRで指定した閾値を満たす遺伝子数を数えあげ、重なり具合をベン図で描画しています。
in_f <- "data_GSE30533_rma.txt"
out_f1 <- "hoge2.txt"
out_f2 <- "hoge2.png"
param_G1 <- 4
param_G2 <- 3
param_G3 <- 3
param_fig <- c(600, 400)
param_FDR <- 0.20
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
cl <- as.factor(c(rep("G1",param_G1), rep("G2",param_G2), rep("G3",param_G3)))
design <- model.matrix(~ 0 + cl)
colnames(design) <- levels(cl)
fit <- lmFit(data, design)
contrast <- makeContrasts(
G1vsG2 = G1 - G2,
G1vsG3 = G1 - G3,
G2vsG3 = G2 - G3,
levels = design)
fit2 <- contrasts.fit(fit, contrast)
out <- eBayes(fit2)
p.value <- out$p.value
q.value <- apply(p.value, MARGIN=2, p.adjust, method="BH")
ranking <- apply(p.value, MARGIN=2, rank)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
vennDiagram(decideTests(out, adjust.method="BH", p.value=param_FDR))
dev.off()
一元配置分散分析(One-way ANOVA)を用いて、多群間での発現変動遺伝子の同定を行う。ここでは対応のない3群(G1, G2, G3群)の解析例を示しています。が、この解析結果を受けて「”どこかの群間で差がある”とされた遺伝子に対して、ではどの群間で発現に差があるのか?」を調べるpost-hoc test(ポストホック検定;)を行うのは大変そうですね。
ちなみに一元配置分散分析に対するポストホック検定として用いられるのは「Tukey検定(総当り比較の場合)」や「Dunnet検定(コントロール群のみとの比較の場合)」らしいです。
マイクロアレイの場合、普通は「”どこかの群間で差がある”として絞り込まれた遺伝子群」に対して行う”その後の解析”はクラスタリングだろうと思っていましたが、結構真面目にpost hoc testをやっている人もいますね。
例えばNorris et al., 2005では、ANOVA p-value < 0.01でoverall statistical testをやっておいて、その後の検定(post hoc test)としてScheffe's post hoc testでp-value < 0.05を満たす、という基準を用いています(Mougeot et al., 2006も同じ流れ)。
また、Wu et al., 2007では、ANOVA p-value < 0.05でoverall statistical testをやっておいて、その後の検定(post hoc test)としてTukey’s multiple comparison procedure を採用しています。
その後の解析でクラスタリングを行っている論文としてはYagil et al., 2005やPoulsen et al., 2005(これらは2-way ANOVAですが...)が挙げられます。
ここでは例題として用いた「G1群6サンプル、G2群5サンプル」の計11サンプルからなる対数変換(log2変換)後のファイル(sample2_log.txt)のラベル情報が「G1群3サンプル、G2群3サンプル、G3群5サンプル」になっていると仮定します:
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample2_log.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. やり方1:
in_f <- "sample2_log.txt"
out_f <- "hoge.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 5
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
Oneway_anova <- function(x, cl){
hoge <- oneway.test(x ~ cl, var=T)
return(c(hoge$statistic, hoge$p.value))
}
out <- t(apply(data, 1, Oneway_anova, data.cl))
stat_f <- out[,1]
rank_f <- rank(-abs(stat_f))
p_f <- out[,2]
tmp <- cbind(rownames(data), data, stat_f, p_f, rank_f)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param4 <- 0.05
out_f2 <- "hoge2.txt"
sum(p_f < param4)
tmp2 <- tmp[p_f < param4,]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
out_f3 <- "hoge3.txt"
tmp2 <- tmp[order(rank_f),]
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)
2. やり方2(関数の定義の部分が少し違うだけです):
in_f <- "sample2_log.txt"
out_f <- "hoge.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 5
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
out <- t(apply(data, 1, Oneway_anova, data.cl))
stat_f <- out[,1]
rank_f <- rank(-abs(stat_f))
p_f <- out[,2]
tmp <- cbind(rownames(data), data, stat_f, p_f, rank_f)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param4 <- 0.05
out_f2 <- "hoge2.txt"
sum(p_f < param4)
tmp2 <- tmp[p_f < param4,]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
out_f3 <- "hoge3.txt"
tmp2 <- tmp[order(rank_f),]
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)
- Wu et al., BBRC., 2007
- Mougeot et al., J. Mol. Biol., 2006
- Norris et al., J. Neurosci., 2005
- Yagil et al., Circ. Res., 2005
- Poulsen et al., J. Neurochem., 2005
- Kerr et al., J. Comput. Biol., 2000
Kruskal-Wallis (KW)検定を用いて、多群間での発現変動遺伝子の同定を行う。ここでは対応のない3群(G1, G2, G3群)の解析例を示しています。が、この解析結果を受けて「”どこかの群間で差がある”とされた遺伝子に対して、ではどの群間で発現に差があるのか?」を調べるpost-hoc test(ポストホック検定;)を行うのは大変そうですね。ちなみにKruskal-Wallis検定に対するポストホック検定として用いられるのは「Nemenyi検定」や「ボンフェローニ補正Mann-Whitney検定」らしいです。この方法はPubMedで調べても、実際にはほとんど使われていないようですね。ANOVAのほうは非常に頻繁に用いられるようですが...。
ここでは例題として用いた「G1群6サンプル、G2群5サンプル」の計11サンプルからなる対数変換(log2変換)後のファイル(sample2_log.txt)のラベル情報が「G1群3サンプル、G2群3サンプル、G3群5サンプル」になっていると仮定します:
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample2_log.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. やり方1:
in_f <- "sample2_log.txt"
out_f <- "hoge.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 5
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
Kruskal_wallis <- function(x, cl){
hoge <- kruskal.test(x ~ cl)
return(c(hoge$statistic, hoge$p.value))
}
out <- t(apply(data, 1, Kruskal_wallis, data.cl))
stat_kw <- out[,1]
rank_kw <- rank(-abs(stat_kw))
p_kw <- out[,2]
tmp <- cbind(rownames(data), data, stat_kw, p_kw, rank_kw)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param4 <- 0.05
out_f2 <- "hoge2.txt"
sum(p_kw < param4)
tmp2 <- tmp[p_kw < param4,]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
out_f3 <- "hoge3.txt"
tmp2 <- tmp[order(rank_kw),]
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)
2. やり方2(関数の定義の部分が少し違うだけです):
in_f <- "sample2_log.txt"
out_f <- "hoge.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 5
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2), rep(3, param_G3))
out <- t(apply(data, 1, Kruskal_wallis, data.cl))
stat_kw <- out[,1]
rank_kw <- rank(-abs(stat_kw))
p_kw <- out[,2]
tmp <- cbind(rownames(data), data, stat_kw, p_kw, rank_kw)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param4 <- 0.05
out_f2 <- "hoge2.txt"
sum(p_kw < param4)
tmp2 <- tmp[p_kw < param4,]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
out_f3 <- "hoge3.txt"
tmp2 <- tmp[order(rank_kw),]
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)
手持ちのアレイデータが以下のような場合にこのカテゴリーに属す方法を適用します(色々な種類のサンプルが沢山ある場合):
サンプルA
サンプルB
サンプルC
サンプルD
サンプルE
サンプルF
サンプルG
サンプルH
サンプルI
サンプルJ
サンプルK
サンプルL
サンプルM
...
2013年6月に調査した結果をリストアップします。最近のものではBayesianIUTとSpeCondなどがR上で利用可能です。
- Dixon test:Greller and Tobin, Genome Res., 1999
- Pattern matching:Pavlidis and Noble, Genome Biol., 2001
- Ueda's AIC:Kadota et al., Physiol Genomics, 2003
- Tissue specificity index:Yanai et al., Bioinformatics, 2005
- Entropy:Schug et al., Genome Biol., 2005
- Sprent's non-parametric method:Ge et al., Genomics, 2005
- Tukey-Kramer’s HSD test:Liang et al., Physiol. Genomics, 2006
- ROKU:Kadota et al., BMC Bioinformatics, 2006
- BayesianIUT:Van Deun et al., Bioinformatics, 2009
- QDMR:Zhang et al., Nucleic Acids Res., 2011
- SpeCond:Cavalli et al., Genome Biol., 2011
- DSA:Zhong et al., BMC Bioinformatics, 2013
以下はROKU法に関する昔書いた記述です。
ROKUは二つの方法を組み合わせたものです。
- 「全体的な組織特異性の度合い」で遺伝子をランキング(エントロピーの低いものほどより組織特異的)
このとき、予めデータ変換したものに対してエントロピーを計算することで、組織特異的高発現だけでなく、
特異的低発現パターンなども検出可能という点でデータ変換せずにそのままエントロピーを計算するSchug's H(x) statisticよりも優れていることが>ROKU(Kadota et al., 2006)論文中で示されています。
- 「特異的なパターンを示す組織の検出」のために赤池情報量規準(AIC)に基づく方法で、特異的組織を外れ値として検出
単にエントロピーでランキングしただけでは、どこかの組織で特異的な遺伝子が上位にランキングされるだけで、どの組織で特異的なのかという情報は与えてくれません。そのために2番目の手順が必要になります。
ROKU論文中では単に「ここでは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の改良版そのもの、ですよね?!
SpeCondパッケージを用いて組織特異的発現遺伝子検出を行います。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
TCCパッケージで提供しているROKU法(Kadota et al., 2006)を用いて、遺伝子発現行列中の遺伝子を全体的な組織特異性の度合いでランキングします。
出力ファイル中の"modH"列の数値は、「ROKU論文中のAdditional file 1(Suppl.xls)の"H(x')"列の数値」と対応しています。つまり、データ変換後のエントロピー値です。
"ranking"列は、modHの値でランキングした結果です。"ranking"列で昇順にソートすることで、全体的な組織特異性の度合いでランキングしていることになります。
つまり、上位が「(どの組織で特異的かはこのスコアだけでは分からないが)組織特異性が高い遺伝子」ということになります。
残りの結果は「1:特異的高発現、-1:特異的低発現、0:その他」からなる「外れ値行列」です。
例えば、組織AとBで1, それ以外の組織で0を示す遺伝子(群)は「AとB特異的高発現遺伝子」と判断します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
log2変換後のデータであるという前提です。
in_f <- "sample21.txt"
out_f <- "hoge1.txt"
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- ROKU(data)
outlier <- hoge$outlier
modH <- hoge$modH
ranking <- hoge$rank
tmp <- cbind(rownames(data), outlier, modH, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
おまけのところで、「心臓特異的発現パターン」を示す遺伝子群を抽出するための"理想的なパターン(テンプレート)"
を含むファイル(GDS1096_cl_heart.txt)を読み込んでいます。
in_f <- "sample5.txt"
out_f <- "hoge2.txt"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
library(affy)
library(som)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.z <- normalize(data, byrow=TRUE)
out <- t(apply(data.z, 1, kadota_2003_physiol_genomics_0.25))
colnames(out) <- colnames(data)
entropy_score <- apply(data, 1, kadota_2006_bmc_bioinformatics)
tmp <- cbind(rownames(data), out, entropy_score)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
in_f2 <- "GDS1096_cl_heart.txt"
out_f2 <- "hoge2.txt"
library(genefilter)
data_cl <- read.table(in_f2, sep="\t", quote="")
template <- data_cl[,2]
tmp <- rbind(out, template)
closeg <- genefinder(tmp, nrow(out)+1, nrow(out))
obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0]
length(obj)
tmp <- cbind(rownames(data), data, entropy_score)
tmp2 <- tmp[obj,]
tmp3 <- tmp2[order(tmp2$entropy_score),]
write.table(tmp3, out_f2, sep="\t", append=F, quote=F, row.names=F)
out_f3 <- "hoge3.txt"
tmp <- cbind(rownames(data), out, entropy_score)
tmp2 <- tmp[order(entropy_score),]
write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)
おまけまでやって得られるhoge2.txtをエクセルなどで開くと、心臓特異的高発現遺伝子が231個検出されていることがわかります。ここまで(231個のうちのどれが一番特異的な遺伝子かなどはわからないということ)しかできなかったのがUeda's AIC-based methodですが、ROKUではエントロピーH(x')も計算するので、得られたサブセット内のランキング(hoge.txt中の“最後の列”H(x')の低い順にソート)が可能になりました。
Ge et al., Genomics, 86(2), 127-141, 2005で用いられた方法です。一つ一つの遺伝子の発現パターン(遺伝子発現ベクトルx)に対して、特異的高(and/or 低)発現組織の有無を一意的に返してくれるという点でUeda's AIC-based methodと同じです。ちなみにこの方法よりもUeda's AIC-based methodのほうが優れていることが参考文献1で示されています。
やっていることは非常にシンプルで、
- 各遺伝子発現ベクトルを独立に中央値を=0、MAD=1になるようにスケーリング
- データ変換後の値の絶対値がXより大きい組織を"特異的組織"とする
を行っているだけです。
ちなみにこのやり方を採用した原著論文(Ge et al., Genomics, 2005)ではX=5としているので、ここではX=5とした場合の解析例を示します。
以下を実行して得られるファイル(hoge.txt)中の結果は「1:特異的高発現、-1:特異的低発現、0:その他」からなる「外れ値行列」なので、
例えば、組織A and Bで1, それ以外の組織で0を示す遺伝子(群)は「AとB特異的高発現遺伝子」ということになります。
「ファイル」−「ディレクトリの変更」で解析したいファイル(遺伝子発現データ:sample5.txt、テンプレートパターン:GDS1096_cl_heart.txt)を置いてあるディレクトリに移動し、以下をコピペ
1. ...の場合:
in_f <- "sample5.txt"
out_f <- "hoge.txt"
param1 <- 5
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.t <- t(data)
data.t.m.mad <- scale(data.t, apply(data.t, 2, median), apply(data.t, 2, mad, constant=1))
data.m.mad <- t(data.t.m.mad)
out <- data.m.mad
out[(out <= param1) & (out >= -param1)] <- 0
out[out < -param1] <- -1
out[out > param1] <- 1
colnames(out) <- colnames(data)
tmp <- cbind(rownames(data), out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
in_f2 <- "GDS1096_cl_heart.txt"
out_f2 <- "hoge2.txt"
library(genefilter)
data_cl <- read.table(in_f2, sep="\t", quote="")
template <- data_cl[,2]
tmp <- rbind(out, template)
closeg <- genefinder(tmp, nrow(out)+1, nrow(out))
obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0]
length(obj)
tmp <- cbind(rownames(data[obj,]), data[obj,])
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
一つ一つの遺伝子の発現パターン(遺伝子発現ベクトルx)に対して、そのエントロピーH(x)を計算します。エントロピーが低い(最小値は0)ほど、その遺伝子の組織特異性の度合いが高いことを意味します。また逆に、エントロピーが高い(最大値はlog2(組織数); 例えば解析組織数が16の場合はlog2(16)=4が最大値となる)ほど、その遺伝子の組織特異性の度合いが低いことを意味します。
したがって、ここでは各遺伝子についてエントロピーH(x)を計算したのち、H(x)で昇順にソートした結果を出力するところまで行います。但し、エントロピーが低いからといって、どの組織で特異的発現を示すかまでは教えてくれないという弱点があるため、目的組織を指定することは原理的(数式的)に不可能です。
使い方としては、様々な実験条件のデータが手元にあった場合などで、「どの条件でもいいから特異的な発現パターンを示す遺伝子を上位からソートしたい」ような場合に使えますが、この方法の改良版ROKUのほうが、“組織特異的低発現パターンなど様々な特異的発現パターンを統一的にランキング可能である”という点において理論的にも実際上も優れているので、この目的においてはROKUを利用することをお勧めします。
「ファイル」−「ディレクトリの変更」で解析したい遺伝子発現行列のファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f <- "sample5.txt"
out_f <- "hoge.txt"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
entropy_score <- apply(data, 1, shannon.entropy)
tmp <- cbind(rownames(data), data, entropy_score)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(entropy_score),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
in_f <- "sample15.txt"
out_f <- "hoge.txt"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
entropy_score <- apply(data, 1, shannon.entropy)
tmp <- cbind(rownames(data), data, entropy_score)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(entropy_score),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
Schugらの方法(Entropy-based Q-statistic)を用いて、任意の1組織(と他の少数の組織)で特異的に発現している遺伝子をランキングします。Schug's H(x) statisticの方法は「どの組織で特異的発現を示すかまでは教えてくれない」という弱点がありました。その1つの解決策としてSchugらが提案している「指定した目的組織(と他の少数の組織)」で特異的な発現パターンを示す遺伝子を上位からランキングする統計量Qを計算します。
最終的に得られるhoge.txtファイルをエクセルなどで開いて、目的組織に相当するカラムでQ-statisticを昇順にソートすれば、目的組織特異的遺伝子をランキングすることができます。
しかし、この方法は目的組織以外の組織でも発現しているようなパターンが上位に来てしまう場合があるという弱点があります。この弱点を改善した方法がROKUです。
「ファイル」−「ディレクトリの変更」で解析したい遺伝子発現行列のファイル(sample5.txt)を置いてあるディレクトリに移動し、以下をコピペ
in_f <- "sample5.txt"
out_f <- "hoge.txt"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
entropy_score <- apply(data, 1, shannon.entropy)
q_score <- t(apply(data, 1, shannon.entropy.q))
tmp <- cbind(rownames(data), q_score, entropy_score)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
param1 <- 2
tmp2 <- tmp[order(q_score[,param1]),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
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特異的高発現遺伝子」ということになります。
「ファイル」−「ディレクトリの変更」で解析したいファイル(遺伝子発現データ:sample5.txt、テンプレートパターン:GDS1096_cl_heart.txt)を置いてあるディレクトリに移動し、以下をコピペ
in_f <- "sample5.txt"
out_f <- "hoge.txt"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
library(som)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.z <- normalize(data, byrow=TRUE)
out <- t(apply(data.z, 1, kadota_2003_physiol_genomics_0.50))
colnames(out) <- colnames(data)
tmp <- cbind(rownames(data), out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
in_f2 <- "GDS1096_cl_heart.txt"
out_f2 <- "hoge2.txt"
library(genefilter)
data_cl <- read.table(in_f2, sep="\t", quote="")
template <- data_cl[,2]
tmp <- rbind(out, template)
closeg <- genefinder(tmp, nrow(out)+1, nrow(out))
obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0]
length(obj)
tmp <- cbind(rownames(data[obj,]), data[obj,])
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
(基本的には、解析 | 似た発現パターンを持つ遺伝子の同定をご覧ください。)
パターンマッチング法を用いて、指定した理想的なパターンとの類似度が高い遺伝子の同定を行うやり方を紹介します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f1 <- "sample15.txt"
in_f2 <- "sample15_cl.txt"
out_f <- "hoge1.txt"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- read.table(in_f2, sep="\t", quote="")
data.cl <- hoge[,2]
r <- apply(data, 1, cor, y=data.cl)
tmp <- cbind(rownames(data), data, r)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. 相関係数の高い順(降順)にソートしたい場合:
in_f1 <- "sample15.txt"
in_f2 <- "sample15_cl.txt"
out_f <- "hoge2.txt"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- read.table(in_f2, sep="\t", quote="")
data.cl <- hoge[,2]
r <- apply(data, 1, cor, y=data.cl)
tmp <- cbind(rownames(data), data, r) tmp2 <- tmp[order(r, decreasing=TRUE),]
write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F)
3. 相関係数の低い順(昇順)にソートしたい場合:
in_f1 <- "sample15.txt"
in_f2 <- "sample15_cl.txt"
out_f <- "hoge3.txt"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- read.table(in_f2, sep="\t", quote="")
data.cl <- hoge[,2]
r <- apply(data, 1, cor, y=data.cl)
tmp <- cbind(rownames(data), data, r) tmp2 <- tmp[order(r, decreasing=FALSE),]
write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F)
手持ちのアレイデータが以下のような場合には「non-periodic genes」のカテゴリーに属す方法を適用し(いわゆる「経時変化遺伝子」を検出したいとき)、
24時間周期のような周期的に発現変動する遺伝子(circadian gene)を検出することが目的の場合には「Periodic genes」のカテゴリーに属す方法を適用します。
サンプルAの刺激後 0Hのデータ
サンプルAの刺激後 1Hのデータ
サンプルAの刺激後 6Hのデータ
サンプルAの刺激後24Hのデータ
2013年6月に調査した結果をリストアップします。Rで利用可能なのはGeneCycle, EMMIX-WIRE。
Periodic gene検出用
- Wichert's method (GeneCycleパッケージ):Wichert et al., Bioinformatics, 2004
- A model-based method:Luan and Li, Bioinformatics, 2004
- Fourier-score-based algorithm:de Lichtenberg et al, Bioinformatics, 2005
- Ahdesmaki's method (GeneCycleパッケージ):Ahdesmaki et al., BMC Bioinformatics, 2005
- Lomb-Scargle periodgram:Glynn et al., Bioinformatics, 2006
- C&G procedure:Chen J., BMC Bioinformatics, 2005
- Liew's method:Liew et al., BMC Bioinformatics, 2007
- M-estimator(GeneCycleパッケージ):Ahdesmaki et al., BMC Bioinformatics, 2007
- Laplace periodogram(MATLAB; リンク切れ):Liang and Wang, BMC Bioinformatics, 2009
- An empirical Bayes procedure (MATLAB):Chudova et al., Bioinformatics, 2009
- A permutation-based method (リンク切れ):Sohn et al., BMC Bioinformatics, 2009
- ARSER(BioClockというweb serverでも利用可能):Yang and Su, Bioinformatics, 2010
- SCM:Junier et al., Algorithms Mol. Biol., 2010
- LSPR(MATLAB; BioClockというweb serverでも利用可能):Yang et al., Bioinformatics, 2011
- Principal-oscillation-pattern:Wang et al., PLoS One, 2012
- EMMIX-WIRE(著者にメール):Wang et al., BMC Bioinformatics, 2012
- FPCA:Wu and Wu, BMC Bioinformatics, 2013
Non-periodic gene検出用
- samr:Tusher et al., PNAS, 2001
- maSigPro:Conesa et al., Bioinformatics, 2006
- ICA:Frigyesi et al., BMC Bioinformatics, 2006
- Ahnert's method:Ahnert et al., Bioinformatics, 2006
- Di Camillo's method:Di Camillo et al., BMC Bioinformatics, 2007
- TimeClust:Magni et al., Bioinformatics, 2008
- BATS (英語じゃないので何を書いてるのか不明...):Angelini et al., BMC Bioinformatics, 2008
- betr:Aryee et al., BMC Bioinformatics, 2009
- SEA (web tool):Nueda et al., Nucleic Acids Res., 2010
- PESTS (web tool):Sinha and Markatou, BMC Bioinformatics, 2011
- Gaussian processes (gptkパッケージ):Kalaitzis and Lawrence, BMC Bioinformatics, 2011
- BHC:Cooke et al., BMC Bioinformatics, 2011
- IPCA (mixOmicsパッケージ):Yao et al., BMC Bioinformatics, 2012
- Di Camillo's method:Di Camillo et al., PLoS One, 2012
- randomized BHC:Darkins et al., PLoS One, 2013
参考文献1, 2の方法を実装したものです。
「ファイル」−「ディレクトリの変更」で解析したいファイル(sample12.txt)を置いてあるディレクトリに移動し、以下をコピペ
「0, 15, 30, 45, 60, 75, 90, 105, 120, 135, 150minの計11 time points×1,444 genes (ORFs)からなる時系列データです。
in_f <- "sample12.txt"
out_f <- "hoge1.txt"
library(GeneCycle)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
out1 <- avgp(t(data))
out2 <- t(dominant.freqs(t(data),3))
tmp_p <- fisher.g.test(t(data))
tmp_fdr <- fdrtool(tmp_p, statistic="pvalue")
tmp_robust_p <- robust.g.test(robust.spectrum(t(data)))
p_gc <- tmp_fdr$pval
lfdr_gc <- tmp_fdr$lfdr
tmp <- cbind(rownames(data), data, p_gc, lfdr_gc)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param_FDR <- 0.1
sum(fdr_gc$lfdr < param_FDR)
avgp(t(data))
out2 <- t(dominant.freqs(t(data),3))
dim(out2)
周期性解析によく用いられる方法としてはFast Fourier Transform (FFT) アルゴリズムがありますが、この方法は1) time-pointの間隔が等しくなければいけない, 2) 欠損値があってはいけない、という制約がありました。
Lomb-Scargle periodogram(Glynn et al., Bioinformatics, 2006)を用いることで上記2つの条件を満たさない場合でもうまく取り扱ってくれるようです。もちろん、False Discovery Rate (FDR)をコントロールして有意なperiodicな発現パターンを検出してくれます。
- LombScargle.zipファイルをデスクトップにダウンロード
- R上ではなく(つまり、「パッケージ」-「ローカルにあるzipファイルからのパッケージのインストール」ではない!!ということ)、普通にLombScargle.zipファイルを解凍
- Step-by-Step Instructionsを参考にしながら、自分の時系列データを解析
BHCパッケージで利用可能なrandomized BHC法を用いて時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。
「ファイル」−「ディレクトリの変更」で解析したい時系列遺伝子発現データのファイルとその実験デザイン情報に関するファイルを置いてあるディレクトリに移動し、以下をコピペ
mixOmicsパッケージで利用可能なIPCA法を用いて時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。
「ファイル」−「ディレクトリの変更」で解析したい時系列遺伝子発現データのファイルとその実験デザイン情報に関するファイルを置いてあるディレクトリに移動し、以下をコピペ
gptkパッケージを用いて時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。
「ファイル」−「ディレクトリの変更」で解析したい時系列遺伝子発現データのファイルとその実験デザイン情報に関するファイルを置いてあるディレクトリに移動し、以下をコピペ
betrパッケージを用いて時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。
「ファイル」−「ディレクトリの変更」で解析したい時系列遺伝子発現データのファイルとその実験デザイン情報に関するファイルを置いてあるディレクトリに移動し、以下をコピペ
maSigPro(Conesa et al., 2006)パッケージを用いて時系列データの中から統計的に有意な発現の異なるプロファイルを検出します。
サンプルデータで示すような「あるサンプル(A)に刺激を与えて3h, 9h, and 27h後に測定した時系列データ」が手元にあり、
「経時的に発現の異なる遺伝子」を検出したい場合に行います。
ここではFDR("発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合; 0 < FDR <= 1)を0.5として計算した結果を示してありますが、
その閾値を満たす遺伝子数があまりにも少なくて困るような場合には最大で1.0まで設定することが可能です。もちろん最初からFDRを1.0に設定しておいて、(解析可能な)全遺伝子の結
果を眺めるという戦略でもいいと思います。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f1 <- "sample10_1group.txt"
in_f2 <- "sample10_1group_cl.txt"
out_f <- "hoge1.txt"
param_FDR <- 0.5
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)
fit <- p.vector(data, design, Q=param_FDR)
in_f1 <- "sample11_1group.txt"
in_f2 <- "sample11_1group_cl.txt"
out_f <- "hoge2.txt"
param_FDR <- 0.5
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)
fit <- p.vector(data, design, Q=param_FDR)
tstep <- T.fit(fit)
gene_profile <- tstep$sig.profiles
gene_id <- rownames(gene_profile)
p.value <- tstep$sol[,1]
ranking <- rank(abs(p.value))
tmp <- cbind(gene_id, gene_profile, p.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(ranking),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
Significance Analysis of Microarrays (SAM)法で「経時的に発現の変化する遺伝子」のランキングを行う。
注意点:例で用いているsample11_1group.txtの一行目のラベル情報(すなわち、"Time0.5","Time2","Time5","Time12.3","Time24")と同じ形式にしてください。"T_0.5"とか"Time_0.5"などとしてはいけません!
「ファイル」−「ディレクトリの変更」で解析したい対数変換(log2変換)後のファイルを置いてあるディレクトリに移動し、以下をコピペ
in_f <- "sample10_1group.txt"
out_f <- "hoge1.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), "_")
data.cl <- NULL
for(i in 1:ncol(data)){ data.cl[i] <- cl.tmp[[i]][1] }
data.cl <- paste(1, data.cl, sep="")
data.cl[1] <- paste(data.cl[1], "Start", sep="")
data.cl[ncol(data)] <- paste(data.cl[ncol(data)], "End", sep="")
data.tmp <- list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)
out <- samr(data.tmp, resp.type="One class timecourse", nperms=30, time.summary.type="slope")
stat_sam <- out$tt
rank_sam <- rank(-abs(stat_sam))
delta.table <- samr.compute.delta.table(out, min.foldchange=0, dels=NULL, nvals=100)
out2 <- samr.compute.siggenes.table(out, del, data.tmp, delta.table, min.foldchange=0, all.genes=T)
fdr.tmp <- as.numeric(c(out2$genes.up[,7], out2$genes.lo[,7]))
fdr.tmp <- fdr.tmp/100
names(fdr.tmp) <- c(out2$genes.up[,2], out2$genes.lo[,2])
fdr_sam <- fdr.tmp[rownames(data)]
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, fdr_sam)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(rank_sam),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
ここは修正すべし!
in_f1 <- "sample11_1group.txt"
in_f2 <- "sample11_1group_cl.txt"
out_f <- "hoge2.txt"
library(samr)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- paste(1, colnames(data), sep="")
data.cl[1] <- paste(data.cl[1], "Start", sep="")
data.cl[ncol(data)] <- paste(data.cl[ncol(data)], "End", sep="")
data.tmp <- list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)
out <- samr(data.tmp, resp.type="One class timecourse", nperms=30, time.summary.type="slope")
stat_sam <- out$tt
rank_sam <- rank(-abs(stat_sam))
delta.table <- samr.compute.delta.table(out, min.foldchange=0, dels=NULL, nvals=100)
out2 <- samr.compute.siggenes.table(out, del, data.tmp, delta.table, min.foldchange=0, all.genes=T)
fdr.tmp <- as.numeric(c(out2$genes.up[,7], out2$genes.lo[,7]))
fdr.tmp <- fdr.tmp/100
names(fdr.tmp) <- c(out2$genes.up[,2], out2$genes.lo[,2])
fdr_sam <- fdr.tmp[rownames(data)]
tmp <- cbind(rownames(data), data, stat_sam, rank_sam, fdr_sam)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(rank_sam),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
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個)は"偽物"という風に解釈します。
機能解析の実体は遺伝子セット解析です。遺伝子セット解析としてGO termを利用するのがGO解析です。
R用:
- globaltest:Goeman et al., Bioinformatics, 2004
- SAFE:Barry et al., Bioinformatics, 2005
- topGO:Alexa et al., Bioinformatics, 2006
- pcot2:Kong et al., Bioinformatics, 2006
- Category:Jiang et al., Bioinformatics, 2007
- GSA (作者のGSAウェブページ):Efron and Tibshirani, Ann. Appl. Stat., 2007
- dCoxS:Cho et al., BMC Bioinformatics, 2009
- GAGE:Luo et al., BMC Bioinformatics, 2009
- GOSemSim:Yu et al., Bioinformatics, 2010
- Camera (limmaの一部, 分かりづらい):We et al., Nucleic Acids Res., 2012
- RamiGO:Schröder et al., Bioinformatics, 2013
- LCT:Dinu et al., BMC Bioinformatics, 2013
- GSNCA法(GSARで提供されている):Rahmatallah et al., Bioinformatics, 2014
- TcGSA(時系列データ解析用):Hejblum et al., PLoS Comput Biol., 2015
- CompGO:Waardenberg et al., BMC Bioinformatics, 2015
- EnrichmentBrowser:Geistlinger et al., BMC Bioinformatics, 2016
- GOexpress:Rue-Albrecht et al., BMC Bioinformatics, 2016
- GSAR:Rahmatallah et al., BMC Bioinformatics, 2017
R以外:
- GSEA:Subramanian et al., PNAS, 2005
- GSEAのユーザーガイド
- 名前とプログラムなし:Jiang and Gentleman, Bioinformatics, 2007
- GeneTrail:Backes et al., NAR, 2007
- SAM-GS (Excel Add-Inらしい):Dinu et al., BMC Bioinformatics, 2007
- GSEA-P:Subramanian et al., Bioinformatics, 2007
- MR-GSE (プログラム自体は公開していない模様):Michaud et al., BMC Genomics, 2008
- GeneTrailExpress:Keller et al., BMC Bioinformatics, 2008
- QuickGO:Binns et al., Bioinformatics, 2009
- EnrichNet:Glaab et al., Bioinformatics, 2012
- JEPETTO:Winterhalter et al., Bioinformatics, 2014
- EDDY:Jung et al., Nucleic Acids Res., 2014
- MMGSA (プログラム公開の有無は不明):Khodakarim et al., Gene, 2014
GSEAに代表される発現変動遺伝子セット解析は、基本的にGSEAの開発者らが作成した様々な遺伝子セット情報を収めた
Molecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
それゆえ、自分がどの遺伝子セットについて機能解析を行いたいのかを予め決めておく必要がありますが、GO解析の場合はbiological process (BP)が一般的なようです。
2015/06/07時点は ver. 5.0、2017/03/08時点はver. 5.2です。
gmt形式ファイルの基本的なダウンロード方法は以下の通りです:
- Molecular Signatures Database (MSigDB)の
「register」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、目的に応じたgmtファイルをダウンロードしておく。
「c5: gene ontology gene sets」の「bp: biological process」を解析する場合:c5.bp.v5.0.symbols.gmt
「c5: gene ontology gene sets」の「cc: cellular components」を解析する場合:c5.cc.v5.0.symbols.gmt
「c5: gene ontology gene sets」の「mf: molecular functions」を解析する場合:c5.mf.v5.0.symbols.gmt
GSARパッケージを用いた解析のやり方を示します。
GSARは、様々なプログラム群からなるパッケージです。
ここでは、GSARで提供されているGene Sets Net Correlations Analysis法(GSNCA; Rahmatallah et al., 2014)を実行するやり方を示します。
オリジナルのprobeset IDからgene symbolにID変換がなされた発現データファイルを入力としています。
これは、「イントロ | アノテーション情報取得 | GEOquery(Davis_2007)」
で入手したprobeset IDとgene symbolの対応表のファイル、およびオリジナルのprobeset IDごとの発現データファイルを用いて
「前処理 | ID変換 | probe ID --> gene symbol」
でID変換したものです。gmtファイルは、MSigDB
(Subramanian et al., PNAS, 2005)から任意のものをダウンロードしてください。
尚、gmtファイルの読み込みにはGSAパッケージ
(Efron and Tibshirani, 2007)中のGSA.read.gmt関数を利用しています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
14,132 genes×24 samplesのデータです。BAT_fed vs. BAT_fastedの2群間比較を行うべく、それらの位置情報を指定しています。
「解析 | 機能解析 | パスウェイ(Pathway)解析 | GSAR (Rahmatallah_2017)」の例題7と
「解析 | 機能解析 | 遺伝子オントロジー(GO)解析 | GSA (Efron_2007)」の例題3を合わせたものです。
ここでは、"STEROID_BIOSYNTHETIC_PROCESS"という遺伝子セットのネットワーク図をpngファイルに出力させています。
in_f1 <- "data_mas_EN_symbol.txt"
in_f2 <- "c5.bp.v5.0.symbols.gmt"
out_f <- "hoge1.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
param_posi <- c(1:4, 5:8)
param <- "STEROID_BIOSYNTHETIC_PROCESS"
param_fig <- c(700, 650)
library(GSAR)
library(GSA)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data <- data[,param_posi]
colnames(data)
hoge <- GSA.read.gmt(in_f2)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
set.seed(1053)
hoge <- gmt[[param]]
length(hoge)
obj <- is.element(rownames(data), hoge)
sum(obj)
p.value <- GSNCAtest(data[obj, ], data.cl)
p.value
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plotMST2.pathway(object=data[obj, ],
group=data.cl, name=param,
legend.size=1.2, leg.x=-1.2,
leg.y=2, label.size=1,
label.dist=0.8, cor.method="pearson")
dev.off()
14,132 genes×24 samplesのデータです。BAT_fed vs. BAT_fastedの2群間比較を行うべく、それらの位置情報を指定しています。
「解析 | 機能解析 | パスウェイ(Pathway)解析 | GSAR (Rahmatallah_2017)」の例題7と
「解析 | 機能解析 | 遺伝子オントロジー(GO)解析 | GSA (Efron_2007)」の例題3を合わせたものです。
ここでは、"STEROID_BIOSYNTHETIC_PROCESS"という遺伝子セットのネットワーク図をpngファイルに出力させています。
in_f1 <- "data_rma_2_nr.txt"
in_f2 <- "c5.bp.v5.0.symbols.gmt"
out_f <- "hoge2.png"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
param_posi <- c(1:4, 5:8)
param <- "STEROID_BIOSYNTHETIC_PROCESS"
param_fig <- c(700, 650)
library(GSAR)
library(GSA)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data <- data[,param_posi]
colnames(data)
hoge <- GSA.read.gmt(in_f2)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
set.seed(1053)
hoge <- gmt[[param]]
length(hoge)
obj <- is.element(rownames(data), hoge)
sum(obj)
p.value <- GSNCAtest(data[obj, ], data.cl)
p.value
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plotMST2.pathway(object=data[obj, ],
group=data.cl, name=param,
legend.size=1.2, leg.x=-1.2,
leg.y=2, label.size=1,
label.dist=0.8, cor.method="pearson")
dev.off()
gageパッケージを用いた解析のやり方を示します。
原著論文では方法名はGAGEですが、Rパッケージ名はgageです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
GSAパッケージを用いた解析のやり方を示します。
オリジナルのprobeset IDからgene symbolにID変換がなされた発現データファイルを入力としています。
これは、「イントロ | アノテーション情報取得 | GEOquery(Davis_2007)」
で入手したprobeset IDとgene symbolの対応表のファイル、およびオリジナルのprobeset IDごとの発現データファイルを用いて
「前処理 | ID変換 | probe ID --> gene symbol」
でID変換したものです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
肝臓のみからなる14,132 genes×8 samplesのデータです。LIV_fed vs. LIV_fastedの2群間比較です。
in_f1 <- "data_rma_2_nr_LIV.txt"
in_f2 <- "c5.bp.v5.0.symbols.gmt"
out_f1 <- "hoge1_G1.txt"
out_f2 <- "hoge1_G2.txt"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
library(GSA)
gmt <- GSA.read.gmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- GSA(data, data.cl,
genesets=gmt$genesets,
genenames=rownames(data),
resp.type="Two class unpaired")
tmp <- GSA.listsets(out,
geneset.names=gmt$geneset.names,
maxchar=max(nchar(gmt$geneset.names)),
FDRcut=param_FDR)
write.table(tmp$negative, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(tmp$positive, out_f2, sep="\t", append=F, quote=F, row.names=F)
14,132 genes×24 samplesのデータです。
LIV_fed vs. LIV_fastedの2群間比較を行うべく、それらの位置情報を指定しています。
in_f1 <- "data_rma_2_nr.txt"
in_f2 <- "c5.bp.v5.0.symbols.gmt"
out_f1 <- "hoge2_G1.txt"
out_f2 <- "hoge2_G2.txt"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
param_posi <- c(17:20, 21:24)
library(GSA)
gmt <- GSA.read.gmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data <- data[,param_posi]
colnames(data)
out <- GSA(data, data.cl,
genesets=gmt$genesets,
genenames=rownames(data),
resp.type="Two class unpaired")
tmp <- GSA.listsets(out,
geneset.names=gmt$geneset.names,
maxchar=max(nchar(gmt$geneset.names)),
FDRcut=param_FDR)
write.table(tmp$negative, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(tmp$positive, out_f2, sep="\t", append=F, quote=F, row.names=F)
14,132 genes×24 samplesのデータです。BAT_fed vs. BAT_fastedの2群間比較を行うべく、それらの位置情報を指定しています。
in_f1 <- "data_rma_2_nr.txt"
in_f2 <- "c5.bp.v5.0.symbols.gmt"
out_f1 <- "hoge3_G1.txt"
out_f2 <- "hoge3_G2.txt"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
param_posi <- c(1:4, 5:8)
library(GSA)
gmt <- GSA.read.gmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data <- data[,param_posi]
colnames(data)
out <- GSA(data, data.cl,
genesets=gmt$genesets,
genenames=rownames(data),
resp.type="Two class unpaired")
tmp <- GSA.listsets(out,
geneset.names=gmt$geneset.names,
maxchar=max(nchar(gmt$geneset.names)),
FDRcut=param_FDR)
write.table(tmp$negative, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(tmp$positive, out_f2, sep="\t", append=F, quote=F, row.names=F)
3.と基本的に同じですが、並べ替え検定時の並べ替え回数(nperms;デフォルトは200)を自在に変更するやり方です。
in_f1 <- "data_rma_2_nr.txt"
in_f2 <- "c5.bp.v5.0.symbols.gmt"
out_f1 <- "hoge4_G1.txt"
out_f2 <- "hoge4_G2.txt"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
param_posi <- c(1:4, 5:8)
param_perm <- 100
library(GSA)
gmt <- GSA.read.gmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data <- data[,param_posi]
colnames(data)
out <- GSA(data, data.cl,
genesets=gmt$genesets,
genenames=rownames(data),
resp.type="Two class unpaired",
nperms=param_perm)
tmp <- GSA.listsets(out,
geneset.names=gmt$geneset.names,
maxchar=max(nchar(gmt$geneset.names)),
FDRcut=param_FDR)
write.table(tmp$negative, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(tmp$positive, out_f2, sep="\t", append=F, quote=F, row.names=F)
Categoryパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
pcot2パッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
globaltestパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
SAFEパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
globaltestパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
機能解析の実体は遺伝子セット解析です。遺伝子セット解析としてKEGGなどのパスウェイ情報を利用するのがパスウェイ解析です。
R用:
- GSA (作者のGSAウェブページ):Efron and Tibshirani, Ann. Appl. Stat., 2007
- SPIA:Tarca et al., Bioinformatics, 2009
- dCoxS:Cho et al., BMC Bioinformatics, 2009
- GAGE:Luo et al., BMC Bioinformatics, 2009
- PADOG:Tarca et al., BMC Bioinformatics, 2012
- Pathview:Luo et al., Bioinformatics, 2013
- GSNCA法(GSARで提供されている):Rahmatallah et al., Bioinformatics, 2014
- TcGSA(時系列データ解析用):Hejblum et al., PLoS Comput Biol., 2015
- EnrichmentBrowser:Geistlinger et al., BMC Bioinformatics, 2016
- GSAR:Rahmatallah et al., BMC Bioinformatics, 2017
R以外:
- PLAGE(リンク切れ):Tomfohr et al., BMC Bioinformatics, 2005
- GSEA:Subramanian et al., PNAS, 2005
- GSEAのユーザーガイド
- ToppGene Suite(loginも要求なし; webtool):Chen et al., Nucleic Acids Res., 2009
- PINTA(loginも要求なし; webtool):Nitsch et al., Nucleic Acids Res., 2011
- FIDEA(loginも要求なし; webtool):D'Andrea et al., Nucleic Acids Res., 2013
Review、ガイドライン、パイプライン系:
- 手法比較:Abatangelo et al., BMC Bioinformatics, 2009
- Review:Khatri H, PLoS Comput Biol., 2012
- Review:Maciejewski H, Brief Bioinform., 2013
- 手法比較:Alavi-Majd et al., Gene, 2014
- 手法比較:Tarca et al., PLoS One, 2013
- 手法比較:Bayerlová et al., BMC Bioinformatics, 2016
- 手法比較:Mathur et al., BioData Min., 2018
遺伝子セットDB系:
- MSigDB:Subramanian et al., PNAS, 2005
- hiPathDB:Yu et al., Nucleic Acids Res., 2012
- IPAVS:Sreenivasaiah et al., Nucleic Acids Res., 2012
- PAGED:Huang et al., BMC Bioinformatics, 2012
- IPAD:Zhang et al., BMC Bioinformatics, 2012
- GeneSetDB:Araki et al., FEBS Open Bio, 2012
GSEAに代表される発現変動遺伝子セット解析は、基本的にGSEAの開発者らが作成した様々な遺伝子セット情報を収めた
Molecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
それゆえ、自分がどの遺伝子セットについて機能解析を行いたいのかを予め決めておく必要がありますが、
パスウェイ解析の場合はc2のBioCarta, KEGG, Reactomeあたりを解析するのでしょう。
2015/06/07時点は ver. 5.0、2017/03/08時点はver. 5.2です。
gmt形式ファイルの基本的なダウンロード方法は以下の通りです:
- Molecular Signatures Database (MSigDB)の
「register」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、目的に応じたgmtファイルをダウンロード。
「c2: curated gene sets」の「all canonical pathways, gene symbols」を解析する場合:c2.cp.v5.0.symbols.gmt
「c2: curated gene sets」の「BioCarta gene sets, gene symbols」を解析する場合:c2.cp.biocarta.v5.0.symbols.gmt
「c2: curated gene sets」の「KEGG gene sets, gene symbols」を解析する場合:c2.cp.kegg.v5.0.symbols.gmt
「c2: curated gene sets」の「Reactome gene sets, gene symbols」を解析する場合:c2.cp.reactome.v5.0.symbols.gmt
GSARパッケージを用いた解析のやり方を示します。
GSARは、様々なプログラム群からなるパッケージです。
ここでは、GSARで提供されているGene Sets Net Correlations Analysis法(GSNCA; Rahmatallah et al., 2014)を実行するやり方を示します。
オリジナルのprobeset IDからgene symbolにID変換がなされた発現データファイルを入力としています。
これは、「イントロ | アノテーション情報取得 | GEOquery(Davis_2007)」
で入手したprobeset IDとgene symbolの対応表のファイル、およびオリジナルのprobeset IDごとの発現データファイルを用いて
「前処理 | ID変換 | probe ID --> gene symbol」
でID変換したものです。gmtファイルは、MSigDB
(Subramanian et al., PNAS, 2005)から任意のものをダウンロードしてください。
尚、gmtファイルの読み込みにはGSAパッケージ
(Efron and Tibshirani, 2007)中のGSA.read.gmt関数を利用しています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. GSARの解析例として示されているp53 datasetの場合:
p53DataSetという名前の8,655 genes×50 samplesのデータです。
17 wild-type (WT) samples vs. 33 mutant (MUT) samplesの2群間比較です。
gmtファイルは、MSigDB (ver. 5.2)の
C2: curated gene sets中の
全データファイル(c2.all.v5.2.symbols.gmt)を利用しています。
この中に解析例で取り扱っている遺伝子セット("LU_TUMOR_VASCULATURE_UP")が含まれています。
ここでは、"LU_TUMOR_VASCULATURE_UP"を構成する遺伝子群(29 genes)の中から、
発現データ中に存在するもの(22 genes)に対してGSNCA法を適用した結果のp-value (= 0.02797)を出力するところまでを示します。
p-value = 0.02797という結果は、比較する2群間(WT vs. MUT)でこの遺伝子セットの発現の相関に差がない(帰無仮説)確率が2.797%しかないことを意味します。
1つの判断基準として、(建前上)有意水準α = 0.05を設定していたのなら、帰無仮説が本当は正しいが間違って棄却してしまう確率を5%に設定したことに相当し、
この場合はp-value < 0.05なので帰無仮説を棄却し対立仮説(差がある)を採択することになります。
in_f <- "c2.all.v5.2.symbols.gmt"
param_G1 <- 17
param_G2 <- 33
param <- "LU_TUMOR_VASCULATURE_UP"
library(GSAR)
library(GSA)
hoge <- GSA.read.gmt(in_f)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
data(p53DataSet)
data <- p53DataSet
rownames(data) <- toupper(rownames(data))
dim(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
set.seed(1053)
hoge <- gmt[[param]]
length(hoge)
obj <- is.element(rownames(data), hoge)
sum(obj)
p.value <- GSNCAtest(data[obj, ], data.cl)
p.value
2. GSARの解析例として示されているp53 datasetの場合:
1.と基本的に同じですが、さらに相関ネットワーク(correlation network)図も描いています。
グループごとに独立にネットワークが描画され、Group1(WT)の相関ネットワークが左側に、
そしてGroup2(MUT)の相関ネットワークが右側に描画されます。
p-value = 0.02797の遺伝子セットの相関ネットワークなので、差がある(i.e., あまりにも似ていない)ことがわかっています。
図の上のほうに、グループごとの最有力遺伝子(most influential genes or hub genes)が示されています。
この場合は、Group1(WT)がTNFAIP6、そしてGroup2(MUT)がVCANとなっていることがわかります。
この図自体はp-valueの大小に関わらず描くことができます。
in_f <- "c2.all.v5.2.symbols.gmt"
param_G1 <- 17
param_G2 <- 33
param <- "LU_TUMOR_VASCULATURE_UP"
library(GSAR)
library(GSA)
hoge <- GSA.read.gmt(in_f)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
data(p53DataSet)
data <- p53DataSet
rownames(data) <- toupper(rownames(data))
dim(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
set.seed(1053)
hoge <- gmt[[param]]
length(hoge)
obj <- is.element(rownames(data), hoge)
sum(obj)
p.value <- GSNCAtest(data[obj, ], data.cl)
p.value
plotMST2.pathway(object=data[obj, ],
group=data.cl, name=param,
legend.size=1.2, leg.x=-1.2,
leg.y=2, label.size=1,
label.dist=0.8, cor.method="pearson")
3. GSARの解析例として示されているp53 datasetの場合:
2.と基本的に同じですが、相関ネットワーク(correlation network)図をpngファイルに保存しています。
in_f <- "c2.all.v5.2.symbols.gmt"
out_f <- "hoge3.png"
param_G1 <- 17
param_G2 <- 33
param <- "LU_TUMOR_VASCULATURE_UP"
param_fig <- c(700, 650)
library(GSAR)
library(GSA)
hoge <- GSA.read.gmt(in_f)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
data(p53DataSet)
data <- p53DataSet
rownames(data) <- toupper(rownames(data))
dim(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
set.seed(1053)
hoge <- gmt[[param]]
length(hoge)
obj <- is.element(rownames(data), hoge)
sum(obj)
p.value <- GSNCAtest(data[obj, ], data.cl)
p.value
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plotMST2.pathway(object=data[obj, ],
group=data.cl, name=param,
legend.size=1.2, leg.x=-1.2,
leg.y=2, label.size=1,
label.dist=0.8, cor.method="pearson")
dev.off()
4. GSARの解析例として示されているp53 datasetの場合:
gmtファイル中の遺伝子セット全体に対して、GSNCA法を遺伝子セットごとに適用するやり方です。
遺伝子セット中の遺伝子リストを発現データ中に含まれるものに限定したのち(前処理)、
遺伝子数が18以上40以下の遺伝子セットに限定して
GSNCA法を適用しています。1,324遺伝子セットの計算で約80分。
実際の局面では、10以上500以下くらいでやるといいと思います(それでも約5000遺伝子セットで約2時間)。
出力結果はhoge4.txtと同じような感じになると思います。
1列目が遺伝子セット名、2列目が遺伝子数、3列目がGSNCA法実行結果のp-valueです。
尚、2列目の遺伝子数は、発現データ中に含まれる遺伝子セットを構成する遺伝子数であり、入力のgmtファイル中の遺伝子数と同じかそれよりも少ない数になります。
in_f <- "c2.all.v5.2.symbols.gmt"
out_f <- "hoge4.txt"
param_G1 <- 17
param_G2 <- 33
param_min <- 18
param_max <- 40
library(GSAR)
library(GSA)
hoge <- GSA.read.gmt(in_f)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
data(p53DataSet)
data <- p53DataSet
rownames(data) <- toupper(rownames(data))
dim(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
obj <- lapply(gmt, is.element, rownames(data))
gmt2 <- list()
for(i in 1:length(gmt)){
uge <- obj[[i]]
gmt2 <- append(gmt2, list(gmt[[i]][uge]))
}
names(gmt2) <- names(gmt)
set.seed(1053)
p.value <- TestGeneSets(object=data, group=data.cl,
geneSets=gmt2, min.size=param_min,
max.size=param_max, test="GSNCAtest")
tmp <- cbind(names(p.value), sapply(gmt2[names(p.value)], length), p.value)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
5. サンプルデータ27の8,655 genes×50 samplesのアレイデータ(sample27.txt; 約7.3MB)の場合:
4.と基本的に同じで、発現データをファイルから読み込んでいるだけです。出力ファイルは、p-valueで昇順(低い -> 高い)にソートしています。
ファイル出力直前のソートは、このページの通常の書き方と異なっています。tmp[order(unlist(p.value)),]のunlist(p.value)の部分です。
このページでは通常tmp[order(tmp$p.value),]のようにtmp$p.valueのような書き方をしますが、これだとエラーが出るからです。
尚、5.と6.は同じ結果になりますが、計算時間は5.は約80分で6.は約40分と2倍ほど高速ですので6.のほうがおススメです。
in_f1 <- "sample27.txt"
in_f2 <- "c2.all.v5.2.symbols.gmt"
out_f <- "hoge5.txt"
param_G1 <- 17
param_G2 <- 33
param_min <- 18
param_max <- 40
library(GSAR)
library(GSA)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data <- as.matrix(data)
dim(data)
hoge <- GSA.read.gmt(in_f2)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
obj <- lapply(gmt, is.element, rownames(data))
gmt2 <- list()
for(i in 1:length(gmt)){
uge <- obj[[i]]
gmt2 <- append(gmt2, list(gmt[[i]][uge]))
}
names(gmt2) <- names(gmt)
set.seed(1053)
p.value <- TestGeneSets(object=data, group=data.cl,
geneSets=gmt2, min.size=param_min,
max.size=param_max, test="GSNCAtest")
tmp <- cbind(names(p.value), sapply(gmt2[names(p.value)], length), p.value)
tmp <- tmp[order(unlist(p.value)), ]
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
6. サンプルデータ27の8,655 genes×50 samplesのアレイデータ(sample27.txt; 約7.3MB)の場合:
5.と同じですが、遺伝子数が18以上40以下の遺伝子セットに限定するのを
TestGeneSets関数を実行する前に独立にやっています。GSARのマニュアルとは異なりますが、6.のほうが高速です。
in_f1 <- "sample27.txt"
in_f2 <- "c2.all.v5.2.symbols.gmt"
out_f <- "hoge6.txt"
param_G1 <- 17
param_G2 <- 33
param_min <- 18
param_max <- 40
library(GSAR)
library(GSA)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data <- as.matrix(data)
dim(data)
hoge <- GSA.read.gmt(in_f2)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
obj <- lapply(gmt, is.element, rownames(data))
gmt2 <- list()
for(i in 1:length(gmt)){
uge <- obj[[i]]
gmt2 <- append(gmt2, list(gmt[[i]][uge]))
}
names(gmt2) <- names(gmt)
obj <- (sapply(gmt2, length) >= param_min)
gmt3 <- gmt2[obj]
obj <- (sapply(gmt3, length) <= param_max)
gmt3 <- gmt3[obj]
length(gmt3)
set.seed(1053)
p.value <- TestGeneSets(object=data, group=data.cl,
geneSets=gmt2, min.size=param_min,
max.size=param_max, test="GSNCAtest")
tmp <- cbind(names(p.value), sapply(gmt2[names(p.value)], length), p.value)
tmp <- tmp[order(unlist(p.value)), ]
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
7. サンプルデータ27の8,655 genes×50 samplesのアレイデータ(sample27.txt; 約7.3MB)の場合:
3.と基本的に同じですが、発現データファイルを読み込ませている点が異なります。
また、set.seed(1053)として、乱数を発生させる際のタネ番号を3.と同じにしているので、結果が全く同じになるはずですが、
ネットワーク図が若干異なっている現象は確認済みです。どなたか理由が分かった方は教えてくださいm(_ _)m
in_f1 <- "sample27.txt"
in_f2 <- "c2.all.v5.2.symbols.gmt"
out_f <- "hoge7.png"
param_G1 <- 17
param_G2 <- 33
param <- "LU_TUMOR_VASCULATURE_UP"
param_fig <- c(700, 650)
library(GSAR)
library(GSA)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data <- as.matrix(data)
dim(data)
hoge <- GSA.read.gmt(in_f2)
gmt <- hoge$genesets
names(gmt) <- hoge$geneset.names
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
set.seed(1053)
hoge <- gmt[[param]]
length(hoge)
obj <- is.element(rownames(data), hoge)
sum(obj)
p.value <- GSNCAtest(data[obj, ], data.cl)
p.value
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plotMST2.pathway(object=data[obj, ],
group=data.cl, name=param,
legend.size=1.2, leg.x=-1.2,
leg.y=2, label.size=1,
label.dist=0.8, cor.method="pearson")
dev.off()
Pathviewパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
gageパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
SPIAパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
GSAパッケージを用いた解析のやり方を示します。
オリジナルのprobeset IDからgene symbolにID変換がなされた発現データファイルを入力としています。
これは、「イントロ | アノテーション情報取得 | GEOquery(Davis_2007)」
で入手したprobeset IDとgene symbolの対応表のファイル、およびオリジナルのprobeset IDごとの発現データファイルを用いて
「前処理 | ID変換 | probe ID --> gene symbol」
でID変換したものです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
肝臓のみからなる14,132 genes×8 samplesのデータです。LIV_fed vs. LIV_fastedの2群間比較です。
in_f1 <- "data_rma_2_nr_LIV.txt"
in_f2 <- "c2.cp.kegg.v5.0.symbols.gmt"
out_f1 <- "hoge1_G1.txt"
out_f2 <- "hoge1_G2.txt"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
library(GSA)
gmt <- GSA.read.gmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
out <- GSA(data, data.cl,
genesets=gmt$genesets,
genenames=rownames(data),
resp.type="Two class unpaired")
tmp <- GSA.listsets(out,
geneset.names=gmt$geneset.names,
maxchar=max(nchar(gmt$geneset.names)),
FDRcut=param_FDR)
write.table(tmp$negative, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(tmp$positive, out_f2, sep="\t", append=F, quote=F, row.names=F)
14,132 genes×24 samplesのデータです。
LIV_fed vs. LIV_fastedの2群間比較を行うべく、それらの位置情報を指定しています。
in_f1 <- "data_rma_2_nr.txt"
in_f2 <- "c2.cp.kegg.v5.0.symbols.gmt"
out_f1 <- "hoge2_G1.txt"
out_f2 <- "hoge2_G2.txt"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
param_posi <- c(17:20, 21:24)
library(GSA)
gmt <- GSA.read.gmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data <- data[,param_posi]
colnames(data)
out <- GSA(data, data.cl,
genesets=gmt$genesets,
genenames=rownames(data),
resp.type="Two class unpaired")
tmp <- GSA.listsets(out,
geneset.names=gmt$geneset.names,
maxchar=max(nchar(gmt$geneset.names)),
FDRcut=param_FDR)
write.table(tmp$negative, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(tmp$positive, out_f2, sep="\t", append=F, quote=F, row.names=F)
14,132 genes×24 samplesのデータです。BAT_fed vs. BAT_fastedの2群間比較を行うべく、それらの位置情報を指定しています。
in_f1 <- "data_rma_2_nr.txt"
in_f2 <- "c2.cp.kegg.v5.0.symbols.gmt"
out_f1 <- "hoge3_G1.txt"
out_f2 <- "hoge3_G2.txt"
param_G1 <- 4
param_G2 <- 4
param_FDR <- 0.1
param_posi <- c(1:4, 5:8)
library(GSA)
gmt <- GSA.read.gmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
rownames(data) <- toupper(rownames(data))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
data <- data[,param_posi]
colnames(data)
out <- GSA(data, data.cl,
genesets=gmt$genesets,
genenames=rownames(data),
resp.type="Two class unpaired")
tmp <- GSA.listsets(out,
geneset.names=gmt$geneset.names,
maxchar=max(nchar(gmt$geneset.names)),
FDRcut=param_FDR)
write.table(tmp$negative, out_f1, sep="\t", append=F, quote=F, row.names=F)
write.table(tmp$positive, out_f2, sep="\t", append=F, quote=F, row.names=F)
sigPathwayパッケージを用いた解析のやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
記述内容が相当古くなっているため、再編予定です。。。
ある程度遺伝子機能が分かっている生物種に対して行う解析手段です。GSEAはGene Set Enrichment Analysisの略です。
基本的に”2群間比較データ”用の解析なのかも...。
例えば、従来の2群間比較(例. 癌 vs. 正常)のような場合で発現変動遺伝子を検出したい場合には、発現変動の度合いで全遺伝子をランキングし、FDRやp値の閾値を満たす上位x個を抽出してそれらがどのような機能をもつものが多いか(例えば「pathway関連遺伝子群が多い」など)などを調べて論文にしていました。
最近では、「代謝パスウェイに関連している遺伝子セット」や「同じGene Ontologyカテゴリに属する遺伝子セット」などが予め(a priori)分かっている場合が多いので、その情報を用いてFold changeやt統計量などの手段で発現変動の度合いで全遺伝子をランキングした結果に対して、例えば「代謝パスウェイに関連している遺伝子セット」が比較しているサンプル間で”動いている”かどうかを偏りの程度から判断するのがGSEA(遺伝子セットの濃縮度解析?!)の基本的な考え方です。
当然a priori defined setの偏りの程度を調べるための手段はいくらでも多くのやり方が考えられるので、GSEA法(Subramanian et al., PNAS, 2005)が出て以来、様々な改良版が報告されています。
実際、Rプログラムが提供されているものだけでも、以下の方法が提案されています:
他にも
など様々な手法が提案されているようです。
これは、入力となる(log2変換後の)遺伝子発現データが与えられてから以下の多くのステップを経てGSEA系解析を行うわけですが、各ステップで様々な選択肢があるためです:
- step1(2群間比較用の様々な統計量の中から一つを選択;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?!」ですので、
ある遺伝子セットに含まれる遺伝子メンバーの半分がG1群>>G2群、もう半分がG1群<<G2群(遺伝子セットAとする)だったとすると、step3でそれらのAD統計量の平均値を計算するとgene-set statisticは0付近の値をとることになります。
PAGE法ではこの平均値の絶対値が大きいものほど有意だと判定されるので、結果としてその遺伝子セットが明らかに2群間で変動していたとしてもその検出は原理的に不可能です。
ゆえに下記の三つのやり方はオリジナルのPAGE法(Kim_2005)に基づいたものなので、上記問題が起こりうることを認識したうえでご利用ください。
ただし、上記のやり方は「遺伝子メンバーの半分がG1群>>G2群、もう半分がその逆」のような遺伝子セットAの検出はできないものの、全体としてG1群(あるいはG2群)で高発現側に偏っているような他の大部分の遺伝子セットは普通に検出できますし、そのような両方向でなく一方向。
遺伝子セットAのようなものも検出するための一つの手段としては、step2で「統計量の絶対値」あるいは「統計量の二乗」に変換することです。これの前者(統計量の絶対値)を実装したのが下記のものです。
2009/10/23現在、このページで最後まで解析ができるのはPAGE法(Kim_2005)のみです。
入力データは、前処理 | ID変換 | 同じ遺伝子名を持つものをまとめるを利用して得られた同じGene Symbolを持たない遺伝子発現データですのでご注意ください。
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サンプル」のデータであることが分かっているとします。
- 「参考文献1のTable1」の解析は参考文献2のデータについて行ったものです。
まずは必要な情報(発現情報や遺伝子セットの情報)をここからゲットします。
- 発現データファイル(Human diabetes expression data)をダウンロード。
- クラスラベル情報を含むファイル(Phenotype data)をダウンロード。
- 遺伝子セット情報を含むファイル(Probe sets corresponding to gene sets)をダウンロード。
- ダウンロードした圧縮ファイルを解凍すると以下のファイルが得られます。
- 発現データファイル(reannotate_select_cal.eis; 対数変換されていないpreprocessing前のデータ)
- クラスラベル情報を含むファイル(Phenotype_Data.xls)
- 「all_pathways」というディレクトリ中にある”酸化的リン酸化に関係する遺伝子のリスト”ファイル(OXPHOS_HG-U133A_probes)
- 実際にRで読み込むのはreannotate_select_cal.eisとOXPHOS_HG-U133A_probesの二つ。
これをデスクトップなりどこか同じディレクトリ内に置く。
- Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
in_f1 <- "reannotate_select_cal.eis"
in_f2 <- "OXPHOS_HG-U133A_probes"
param1 <- 1:17
param2 <- 26:43
param3 <- 1:8
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data$NAME <- NULL
data <- data[-1,]
mean_value <- 1000
floor_value <- 100
tmp_mean <- apply(data, 2, mean, na.rm=TRUE)
data.tmp <- sweep(data, 2, mean_value/tmp_mean, "*")
data.tmp[data.tmp < floor_value] <- floor_value
data.tmp <- log(data.tmp, base=2)
rownames(data.tmp) <- rownames(data)
colnames(data.tmp) <- substr(colnames(data),param3[1],param3[length(param3)])
dim(data.tmp)
logratio <- apply(data.tmp[,param2], 1, mean, na.rm=TRUE) - apply(data.tmp[,param1], 1, mean, na.rm=TRUE)
mean_set <- mean(logratio)
sd_set <- sd(logratio)
probe_OXPHOS <- read.table(in_f2, row.names=1, quote="")
mean_sample <- mean(logratio[rownames(probe_OXPHOS)])
n <- nrow(probe_OXPHOS)
zscore <- (mean_sample - mean_set)*sqrt(n)/sd_set
pvalue <- (1 - pnorm(abs(zscore)))*2
zscore
pvalue
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が正の値の遺伝子は、G2群で発現が上昇した」ということを意味するので、G2群で発現が上昇した遺伝子が多数を占める遺伝子セットの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サンプル(G1群)は17-20列目、24h-fastedサンプル(G2群)は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
- Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
とりあえず「c5: gene ontology gene sets」の「GO biological process gene sets file」を解析すべく、
c5.bp.v4.0.symbols.gmtファイルを(data_GSE7623_rma_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
- Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
in_f1 <- "data_GSE7623_rma_nr.txt"
in_f2 <- "c5.bp.v4.0.symbols.gmt"
param1 <- 17:20
param2 <- 21:24
out_f <- "hoge.txt"
library(PGSEA)
gmt <- readGmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
colnames(data)
calc_z <- function(x, AD1, mean_set1, sd_set1){
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1
return(hoge)
}
AD <- apply(data[,param2], 1, mean, na.rm=TRUE) - apply(data[,param1], 1, mean, na.rm=TRUE)
names(AD) <- toupper(names(AD))
mean_set <- mean(AD)
sd_set <- sd(AD)
z_page <- NULL
for(i in 1:length(gmt)){
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))
}
p_page <- (1 - pnorm(abs(z_page)))*2
out <- NULL
for(i in 1:length(gmt)){
Geneset_name <- gmt[[i]]@reference
GO_ID <- substring(gmt[[i]]@desc, 32, 41)
Member_num <- length(gmt[[i]]@ids)
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip))
}
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")
tmp <- cbind(out, z_page, p_page)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(p_page),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
Nakai et al., BBB, 2008(「Affymetrix Rat Genome 230 2.0 Array」を利用)のデータを遺伝子名重複を前処理 | ID変換 | 同じ遺伝子名を持つものをまとめることにより排除して得られた「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サンプル(G1群)は17-20列目、24h-fastedサンプル(G2群)は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
- Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
とりあえず「c5: gene ontology gene sets」の「GO biological process gene sets file」を解析すべく、
c5.bp.v4.0.symbols.gmtファイルを(data_GSE7623_rma_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
- Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
in_f1 <- "data_GSE7623_rma_nr.txt"
in_f2 <- "c5.bp.v4.0.symbols.gmt"
param1 <- 17:20
param2 <- 21:24
out_f <- "hoge.txt"
library(PGSEA)
gmt <- readGmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
colnames(data)
AD <- apply(data[,param2], 1, mean, na.rm=TRUE) - apply(data[,param1], 1, mean, na.rm=TRUE)
names(AD) <- toupper(names(AD))
stat_page <- NULL
for(i in 1:length(gmt)){
genenames <- intersect(names(AD), gmt[[i]]@ids)
stat_page <- c(stat_page, mean(abs(AD[genenames])))
}
out <- NULL
for(i in 1:length(gmt)){
Geneset_name <- gmt[[i]]@reference
GO_ID <- substring(gmt[[i]]@desc, 32, 41)
Member_num <- length(gmt[[i]]@ids)
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip))
}
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")
tmp <- cbind(out, stat_page)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(-stat_page),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
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つ(G2群で発現が上昇した遺伝子が多数を占める遺伝子セットを意味する)は"FATTY_ACID"や"METABOLIC"などの記述がかぶっているので、
Gene Ontology階層構造の親子関係になっていることが想像できます。この親子関係になっている様子を図で表したいときに以下を行います。
- エクセルで開いたhoge.txtをp値の低い順にソートして得られた状態で、上位10個のGene Ontology IDsに相当するセルをコピー
- QuickGOのウェブページを開き、「Your selection (0 terms)」の部分をクリック
もし「Your selection (0 terms)」となってない場合は「Empty」の部分をクリックして、以前の作業で残っていた情報を消す
- 四角のボックス部分に1.でコピーしておいたGO IDsをペーストし、「Add」ボタンを押す
「Your selection (0 terms)」だったのが、「Your selection (10 terms)」となります
- 「Your selection (10 terms)」の部分をクリックして、「View selected terms」をクリック
- 「Select all」の部分をクリックし、「chart」をクリック
- 以下のようなチャート図が得られるので、図上を右クリックで「名前を付けて画像を保存」とすれば図の完成です
PAGE法を用いて、どのパスウェイが動いていたかを調べたいときに用います。
前処理 | フィルタリング | NAを含むものを除去の4を適用することによって得られた、各群で少なくとも一つ以上の数値の要素を含むものの、
NAやNaNの要素を含むsample13_7vs7_nr2.txtのようなAgilent two-colorデータの解析例を示します。
この例では、GSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードしたKEGG gene sets fileファイル(c2.kegg.v4.0.symbols.gmt)を読み込んで解析を行います。
この例で示す遺伝子発現行列データ(sample13_7vs7_nr2.txt)のサンプルラベル情報は「最初の7 samplesが面白い話を聞いた患者(G1群)で、残りの7 samplesが退屈な講義を聞いた患者(G2群)」です。
ちなみに、ここではlogratioをmean(B)-mean(A)で定義しているので、「logratioが正の値の遺伝子は、面白い話(A)を聞いたときに発現が減少し、退屈な話(B)を聞いて発現が上昇した」ということを意味します。よって、logratio > 0を満たす遺伝子が多数を占める遺伝子セットのZスコア(hoge.txt中のz_page列に相当)は負の大きな値を示します。
得られたhoge.txtファイルをエクセルなどで開き、"p_page"列(p値)で低い順にソートすれば、「G1群 vs. G2群」の二つの状態間で”動いているパスウェイ”順にソートされたことになる。論文の表とかで示す場合には「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"です。
- Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
とりあえず「c2: curated gene sets」の「KEGG gene sets file」を解析すべく、
c2.kegg.v4.0.symbols.gmtファイルを(sample13_7vs7_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
- Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
in_f1 <- "sample13_7vs7_nr2.txt"
in_f2 <- "c2.kegg.v4.0.symbols.gmt"
out_f <- "hoge.txt"
param_G1 <- 7
param_G2 <- 7
library(PGSEA)
gmt <- readGmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
calc_z <- function(x, AD1, mean_set1, sd_set1){
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1
return(hoge)
}
AD <- apply(data[,data.cl == 2], 1, mean, na.rm=TRUE) - apply(data[,data.cl == 1], 1, mean, na.rm=TRUE)
names(AD) <- toupper(names(AD))
mean_set <- mean(AD)
sd_set <- sd(AD)
z_page <- NULL
for(i in 1:length(gmt)){
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))
}
p_page <- (1 - pnorm(abs(z_page)))*2
out <- NULL
for(i in 1:length(gmt)){
Geneset_name <- gmt[[i]]@reference
Member_num <- length(gmt[[i]]@ids)
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))
out <- rbind(out, c(Geneset_name, Member_num, Member_num_thischip))
}
colnames(out) <- c("Geneset_name", "Member_num", "Member_num_thischip")
tmp <- cbind(out, z_page, p_page)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(p_page),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
PAGE法を用いて、どのパスウェイが動いていたかを調べたいときに用います。
前処理 | フィルタリング | NAを含むものを除去の4を適用することによって得られた、各群で少なくとも一つ以上の数値の要素を含むものの、
NAやNaNの要素を含むsample13_7vs7_nr2.txtのようなAgilent two-colorデータの解析例を示します。
この例では、GSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードしたKEGG gene sets fileファイル(c2.kegg.v4.0.symbols.gmt)を読み込んで解析を行います。
この例で示す遺伝子発現行列データ(sample13_7vs7_nr2.txt)のサンプルラベル情報は「最初の7 samplesが面白い話を聞いた患者(G1群)で、残りの7 samplesが退屈な講義を聞いた患者(G2群)」です。
ちなみに、ここではAD統計量をmean(B)-mean(A)で定義しているので、「ADが正の値の遺伝子は、面白い話(A)を聞いたときに発現が減少し、退屈な話(B)を聞いて発現が上昇した」ということを意味します。。得られたhoge2.txtファイルは、「G1群 vs. G2群」の二つの状態間で”動いているパスウェイ”順にソートされた結果です。この場合、論文の表とかで示す場合には「上位10個だけ」などを表示することになります。
注意点としては、「"Member_num_thischip"列の数値が10未満のものは怪しい」ので、できればリストからは除外しておいたほうがいいです。一般的にメンバー数が10以上とか15以上の遺伝子セットのみ解析というのが多いというのも理由の一つです。例えば参考文献2では、メンバー数が15-500 genesの範囲の遺伝子セットのみを解析対象としています。
- Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
とりあえず「c2: curated gene sets」の「KEGG gene sets file」を解析すべく、
c2.kegg.v4.0.symbols.gmtファイルを(sample13_7vs7_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
- Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
in_f1 <- "sample13_7vs7_nr2.txt"
in_f2 <- "c2.kegg.v4.0.symbols.gmt"
out_f <- "hoge.txt"
param_G1 <- 7
param_G2 <- 7
library(PGSEA)
gmt <- readGmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
AD <- apply(data[,data.cl == 2], 1, mean, na.rm=TRUE) - apply(data[,data.cl == 1], 1, mean, na.rm=TRUE)
names(AD) <- toupper(names(AD))
stat_page <- NULL
for(i in 1:length(gmt)){
genenames <- intersect(names(AD), gmt[[i]]@ids)
stat_page <- c(stat_page, mean(abs(AD[genenames])))
}
out <- NULL
for(i in 1:length(gmt)){
Geneset_name <- gmt[[i]]@reference
Member_num <- length(gmt[[i]]@ids)
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))
out <- rbind(out, c(Geneset_name, Member_num, Member_num_thischip))
}
colnames(out) <- c("Geneset_name", "Member_num", "Member_num_thischip")
tmp <- cbind(out, stat_page)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(-stat_page),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
まだ作成途中です...
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
この結果から、最も比較した2群間で動いているパスウェイは「HSA04612_ANTIGEN_PROCESSING_AND_PRESENTATION」であり、
遺伝子発現データ取得に用いたチップ上には75個の遺伝子が搭載されていることが分かりますが、
そのパスウェイ構成メンバーのどの遺伝子の発現がどちら向き(G1群 > G2群 or G1群 < G2群)に変化したのかまでをパスウェイ上に色でマップしたいときに以下を行います。
1. 知りたいパスウェイIDHSA04612を構成する遺伝子セットのAD統計量情報から対応する色の16進数値を入手すべく、以下をコピペ
- AD統計量が負の値のもの(G1群で発現上昇)を水色、AD統計量が正の値のもの(G2群で発現上昇)をピンク色で図示したい場合
param <- "HSA04612"
param1 <- "#FF00FF"
param2 <- "#0099FF"
out_f3 <- "hoge_detail.txt"
out_f4 <- "hoge_kegg.txt"
calc_color <- function(x){
if(x > 0){ tmp_color <- param1 }
if(x < 0){ tmp_color <- param2 }
return(tmp_color)
}
posi <- pmatch(param, tmp[,1])
genenames <- intersect(names(AD), gmt[[posi]]@ids)
tmpAD <- AD[genenames]
out <- apply(as.matrix(tmpAD), 1, calc_color)
tmp3 <- cbind(genenames, tmpAD)
write.table(tmp3, out_f3, sep="\t", append=F, quote=F, row.names=F, col.names=F)
tmp4 <- cbind(genenames, out)
write.table(tmp4, out_f4, sep=" ", append=F, quote=F, row.names=F, col.names=F)
- 上記の色使いを基本としつつ、AD <= -1を水色、-1 < AD < 0を薄水色、0 < AD < 1を薄ピンク色、AD >= 1をピンク色の4諧調で図示したい場合
(ちなみにAD統計量は「log2 scaleでの各群の算術平均値の差」なので、
AD <= -1は「G1群で2倍以上発現上昇」に相当し、AD >= 1は「G2群で2倍以上発現上昇」に相当します。)
param <- "HSA04612"
param1 <- "#FF00FF"
param2 <- "#FFCCFF"
param3 <- "#CCFFFF"
param4 <- "#0099FF"
out_f3 <- "hoge_detail.txt"
out_f4 <- "hoge_kegg.txt"
calc_color <- function(x){
if(x >= 1){ tmp_color <- param1 }
if((0 < x) & (x < 1)){ tmp_color <- param2 }
if((-1 < x) & (x < 0)){ tmp_color <- param3 }
if(x <= -1){ tmp_color <- param4 }
return(tmp_color)
}
posi <- pmatch(param, tmp[,1])
genenames <- intersect(names(AD), gmt[[posi]]@ids)
tmpAD <- AD[genenames]
out <- apply(as.matrix(tmpAD), 1, calc_color)
tmp3 <- cbind(genenames, tmpAD)
write.table(tmp3, out_f3, sep="\t", append=F, quote=F, row.names=F, col.names=F)
tmp4 <- cbind(genenames, out)
write.table(tmp4, out_f4, sep=" ", append=F, quote=F, row.names=F, col.names=F)
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)のものをクリック
デフォルトの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サンプルがG1群、残りの4サンプルがG2群です。
- Molecular Signatures Database (MSigDB)の
「Registration」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
とりあえず「c5: gene ontology gene sets」の「GO biological process gene sets file」を解析すべく、
c5.bp.v4.0.symbols.gmtファイルを(data_GSE7623_unlog_nr.txtをダウンロードしたディレクトリと同じところに)ダウンロードする。
- Rを立ち上げ、読み込む二つのファイルを置いているディレクトリに移動し、以下をコピペ
(a) log変換されていないデータ(sample17_unlog.txt)を読み込んでlog10変換して解析する場合:
in_f1 <- "sample17_unlog.txt"
in_f2 <- "c5.bp.v4.0.symbols.gmt"
out_f <- "hoge.txt"
param_G1 <- 4
param_G2 <- 4
library(PGSEA)
gmt <- readGmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
colnames(data)
data_log10 <- log10(data)
zscore <- scale(data_log10)
apply(zscore, 2, sd)
apply(zscore, 2, mean)
mean_zscore_A <- apply(zscore[,data.cl == 1], 1, mean)
mean_zscore_B <- apply(zscore[,data.cl == 2], 1, mean)
zratio <- (mean_zscore_B - mean_zscore_A)/sd(mean_zscore_B - mean_zscore_A)
calc_z <- function(x, AD1, mean_set1, sd_set1){
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1
return(hoge)
}
AD <- zratio
names(AD) <- toupper(names(AD))
mean_set <- mean(AD)
sd_set <- sd(AD)
z_page <- NULL
for(i in 1:length(gmt)){
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))
}
p_page <- (1 - pnorm(abs(z_page)))*2
out <- NULL
for(i in 1:length(gmt)){
Geneset_name <- gmt[[i]]@reference
GO_ID <- substring(gmt[[i]]@desc, 32, 41)
Member_num <- length(gmt[[i]]@ids)
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip))
}
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")
tmp <- cbind(out, z_page, p_page)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(p_page),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
(b) log2変換されたデータ(sample17.txt)を読み込んでそのまま解析する場合:
in_f1 <- "sample17.txt"
in_f2 <- "c5.bp.v4.0.symbols.gmt"
out_f <- "hoge.txt"
param_G1 <- 4
param_G2 <- 4
library(PGSEA)
gmt <- readGmt(in_f2)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
colnames(data)
zscore <- scale(data)
apply(zscore, 2, sd)
apply(zscore, 2, mean)
mean_zscore_A <- apply(zscore[,data.cl == 1], 1, mean)
mean_zscore_B <- apply(zscore[,data.cl == 2], 1, mean)
zratio <- (mean_zscore_B - mean_zscore_A)/sd(mean_zscore_B - mean_zscore_A)
calc_z <- function(x, AD1, mean_set1, sd_set1){
hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1
return(hoge)
}
AD <- zratio
names(AD) <- toupper(names(AD))
mean_set <- mean(AD)
sd_set <- sd(AD)
z_page <- NULL
for(i in 1:length(gmt)){
z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))
}
p_page <- (1 - pnorm(abs(z_page)))*2
out <- NULL
for(i in 1:length(gmt)){
Geneset_name <- gmt[[i]]@reference
GO_ID <- substring(gmt[[i]]@desc, 32, 41)
Member_num <- length(gmt[[i]]@ids)
Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))
out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip))
}
colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")
tmp <- cbind(out, z_page, p_page)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out_f2 <- "hoge2.txt"
tmp2 <- tmp[order(p_page),]
write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)
k-Nearest Neighbor (k-NN) 法を用いて分類します。ここではk=3とする場合について示します(距離の計算は"ユークリッド距離(Euclidean distance)"だけでしか行えないようです)。
分類に用いる遺伝子セットの選択(Feature selection)を不等分散性を仮定したt統計量(Welch t statistic)で行う場合の例を紹介します。
また、ここでは分類精度を交差検証法の一種であるLeave-one-out cross validation(LOOCV)を用いて行っています。分類精度は用いる遺伝子数によって変わりますので、
ここでは上位2, 3, ..., 15個を分類に用いた場合の結果を出力するようにしています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
RMA-preprocessed data (G1群:50 samples vs. G2群:52 samples)です。
Feature selectionを不等分散性を仮定したt統計量(Welch t statistic)で行うやり方です。
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge1.txt"
param_G1 <- 50
param_G2 <- 52
library(class)
Welch_tstat <- function(x, cl){
x.class1 <- x[(cl == 1)]
x.class2 <- x[(cl == 2)]
if((sd(x.class1)+sd(x.class2)) == 0){
statistic <- 0
return(statistic)
}
else{
hoge <- t.test(x.class1, x.class2, var.equal=F)
return(hoge$statistic)
}
}
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
rank.matrix <- rownames(data)
for (i in 1:length(data.cl)){
data.tmp <- data[,-i]
data.cl.tmp <- data.cl[-i]
tmpall <- apply(data.tmp, 1, Welch_tstat, data.cl.tmp)
rank.matrix <- cbind(rank.matrix, rank(-abs(tmpall)))
}
write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F)
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){
pred.vector <- NULL
for(j in 1:ncol(data.tmp)){
data.rank <- data.tmp[,j]
data.s <- data[order(data.rank),]
data.sub.train <- data.s[1:g_num,-j]
data.sub.test <- data.s[1:g_num,j]
data.cl.train <- data.cl[-j]
data.cl.test <- data.cl[j]
predicted <- knn(t(data.sub.train), t(data.sub.test), k=3, factor(data.cl.train))
pred.vector <- c(pred.vector, as.vector(predicted))
}
CrossTable <- table(true = data.cl, pred = pred.vector)
TN <- CrossTable[1,1]
FP <- CrossTable[1,2]
FN <- CrossTable[2,1]
TP <- CrossTable[2,2]
accuracy = (TP+TN)/(TP+FP+FN+TN)
MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN))
result <- rbind(result, c(g_num, accuracy, MCC))
}
write.table(result, out_f, sep = "\t", append=F, quote=F, row.names=F)
Self-Organizing Maps (SOM) 法を用いて分類します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
Support Vector Machine (SVM) 法を用いて分類します。分類に用いる遺伝子セットの選択(Feature selection)をRank product (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個を分類に用いた場合の結果を出力するようにしています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
RMA-preprocessed data (G1群:50 samples vs. G2群:52 samples)です。
Feature selectionをRank product (Breitling et al., FEBS Lett., 2004))で行うやり方です。
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "hoge1.txt"
param_G1 <- 50
param_G2 <- 52
library(e1071)
library(RankProd)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
rank.matrix <- rownames(data)
for (i in 1:length(data.cl)){
data.tmp <- data[,-i]
data.cl.tmp <- data.cl[-i]
tmpall <- RP(data.tmp, data.cl.tmp, num.perm=1, logged=TRUE, na.rm = FALSE, plot = FALSE, rand = 123)
tmprankall <- rank(apply(tmpall$RPs, 1, min))
rank.matrix <- cbind(rank.matrix, tmprankall)
}
write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F)
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){
pred.vector <- NULL
for(j in 1:ncol(data.tmp)){
data.rank <- data.tmp[,j]
data.s <- data[order(data.rank),]
data.sub.train <- data.s[1:g_num,-j]
data.sub.test <- data.s[1:g_num,j]
data.cl.train <- data.cl[-j]
data.cl.test <- data.cl[j]
svm.model <- svm(x=t(data.sub.train), y=factor(data.cl.train), scale=T, type="C-classification", kernel="linear")
predicted <- predict(svm.model, t(data.sub.test))
pred.vector <- c(pred.vector, as.vector(predicted))
}
CrossTable <- table(true = data.cl, pred = pred.vector)
TN <- CrossTable[1,1]
FP <- CrossTable[1,2]
FN <- CrossTable[2,1]
TP <- CrossTable[2,2]
accuracy = (TP+TN)/(TP+FP+FN+TN)
MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN))
result <- rbind(result, c(g_num, accuracy, MCC))
}
write.table(result, out_f, sep = "\t", append=F, quote=F, row.names=F)
in_f <- "data_Singh_RMA_3274.txt"
out_f <- "result_loocv.txt"
param_G1 <- 50
param_G2 <- 52
library(e1071)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
rank.matrix <- rownames(data)
for (i in 1:length(data.cl)){
data.tmp <- data[,-i]
data.cl.tmp <- data.cl[-i]
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)))
}
write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F)
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){
pred.vector <- NULL
for(j in 1:ncol(data.tmp)){
data.rank <- data.tmp[,j]
data.s <- data[order(data.rank),]
data.sub.train <- data.s[1:g_num,-j]
data.sub.test <- data.s[1:g_num,j]
data.cl.train <- data.cl[-j]
data.cl.test <- data.cl[j]
svm.model <- svm(x=t(data.sub.train), y=factor(data.cl.train), scale=T, type="C-classification", kernel="linear")
predicted <- predict(svm.model, t(data.sub.test))
pred.vector <- c(pred.vector, as.vector(predicted))
}
CrossTable <- table(true = data.cl, pred = pred.vector)
TN <- CrossTable[1,1]
FP <- CrossTable[1,2]
FN <- CrossTable[2,1]
TP <- CrossTable[2,2]
accuracy = (TP+TN)/(TP+FP+FN+TN)
MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN))
result <- rbind(result, c(g_num, accuracy, MCC))
}
write.table(result, out_f, sep = "\t", append=F, quote=F, row.names=F)
Naive Bayesian (NB) 法を用いて分類します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
アレイCGH(Comparative Genomic Hybridization)法は、もともとは腫瘍組織で染色体に異常が生じている領域を正常組織との比較により同定することを目的とした解析技術です。二色法のマイクロアレイと本質的に同じ。
目的がDNAコピー数が変化している領域を同定(アレイCGH;この意味において、”DNAコピー数解析”などとも呼ばれます)するか、発現変動遺伝子の同定(従来型の二色法マイクロアレイの利用)などかという程度の違いです。
昔はBACクローンなどがアレイに搭載されていて解像度がそれほど高くありませんでしたが、最近ではタイリングアレイのような感じでかなり高い解像度のデータが得られるようになっているようです。したがって得られるデータのイメージ図は、「横軸:ゲノム上の位置、縦軸:比較二つのサンプルのlog比」です。
「比較二つのサンプルのlog比のデータ」を入力として与えて、「”連続してlog比の絶対値が高い領域”のリストやそれの図」を出力として返してくれます。
2013年6月に調査した結果をリストアップします。
- GLAD:Hupe et al., Bioinformatics, 2004
- CBS (DNAcopyパッケージ):Olshen et al., Biostatistics, 2004
- faster CBS (DNAcopyパッケージ):Venkatraman and Olshen, Bioinformatics, 2007
- ADaCGH(Rだが、なくなっている):Diaz-Uriarte and Rueda, PLoS One, 2007
- DP-EM:Picard et al., Biometrics, 2007
- :Staaf et al., Genome Biol., 2008
- Ultrasome:Nilsson et al., Bioinformatics, 2009
- CGHnormaliter:van Houte et al., Bioinformatics, 2010
- MDLS:Wang et al., J Bioinform Comput Biol., 2011
- parsimonious higher-order HMMs:Seifert et al., PLoS Comput Biol., 2012
- GFL:Zhang et al., BMC Bioinformatics, 2012
- :Scharpf et al., BMC Bioinformatics, 2012
- CnaStruct:Mosen-Ansorena and Aransay, BMC Bioinformatics, 2013
GLADパッケージを用いて解析を行う。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
DNAcopyパッケージを用いて解析を行う。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
サンプルデータの31,099 probesets×24 samplesのデータを読み込んでM-Aプロットを作成します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 31,099 probesets×24 samplesのMAS5-preprocessedデータ(data_mas.txt)の場合:
(データを読み込んだ後に、最初の4列分(Brown adopise tissue)のみ抽出して2 fed samples vs. 2 fed samplesの2群間比較データとして取り扱っています)
in_f <- "data_mas.txt"
out_f <- "hoge1.png"
param_G1 <- 2
param_G2 <- 2
param_fig <- c(400, 380)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- 2^data
data <- data[,1:4]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
G1 <- apply(as.matrix(data[,data.cl==1]), 1, mean)
G2 <- apply(as.matrix(data[,data.cl==2]), 1, mean)
M <- log2(G2) - log2(G1)
A <- (log2(G1) + log2(G2))/2
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(A, M, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)",
ylim=c(-7, 7), xlim=c(0, 16), pch=20, cex=.1)
grid(col="gray", lty="dotted")
median(M, na.rm=TRUE)
abline(h=median(M, na.rm=TRUE), col="black")
obj <- (abs(M) >= 1)
points(A[obj], M[obj], col="magenta", cex=0.8, pch=6)
sum(obj, na.rm=TRUE)
dev.off()
2. 31,099 probesets×24 samplesのRMA-preprocessedデータ(data_rma_2.txt)の場合:
(データを読み込んだ後に、最初の4列分(Brown adopise tissue)のみ抽出して2 fed samples vs. 2 fed samplesの2群間比較データとして取り扱っています)
in_f <- "data_rma_2.txt"
out_f <- "hoge2.png"
param_G1 <- 2
param_G2 <- 2
param_fig <- c(400, 380)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- 2^data
data <- data[,1:4]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
G1 <- apply(as.matrix(data[,data.cl==1]), 1, mean)
G2 <- apply(as.matrix(data[,data.cl==2]), 1, mean)
M <- log2(G2) - log2(G1)
A <- (log2(G1) + log2(G2))/2
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(A, M, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)",
ylim=c(-7, 7), xlim=c(0, 16), pch=20, cex=.1)
grid(col="gray", lty="dotted")
median(M, na.rm=TRUE)
abline(h=median(M, na.rm=TRUE), col="black")
obj <- (abs(M) >= 1)
points(A[obj], M[obj], col="magenta", cex=0.8, pch=6)
sum(obj, na.rm=TRUE)
dev.off()
論文中でよく見かけるヒートマップ(pseudo-color image)を作成してくれます(例えばKadota et al., Physiol. Genomics, 2003
の図2を作成してくれます)。
ここでは、サンプルデータ26の仮想データを用いて示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
23遺伝子×6サンプルのデータです。基本形です。
R Console画面の後ろのほうに、R Graphics画面が起動して描画されます。
デフォルトだと、クラスタリングも実行されるようです。
高発現が白で低発現が赤で示されています。
行ごとにスケーリングされていることもわかります。
gene3からgene21までは行方向がすべて同じ値のため、うまくスケーリングできずに赤と白の中間色ではなく全部白になっているのか、
それとも計算できないので空白の意味で白になっているのかは定かではありません。
in_f <- "sample26.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
heatmap(as.matrix(data))
得られた図をサイズを指定して
(700×400ピクセル)、PNG形式ファイル(ファイル名はhoge2.png)で保存するやり方です。
縦幅で決まっているようなので、横幅を変えても空白エリアが増えるだけのようです。
in_f <- "sample26.txt"
out_f <- "hoge2.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data))
dev.off()
列方向(サンプル)のクラスタリングをやらずに、
入力ファイル通りの列の並びで表示させるやり方です。
in_f <- "sample26.txt"
out_f <- "hoge3.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA)
dev.off()
行と列両方のクラスタリングをやらずに、
入力ファイル通りの行と列の並びで表示させるやり方です。
in_f <- "sample26.txt"
out_f <- "hoge4.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA, Rowv=NA)
dev.off()
ヒートマップ(pseudo-color image)の色を変えるやり方を示します。heat.colors, cm.colors, topo.colors, g2r.colors, rainbowなどが選べます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
23遺伝子×6サンプルのデータです。デフォルトの高発現(白色)から低発現(赤色)の色指定を明示させただけです。
heat.colors(256)は、「暖色256段階」の意味です。
in_f <- "sample26.txt"
out_f <- "hoge1.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256))
dev.off()
heat.colors(3)として、「暖色3段階」にしています。
gene1, 2, 22, 23で表示されている3色(黄色、オレンジ、赤)が3段階に相当すると思います。
gene3からgene21が白色で見えているのは、白ではなく空白という意味なのだろうと推測しています。
in_f <- "sample26.txt"
out_f <- "hoge2.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(3))
dev.off()
寒色の高発現(ピンク色)から低発現(水色)の色指定のやり方です。
cm.colors(3)として、「寒色3段階」にするやりかたです。
高発現(ピンク色)、中発現(白色)、低発現(水色)の三段階になるようです。
in_f <- "sample26.txt"
out_f <- "hoge3.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=cm.colors(3))
dev.off()
Heatplusパッケージで提供されている
g2r.colors関数を利用して、「緑から赤への256段階」にするやりかたです。
昔のマイクロアレイの図での色使いです。
in_f <- "sample26.txt"
out_f <- "hoge4.png"
param_fig <- c(700, 400)
library(Heatplus)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=g2r.colors(256))
dev.off()
ヒートマップ(pseudo-color image)時にデータを変換する/しない周辺を解説します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
23遺伝子×6サンプルのデータです。デフォルトの。scale="row"を明示しただけです。
内部的には行ごとに、おそらくZ scaling (Z-score化)をしているのだろうと思います。
Zスコア化することで、任意のベクトルが与えられたときに平均が0、標準偏差が1になるような変換
(the rows are scaled to have mean zero and standard deviation one)を行うことになります。
例えば、Golub et al., Science, 1999の図3などです。
in_f <- "sample26.txt"
out_f <- "hoge1.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256),
scale="row")
dev.off()
scale="none"としてスケーリングをしないやり方です。
見栄えが違うことがわかります。色調は、heat.colors(256)です。
gene1の発現レベル18が最大で、-18が最小値ですが、これが白色と赤色で表示されているのがわかります。
in_f <- "sample26.txt"
out_f <- "hoge2.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256),
scale="none")
dev.off()
scale="none"としてスケーリングをしないやり方です。
Heatplusパッケージで提供されている
g2r.colors関数を利用して、「緑から赤への256段階」にするやりかたです。
gene1の発現レベル18が最大で、-18が最小値ですが、これが赤色と緑色で表示されているのがわかります。
in_f <- "sample26.txt"
out_f <- "hoge3.png"
param_fig <- c(700, 400)
library(Heatplus)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=g2r.colors(256),
scale="none")
dev.off()
ヒートマップ(pseudo-color image)時に余白を変えるやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
23遺伝子×6サンプルのデータです。デフォルトのmargins=c(5, 5)を明示しただけです。
スケーリングを行っていない(scale="none")ので、
最大値(白色)と最小値(赤色)を含むgene1が最大のコントラストとなっているのがわかります。
in_f <- "sample26.txt"
out_f <- "hoge1.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256),
scale="none", margins=c(5, 5))
dev.off()
23遺伝子×6サンプルのデータです。margins=c(3, 5)として、列名のマージンを狭くするやり方です。
in_f <- "sample26.txt"
out_f <- "hoge2.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256),
scale="none", margins=c(3, 5))
dev.off()
ヒートマップ(pseudo-color image)時に列や行名の大きさを変えるやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動。
23遺伝子×6サンプルのデータです。cexCol=1.5として、列名を通常の1.5倍にしています。
in_f <- "sample26.txt"
out_f <- "hoge1.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256),
scale="none", margins=c(9, 5),
cexCol=1.5)
dev.off()
10遺伝子×36サンプルのデータです。cexCol=1.5として、列名を通常の1.5倍に、そして行名を通常の2.0倍にしています。
in_f <- "GDS1096_best10_heart.txt"
out_f <- "hoge2.png"
param_fig <- c(700, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256),
scale="row", margins=c(9, 5),
cexCol=1.5, cexRow=2.0)
dev.off()
10遺伝子×36サンプルのデータです。図のサイズ列名、行名のサイズを変えています。
in_f <- "GDS1096_best10_heart.txt"
out_f <- "hoge3.png"
param_fig <- c(500, 600)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
heatmap(as.matrix(data), Colv=NA,
Rowv=NA, col=heat.colors(256),
scale="row", margins=c(9, 5),
cexCol=1.0, cexRow=1.5)
dev.off()
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. (param_Ngene)個の遺伝子をWADなどでランキングして、”真の発現変動遺伝子(DEG)”3個が1, 3, 4位だった。このAUC値:
param1 <- c(1,3,4)
param_Ngene <- 10
library(ROC)
DEG_posi <- rep(0, param_Ngene)
DEG_posi <- replace(DEG_posi, param1, 1)
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param_Ngene), rule=dxrule.sca)
AUC(out)
2. このROC曲線の図:
param1 <- c(1,3,4)
param_Ngene <- 10
library(ROC)
DEG_posi <- rep(0, param_Ngene)
DEG_posi <- replace(DEG_posi, param1, 1)
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param_Ngene), rule=dxrule.sca)
plot(out)
3. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合:
out_f <- "hoge3.png"
param1 <- c(1,3,4)
param_Ngene <- 10
param_fig <- c(400, 400)
library(ROC)
DEG_posi <- rep(0, param_Ngene)
DEG_posi <- replace(DEG_posi, param1, 1)
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param_Ngene), rule=dxrule.sca)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
4. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合(x,y軸の文字も指定):
out_f <- "hoge4.png"
param1 <- c(1,3,4)
param_Ngene <- 10
param_fig <- c(400, 400)
param6 <- "1 - specificity"
param7 <- "sensitivity"
library(ROC)
DEG_posi <- rep(0,param2)
DEG_posi <- replace(DEG_posi, param1, 1)
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param_Ngene), rule=dxrule.sca)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab=param6, ylab=param7)
dev.off()
5. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合(x,y軸のラベルを描かないようにしたい):
out_f <- "hoge5.png"
param1 <- c(1,3,4)
param_Ngene <- 10
param_fig <- c(400, 400)
param6 <- "1 - specificity"
param7 <- "sensitivity"
library(ROC)
DEG_posi <- rep(0,param2)
DEG_posi <- replace(DEG_posi, param1, 1)
out <- rocdemo.sca(truth=DEG_posi, data=-(1:param_Ngene), rule=dxrule.sca)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="", ylab="")
dev.off()
Memorandum(自分用の備忘録)
- genefilterパッケージのcolttests関数で、行列のt検定ができる。