basic alignerはジャンクションリード(junciton reads; spliced reads)のマッピングができません。
splice-aware alignerは計算に時間がかかるものの、それらもマッピングしてくれます。
SpliceMapは、リードの半分の長さをマップさせておいてそのアラインメントを拡張(extend)させる戦略を採用しています。
いずれの方法も、バージョンアップがどんどんなされるプログラムは、アルゴリズム（計算手順）自体も変わっていたりしますので参考程度にしてください。
大きな分類としては、seed-and-extend系とexon-first系に分けられるようです。
exon-first系は、内部的にbasic-alignerを用いてざっくりとマップできるものをマップし、マップされなかったものがジャンクションリード候補としてリードを分割してマップされる場所を探すイメージです。
seed-and-extend系は、前者に比べて計算時間がかかるものの、全リードを等価に取り扱うため、exon-first系にありがちな
「本当はジャンクションリードなんだけどbasic alignerでのマッピング時にpseudogeneにマップされてしまう」ということはないようです(Garber et al., 2011)。
その後multi-seed系の方法も提案されているようです(Gatto et al., 2014)。
BAM形式などのマッピング結果ファイルからカウントデータを取得するためのパッケージや関数もいくつかあります。
htSeqToolsのislandCounts関数、
Rsubread(Windows版はなし)のfeatureCounts関数、
GenomicRangesのsummarizeOverlaps関数などです。
QuasRは、内部的にGenomicRangesのsummarizeOverlaps関数を利用しています。
QuasRパッケージを用いたsingle-end RNA-seqデータのリファレンスゲノム配列へのBowtieによるマッピングから、
カウントデータ取得までの一連の流れを示します。アノテーション情報は、GenomicFeatures
パッケージ中の関数を利用してTranscriptDbオブジェクトをネットワーク経由で取得するのを基本としつつ、
TxDbパッケージを読み込むやり方も示しています。
マッピングのやり方やオプションの詳細については
マッピング | single-end | ゲノム | basic aligner(応用) | QuasR(Gaidatzis_2014)などを参考にしてください。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
mapping_single_genome3.txtのような2行目の1列目に「マッピングしたいRNA-seqファイル名」(SRR037439.fastq)、
そして2行目の2列目に「任意のサンプル名」(例：human_brain)を記載したタブ区切りテキストファイルを用意した上で(オプションを"-m 1 --best --strata -v 2"として)行っています。
hg19にマップした結果なので、TranscriptDbオブジェクト取得時のゲノム情報もそれを基本として、
UCSC Genes ("knownGene")を指定しているので、Entrez Gene IDに対するカウントデータ取得になっています。
in_f1 <- "mapping_single_genome3.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f <- "hoge1.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param_txdb1 <- "hg19"
param_txdb2 <- "knownGene"
param_reportlevel <- "gene"
library(QuasR)
library(GenomicFeatures)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
txdb <- makeTranscriptDbFromUCSC(genome=param_txdb1, tablename=param_txdb2)
txdb
count <- qCount(out, txdb, reportLevel=param_reportlevel)
dim(count)
head(count)
tmp <- cbind(rownames(count), count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
mapping_single_genome3.txtのような2行目の1列目に「マッピングしたいRNA-seqファイル名」(SRR037439.fastq)、
そして2行目の2列目に「任意のサンプル名」(例：human_brain)を記載したタブ区切りテキストファイルを用意した上で
(オプションを"-m 1 --best --strata -v 2"として)行っています。
hg19にマップした結果なので、TranscriptDbオブジェクト取得時のゲノム情報もそれを基本として、
RefSeq Genes ("refGene")を指定しているのでRefSeq Gene IDに対するカウントデータ取得になっていますはずですが、そうはなっていません。
この理由は（バグか開発者のポリシーかは不明ですが）おそらくRefSeqが転写物単位のIDなためゲノムマッピング結果の取り扱いとは相性が悪いためでしょう。
ちなみに長さ情報は変わっているので、なんらかの形でRefSeqの情報が反映されているのでしょう。
in_f1 <- "mapping_single_genome3.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f <- "hoge2.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param_txdb1 <- "hg19"
param_txdb2 <- "refGene"
param_reportlevel <- "gene"
library(QuasR)
library(GenomicFeatures)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
txdb <- makeTranscriptDbFromUCSC(genome=param_txdb1, tablename=param_txdb2)
txdb
count <- qCount(out, txdb, reportLevel=param_reportlevel)
dim(count)
head(count)
tmp <- cbind(rownames(count), count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
mapping_single_genome3.txtのような2行目の1列目に「マッピングしたいRNA-seqファイル名」(SRR037439.fastq)、
そして2行目の2列目に「任意のサンプル名」(例：human_brain)を記載したタブ区切りテキストファイルを用意した上で
(オプションを"-m 1 --best --strata -v 2"として)行っています。
hg19にマップした結果なので、TranscriptDbオブジェクト取得時のゲノム情報もそれを基本として
Ensembl Genes ("ensGene")を指定しているので、Ensembl Gene IDに対するカウントデータ取得になっています。
in_f1 <- "mapping_single_genome3.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f <- "hoge3.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param_txdb1 <- "hg19"
param_txdb2 <- "ensGene"
param_reportlevel <- "gene"
library(QuasR)
library(GenomicFeatures)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
txdb <- makeTranscriptDbFromUCSC(genome=param_txdb1, tablename=param_txdb2)
txdb
count <- qCount(out, txdb, reportLevel=param_reportlevel)
dim(count)
head(count)
tmp <- cbind(rownames(count), count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
mapping_single_genome3.txtのような2行目の1列目に「マッピングしたいRNA-seqファイル名」(SRR037439.fastq)、
そして2行目の2列目に「任意のサンプル名」(例：human_brain)を記載したタブ区切りテキストファイルを用意した上で
(オプションを"-m 1 --best --strata -v 2"として)行っています。
hg19にマップした結果なので、TranscriptDbオブジェクト取得時のゲノム情報もそれを基本として
Ensembl Genes ("ensGene")を指定しているので、Ensembl Gene IDに対するカウントデータ取得になっています。
基本は3と同じですが、一般的なカウントデータ行列の形式(2列目以降がカウント情報)にし、配列長情報と別々のファイルにして保存するやり方です。
in_f1 <- "mapping_single_genome3.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f1 <- "hoge4_count.txt"
out_f2 <- "hoge4_genelength.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param_txdb1 <- "hg19"
param_txdb2 <- "ensGene"
param_reportlevel <- "gene"
library(QuasR)
library(GenomicFeatures)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
txdb <- makeTranscriptDbFromUCSC(genome=param_txdb1, tablename=param_txdb2)
txdb
count <- qCount(out, txdb, reportLevel=param_reportlevel)
dim(count)
head(count)
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
genelength <- count[,1]
tmp <- cbind(names(genelength), genelength)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
mapping_single_genome3.txtのような2行目の1列目に「マッピングしたいRNA-seqファイル名」(SRR037439.fastq)、
そして2行目の2列目に「任意のサンプル名」(例：human_brain)を記載したタブ区切りテキストファイルを用意した上で
(オプションを"-m 1 --best --strata -v 2"として)行っています。
3.と違って、TranscriptDbオブジェクト取得時に、Ensemblにアクセスしてhsapiens_gene_ensembl
をデータベース名として指定しています。
ちなみにこれは、txdbオブジェクトの作成まではうまくいきますが、最後のqCount関数の実行のところでエラーが出ます。
理由は、Ensemblで提供されている染色体名seqnames(transcripts(txdb))の中にBSgenome.Hsapiens.UCSC.hg19で提供されている染色体名以外の名前のものが含まれているためです。
データ提供元が異なるとうまくいかない例です。
in_f1 <- "mapping_single_genome3.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f <- "hoge5.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param_txdb_ds <- "hsapiens_gene_ensembl"
param_reportlevel <- "gene"
library(QuasR)
library(GenomicFeatures)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
txdb <- makeTranscriptDbFromBiomart(dataset=param_txdb_ds)
txdb
count <- qCount(out, txdb, reportLevel=param_reportlevel)
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
マップしたいFASTQファイルリストおよびそのサンプル名を記述したsrp017142_samplename.txtを作業ディレクトリに保存したうえで、下記を実行します。
BSgenome.Hsapiens.UCSC.hg19へマッピングしています。
名前から推測できるように"UCSC"の"hg19"にマップしているのと同じです。
basic alignerの一つであるBowtieを内部的に用いており、
ここではマッピング時のオプションを"-m 1 --best --strata -v 2"にしています。
ここでの目的はUCSC known genesのgene-levelのカウントデータを得ることです。10時間程度かかります。
TxDbオブジェクトのバージョン次第で行数やカウント数は若干変化しますがhoge6.txtのような感じになっていれば正解です。
in_f1 <- "srp017142_samplename.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f <- "hoge6.txt"
param_txdb <- "TxDb.Hsapiens.UCSC.hg19.knownGene"
param_mapping <- "-m 1 --best --strata -v 2"
param_reportlevel <- "gene"
library(QuasR)
library(GenomicAlignments)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
library(param_txdb, character.only=T)
tmp <- ls(paste("package", param_txdb, sep=":"))
txdb <- eval(parse(text=tmp))
count <- qCount(out, txdb, reportLevel=param_reportlevel)
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
6と基本的に同じです。UCSC known genesのgene-levelとexon-levelの両方のカウントデータを同時に得るやり方です。
TxDbオブジェクトのバージョン次第で行数やカウント数は若干変化しますがhoge7_count_gene.txtや
hoge7_count_exon.txtのような感じになっていれば正解です。
in_f1 <- "srp017142_samplename.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f1 <- "hoge7_count_gene.txt"
out_f2 <- "hoge7_count_exon.txt"
param_txdb <- "TxDb.Hsapiens.UCSC.hg19.knownGene"
param_mapping <- "-m 1 --best --strata -v 2"
library(QuasR)
library(GenomicAlignments)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
library(param_txdb, character.only=T)
tmp <- ls(paste("package", param_txdb, sep=":"))
txdb <- eval(parse(text=tmp))
count <- qCount(out, txdb, reportLevel="gene")
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
data_gene <- data
count <- qCount(out, txdb, reportLevel="exon")
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
data_exon <- data
7と基本的に同じです。Quality Control (QC)レポートファイルも作成するやり方です。
TxDbオブジェクトのバージョン次第で行数やカウント数は若干変化しますがhoge8_QC.pdf、
hoge8_count_gene.txtや
hoge8_count_exon.txtのような感じになっていれば正解です。
in_f1 <- "srp017142_samplename.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f1 <- "hoge8_count_gene.txt"
out_f2 <- "hoge8_count_exon.txt"
out_f3 <- "hoge8_QC.pdf"
param_txdb <- "TxDb.Hsapiens.UCSC.hg19.knownGene"
param_mapping <- "-m 1 --best --strata -v 2"
library(QuasR)
library(GenomicAlignments)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
qQCReport(out, pdfFilename=out_f3)
library(param_txdb, character.only=T)
tmp <- ls(paste("package", param_txdb, sep=":"))
txdb <- eval(parse(text=tmp))
count <- qCount(out, txdb, reportLevel="gene")
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
data_gene <- data
count <- qCount(out, txdb, reportLevel="exon")
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
data_exon <- data
4と8を組み合わせたようなやり方です。数値だけのUCSC gene IDではなくEnsembl Gene IDで取り扱うやり方です。
TxDbオブジェクトのバージョン次第で行数やカウント数は若干変化しますがhoge9_QC.pdf、
hoge9_count_gene.txtや
hoge9_count_exon.txtのような感じになっていれば正解です。
in_f1 <- "srp017142_samplename.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f1 <- "hoge9_count_gene.txt"
out_f2 <- "hoge9_count_exon.txt"
out_f3 <- "hoge9_QC.pdf"
param_txdb1 <- "hg19"
param_txdb2 <- "ensGene"
param_mapping <- "-m 1 --best --strata -v 2"
library(QuasR)
library(GenomicFeatures)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
qQCReport(out, pdfFilename=out_f3)
txdb <- makeTranscriptDbFromUCSC(genome=param_txdb1, tablename=param_txdb2)
txdb
count <- qCount(out, txdb, reportLevel="gene")
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
data_gene <- data
count <- qCount(out, txdb, reportLevel="exon")
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
data_exon <- data
QuasRパッケージを用いたsingle-end RNA-seqデータのリファレンスゲノム配列へのBowtieによるマッピングから、
カウントデータ取得までの一連の流れを示します。アノテーション情報がない場合を想定しているので、GenomicAlignments
パッケージを利用して、マップされたリードの和集合領域(union range)を得たのち、領域ごとにマップされたリード数をカウントしています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
オプションを"-m 1 --best --strata -v 0"とした例です。
in_f1 <- "mapping_single_genome1.txt"
in_f2 <- "ref_genome.fa"
param_mapping <- "-m 1 --best --strata -v 0"
library(QuasR)
library(GenomicAlignments)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
time_e <- proc.time()
time_e - time_s
out
alignmentStats(out)
tmpfname <- out@alignments[,1]
tmpsname <- out@alignments[,2]
for(i in 1:length(tmpfname)){
if(i == 1){
k <- readGAlignments(tmpfname[i])
} else{
k <- c(k, readGAlignments(tmpfname[i]))
}
}
m <- reduce(granges(k))
tmp <- as.data.frame(m)
for(i in 1:length(tmpfname)){
tmpcount <- summarizeOverlaps(m, tmpfname[i])
count <- assays(tmpcount)$counts
colnames(count) <- tmpsname[i]
tmp <- cbind(tmp, count)
}
out_f <- sub(".bam", "_range.txt", tmpfname[i])
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
2.サンプルデータ7のFASTQ形式ファイル(SRR037439.fastq)の
BSgenomeパッケージで利用可能なBSgenome.Hsapiens.UCSC.hg19
へのマッピング結果の場合：
mapping_single_genome3.txtのような2行目の1列目に「マッピングしたいRNA-seqファイル名」(SRR037439.fastq)、
そして2行目の2列目に「任意のサンプル名」(例：human_brain)を記載したタブ区切りテキストファイルを用意した上で(オプションを"-m 1 --best --strata -v 2"として)行っています。
RNA-seqデータのほうのリード数は少ないですが、リファレンス配列の前処理でかなり時間がかかるようです（2時間とか...）。
in_f1 <- "mapping_single_genome3.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
param_mapping <- "-m 1 --best --strata -v 2"
library(QuasR)
library(GenomicAlignments)
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
alignmentStats(out)
tmpfname <- out@alignments[,1]
tmpsname <- out@alignments[,2]
for(i in 1:length(tmpfname)){
k <- readGAlignments(tmpfname[i])
m <- reduce(granges(k))
tmpcount <- summarizeOverlaps(m, tmpfname[i])
count <- assays(tmpcount)$counts
colnames(count) <- tmpsname[i]
tmp <- cbind(as.data.frame(m), count)
out_f <- sub(".bam", "_range.txt", tmpfname[i])
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
}
複数のRNA-seqデータファイルごとに和集合領域を定めてカウント情報を得るやり方です。"*_range.txt"という2つの出力ファイルが生成されます。
in_f1 <- "mapping_single_genome4.txt"
in_f2 <- "ref_genome.fa"
param_mapping <- "-m 1 --best --strata -v 1"
library(QuasR)
library(GenomicAlignments)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
time_e <- proc.time()
time_e - time_s
out
alignmentStats(out)
tmpfname <- out@alignments[,1]
tmpsname <- out@alignments[,2]
for(i in 1:length(tmpfname)){
k <- readGAlignments(tmpfname[i])
m <- reduce(granges(k))
tmpcount <- summarizeOverlaps(m, tmpfname[i])
count <- assays(tmpcount)$counts
colnames(count) <- tmpsname[i]
tmp <- cbind(as.data.frame(m), count)
out_f <- sub(".bam", "_range.txt", tmpfname[i])
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
}
全部のマッピング結果をまとめて和集合領域を定め、カウント情報を得るやり方です。サンプル間比較の際に便利。
in_f1 <- "mapping_single_genome4.txt"
in_f2 <- "ref_genome.fa"
out_f <- "hoge3.txt"
param_mapping <- "-m 1 --best --strata -v 1"
library(QuasR)
library(GenomicAlignments)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
time_e <- proc.time()
time_e - time_s
out
alignmentStats(out)
tmpfname <- out@alignments[,1]
tmpsname <- out@alignments[,2]
for(i in 1:length(tmpfname)){
if(i == 1){
k <- readGAlignments(tmpfname[i])
} else{
k <- c(k, readGAlignments(tmpfname[i]))
}
}
m <- reduce(granges(k))
tmp <- as.data.frame(m)
for(i in 1:length(tmpfname)){
tmpcount <- summarizeOverlaps(m, tmpfname[i])
count <- assays(tmpcount)$counts
colnames(count) <- tmpsname[i]
tmp <- cbind(tmp, count)
}
out_f <- sub(".bam", "_range.txt", tmpfname[i])
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
全部のマッピング結果をまとめて和集合領域を定め、カウント情報を得るやり方です。一般的なカウントデータ行列の形式(2列目以降がカウント情報)にし、配列長情報と別々のファイルにして保存するやり方です。
in_f1 <- "mapping_single_genome4.txt"
in_f2 <- "ref_genome.fa"
out_f1 <- "hoge4_count.txt"
out_f2 <- "hoge4_genelength.txt"
param_mapping <- "-m 1 --best --strata -v 1"
library(QuasR)
library(GenomicAlignments)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
time_e <- proc.time()
time_e - time_s
out
alignmentStats(out)
tmpfname <- out@alignments[,1]
tmpsname <- out@alignments[,2]
for(i in 1:length(tmpfname)){
if(i == 1){
k <- readGAlignments(tmpfname[i])
} else{
k <- c(k, readGAlignments(tmpfname[i]))
}
}
m <- reduce(granges(k))
h <- as.data.frame(m)
tmp <- paste(h[,1],h[,2],h[,3],h[,4],h[,5], sep="_")
for(i in 1:length(tmpfname)){
tmpcount <- summarizeOverlaps(m, tmpfname[i])
count <- assays(tmpcount)$counts
colnames(count) <- tmpsname[i]
tmp <- cbind(tmp, count)
}
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
tmp <- paste(h[,1],h[,2],h[,3],h[,4],h[,5], sep="_")
tmp <- cbind(tmp, h$width)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=T)
BED形式のマップ後のファイルと(マップされる側の)リファレンス配列ファイルを読み込んでリファレンス配列の並びで配列長とカウント情報を取得するやり方を示します。
出力ファイルの並びは「リファレンス配列のdescription行」「配列長」「カウント情報」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. マップされる側の配列（hoge4.fa）中のIDの並びでBED形式ファイル(sample_1.bed)中の出現回数をカウントする場合：
in_f1 <- "sample_1.bed"
in_f2 <- "hoge4.fa"
out_f <- "hoge1.txt"
library(ShortRead)
data <- read.table(in_f1, sep="\t")
fasta <- readDNAStringSet(in_f2, format="fasta")
fasta
head(data)
hoge <- table(data[,1])
head(hoge)
out <- rep(0, length(fasta))
names(out) <- names(fasta)
out[names(hoge)] <- hoge
head(out)
tmp <- cbind(names(out), width(fasta), out)
colnames(tmp) <- c("ID", "Length", "Count")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
2. マップされる側の配列（hoge4.fa）中のIDをソートした並びでBED形式ファイル(sample_1.bed)中の出現回数をカウントする場合：
in_f1 <- "sample_1.bed"
in_f2 <- "hoge4.fa"
out_f <- "hoge2.txt"
library(ShortRead)
data <- read.table(in_f1, sep="\t")
fasta <- readDNAStringSet(in_f2, format="fasta")
fasta
head(data)
hoge <- table(data[,1])
head(hoge)
out <- rep(0, length(fasta))
names(out) <- sort(names(fasta))
out[names(hoge)] <- hoge
head(out)
tmp <- cbind(names(out), width(fasta[names(out)]), out)
colnames(tmp) <- c("ID", "Length", "Count")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
in_f1 <- "SRR002324_t.bed"
in_f2 <- "h_rna.fasta"
out_f <- "hoge3.txt"
library(ShortRead)
data <- read.table(in_f1, sep="\t")
fasta <- readDNAStringSet(in_f2, format="fasta")
fasta
head(data)
hoge <- table(data[,1])
head(hoge)
out <- rep(0, length(fasta))
names(out) <- names(fasta)
out[names(hoge)] <- hoge
head(out)
tmp <- cbind(names(out), width(fasta), out)
colnames(tmp) <- c("ID", "Length", "Count")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
4. マップされる側の配列（h_rna.fasta）中のIDをソートした並びでBED形式ファイル(SRR002324_t.bed)中の出現回数をカウントする場合：
in_f1 <- "SRR002324_t.bed"
in_f2 <- "h_rna.fasta"
out_f <- "hoge4.txt"
library(ShortRead)
data <- read.table(in_f1, sep="\t")
fasta <- readDNAStringSet(in_f2, format="fasta")
fasta
head(data)
hoge <- table(data[,1])
head(hoge)
out <- rep(0, length(fasta))
names(out) <- sort(names(fasta))
out[names(hoge)] <- hoge
head(out)
tmp <- cbind(names(out), width(fasta[names(out)]), out)
colnames(tmp) <- c("ID", "Length", "Count")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
RNA-seqデータは、原理的に配列長が長い転写物ほどその断片配列のリード数が多い傾向にあります。ここではそれを眺めます。
2014年7月3日に、boxplotで示すためにparam個で分割(20分割など)するテクニックとして「floor(nrow(data)/param)+1」としていましたが、
これだと割り切れる場合でも+1してしまうことが判明したため「ceiling(nrow(data)/param)」に修正しました(佐伯亘平氏提供情報)。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
「マップ後 | カウント情報取得 | トランスクリプトーム | BED形式ファイルから」の出力ファイルです。
横軸：配列長、縦軸：カウント数のシンプルな散布図を作成したい場合です。
(ダイナミックレンジが広いので両軸ともにlog10にしています。したがって、ゼロカウントになるところはlogを計算できないのでプロットされませんよ、という警告が出ます)
in_f <- "sample_length_count.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
plot(data, log="xy")
#plot(Count ~ Length, data=data, log="xy")
#plot(Count ~ Length, data=log10(data), xlab="log10(Length)", ylab="log10(Count)")
「マップ後 | カウント情報取得 | トランスクリプトーム | BED形式ファイルから」の出力ファイルです。
横軸：配列長、縦軸：カウント数のシンプルな散布図を作成したい場合です。線形回帰も行っています。
(ダイナミックレンジが広いので両軸ともにlog10にしています。したがって、ゼロカウントになるところはlogを計算できないのでプロットされませんよ、という警告が出ます)
in_f <- "sample_length_count.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
head(data)
data <- data[data[,2]>0,]
dim(data)
head(data)
plot(data, log="xy")
out <- lm(Count ~ Length, data=log10(data))
abline(out, col="red")
「マップ後 | カウント情報取得 | トランスクリプトーム | BED形式ファイルから」の出力ファイルです。
横軸：配列長、縦軸：カウント数のシンプルな散布図を作成したい場合です。平滑化曲線を追加しています。
(ダイナミックレンジが広いので両軸ともにlog10にしています。したがって、ゼロカウントになるところはlogを計算できないのでプロットされませんよ、という警告が出ます)
in_f <- "sample_length_count.txt"
param <- 0.2
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
head(data)
data <- data[data[,2]>0,]
dim(data)
head(data)
plot(data, log="xy")
lines(lowess(data, f=param), col="red")
「マップ後 | カウント情報取得 | トランスクリプトーム | BED形式ファイルから」の出力ファイルです。
横軸：配列長、縦軸：カウント数のboxplot(箱ひげ図)を作成したい場合です。
in_f <- "sample_length_count.txt"
param <- 20
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
head(data)
data <- data[data[,2]>0,]
dim(data)
head(data)
data <- data[order(data[,1]),]
head(data)
tail(data)
f <- gl(param, ceiling(nrow(data)/param), nrow(data))
head(f)
plot(f, log10(data[,2]), xlab="Length", ylab="log10(Count)")
data_shortest <- data[f==1,]
summary(data_shortest)
summary(log10(data_shortest))
data_longest <- data[f==param,]
summary(data_longest)
summary(log10(data_longest))
「マップ後 | カウント情報取得 | トランスクリプトーム | BED形式ファイルから」の出力ファイルです。
横軸：配列長、縦軸：カウント数のboxplot(箱ひげ図)をpng形式ファイルで保存したい場合です。
in_f <- "sample_length_count.txt"
out_f <- "hoge5.png"
param1 <- 20
param_fig <- c(600, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- data[data[,2]>0,]
data <- data[order(data[,1]),]
f <- gl(param1, ceiling(nrow(data)/param1), nrow(data))
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(f, log10(data[,2]), xlab="Length", ylab="log10(Count)")
dev.off()
「パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)」の出力ファイルです。
カウントデータファイルは全部で6サンプル分のデータが含まれていますが、ここでは(Ensembl Gene ID列を除く)3列目の"Pro_rep3"のカウントデータと配列長との関係を調べています。
横軸：配列長、縦軸：カウント数のboxplot(箱ひげ図)をpng形式ファイルで保存したい場合です。
in_f1 <- "srp017142_count_bowtie.txt"
in_f2 <- "srp017142_genelength.txt"
out_f <- "hoge6.png"
param1 <- 20
param2 <- 3
param_fig <- c(600, 400)
hoge <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
len <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- hoge[, param2]
data <- cbind(len, hoge)
data <- data[data[,2]>0,]
data <- data[order(data[,1]),]
f <- gl(param1, ceiling(nrow(data)/param1), nrow(data))
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(f, log10(data[,2]), xlab="Length", ylab="log10(Count)")
dev.off()
「パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)」の出力ファイルです。
RPKMデータファイルは全部で6サンプル分のデータが含まれていますが、ここでは(Ensembl Gene ID列を除く)3列目の"Pro_rep3"のカウントデータと配列長との関係を調べています。
横軸：配列長、縦軸：カウント数のboxplot(箱ひげ図)をpng形式ファイルで保存したい場合です。配列長補正によって、偏りが軽減されていることがわかります。
in_f1 <- "srp017142_RPKM_bowtie.txt"
in_f2 <- "srp017142_genelength.txt"
out_f <- "hoge7.png"
param1 <- 20
param2 <- 3
param_fig <- c(600, 400)
hoge <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
len <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- hoge[, param2]
data <- cbind(len, hoge)
data <- data[data[,2]>0,]
data <- data[order(data[,1]),]
f <- gl(param1, ceiling(nrow(data)/param1), nrow(data))
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(f, log10(data[,2]), xlab="Length", ylab="log10(Count)")
dev.off()
書籍 | トランスクリプトーム解析 | 2.3.6 カウントデータ取得のp92のコードを実行して得られたファイルです。
(Gene ID列を除く)1列目の配列長と2列目の"Kidney"のカウントデータとの関係を調べています。
横軸：配列長、縦軸：カウント数のboxplot(箱ひげ図)をpng形式ファイルで保存したい場合です。
in_f <- "SRA000299_ensgene.txt"
out_f <- "hoge8.png"
param1 <- 20
param2 <- c(1, 2)
param_fig <- c(600, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- data[, param2]
data <- data[data[,2]>0,]
data <- data[order(data[,1]),]
f <- gl(param1, ceiling(nrow(data)/param1), nrow(data))
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(f, log10(data[,2]), xlab="Length", ylab="log10(Count)")
dev.off()
記述内容が相当古いので参考程度にしてください(2014/06/22)。。。
サンプル内正規化周辺：
一つ上の項目（前処理 | 発現レベルの定量化について）は主にリファレンス配列（ゲノムやトランスクリプトーム）に対してRNA-seqによって得られたリードをマップし、
既知の遺伝子構造に対して転写物ごとの発現レベルに応じたspliced readsの割り当て方や遺伝子レベルの発現量をどのように見積もるか？といった問題に対処するプログラムを紹介しています。
そのため、サンプル内での異なる遺伝子間の発現レベルの大小を比較可能にしたうえでqPCR結果とのlinearityなどの評価を行うことになりますので、「(gene lengthなどの)サンプル内の正規化」は内包していると考えても基本的に差し支えはありません。
「長い遺伝子ほどマップされるリード数が多くなる」ことは2008年頃の時点ですでにわかっていたので、gene lengthの補正は基本的に組み込まれていました。
しかし、その後gene length補正後でも「配列長が長いほど（発現レベルが高いほど）有意に発現変動していると検出される傾向にある(Oshlack and Wakefield, 2009)」という報告や、
「GC含量が高くても低くてもリードカウント数が少なくなり、中程度のGC含量のところがリードカウント数が多い傾向にある（unimodal; Risso et al., 2011）」といったことがわかってきており、リードカウント数(or 発現変動解析結果)とGC含量（or gene length）のbiasをなくす方法が提案されてきました。
どの順番（またはタイミング）で正規化を行うかについてはまだよくわかっていません。Young(2010)らはGene Ontology解析時に発現変動解析後にgene lengthの補正を行っていますが、Risso(2011)らは発現変動解析前にGC-related bias補正を行うほうがよいと述べています。
尚、ここでの主な評価基準は下記のa.およびb.です。
サンプル間正規化周辺：
sequence depth関連のサンプル間正規化の主な目的の一つとして、異なるサンプル（グループ）間で発現の異なる遺伝子(Differentially Expressed Genes; DEGs)を検出することが挙げられます。
したがって、特にサンプル間正規化を目的とした正規化法の評価は下記のよく用いられる評価基準のうち、「c.」が重要視されます。
「どの正規化法を使うか？」ということが「どの発現変動遺伝子検出法を使うか？」ということよりも結果に与える影響が大きい(Bullard et al., 2010; Kadota et al., 2012; Garmire and Subramaniam, 2012)ことがわかりつつあります。
正規化 | サンプル間 | 複製あり | TbT正規化(Kadota_2012)でも述べていますが、従来のサンプル間正規化法（RPMやTMM法）は比較する二群間（G1群 vs. G2群）でDEG数に大きな偏りがないことを前提にしています。
つまり、「(G1群 >> G2群)のDEG数と(G1群 << G2群)のDEG数が同程度」という前提条件がありますが、実際には大きく偏りがある場合も想定すべきで、偏りがあるなしにかかわらずロバストに正規化を行ってくれるのがTbT正規化法(Kadota et al., 2012)です。
偏りがあるなしの主な原因はDEGの分布にあるわけです。よって、TbT論文では、「正規化中にDEG検出を行い、DEGを除き、non-DEGのみで再度正規化係数を決める」というDEG elimination strategyに基づく正規化法を提案しています。
そして、TbT法を含むDEG elimination strategyに基づくいくつかの正規化法をTCCというRパッケージ中に実装しています(TCC論文中ではこの戦略をDEGES「でげす」と呼んでいます; Sun et al., 2013)。TCCパッケージ中に実装されている主な方法および入力データは以下の通りです：
- DEGES/TbT：オリジナルのTbT法そのもの。TMM-baySeq-TMMという3ステップで正規化を行う方法。step 2のDEG同定のところで計算時間のかかるbaySeqを採用しているため、他のパッケージでは数秒で終わる正規化ステップが数十分程度はかかるのがネック。また、biological replicatesがあることを前提としている。（A1, A2, ...） vs. (B1, B2, ...)のようなデータという意味。
- iDEGES/edgeR：DEGES/TbT法の超高速版(100倍程度高速)。TMM-(edgeR-TMM)nというステップで正規化を行う方法(デフォルトはn = 3)。step 2のDEG同定のところでedgeRパッケージ中のexact test (Robinson and Smyth, 2008)を採用しているためDEG同定の高速化が可能。
したがって、(step2 - step3)のサイクルをiterative (それゆえDEGESの頭にiterativeの意味を示すiがついたiDEGESとなっている)に行ってよりロバストな正規化係数を得ることが理論的に可能な方法です。それゆえreplicatesのある二群間比較を行いたい場合にはDEGES/TbTよりもiDEGES/edgeRのほうがおすすめ。
- iDEGES/DESeq：一連のmulti-stepの正規化手順をすべてDESeqパッケージ中の関数のみで実装したパイプライン。複製実験のない二群間比較時(i.e., A1 vs. B1など)にはこちらを利用します。
ここでは、主に生のリードカウント（整数値；integer）データを入力として（異なる遺伝子間の発現レベルの大小比較のため）サンプル内で行うGC含量補正やgene length補正を行う方法や、
（サンプル間で同一遺伝子の発現変動比較のため）サンプル間で行うsequence depth関連の補正を行う方法についてリストアップしておきます。なぜ前処理 | 発現レベルの定量化についてで得られた数値データを使わないのか？についてですが、
よく言われることとしては「モデル（Poisson model, generalized Poisson model, negative binomial modelなど）に従わなくなるから取り扱いずらくなる」ということもあるんでしょうね。このあたりはedgeRのマニュアルなどで明記されていたりもします。
spliced read情報を含んだ発現情報を用いた正規化法の開発についてもディスカッションではよく述べられています(Dillies et al., in press)が、、、対応版は近い将来publishされる論文で出てくるでしょう。
また、現在の方法は主に転写物レベルではなく遺伝子レベルの解析です。一歩踏み込んだエクソンレベルの解析用Rパッケージ（正規化法含む）も出てきています(Anders et al., 2012)。
一般によく用いられるカウントデータは「2塩基ミスマッチまで許容して一か所にのみマップされるリードの数（uniquely mapped reads allowing up to two mismatches）」です(Frazee et al., 2011; Risso et al., 2011; Sun and Zhu, 2012)。
どの正規化法がいいかを評価する基準としてよく用いられているのは下記のものなどが挙げられます。
二番目については、gold standardの結果自体も測定誤差(measurement error; ME)を含むのでgold standard非依存のME modelを利用した評価法(Sun and Zhu, 2012)も提案されています：
- 複製実験データの再現性が高いかどうか？(reproducibilityとかprecisionという用語が対応します)
- qRT-PCRやmicroarrayなどの他の実験技術由来のデータをgold standardとしてそれとの相関係数が高いかどうか？(accuracy; Garmire and Subramaniam, 2012)
- シミュレーションデータなど、既知の発現変動遺伝子（DEGs）を発現変動遺伝子として上位にランキングできる正規化法かどうか？(AUC; Kadota et al., 2012)
「方法名」：「Rパッケージ名」：「原著論文」の順番です。(あれば)
また、必ずしも正規化法の原著論文とは対応付いていませんのであしからず。この方法を使いたいがどのパッケージで利用可能？、という視点でご覧になってください。
- 正規化(サンプル内; GC含量補正)：
-
- regression正規化(loess)：EDASeq：Risso et al., BMC Bioinformatics, 2011
- global正規化：EDASeq：Risso et al., BMC Bioinformatics, 2011
- full quantile (FQ)正規化：EDASeq：Risso et al., BMC Bioinformatics, 2011
- conditional quantile正規化(CQN)：cqn：Hansen et al., Biostatistics, 2012
- GCcorrect：Benjamini and Speed, Nucleic Acids Res., 2012
- 正規化(サンプル内; GC contents and gene length同時補正)：
-
- 正規化(サンプル内; 全般；分布系)：
-
- 正規化(サンプル内; 全般；その他(自分の前後の塩基の使用頻度を考慮, sequencing preference))：
-
- 正規化(サンプル間)：
-
- RPM (or CPM)正規化：edgeR：Robinson et al., Bioinformatics, 2010
- TMM正規化：edgeR：Robinson et al., Bioinformatics, 2010
- Anders and Huberの(AH)正規化：DESeq：Anders and Huber, Genome Biol, 2010
- median正規化：EDASeq：Risso et al., BMC Bioinformatics, 2011
- Upper-quartile (UQ)正規化：EDASeq：Risso et al., BMC Bioinformatics, 2011
- full quantile (FQ)正規化：EDASeq：Risso et al., BMC Bioinformatics, 2011
- TbT (DEGES/TbT)正規化(複製あり、なしデータ用)：TCC：Kadota et al., Algorithms Mol. Biol., 2012
- iDEGES/edgeR正規化(複製ありデータ用)：TCC：Sun et al., BMC Bioinformatics, 2013
- iDEGES/DESeq正規化(複製なしデータ用)：TCC：Sun et al., BMC Bioinformatics, 2013
他の参考文献：
- an exact test for negative binomial distribution：Robinson and Smyth, Biostatistics, 2008
- Oshlack and Wakefield, Biology Direct, 2009
- goseq：Young et al., Genome Biol., 2010
- Bullard et al., BMC Bioinformatics, 2010
- ReCount：Frazee et al., BMC Bioinformatics, 2011
- Garmire and Subramanian, RNA, 2012
- DEXseq：Anders et al., Genome Res., 2012
- Sun and Zhu, Bioinformatics, 2012
- Dillies et al., Brief. Bioinform., in press
ここでは、「マップ後 | カウント情報取得 | トランスクリプトーム | BED形式ファイルから」で得られた配列長とカウント情報を含むファイル(sample_length_count.txt)から、
転写物ごとのリード数を「配列長が1000 bp (kilobase)だったときのリード数; Reads per kilobase (RPK)」に変換するやり方を示します。
「リード数 = カウント数」なのでReadsのところをCountsに置き換えた表現(Counts per kilobase; CPK)もときどき見受けられます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
in_f <- "sample_length_count.txt"
out_f <- "hoge1.txt"
param1 <- 1000
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
nf <- param1/data[,1]
out <- data[,2] * nf
tmp <- cbind(rownames(data), data[,1], out)
colnames(tmp) <- c("ID", "Length", "Count")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. 配列長とカウント情報を含むファイル(sample_length_count.txt)を読み込んで変換し、横軸：配列長、縦軸：RPK値のboxplot(箱ひげ図)をpng形式ファイルで保存したい場合：
in_f <- "sample_length_count.txt"
out_f <- "hoge2.png"
param1 <- 20
param_fig <- c(600, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
data <- data[data[,2]>0,]
head(data)
data <- data[order(data[,1]),]
head(data)
f <- gl(param1, floor(nrow(data)/param1)+1, nrow(data))
nf <- 1000/data[,1]
data[,2] <- data[,2] * nf
head(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(f, log10(data[,2]), xlab="Length", ylab="log10(Count)")
abline(h=1, col="red")
dev.off()
in_f1 <- "data_marioni.txt"
in_f2 <- "length_marioni.txt"
out_f <- "hoge3.txt"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
len <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
dim(len)
head(data)
head(len)
colSums(data)
nf <- 1000/len[,1]
data <- sweep(data, 1, nf, "*")
head(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
カウントデータファイルを読み込んで、転写物ごとのリード数を「総リード数が100万 (million)だったときのリード数; Reads per million (RPM)」に変換するやり方を示します。
「リード数 = カウント数」なのでReadsのところをCountsに置き換えた表現(Counts per million; CPM)もときどき見受けられます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 3列目にカウント情報を含むファイル(sample_length_count.txt)からRPM変換した結果をファイルに保存したい場合：
in_f <- "sample_length_count.txt"
out_f <- "hoge1.txt"
param1 <- 1000000
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
sum(data[,2])
nf <- param1/sum(data[,2])
out <- data[,2] * nf
head(out)
sum(out)
tmp <- cbind(rownames(data), data[,1], out)
colnames(tmp) <- c("ID", "Length", "Count")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.txt"
param1 <- 1000000
param_nonDEG <- 2001:10000
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
dim(data)
colSums(data)
data <- data[param_nonDEG,]
head(data)
dim(data)
colSums(data)
nf <- param1/colSums(data)
data <- sweep(data, 2, nf, "*")
head(data)
colSums(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
non-DEGデータのみを正規化してM-A plotを作成しています。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge3.txt"
param1 <- 1000000
param_nonDEG <- 2001:10000
param_G1 <- 3
param_G2 <- 3
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- data[param_nonDEG,]
nf <- param1/colSums(data)
data <- sweep(data, 2, nf, "*")
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
plot(A, M, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
median(M, na.rm=TRUE)
abline(h=median(M, na.rm=TRUE), col="black")
tmp <- cbind(rownames(data), data, G1, G2, log2(G1), log2(G2), M, A)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
non-DEGデータのみを正規化してM-A plotを作成していろいろとハイライトさせるやり方です。
in_f <- "data_hypodata_3vs3.txt"
param1 <- 1000000
param_nonDEG <- 2001:10000
param_G1 <- 3
param_G2 <- 3
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- data[param_nonDEG,]
nf <- param1/colSums(data)
data <- sweep(data, 2, nf, "*")
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
plot(A, M, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
obj <- "gene_2002"
points(A[obj], M[obj], col="red", cex=1.0, pch=20)
obj <- (M >= log2(4))
points(A[obj], M[obj], col="blue", cex=0.8, pch=6)
sum(obj, na.rm=TRUE)
obj <- (A > 10)
points(A[obj], M[obj], col="lightblue", cex=0.8, pch=17)
sum(obj, na.rm=TRUE)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
上記DEGを色分けするやり方です。
in_f <- "data_hypodata_3vs3.txt"
param1 <- 1000000
param_G1 <- 3
param_G2 <- 3
param_DEG_G1 <- 1:1800
param_DEG_G2 <- 1801:2000
param_nonDEG <- 2001:10000
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
nf <- param1/colSums(data)
data <- sweep(data, 2, nf, "*")
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
plot(A, M, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
median(M[param_nonDEG], na.rm=TRUE)
abline(h=median(M[param_nonDEG], na.rm=TRUE), col="black")
obj <- param_DEG_G1
points(A[obj], M[obj], col="blue", cex=0.1, pch=20)
obj <- param_DEG_G2
points(A[obj], M[obj], col="red", cex=0.1, pch=20)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
上記DEGを色分けしてPNG形式ファイルとして保存するやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge6.png"
param1 <- 1000000
param_G1 <- 3
param_G2 <- 3
param_DEG_G1 <- 1:1800
param_DEG_G2 <- 1801:2000
param_nonDEG <- 2001:10000
param_fig <- c(400, 380)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
nf <- param1/colSums(data)
data <- sweep(data, 2, nf, "*")
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(-8, 6), pch=20, cex=.1)
grid(col="gray", lty="dotted")
median(M[param_nonDEG], na.rm=TRUE)
abline(h=median(M[param_nonDEG], na.rm=TRUE), col="black")
obj <- param_DEG_G1
points(A[obj], M[obj], col="blue", cex=0.1, pch=20)
obj <- param_DEG_G2
points(A[obj], M[obj], col="red", cex=0.1, pch=20)
legend("topright", c("DEG(G1)", "DEG(G2)", "non-DEG"), col=c("blue", "red", "black"), pch=20)
dev.off()
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
edgeRパッケージ中のcpm関数を用いるやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge7.txt"
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
colSums(data)
data <- cpm(data)
head(data)
colSums(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param_G1 <- 3
param_G2 <- 3
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
6.をTCCパッケージを利用して行うやり方です。
各サンプルのリード数を100万ではなく平均リード数に揃えています。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge8.txt"
out_f2 <- "hoge8.png"
param_G1 <- 3
param_G2 <- 3
param_DEG_G1 <- 1:1800
param_DEG_G2 <- 1801:2000
param_nonDEG <- 2001:10000
param_fig <- c(400, 380)
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))
tcc <- new("TCC", data, data.cl)
data <- getNormalizedData(tcc)
tmp <- cbind(rownames(data), data)
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])
obj <- c(rep(1, length(param_DEG_G1)),
rep(2, length(param_DEG_G2)),
rep(3, length(param_nonDEG)))
cols <- c("blue", "red", "black")
plot(tcc, col=cols, col.tag=obj, normalize=T)
legend("topright", c("DEG(G1)", "DEG(G2)", "non-DEG"), col=c("blue", "red", "black"), pch=20)
dev.off()
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
2.をTCCパッケージを利用して行うやり方です。
各サンプルのリード数を100万ではなく平均リード数に揃えています。
non-DEGデータのみを正規化してM-A plotを作成するやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge9.txt"
out_f2 <- "hoge9.png"
param_G1 <- 3
param_G2 <- 3
param_nonDEG <- 2001:10000
param_fig <- c(400, 380)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- data[param_nonDEG,]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tcc <- new("TCC", data, data.cl)
data <- getNormalizedData(tcc)
tmp <- cbind(rownames(data), data)
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(tcc, normalize=T)
dev.off()
ここでは、「マップ後 | カウント情報取得 | トランスクリプトーム | BED形式ファイルから」で得られた配列長とカウント情報を含むファイル(sample_length_count.txt)から、
転写物ごとのリード数を「配列長が1000 bp (kilobase)で総リード数が100万だったときのリード数; Reads per kilobase per million (RPKM)」に変換するやり方を示します。
また、18,110 genes×10 samplesサンプルデータのカウントデータ(data_marioni.txt; G1群5サンプル vs. G2群5サンプル)
についても、長さ情報を含む別ファイル(length_marioni.txt)を同時に読み込んでRPKM値に変換するやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
in_f <- "sample_length_count.txt"
out_f <- "hoge1.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
sum(data[,2])
nf_RPM <- 1000000/sum(data[,2])
nf_RPK <- 1000/data[,1]
data[,2] <- data[,2] * nf_RPM * nf_RPK
head(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
in_f1 <- "data_marioni.txt"
in_f2 <- "length_marioni.txt"
out_f <- "hoge2.txt"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
len <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
dim(len)
head(data)
head(len)
colSums(data)
nf_RPM <- 1000000/colSums(data)
data <- sweep(data, 2, nf_RPM, "*")
head(data)
colSums(data)
nf_RPK <- 1000/len[,1]
data <- sweep(data, 1, nf_RPK, "*")
head(data)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
ゲノムへのマッピング結果ファイル(BED format)をもとにして、(既知)遺伝子の発現レベルを計算してくれます。
そのためには、マッピング結果ファイルだけでなく、どの領域にどの遺伝子があるのかという座標(Coordinates)情報を含むrefFlatという形式のファイル(アノテーション情報取得 | refFlatファイルを参照)も同時に必要ですので予め入手しておいてください。
ここでは、以下を行って得られたBED formatファイル(SRR002323.bowtiebed; 140MB程度あります)とヒトのrefFlat.txtの二つのファイルを入力として遺伝子発現レベルを見積もるやり方を示します。
ちなみにこのSRR002323.bowtiebedファイルは、NCBI SRAから得られたSRR002323.fastqファイルをfastq_process2.plで前処理(マッピング | 入力ファイル形式についてを参照)して得られたSRR002323.fastq2ファイルをマッピングプログラムBowtie ver. 0.12.5 (オプションは"--offrate 3 -p 8 -a --best --strata -v 2 -m 1 --sam")を用いて、
ヒトゲノム配列(chr1-22, X, Y, and M；配列取得 | リファレンス配列(マップされる側)を参照)に対して実行して得られたSAM formatファイルをBED formatに変換(イントロ | NGS | ファイル形式の変換を参照)したものです。
以下を実行して得られるファイル(SRR002323.bowtieexp)は、5列から構成されます：
- 1列目：「Gene symbol」
- 2列目：「生のsequenceされた回数(raw counts)」
- 3列目：「正規化後の発現レベル(RPKM)」
- 4列目：「入力BED formatファイル中の行数(マップされた総リード数に相当；all reads)」
- 5列目：「配列長(そのgene symbolを構成するエクソン領域の和集合)」
この3列目のRPKM値がいわゆるglobal normalization後のデータということになります。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
in_f1 <- "SRR002323.bowtiebed"
in_f2 <- "refFlat.txt"
out_f <- "hoge1.txt"
library(DEGseq)
out <- getGeneExp(in_f1, refFlat=in_f2, output=out_f)
out[,3]
Risso et al., BMC Bioinformatics, 2011のFig.1を見ればわかりますが、
遺伝子のカウント数（発現量に相当；縦軸）をGC含量で横軸に展開してやるとunimodal（山が一つ、の意味）な分布になる傾向にあります。
つまり、GC含量が低すぎても高すぎてもカウント数が低くなり、中程度のときにタグカウント数が多くなる傾向にある、ということを言っているわけです。
彼らはこの傾向をYeastのRNA-seqデータ(同じgrowth conditionで得られた4つのcultures。これらはbiological replicatesとみなせるそうです。
そしてcultureごとに2 technical replicatesがある。計8列分のデータ; Y1, Y1, Y2, Y2, Y7, Y7, Y4, Y4; SRA048710)で示しています。
このデータから4 replicates vs. 4 replicatesの"null pseudo-dateset"を計choose(8,4)/2 = 35セットの「発現変動遺伝子(DEG)のないデータセット」を作成可能ですが、
GC含量が高いほどDEGとcallされる傾向にある(Fig.6)ことも示しています。
マイクロアレイではこのようなGC biasは見られませんので、library preparation時にこのようなbiasが導入されているんだろう(Benjamini and Speed, Nucleic Acids Res., 2012)と言われています。
Rissoらは、このGC biasを補正するための方法として、EDASeqパッケージ中でloess, median, FQ (full quantile)の三つの正規化法を提案し実装していますが、ここでは彼らの論文中で最もGC biasを補正できたというFQ正規化法のやり方を示します。
もちろんGC biasを補正するわけですから、入力データはいわゆる「遺伝子発現行列データ(count matrix)」以外に「遺伝子ごとのGC含量情報を含むベクトル情報」が必要です。
ここではサンプルデータ10のyeastRNASeqパッケージから取得可能な「2 samples vs 2 samples」のyeast RNA-seq dataset (7065 genes×4列; Lee et al., 2008)、
およびEDASeqパッケージから取得可能なSGD ver. r64に基づくyeast遺伝子のGC含量情報(6717 genes)を用いて一連の解析を行います。
発現情報とGC含量情報の対応付けが若干ややこしいですが、このあたりのテクニックは結構重要です。
尚、以下ではparam1のところで、"full"を指定することでfull quantile正規化(GCのbinごとにカウントの順位が同じものは同じカウントになるような正規化)を実現していますが、ここを以下のように変えることで他に三種類の異なる正規化を実行することができます：
- "loess"の場合：loess正規化(non-linearな局所的な回帰を行ってくれる)
- "median"の場合：median正規化(GCのbinごとのmedianが同じになるような正規化を行う)
- "upper"の場合：upper quartile正規化(GCのbinごとのupper quartile (75 percentile rankのこと)が同じになるような正規化を行う)
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてある(or 出力ファイルを置きたい)ディレクトリに移動し以下をコピペ。
in_f <- "sample_gc_count.txt"
out_f <- "hoge1.txt"
param1 <- "full"
param2 <- 10
library(EDASeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
count <- as.matrix(data[,2])
rownames(count) <- rownames(data)
GC <- data.frame(GC=data[,1]/100)
rownames(GC) <- rownames(data)
head(count)
head(GC)
data.cl <- c(rep(1, ncol(count)))
es <- newSeqExpressionSet(exprs=count,
featureData=GC,
phenoData=data.frame(conditions=data.cl))
es
out <- withinLaneNormalization(es, "GC", which=param1, num.bins=param2, round=FALSE)
tmp <- cbind(rownames(data), GC, exprs(out))
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
(どういう正規化係数がかかっているのかについて詳細な情報を出力している)
in_f <- "sample_gc_count.txt"
out_f1 <- "hoge2_before.png"
out_f2 <- "hoge2_after.png"
out_f3 <- "hoge2.txt"
param1 <- "full"
param2 <- 10
param_fig <- c(500, 450)
library(EDASeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
count <- as.matrix(data[,2])
rownames(count) <- rownames(data)
GC <- data.frame(GC=data[,1]/100)
rownames(GC) <- rownames(data)
head(count)
head(GC)
data.cl <- c(rep(1, ncol(count)))
es <- newSeqExpressionSet(exprs=count,
featureData=GC,
phenoData=data.frame(conditions=data.cl))
es
out <- withinLaneNormalization(es, "GC", which=param1, num.bins=param2, round=FALSE)
out2 <- withinLaneNormalization(es, "GC", which=param1, num.bins=param2, offset=TRUE)
png(out_f1, pointsize=13, width=param_fig[1], height=param_fig[2])
biasPlot(es, "GC", log = T)
dev.off()
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
biasPlot(out, "GC", log = T)
dev.off()
tmp <- cbind(rownames(data), data, exp(offst(out2)), exprs(out))
colnames(tmp) <- c("ID", "GC_contents", "Count(before)", "Norm_factor", "Count(after")
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
3. EDASeqパッケージ中の記述と似たやり方で示した場合：
param_G1 <- 2
param_G2 <- 2
param1 <- "full"
library(yeastRNASeq)
library(EDASeq)
data(geneLevelData)
data(yeastGC)
dim(geneLevelData)
head(geneLevelData)
length(yeastGC)
head(yeastGC)
head(rownames(geneLevelData))
head(names(yeastGC))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
common <- intersect(rownames(geneLevelData), names(yeastGC))
length(common)
data <- as.matrix(geneLevelData[common, ])
GC <- data.frame(GC = yeastGC[common])
head(rownames(data))
head(rownames(GC))
es <- newSeqExpressionSet(exprs = data,
featureData = GC,
phenoData = data.frame(conditions = data.cl,
row.names = colnames(data)))
es
biasPlot(es, "GC", log = T, ylim = c(-1, 4))
out <- withinLaneNormalization(es, "GC", which = param1)
biasPlot(out, "GC", log = T, ylim = c(-1, 4))
out_f1 <- "data_yeastGCbias_common_before.txt"
out_f2 <- "data_yeastGCbias_common_after.txt"
out_f3 <- "data_yeastGCbias_common_GCcontent.txt"
tmp <- cbind(rownames(exprs(es)), exprs(es))
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
tmp <- cbind(rownames(exprs(out)), exprs(out))
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
tmp <- cbind(rownames(fData(es)), fData(es))
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
out_f4 <- "data_yeastGCbias_common_offset.txt"
out2 <- withinLaneNormalization(es, "GC", which = param1, offset = TRUE)
head(offst(out2))
tmp <- cbind(rownames(offst(out2)), offst(out2))
write.table(tmp, out_f4, sep="\t", append=F, quote=F, row.names=F)
head(exprs(out))
head(exprs(es))
head(exp(offst(out2)))
normalized <- exprs(es) * exp(offst(out2))
head(normalized)
head(round(normalized))
4. 二つのタブ区切りテキストファイルの読み込みからやる場合：
7,065行×4列のyeast RNA-seqデータ(data_yeast_7065.txt; 2 wild-types vs. 2 mutant strains; technical replicates)
6,717 yeast genes (SGD ver. r64)のGC含量(yeastGC_6717.txt)
in_f1 <- "data_yeast_7065.txt"
in_f2 <- "yeastGC_6717.txt"
param_G1 <- 2
param_G2 <- 2
param1 <- "full"
library(EDASeq)
data.tmp <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
gc.tmp <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
common <- intersect(rownames(data.tmp), rownames(gc.tmp))
length(common)
data <- as.matrix(data.tmp[common, ])
GC <- data.frame(GC = gc.tmp[common, ])
rownames(GC) <- common
es <- newSeqExpressionSet(exprs = data,
featureData = GC,
phenoData = data.frame(conditions = data.cl,
row.names = colnames(data)))
es
biasPlot(es, "GC", log = T, ylim = c(-1, 4))
out <- withinLaneNormalization(es, "GC", which = param1)
biasPlot(out, "GC", log = T, ylim = c(-1, 4))
out_f1 <- "data_yeastGCbias_common_before.txt"
out_f2 <- "data_yeastGCbias_common_after.txt"
out_f3 <- "data_yeastGCbias_common_GCcontent.txt"
tmp <- cbind(rownames(exprs(es)), exprs(es))
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
tmp <- cbind(rownames(exprs(out)), exprs(out))
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
tmp <- cbind(rownames(fData(es)), fData(es))
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
RNASeqBiasというRパッケージの正規化法の論文です。論文中では、GAM correction法と呼んでいます。
a simple generalized-additive-model based approachを用いてGC contentやgene lengthの補正を同時に行ってくれるようです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Bullardら(2010)の各種統計的解析手法の評価論文で用いられた正規化法です。
マイクロアレイデータのときは「中央値(median)を揃える」などが行われたりしましたが、
「第3四分位数（upper-quartile or 75 percentile rank）の値を揃える」という操作を行うことに相当します。
EDASeqというパッケージを用いて正規化を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "data_hypodata_3vs3_UQ.txt"
param_G1 <- 3
param_G2 <- 3
param1 <- "upper"
library(EDASeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
es <- newSeqExpressionSet(exprs = as.matrix(data),
phenoData = data.frame(conditions = data.cl,
row.names = colnames(data)))
es
summary(exprs(es))
hoge <- betweenLaneNormalization(es, which=param1)
normalized.count <- exprs(hoge)
summary(normalized.count)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt"
out_f <- "data_yeast_7065_UQ.txt"
param_G1 <- 2
param_G2 <- 2
param1 <- "upper"
library(EDASeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
es <- newSeqExpressionSet(exprs = as.matrix(data),
phenoData = data.frame(conditions = data.cl,
row.names = colnames(data)))
es
summary(exprs(es))
hoge <- betweenLaneNormalization(es, which=param1)
normalized.count <- exprs(hoge)
summary(normalized.count)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
カウントデータの「サンプル(列)間でカウント数の順位が同じならばカウント数も同じ」になるような操作を行う正規化です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
library(limma)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
hoge <- normalizeBetweenArrays(as.matrix(data))
normalized.count <- exprs(hoge)
summary(normalized.count)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
箱ひげ図(box plot)も作成しています。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
library(EDASeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
es <- newSeqExpressionSet(exprs=as.matrix(data),
phenoData=data.frame(conditions=data.cl,
ow.names=colnames(data)))
es
summary(exprs(es))
hoge <- betweenLaneNormalization(es, which="full")
normalized.count <- exprs(hoge)
summary(normalized.count)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
library(EDASeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
es <- newSeqExpressionSet(exprs=as.matrix(data),
phenoData=data.frame(conditions=data.cl,
ow.names=colnames(data)))
es
summary(exprs(es))
hoge <- betweenLaneNormalization(es, which="full")
normalized.count <- exprs(hoge)
summary(normalized.count)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
TCCパッケージ(Sun et al., BMC Bioinformatics, 2013)から利用可能なiDEGES/edgeR正規化法の実行手順を示します。
iDEGES/edgeRは、TbT正規化法(Kadota et al., Algorithms Mol. Biol., 2012)
以上の理論性能かつ100倍程度高速(デフォルトの場合)化を実現したお勧めの正規化法です。
ここでは、iDEGES/edgeR法の実体である「TMM-(edgeR-TMM)n」パイプラインのnの値(iterationの回数)を3として実行します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
data <- getNormalizedData(tcc)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
M-A plotを作成したり、non-DEGの分布についても確認しています。
in_f <- "data_hypodata_3vs3.txt"
param_G1 <- 3
param_G2 <- 3
param_DEG_G1 <- 1:1800
param_DEG_G2 <- 1801:2000
param_nonDEG <- 2001:10000
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
data <- getNormalizedData(tcc)
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
plot(A, M, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
median(M[param_nonDEG], na.rm=TRUE)
abline(h=median(M[param_nonDEG], na.rm=TRUE), col="black")
obj <- param_DEG_G1
points(A[obj], M[obj], col="blue", cex=0.1, pch=20)
obj <- param_DEG_G2
points(A[obj], M[obj], col="red", cex=0.1, pch=20)
legend("topright", c("DEG(G1)", "DEG(G2)", "non-DEG"), col=c("blue", "red", "black"), pch=20)
summary(data[param_nonDEG,])
apply(data[param_nonDEG,], 2, median)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
M-A plotをpng形式ファイルで保存するやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge3.png"
param_G1 <- 3
param_G2 <- 3
param_DEG_G1 <- 1:1800
param_DEG_G2 <- 1801:2000
param_nonDEG <- 2001:10000
param_fig <- c(400, 380)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
data <- getNormalizedData(tcc)
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(-8, 6), pch=20, cex=.1)
grid(col="gray", lty="dotted")
median(M[param_nonDEG], na.rm=TRUE)
abline(h=median(M[param_nonDEG], na.rm=TRUE), col="black")
obj <- param_DEG_G1
points(A[obj], M[obj], col="blue", cex=0.1, pch=20)
obj <- param_DEG_G2
points(A[obj], M[obj], col="red", cex=0.1, pch=20)
legend("topright", c("DEG(G1)", "DEG(G2)", "non-DEG"), col=c("blue", "red", "black"), pch=20)
dev.off()
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
TCCパッケージ中のplot関数を使ってシンプルにM-A plotをpng形式ファイルで保存するやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge4.png"
param_G1 <- 3
param_G2 <- 3
param_DEG_G1 <- 1:1800
param_DEG_G2 <- 1801:2000
param_nonDEG <- 2001:10000
param_fig <- c(400, 380)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
obj <- c(rep(1, length(param_DEG_G1)),
rep(2, length(param_DEG_G2)),
rep(3, length(param_nonDEG)))
cols <- c("blue", "red", "black")
plot(tcc, col=cols, col.tag=obj, ylim=c(-8, 6), median.lines=TRUE)
legend("topright", c("DEG(G1)", "DEG(G2)", "non-DEG"), col=c("blue", "red", "black"), pch=20)
dev.off()
- Robinson and Smyth, Biostatistics, 2008
- TMM正規化法：Robinson and Oshlack, Genome Biol., 2010
- edgeR：Robinson et al., Bioinformatics, 2010
- baySeq：Hardcastle and Kelly, BMC Bioinformatics, 2010
- TCC：Sun et al., BMC Bioinformatics, 2013
TbT法の正規化における基本戦略は「正規化時に悪さをするDEGを正規化前に除いてしまえ (DEG elimination strategy; DEGES; でげす)」です。
通常のDEG検出手順は「1.データ正規化( → 2.DEG検出)」の2ステップで完結するため、上記コンセプトを実現することができません。そこで通常の手順を二回繰返す解析パイプラインを提案しています。
つまり「1.データ正規化 → 2.DEG検出 → 3.データ正規化( → 4.DEG検出)」です。この手順で行えばStep3のデータ正規化時にStep2で検出されたDEG候補を除いたデータで正規化を行うことができるのです。
TbT法の実体は、「1.TMM法(Robinson and Oshlack, 2010) → 2.baySeq (Hardcastle and Kelly, 2010) → 3.TMM法」の解析パイプラインです。Step1で既存正規化法の中で高性能なTMM法を採用し、
Step2で(Step1で得られたTMM正規化係数と総リード数(library sizes)を掛けて得られた)effective library sizesを与えてbaySeqを実行してDEG候補を取得し、
Step3でnon-DEGsのみで再度TMM正規化を実行して得られたものがTbT正規化係数です。従って、TbT正規化法を利用する場合は、内部的に用いられた文献も引用するようにお願いします。
以下のスクリプトを実行すると概ね数十分程度はかかります(*_*)...。これは、TbT法の内部で計算時間のかかるbaySeqを利用しているためです。
動作確認のみしたい、という人はparam_samplesizeのところで指定する数値を500とかにして実行してください。おそらく数分で結果を得られると思われます。
ここでは、TbT正規化係数の算出法とTbT正規化後のデータを得る手順などを示しています。
が、基本的に正規化だけで終わることはありませんので、ここの項目のみでは何の役にも立ちませんのであしからず。。。
また、サンプルデータ14 (data_hypodata_1vs1.txt)の1 sample vs. 1 sampleのような「複製なし」データの正規化は実行できません（理由はstep2で用いるbaySeqが複製ありを前提としているためです）のでご注意ください。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_samplesize <- 10000
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm",
test.method="bayseq", samplesize=param_samplesize)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
table(tcc$private$DEGES.potentialDEG)
tcc$norm.factors
tcc$private$simulation <- TRUE
tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))
plot(tcc, median.lines=TRUE)
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge2.txt"
param_G1 <- 2
param_G2 <- 2
param_samplesize <- 10000
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm",
test.method="bayseq", samplesize=param_samplesize)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
table(tcc$private$DEGES.potentialDEG)
tcc$norm.factors
このデータはどのサンプルでも発現していない（zero count; ゼロカウント）ものが多いので、
どこかのサンプルで0より大きいカウントのもののみからなるサブセットを抽出して2.と同様の計算を行っています。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 2
param_samplesize <- 10000
param_lowcount <- 0
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))
tcc <- new("TCC", data, data.cl)
dim(tcc$count)
tcc <- filterLowCountGenes(tcc, low.count = param_lowcount)
dim(tcc$count)
tcc <- calcNormFactors(tcc, norm.method="tmm",
test.method="bayseq", samplesize=param_samplesize)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
table(tcc$private$DEGES.potentialDEG)
tcc$norm.factors
- Marioni et al., Genome Res., 2008
- TMM正規化法：Robinson and Oshlack, Genome Biol., 2010
- TbT正規化法：Kadota et al., Algorithms Mol. Biol., 2012
- edgeR：Robinson et al., Bioinformatics, 2010
- baySeq：Hardcastle and Kelly, BMC Bioinformatics, 2010
- TCC：Sun et al., BMC Bioinformatics, 2013
前処理 | についてでも述べていますがNGSデータはマイクロアレイに比べてダイナミックレンジが広いという利点はあるとは思いますが、
RPM(やRPKM)で実装されているいわゆるグローバル正規化に基づく方法はごく少数の高発現遺伝子の発現レベルの影響をもろに受けます。
そしてこれらが比較するサンプル間で発現変動している場合には結論が大きく変わってしまいます。なぜなら総リード数に占める高発現の発現変動遺伝子(Differentially Expressed Genes; DEGs)のリード数の割合が大きいからです。
RobinsonらはMarioniら(2008)の「腎臓 vs. 肝臓」データの比較において実際にこのような現象が起きていることを(housekeeping遺伝子の分布を真として)示し、
少数の高発現遺伝子の影響を排除するためにtrimmed mean of M values (TMM)という正規化法を提案しています(Robinson and Oshlack, 2010)。
この方法はRのedgeRというパッケージ中にcalcNormFactorsという名前の関数で存在します。
また、この方法はTCCパッケージ中の関数を用いても実行可能です。
TCCパッケージから得られる(TMM)正規化係数は「正規化係数の平均が1になるようにさらに正規化したもの」であるため、両者の正規化係数に若干の違いがありますが細かいことは気にする必要はありません。
ここでは、正規化係数の算出と正規化後のデータを得る手順などを示していますが、基本的に正規化だけで終わることはありませんので、ここの項目のみでは何の役にも立ちませんのであしからず。。。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
tcc$norm.factors
tcc$private$simulation <- TRUE
tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))
plot(tcc, median.lines=TRUE)
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge2.txt"
param_G1 <- 2
param_G2 <- 2
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
tcc$norm.factors
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
TCCを使わずにedgeRパッケージ内の関数を用いて2.と同じ結果を出すやり方です。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 2
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data, group=data.cl)
d <- calcNormFactors(d)
d$samples$norm.factors
mean(d$samples$norm.factors)
norm.factors <- d$samples$norm.factors/mean(d$samples$norm.factors)
norm.factors
ef.libsizes <- colSums(data)*norm.factors
normalized.count <- sweep(data, 2, mean(ef.libsizes)/ef.libsizes, "*")
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
DESeqというRパッケージ中で採用されている正規化法を採用して得られた正規化後のデータを得るやり方を示します。
DESeqは正規化係数(normalization factor)という言葉を使わずにsize factorという言葉を使っています。
これはTbTやTMM正規化係数とは異なるものなので、ここでは「DESeqの正規化係数」を得ています。
また、この方法はTCCパッケージ中の関数を用いても実行可能です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
tcc$norm.factors
tcc$private$simulation <- TRUE
tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))
plot(tcc, median.lines=TRUE)
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge2.txt"
param_G1 <- 2
param_G2 <- 2
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
tcc$norm.factors
summary(normalized.count)
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
TCCを使わずにDESeqパッケージ内の関数を用いて2.と同じ結果を出すやり方です。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 2
library(DESeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
cds <- newCountDataSet(data, data.cl)
cds <- estimateSizeFactors(cds)
sizeFactors(cds)
norm.factors <- sizeFactors(cds)/colSums(data)
norm.factors <- norm.factors/mean(norm.factors)
norm.factors
sizeFactors(cds) <- sizeFactors(cds)/mean(sizeFactors(cds))
normalized.count <- counts(cds, normalized=TRUE)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
summary(normalized.count)
technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
DESeqパッケージ内の関数を用いてDESeqパッケージ内のマニュアル通りにやった場合。
若干数値が違ってきます（ということを示したいだけです）が正規化後の値の要約統計量をどこに揃えるか程度の違いなので気にする必要はないです。
実際、ここで得られるsize factorsの平均は1.019042ですが、この定数値を正規化後のデータに掛けるとTCCで得られるデータと同じになります。
in_f <- "data_yeast_7065.txt"
out_f <- "hoge4.txt"
param_G1 <- 2
param_G2 <- 2
library(DESeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
cds <- newCountDataSet(data, data.cl)
cds <- estimateSizeFactors(cds)
normalized.count <- counts(cds, normalized=TRUE)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
summary(normalized.count)
iDEGES/edgeR法(Sun et al., BMC Bioinformatics, 2013)は、サンプルデータ14 (data_hypodata_1vs1.txt)の1 sample vs. 1 sampleのような「複製なし」データの正規化は実行できません。
理由はstep2で用いるexact test(iDEGES/edgeR法の場合)が複製ありを前提としているためです。
iDEGES/DESeq法(Sun et al., BMC Bioinformatics, 2013)は複製なしの二群間比較用データの正規化を「正規化時に悪さをするDEGを正規化前に除いてしまえ (DEG elimination strategy; DEGES; でげす)」というTbT法論文(Kadota et al., 2012)で提唱した戦略を
DESeqパッケージ中の関数(正規化法やDEG検出法)のみで実現したDESeq-(DESeq-DESeq)n(デフォルトはn=3)からなるパイプラインです。
ここでは、iDEGES/DESeq正規化係数の算出法とiDEGES/DESeq正規化後のデータを得る手順などを示しています。
が、基本的に正規化だけで終わることはありませんので、ここの項目のみでは何の役にも立ちませんのであしからず。。。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群1サンプル vs. G2群1サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge1.txt"
param_G1 <- 1
param_G2 <- 1
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, iteration=3)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
table(tcc$private$DEGES.potentialDEG)
tcc$norm.factors
tcc$private$simulation <- TRUE
tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))
plot(tcc, median.lines=TRUE)
TMM正規化法をTCCパッケージを用いて行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群1サンプル vs. G2群1サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge1.txt"
param_G1 <- 1
param_G2 <- 1
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
tcc$norm.factors
tcc$private$simulation <- TRUE
tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))
plot(tcc, median.lines=TRUE)
DESeqというRパッケージ中で採用されている正規化法を採用して得られた正規化後のデータを得るやり方を示します。
DESeqは正規化係数(normalization factor)という言葉を使わずにsize factorという言葉を使っています。
これはTbTやTMM正規化係数とは異なるものなので、ここでは「DESeqの正規化係数」を得ています。
また、この方法はTCCパッケージ中の関数を用いても実行可能です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群1サンプル vs. G2群1サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge1.txt"
param_G1 <- 1
param_G2 <- 1
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0)
normalized.count <- getNormalizedData(tcc)
tmp <- cbind(rownames(normalized.count), normalized.count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc)
nonDEG <- 2001:10000
boxplot(log(normalized.count[nonDEG, ]))
summary(normalized.count[nonDEG, ])
apply(normalized.count[nonDEG, ], 2, median)
tcc$norm.factors
tcc$private$simulation <- TRUE
tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))
plot(tcc, median.lines=TRUE)
TCCパッケージ(Sun et al., BMC Bioinformatics, 2013)から利用可能なiDEGES/edgeR正規化法の実行手順を示します。
ここでは、iDEGES/edgeR法の実体である「TMM-(edgeR-TMM)n」パイプラインのnの値(iterationの回数)を3として実行します。RPKMのような長さ補正は行っていませんのでご注意ください。ここの出力結果はRPMに相当するものです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で高発現、gene_2101〜gene_2700がG2群で高発現、gene_2701〜gene_3000がG3群で高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
data <- getNormalizedData(tcc)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で高発現、gene_2101〜gene_2700がG2群で高発現、gene_2701〜gene_3000がG3群で高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
non-DEGの分布について確認しています。
in_f <- "data_hypodata_3vs3vs3.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_nonDEG <- 3001:10000
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
data <- getNormalizedData(tcc)
summary(data[param_nonDEG,])
apply(data[param_nonDEG,], 2, median)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
data <- getNormalizedData(tcc)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
non-DEGの分布について確認しています。
in_f <- "data_hypodata_2vs4vs3.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_nonDEG <- 3001:10000
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
data <- getNormalizedData(tcc)
summary(data[param_nonDEG,])
apply(data[param_nonDEG,], 2, median)
edgeRパッケージから利用可能なTMM正規化法(Robinson and Oshlack, Genome Biol., 2010)の実行手順を示します。RPKMのような長さ補正は行っていませんのでご注意ください。ここの出力結果はRPMに相当するものです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で高発現、gene_2101〜gene_2700がG2群で高発現、gene_2701〜gene_3000がG3群で高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
data <- getNormalizedData(tcc)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で高発現、gene_2101〜gene_2700がG2群で高発現、gene_2701〜gene_3000がG3群で高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
non-DEGの分布について確認しています。
in_f <- "data_hypodata_3vs3vs3.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_nonDEG <- 3001:10000
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
data <- getNormalizedData(tcc)
summary(data[param_nonDEG,])
apply(data[param_nonDEG,], 2, median)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
data <- getNormalizedData(tcc)
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
non-DEGの分布について確認しています。
in_f <- "data_hypodata_2vs4vs3.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_nonDEG <- 3001:10000
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
data <- getNormalizedData(tcc)
summary(data[param_nonDEG,])
apply(data[param_nonDEG,], 2, median)
グローバルアラインメント(global alignment；EMBOSSのneedleに相当)や
ローカルアラインメント(local alignment; EMBOSSのwaterに相当)をやってくれます。
ここでは、3つの塩基配列（seq1, seq2, and seq3）からなるmulti-FASTA形式のファイルtest2.fastaや、通常のfasta形式の二つのファイル（seq2.fasta, seq3.fasta）の比較を例題とします。
ちなみにこのページでは、「配列A vs. 配列B」という表記法で、配列Bに相当するほうが"subject"で配列Aに相当するほうが"pattern"です。
また、置換行列（nucleotideSubstitutionMatrix）を指定してやる必要がありますが、ここではEMBOSSの塩基配列比較時にデフォルトで用いている「EDNAFULL」という置換行列を用います。
local alignmentの結果は極めてEMBOSSのものと似ていますが（EMBOSSのスコア=34, Rのスコア=33）、global alignmentの結果は相当違っていることは認識しています（2010/6/8現在）。
おそらくギャップペナルティを計算する際の数式の違いによるものだろうと楽観していますが、もし間違っていればご指摘よろしくお願いします。
BLOSUM62やPAM250などの代表的な置換行列もftp://ftp.ncbi.nih.gov/blast/matrices/から取得することができます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 「seq2.fasta vs. seq3.fasta」のlocal alignmentの場合：
in_f1 <- "seq2.fasta"
in_f2 <- "seq3.fasta"
param1 <- "local"
param2 <- -10
param3 <- -0.5
file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4"
submat <- as.matrix(read.table(file, check.names=FALSE))
library(Biostrings)
read1 <- readDNAStringSet(in_f1, format="fasta")
read2 <- readDNAStringSet(in_f2, format="fasta")
out <- pairwiseAlignment(pattern=read1,subject=read2,type=param1,
gapOpening=param2,gapExtension=param3,substitutionMatrix=submat)
out@pattern
out@subject
out@score
out_f <- "hoge.txt"
tmp <- cbind(names(read1), names(read2), out@score)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)
2. multi-FASTAファイル中の「seq3 vs. seq1」のglobal alignmentの場合：
in_f <- "test2.fasta"
param1 <- "global"
param2 <- 3
param3 <- 1
param4 <- -10
param5 <- -0.5
file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4"
submat <- as.matrix(read.table(file, check.names=FALSE))
library(Biostrings)
reads <- readDNAStringSet(in_f, format="fasta")
out <- pairwiseAlignment(pattern=reads[param2],subject=reads[param3],type=param1,
gapOpening=param4,gapExtension=param5,substitutionMatrix=submat)
out_f <- "hoge.txt"
tmp <- cbind(names(reads[param2]), names(reads[param3]), score(out), pid(out))
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)
アラインメント（ペアワイズ；基礎1）では、二つの配列間のアラインメントについて、その基本的な利用法とアラインメントスコアを抽出する方法について述べましたが、
他にも配列一致度など様々な情報を抽出することができます。そこで、ここでは「seq2 vs. seq3のlocal alignment結果」からどのような情報が取れるかなどを中心に手広く紹介します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
in_f1 <- "seq2.fasta"
in_f2 <- "seq3.fasta"
param1 <- "local"
param2 <- -10
param3 <- -0.5
file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4"
submat <- as.matrix(read.table(file, check.names=FALSE))
library(Biostrings)
read1 <- readDNAStringSet(in_f1, format="fasta")
read2 <- readDNAStringSet(in_f2, format="fasta")
out <- pairwiseAlignment(pattern=read1,subject=read2,type=param1,
gapOpening=param2,gapExtension=param3,substitutionMatrix=submat)
out
score(out)
pattern(out)
subject(out)
nchar(out)
nmatch(out)
nmismatch(out)
nedit(out)
pid(out)
グローバルアラインメント(global alignment；EMBOSSのneedleに相当)や
ローカルアラインメント(local alignment; EMBOSSのwaterに相当)をやってくれます。
ここでは、3つの塩基配列（seq1, seq2, and seq3）からなるmulti-FASTA形式のファイルtest2.fastaを入力として、「それ以外 vs. 特定の配列」のペアワイズアラインメントを一気にやる方法を紹介します
ちなみにこのページでは、「配列A vs. 配列B」という表記法で、配列Bに相当するほうが"subject"で配列Aに相当するほうが"pattern"です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 特定の配列が入力multi-FASTAファイルの1番目にある場合：
in_f <- "test2.fasta"
param1 <- "local"
param2 <- 1
param3 <- -10
param4 <- -0.5
file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4"
submat <- as.matrix(read.table(file, check.names=FALSE))
library(Biostrings)
reads <- readDNAStringSet(in_f, format="fasta")
out <- pairwiseAlignment(pattern=reads[-param2],subject=reads[param2],type=param1,
gapOpening=param3,gapExtension=param4,substitutionMatrix=submat)
names(reads[param2])
names(reads[-param2])
length(reads[-param2])
out[1]
out[1]@score
score(out[1])
out[2]
out[2]@score
score(out[2])
score(out)
out_f <- "hoge.txt"
tmp <- NULL
for(i in 1:length(reads[-param2])){
tmp <- rbind(tmp, c(names(reads[-param2])[i], names(reads[param2]), out[i]@score))
}
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)
2. 特定の配列が入力multi-FASTAファイルの3番目にある場合：
in_f <- "test2.fasta"
param1 <- "local"
param2 <- 3
param3 <- -10
param4 <- -0.5
file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4"
submat <- as.matrix(read.table(file, check.names=FALSE))
library(Biostrings)
reads <- readDNAStringSet(in_f, format="fasta")
out <- pairwiseAlignment(pattern=reads[-param2],subject=reads[param2],type=param1,
gapOpening=param3,gapExtension=param4,substitutionMatrix=submat)
names(reads[param2])
names(reads[-param2])
length(reads[-param2])
out[1]
out[1]@score
score(out[1])
out[2]
out[2]@score
score(out[2])
score(out)
out_f <- "hoge.txt"
tmp <- NULL
for(i in 1:length(reads[-param2])){
tmp <- rbind(tmp, c(names(reads[-param2])[i], names(reads[param2]), out[i]@score))
}
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)
リファレンス配列(マップされる側)から文字列検索(マップする側)を行うやり方を示します。マッピングと同じです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. DHFR.fastaを入力として、"AATGCTCAGGTA"でキーワード探索を行う場合（No hitです...）：
(Dihydrofolate reductase (DHFR)という塩基配列（NM_000791）のFASTA形式ファイルで、
Zinc Finger Nuclease (ZFN)認識配列(AATGCTCAGGTA)領域の探索の場合をイメージしています)
in_f <- "DHFR.fasta"
param <- "AATGCTCAGGTA"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
out <- vmatchPattern(pattern=param, subject=fasta)
out[[1]]
2. DHFR.fastaを入力として、"CCTACTATGT"でキーワード探索を行う場合（存在することが分かっている断片配列）：
in_f <- "DHFR.fasta"
param <- "CCTACTATGT"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
out <- vmatchPattern(pattern=param, subject=fasta)
out[[1]]
unlist(out)
start(unlist(out))
3. DHFR.fastaを入力として、"CCTACTATGT"でキーワード探索を行った結果をファイルに保存する場合：
in_f <- "DHFR.fasta"
out_f <- "hoge3.txt"
param <- "CCTACTATGT"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
hoge <- vmatchPattern(pattern=param, subject=fasta)
out <- cbind(start(unlist(hoge)), end(unlist(hoge)))
colnames(out) <- c("start", "end")
out
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)
4. multi-FASTAファイルhoge4.faを入力として、"AGG"でキーワード探索を行う場合：
in_f <- "hoge4.fa"
out_f <- "hoge4.txt"
param <- "AGG"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
hoge <- vmatchPattern(pattern=param, subject=fasta)
out <- cbind(start(unlist(hoge)), end(unlist(hoge)))
colnames(out) <- c("start", "end")
rownames(out) <- names(unlist(hoge))
out
tmp <- cbind(rownames(out), out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
5. multi-FASTAファイルhoge4.faをリファレンス配列（マップされる側）として、10リードからなるdata_seqlogo1.txtでマッピングを行う場合：
in_f1 <- "hoge4.fa"
in_f2 <- "data_seqlogo1.txt"
out_f <- "hoge5.txt"
library(Biostrings)
fasta <- readDNAStringSet(in_f1, format="fasta")
reads <- readDNAStringSet(in_f2, format="fasta")
out <- c("in_f2", "in_f1", "start", "end")
for(i in 1:length(reads)){
hoge <- vmatchPattern(pattern=as.character(reads[i]), subject=fasta)
hoge1 <- cbind(start(unlist(hoge)), end(unlist(hoge)))
hoge2 <- names(unlist(hoge))
hoge3 <- rep(as.character(reads[i]), length(hoge2))
out <- rbind(out, cbind(hoge3, hoge2, hoge1))
}
head(out)
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)
6. multi-FASTAファイルhoge4.faをリファレンス配列（マップされる側）として、4リードからなるdata_reads.txtでマッピングを行う場合：
in_f1 <- "hoge4.fa"
in_f2 <- "data_reads.txt"
out_f <- "hoge6.txt"
library(Biostrings)
fasta <- readDNAStringSet(in_f1, format="fasta")
reads <- readDNAStringSet(in_f2, format="fasta")
out <- c("in_f2", "in_f1", "start", "end")
for(i in 1:length(reads)){
hoge <- vmatchPattern(pattern=as.character(reads[i]), subject=fasta)
hoge1 <- cbind(start(unlist(hoge)), end(unlist(hoge)))
hoge2 <- names(unlist(hoge))
hoge3 <- rep(as.character(reads[i]), length(hoge2))
out <- rbind(out, cbind(hoge3, hoge2, hoge1))
}
head(out)
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)
7. multi-FASTAファイルhoge4.faをリファレンス配列（マップされる側）として、4リードからなるdata_reads.txtでマッピングを行う場合(hoge1オブジェクトの作成のところの記述の仕方が若干異なる)：
in_f1 <- "hoge4.fa"
in_f2 <- "data_reads.txt"
out_f <- "hoge5.txt"
library(Biostrings)
fasta <- readDNAStringSet(in_f1, format="fasta")
reads <- readDNAStringSet(in_f2, format="fasta")
out <- c("in_f2", "in_f1", "start", "end")
for(i in 1:length(fasta)){
hoge <- matchPDict(PDict(reads), fasta[[i]])
hoge1 <- cbind(start(unlist(hoge)), end(unlist(hoge)))
hoge2 <- names(unlist(hoge))
hoge3 <- rep(names(fasta[i]), length(hoge2))
out <- rbind(out, cbind(hoge3, hoge2, hoge1))
#as.integer(coverage(hoge, 1, width(fasta[i])))
}
head(out)
write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)
multi-FASTA形式ファイルを読み込んで配列ごとのGC含量 (GC contents)を出力するやり方を示します。
出力ファイルは、「description」「CGの総数」「ACGTの総数」「配列長」「%GC含量」としています。
尚、%GC含量は「CGの総数/ACGTの総数」で計算しています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
in_f <- "hoge4.fa"
out_f <- "hoge1.txt"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
hoge <- alphabetFrequency(fasta)
CG <- rowSums(hoge[,2:3])
ACGT <- rowSums(hoge[,1:4])
GC_content <- CG/ACGT*100
tmp <- cbind(names(fasta), CG, ACGT, width(fasta), GC_content)
colnames(tmp) <- c("description", "CG", "ACGT", "Length", "%GC_contents")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
in_f <- "h_rna.fasta"
out_f <- "hoge2.txt"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
hoge <- alphabetFrequency(fasta)
CG <- rowSums(hoge[,2:3])
ACGT <- rowSums(hoge[,1:4])
GC_content <- CG/ACGT*100
tmp <- cbind(names(fasta), CG, ACGT, width(fasta), GC_content)
colnames(tmp) <- c("description", "CG", "ACGT", "Length", "%GC_contents")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
in_f <- "test1.fasta"
out_f <- "hoge3.txt"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
hoge <- alphabetFrequency(fasta)
CG <- rowSums(hoge[,2:3])
ACGT <- rowSums(hoge[,1:4])
GC_content <- CG/ACGT*100
tmp <- cbind(names(fasta), CG, ACGT, width(fasta), GC_content)
colnames(tmp) <- c("description", "CG", "ACGT", "Length", "%GC_contents")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
4. 120MB程度のシロイヌナズナゲノムのmulti-FASTAファイル(TAIR10_chr_all.fas)の場合:
in_f <- "TAIR10_chr_all.fas"
out_f <- "hoge4.txt"
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
hoge <- alphabetFrequency(fasta)
CG <- rowSums(hoge[,2:3])
ACGT <- rowSums(hoge[,1:4])
GC_content <- CG/ACGT*100
tmp <- cbind(names(fasta), CG, ACGT, width(fasta), GC_content)
colnames(tmp) <- c("description", "CG", "ACGT", "Length", "%GC_contents")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
seqLogoパッケージを用いてsequence logos (Schneider and Stephens, 1990)を実行するやり方を示します。
ここでは、multi-FASTAファイルを読み込んでポジションごとの出現頻度を調べる目的で利用します。上流-35 bpにTATA boxがあることを示す目的などに利用されます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 入力ファイルがmulti-FASTA形式のファイル(test1.fasta)の場合：
in_f <- "test1.fasta"
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fasta")
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
seqLogo(out)
in_f <- "data_seqlogo1.fasta"
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fasta")
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
seqLogo(out)
得られた結果をPNG形式ファイルとして保存するやり方です。
in_f <- "data_seqlogo1.fasta"
out_f <- "hoge3.png"
param_fig <- c(600, 400)
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fasta")
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
seqLogo(out)
dev.off()
全部で4行からなり、1行目がA, 2行目がC, 3行目がG, そして4行目がTの並びになっているという前提です。
列数は塩基配列の長さ分だけ長くなってかまいません。
in_f <- "data_seqlogo2.fasta"
library(Biostrings)
library(seqLogo)
hoge <- read.table(in_f)
out <- makePWM(hoge)
seqLogo(out)
Arabidopsisの上流500bpの配列セットです。500bpと長いため、461-500bpの範囲のみについて解析し、得られた図をファイルに保存するやり方です。
以下はダウンロードしたファイルの拡張子として、"fasta"を付加しているという前提です。
in_f <- "TAIR10_upstream_500_20101028.fasta"
out_f <- "hoge5.png"
param1 <- c(461, 500)
param2 <- 500
param_fig <- c(700, 400)
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
obj <- as.logical(width(fasta) == param2)
fasta <- fasta[obj]
fasta
fasta <- subseq(fasta, param1[1], param1[2])
fasta
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
seqLogo(out)
dev.off()
Arabidopsisの上流1000bpの配列セットです。1000bpと長いため、951-1000bpの範囲のみについて解析し、得られた図をファイルに保存するやり方です。
ファイル中の1塩基目が転写開始点からもっとも遠く離れたところで、1000塩基目が転写開始点のすぐ隣ということになります。
以下はダウンロードしたファイルの拡張子として、"fasta"を付加しているという前提です。
in_f <- "TAIR10_upstream_1000_20101104.fasta"
out_f <- "hoge6.png"
param1 <- c(951, 1000)
param2 <- 1000
param_fig <- c(800, 400)
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
obj <- as.logical(width(fasta) == param2)
fasta <- fasta[obj]
fasta
fasta <- subseq(fasta, start=param1[1], end=param1[2])
fasta
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
seqLogo(out)
dev.off()
6.と同じ結果が得られますが、転写開始点上流50bpのみを切り出して解析するというオプションにしています。
in_f <- "TAIR10_upstream_1000_20101104.fasta"
out_f <- "hoge7.png"
param1 <- 50
param2 <- 1000
param_fig <- c(800, 400)
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
obj <- as.logical(width(fasta) == param2)
fasta <- fasta[obj]
fasta
fasta <- subseq(fasta, width=param1, end=param2)
fasta
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
seqLogo(out)
dev.off()
fasta <- readDNAStringSet(in_f, format="fasta")
table(width(fasta))
obj <- as.logical(width(fasta) != param2)
fasta <- fasta[obj]
fasta
8. FASTQ形式ファイル(SRR609266.fastq.gz)の場合：
small RNA-seqデータ(400Mb弱、11,928,428リード)です。圧縮ファイルもreadDNAStringSet関数で通常手順で読み込めます。
原著論文(Nie et al., BMC Genomics, 2013)中の記述から
GSE41841を頼りに、
SRP016842にたどりつき、
イントロ | NGS | 配列取得 | FASTQ or SRA | SRAdb(Zhu_2013)の7を実行して得られたものが入力ファイルです。
in_f <- "SRR609266.fastq.gz"
out_f <- "hoge8.png"
param_fig <- c(800, 370)
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fastq")
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
seqLogo(out)
dev.off()
9. FASTQ形式ファイル(hoge4.fastq.gz)の場合：
small RNA-seqデータ(280Mb弱、11,928,428リード)です。
原著論文(Nie et al., BMC Genomics, 2013)中の記述から
GSE41841を頼りに、
SRP016842にたどりつき、
前処理 | トリミング | アダプター配列除去(応用) | ShortRead(Morgan_2009)の4を実行して得られたものが入力ファイルです。
アダプター配列除去後のデータなので、リードごとに配列長が異なる場合でも読み込めるShortReadパッケージ中の
readFastq関数を用いています。
in_f <- "hoge4.fastq.gz"
out_f <- "hoge9.png"
param_fig <- c(787, 370)
library(ShortRead)
library(seqLogo)
fastq <- readFastq(in_f)
fasta <- sread(fastq)
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
seqLogo(out)
dev.off()
前処理 | フィルタリング | 任意のリード(サブセット)を抽出
の8.を実行して得られたsmall RNA-seqデータ(100,000リード; 約16MB)です。
in_f <- "SRR609266_sub.fastq"
out_f <- "hoge10.png"
param_fig <- c(800, 370)
library(Biostrings)
library(seqLogo)
fasta <- readDNAStringSet(in_f, format="fastq")
hoge <- consensusMatrix(fasta, as.prob=T, baseOnly=T)
out <- makePWM(hoge[1:4,])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
seqLogo(out)
dev.off()
Local Distribution of Short Sequence (LDSS)というのは、例えば手元に転写開始点上流1000塩基（upstream 1kb；下流3000塩基などでもよい）のFASTA形式の塩基配列セットがあったときに、
hexamer (6-mer)とかoctamer (8-mer)程度の短い塩基配列（short sequence）の分布を調べて、「Arabidopsis thalianaでは、"CTCTTC"というhexamerが転写開始点（Transcription Start Site; TSS）の近くにくるほどより多く出現する(参考文献1)」などの解析をしたい場合に行います。
入力データとして用いる上流 or 下流X塩基の配列セットは、配列取得 | 遺伝子の転写開始点近傍配列(上流配列など)を参考にして取得してください。
ここではArabidopsisの上流1000bpの配列セット（ファイル名："TAIR10_upstream_1000_20101104.fasta"）とラットの上流1000bpの配列セット（ファイル名："rat_upstream_1000.fa"）に対して、
pentamer (5-mer)の4^5(=1024)通りの配列一つ一つについて「上流1000bpのどこに出現したかを上流配列セット全体で出現頻度をカウントします。
この時、得られる情報はpentamerごとに「1bp目, 2bp目,...(1000 - 5 - 1)bp目の出現頻度」となるので、原著論文(参考文献1)と似た思想(全く同じというわけではありません！)でRPH, RPA, およびバックグラウンドレベルに比べて有意に局在化している短い配列(short sequences having localized distributions within upstream region)かどうかのフラグ情報を出力するやり方を示します。
- 1024通りのpentamer一つ一つについて、その「RPH, RPA, Local Distributionしているか否か」情報のみをファイル出力する場合：
- 上記に加え、全1024通りの配列のshort sequencesの実際の分布もpngファイルで出力したい場合：
尚、この方法（LDSS）はposition-sensitive typeには有効ですが、position-insensitive typeのものはアルゴリズム的に検出不可能です（参考文献6）。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. pentamer(5-mer; 4^5=1024通り)でプロモータ構成モチーフ候補リストを作成したい場合：
in_f <- "TAIR10_upstream_1000_20101104.fasta"
out_f <- "hoge.txt"
param_kmer <- 5
param_fig <- c(1000, 500)
library(Biostrings)
seq <- readDNAStringSet(in_f, format="fasta")
seq
seq <- seq[width(seq) == median(width(seq))]
seq
reads <- mkAllStrings(c("A", "C", "G", "T"), param_kmer)
out <- NULL
for(i in 1:length(reads)){
tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)
s_posi_freq <- rle(sort(start(unlist(tmp))))
hoge <- rep(0, (width(seq[1]) - param_kmer + 1))
hoge2 <- replace(hoge, s_posi_freq$values, s_posi_freq$lengths)
out <- rbind(out, hoge2)
if(i%%10 == 0) cat(i, "/", length(reads), "finished\n")
}
rownames(out) <- reads
threshold <- apply(out,1,median) + 5*apply(out,1,mad)
obj <- apply(out,1,max) > threshold
baseline <- apply(out,1,median)
baseline[baseline < 1] <- 1
RPH <- apply(out,1,max) / baseline
RPA <- apply((out - baseline),1,sum) / apply(out,1,sum)
tmp <- cbind(rownames(out), RPH, RPA, obj)
colnames(tmp) <- c("k-mer", "Relative Peak Height (RPH)", "Relative Peak Area (RPA)", "Local Distribution")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
plot(out["TATAA",])
plot(out["GCCCA",])
2. 上記を基本としつつ組合せ数分だけ原著論文（参考文献1）Fig.1と同じような図をpngファイルで生成したい場合：
（以下をコピペすると作業ディレクトリ上に1024個のpngファイルが生成されますので注意！！）
in_f <- "TAIR10_upstream_1000_20101104.fasta"
out_f <- "hoge.txt"
param_kmer <- 5
param_fig <- c(1000, 500)
library(Biostrings)
seq <- readDNAStringSet(in_f, format="fasta")
seq
seq <- seq[width(seq) == median(width(seq))]
seq
reads <- mkAllStrings(c("A", "C", "G", "T"), param_kmer)
out <- NULL
for(i in 1:length(reads)){
tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)
s_posi_freq <- rle(sort(start(unlist(tmp))))
hoge <- rep(0, (width(seq[1]) - param_kmer + 1))
hoge2 <- replace(hoge, s_posi_freq$values, s_posi_freq$lengths)
out <- rbind(out, hoge2)
if(i%%10 == 0) cat(i, "/", length(reads), "finished\n")
}
rownames(out) <- reads
threshold <- apply(out,1,median) + 5*apply(out,1,mad)
obj <- apply(out,1,max) > threshold
baseline <- apply(out,1,median)
baseline[baseline < 1] <- 1
PH <- apply(out,1,max)
RPH <- PH / baseline
RPA <- apply((out - baseline),1,sum) / apply(out,1,sum)
tmp <- cbind(rownames(out), RPH, RPA, obj)
colnames(tmp) <- c("k-mer", "Relative Peak Height (RPH)", "Relative Peak Area (RPA)", "Local Distribution")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
for(i in 1:length(reads)){
out_f <- paste("result_", rownames(out)[i], ".png", sep="")
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out[i,], ylim=c(0, max(c(PH[i], threshold[i]))),
ylab="Occurence", xlab="Position", type="p", pch=20, cex=0.8)
abline(h=baseline[i], col="red")
text(0, baseline[i], "baseline", col="red", adj=c(0,0))
abline(h=threshold[i], col="red")
text(0, threshold[i], "threshold(= baseline + 5*MAD)", col="red", adj=c(0,0))
dev.off()
}
in_f <- "rat_upstream_1000.fa"
out_f <- "hoge.txt"
param_kmer <- 5
param_fig <- c(1000, 500)
library(Biostrings)
seq <- readDNAStringSet(in_f, format="fasta")
seq
seq <- seq[width(seq) == median(width(seq))]
seq
reads <- mkAllStrings(c("A", "C", "G", "T"), param1)
out <- NULL
for(i in 1:length(reads)){
tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)
s_posi_freq <- rle(sort(start(unlist(tmp))))
hoge <- rep(0, (width(seq[1]) - param_kmer + 1))
hoge2 <- replace(hoge, s_posi_freq$values, s_posi_freq$lengths)
out <- rbind(out, hoge2)
if(i%%10 == 0) cat(i, "/", length(reads), "finished\n")
}
rownames(out) <- reads
threshold <- apply(out,1,median) + 5*apply(out,1,mad)
obj <- apply(out,1,max) > threshold
baseline <- apply(out,1,median)
baseline[baseline < 1] <- 1
PH <- apply(out,1,max)
RPH <- PH / baseline
RPA <- apply((out - baseline),1,sum) / apply(out,1,sum)
tmp <- cbind(rownames(out), RPH, RPA, obj)
colnames(tmp) <- c("k-mer", "Relative Peak Height (RPH)", "Relative Peak Area (RPA)", "Local Distribution")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
for(i in 1:length(reads)){
out_f <- paste("result_", rownames(out)[i], ".png", sep="")
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out[i,], ylim=c(0, max(c(PH[i], threshold[i]))),
ylab="Occurence", xlab="Position", type="p", pch=20, cex=0.8)
abline(h=baseline[i], col="red")
text(0, baseline[i], "baseline", col="red", adj=c(0,0))
abline(h=threshold[i], col="red")
text(0, threshold[i], "threshold(= baseline + 5*MAD)", col="red", adj=c(0,0))
dev.off()
}
- LDSS：Yamamoto et al., BMC Genomics, 2007
- RAP-DB：Rice Annotation Project, Nucleic Acids Res., 2008
- TAIR：Lamesch et al., Nucleic Acids Res., 2012
- PPDB：Yamamoto and Obokata, Nucleic Acids Res., 2008
- PLACE：Higo et al., Nucleic Acids Res., 1999
- RAR：Yamamoto et al., BMC Plant Biol., 2011
手元に(Rで)マイクロアレイデータ解析のサンプルマイクロアレイデータ21の「発現変動遺伝子(DEG)の転写開始点のFASTA形式の上流配列セット(ファイル名："seq_BAT_DEG.fa")」と「それ以外(nonDEG)の上流配列セット(ファイル名："seq_BAT_nonDEG.fa")」
の二つのファイルがあったときに、任意のk-mer(4k通り；k=6のときは4096通り)に対して、どのk-merが発現変動と関連しているかをFisher's Exact Testを用いてp値を計算する手順を示します。
尚、ここで用いている二つのファイルはいずれも「ACGTのみからなり、配列長は1000bp」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. pentamer(5-mer; 45=1024通り)で各k-merごとにp値とFDR値をリストアップする場合：
in_f1 <- "seq_BAT_DEG.fa"
in_f2 <- "seq_BAT_nonDEG.fa"
out_f <- "hoge.txt"
param_kmer <- 5
library(Biostrings)
seq_DEG <- readDNAStringSet(in_f1, format="fasta")
seq_DEG
seq_nonDEG <- readDNAStringSet(in_f2, format="fasta")
seq_nonDEG
reads <- mkAllStrings(c("A", "C", "G", "T"), param1)
out <- NULL
for(i in 1:length(reads)){
tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq_DEG)
out_DEG <- length(start(unlist(tmp)))
tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq_nonDEG)
out_nonDEG <- length(start(unlist(tmp)))
x <- c(out_nonDEG, length(seq_nonDEG), out_DEG, length(seq_DEG))
data <- matrix(x, ncol=2, byrow=T)
pvalue <- fisher.test(data)$p.value
out <- rbind(out, c(x, pvalue))
if(i%%10 == 0) cat(i, "/", length(reads), "finished\n")
}
rownames(out) <- reads
p.value <- out[,ncol(out)]
q.value <- p.adjust(p.value, method="BH")
tmp <- cbind(rownames(out), out, q.value)
colnames(tmp) <- c("k-mer", "Occurence in nonDEG", "# of nonDEG sequences", "Occurence in DEG", "# of DEG sequences", "p.value", "q.value")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
qrqcパッケージを用いてNGSデータのk-mer解析を行うやり方を示します。
ゲノムサイズ推定を行うための基本的な考え方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
4X coverageであることが分かっているデータです。
理由は、50塩基長のリファレンス配列から20塩基長のリードを10個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は20塩基以下ですので、条件を満たす19を指定しています。
in_f <- "sample32_ngs.fasta"
out_f <- "hoge1.png"
param_kmer <- 19
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""))
dev.off()
4X coverageであることが分かっているデータです。
理由は、50塩基長のリファレンス配列から20塩基長のリードを10個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は20塩基以下ですので、条件を満たす11を指定しています。
in_f <- "sample32_ngs.fasta"
out_f <- "hoge2.png"
param_kmer <- 11
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""))
dev.off()
4X coverageであることが分かっているデータです。
理由は、50塩基長のリファレンス配列から20塩基長のリードを10個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は20塩基以下ですので、条件を満たす5を指定しています。
in_f <- "sample32_ngs.fasta"
out_f <- "hoge3.png"
param_kmer <- 5
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""))
dev.off()
4X coverageであることが分かっているデータです。
理由は、1,000塩基長のリファレンス配列から20塩基長のリードを200個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は20塩基以下ですので、条件を満たす5を指定しています。
in_f <- "sample33_ngs.fasta"
out_f <- "hoge4.png"
param_kmer <- 5
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""))
dev.off()
10X coverageであることが分かっているデータです。
理由は、1,000塩基長のリファレンス配列から20塩基長のリードを500個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は20塩基以下ですので、条件を満たす5を指定しています。
in_f <- "sample34_ngs.fasta"
out_f <- "hoge5.png"
param_kmer <- 5
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""))
dev.off()
10X coverageであることが分かっているデータです。
理由は、10,000塩基長のリファレンス配列から40塩基長のリードを2,500個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は40塩基以下ですので、条件を満たす15を指定しています。
in_f <- "sample35_ngs.fasta"
out_f <- "hoge6.png"
param_kmer <- 15
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""))
dev.off()
40X coverageであることが分かっているデータです。
理由は、10,000塩基長のリファレンス配列から80塩基長のリードを5,000個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は80塩基以下ですので、条件を満たす21を指定しています。
hist関数実行時に分割数を指定すべくbreaksオプションも変更しています。
in_f <- "sample36_ngs.fasta"
out_f <- "hoge7.png"
param_kmer <- 21
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""),
breaks=max(kmer))
dev.off()
100X coverageであることが分かっているデータです。
理由は、10,000塩基長のリファレンス配列から100塩基長のリードを10,000個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は100塩基以下ですので、条件を満たす21を指定しています。
hist関数実行時に分割数を指定すべくbreaksオプションも変更しています。
in_f <- "sample37_ngs.fasta"
out_f <- "hoge8.png"
param_kmer <- 21
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""),
breaks=max(kmer))
dev.off()
100X coverageであることが分かっているデータです。
理由は、10,000塩基長のリファレンス配列から100塩基長のリードを10,000個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は100塩基以下ですので、条件を満たす31を指定しています。
hist関数実行時に分割数を指定すべくbreaksオプションも変更しています。
in_f <- "sample37_ngs.fasta"
out_f <- "hoge9.png"
param_kmer <- 31
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""),
breaks=max(kmer))
dev.off()
100X coverageであることが分かっているデータです。
理由は、10,000塩基長のリファレンス配列から100塩基長のリードを10,000個ランダム抽出したものだからです。
k-merのkの値は、リード配列長以下に設定します。この場合は100塩基以下ですので、条件を満たす11を指定しています。
hist関数実行時に分割数を指定すべくbreaksオプションも変更しています。
in_f <- "sample37_ngs.fasta"
out_f <- "hoge10.png"
param_kmer <- 11
param_fig <- c(400, 380)
library(qrqc)
hoge <- readSeqFile(in_f, type="fasta", kmer=T, k=param_kmer)
hoge
kmer <- table(hoge@kmer$kmer)
kmer
length(kmer)
table(kmer)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hist(kmer, ylab="Frequency(number of k-mers)",
xlab=paste("Number of occurences at k=", param_kmer, sep=""),
breaks=max(kmer))
dev.off()
MarioniらはTechnical replicatesのデータがポアソン分布（Poisson distribution）に従うことを報告しています（Marioni et al., Genome Res., 2008）。
つまり「各遺伝子のtechnical replicatesデータの平均と分散が全体として同じ」だと言っているわけです。ここでは、横軸：平均、縦軸：分散としたプロットを描画してその傾向を眺めます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. サンプルデータ4の18,110 genes×10 samplesのリアルデータ(data_marioni.txt; kidney 5サンプル vs. liver 5サンプル)の場合：
総リード数補正を行って、群ごとにプロットしています。
in_f <- "data_marioni.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)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
hoge <- data[,data.cl==1]
nf <- mean(colSums(hoge))/colSums(hoge)
G1 <- sweep(hoge, 2, nf, "*")
colSums(G1)
hoge <- data[,data.cl==2]
nf <- mean(colSums(hoge))/colSums(hoge)
G2 <- sweep(hoge, 2, nf, "*")
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=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), 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=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), 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=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), 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=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), 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. サンプルデータ4の18,110 genes×10 samplesのリアルデータ(data_marioni.txt; kidney 5サンプル vs. liver 5サンプル)の場合：
総リード数補正を行って、2つの群をまとめてプロットしています。
in_f <- "data_marioni.txt"
out_f1 <- "hoge2.txt"
out_f2 <- "hoge2.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(380, 420)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
nf <- mean(colSums(data))/colSums(data)
normalized.count <- sweep(data, 2, nf, "*")
colSums(normalized.count)
hoge <- normalized.count
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), 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=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), col="black")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", "G1+G2", col="black", 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()
3. サンプルデータ4の18,110 genes×10 samplesのリアルデータ(data_marioni.txt; kidney 5サンプル vs. liver 5サンプル)の場合：
総リード数補正を行って、2つの群をまとめてプロットしています。また、G2群のみのプロットも重ね書きしています。
in_f <- "data_marioni.txt"
out_f <- "hoge3.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(380, 420)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
nf <- mean(colSums(data))/colSums(data)
normalized.count <- sweep(data, 2, nf, "*")
colSums(normalized.count)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hoge <- normalized.count
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1, ann=F,
xlim=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), col="black")
par(new=T)
MEAN <- apply(hoge[,data.cl==2], 1, mean)
VARIANCE <- apply(hoge[,data.cl==2], 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("bottomright", c("G1+G2", "G2"), col=c("black", "red"), pch=20)
dev.off()
4. サンプルデータ4の18,110 genes×10 samplesのリアルデータ(data_marioni.txt; kidney 5サンプル vs. liver 5サンプル)の場合：
TCCパッケージ中のiDEGES/edgeR正規化後のデータを用いて、2つの群をまとめてプロットしています。また、G2群のみのプロットも重ね書きしています。
in_f <- "data_marioni.txt"
out_f <- "hoge4.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(380, 420)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized.count <- getNormalizedData(tcc)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hoge <- normalized.count
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1, ann=F,
xlim=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), col="black")
par(new=T)
MEAN <- apply(hoge[,data.cl==2], 1, mean)
VARIANCE <- apply(hoge[,data.cl==2], 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("bottomright", c("G1+G2", "G2"), col=c("black", "red"), pch=20)
dev.off()
5. サンプルデータ4の18,110 genes×10 samplesのリアルデータ(data_marioni.txt; kidney 5サンプル vs. liver 5サンプル)の場合：
TCCパッケージ中のiDEGES/edgeR正規化後のデータを用いて、2つの群をまとめてプロットしています。
iDEGES/edgeR-edgeR解析パイプライン適用後のFDR < 0.05を満たす遺伝子をマゼンタで色づけしています。
in_f <- "data_marioni.txt"
out_f <- "hoge5.png"
param_G1 <- 5
param_G2 <- 5
param_FDR <- 0.05
param_fig <- c(380, 420)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized.count <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
obj <- as.logical(tcc$stat$q.value < param_FDR)
sum(tcc$stat$q.value < param_FDR)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hoge <- normalized.count
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+06), ylim=c(1e-02, 1e+06), col="black")
points(MEAN[obj], VARIANCE[obj], col="magenta", cex=0.1, pch=20)
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("bottomright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
Biological replicatesのデータは負の二項分布（negative binomial distribution; 分散 > 平均）に従うことを検証します。
つまり、ポアソン分布(分散 = 平均)よりももっとばらつきが大きいということを言っています。
ここでは、横軸：平均、縦軸：分散としたプロットを描画してその傾向を眺めます。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.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 <- 3
param_G2 <- 3
param_fig <- c(380, 420)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
hoge <- data[,data.cl==1]
nf <- mean(colSums(hoge))/colSums(hoge)
G1 <- sweep(hoge, 2, nf, "*")
colSums(G1)
hoge <- data[,data.cl==2]
nf <- mean(colSums(hoge))/colSums(hoge)
G2 <- sweep(hoge, 2, nf, "*")
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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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()
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
non-DEGデータのみで総リード数を揃えてから計6サンプルを一緒にしてプロットしています。これが検定のイメージです。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge2.txt"
out_f2 <- "hoge2.png"
param_DEG_G1 <- 1:1800
param_DEG_G2 <- 1801:2000
param_nonDEG <- 2001:10000
param_fig <- c(380, 420)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
colSums(data[param_nonDEG,])
hoge <- data[param_nonDEG,]
nf <- mean(colSums(hoge))/colSums(hoge)
normalized <- sweep(data, 2, nf, "*")
colSums(normalized[param_nonDEG,])
hoge <- normalized
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
tmp <- cbind(rownames(data), data, 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])
obj <- param_nonDEG
plot(MEAN[obj], VARIANCE[obj], log="xy", pch=20, cex=.1, ann=F,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="black")
par(new=T)
obj <- param_DEG_G1
plot(MEAN[obj], VARIANCE[obj], log="xy", pch=20, cex=.1, ann=F,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="blue")
par(new=T)
obj <- param_DEG_G2
plot(MEAN[obj], VARIANCE[obj], log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="red",
xlab="MEAN", ylab="VARIANCE")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", c("DEG(G1)", "DEG(G2)", "non-DEG"), col=c("blue", "red", "black"), pch=20)
dev.off()
3. NBPSeqパッケージ中の26,222 genes×6 samplesの場合：
3 Mockサンプル vs. 3 treatedサンプルのデータです。
もう少し具体的には、バクテリアを感染させて防御応答をみたデータで、詳細はCumbie et al., PLoS One, 2011に書かれています。
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 <- 3
param_G2 <- 3
param_fig <- c(380, 420)
library(NBPSeq)
data(arab)
data <- arab
dim(data)
head(data)
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
hoge <- data[,data.cl==1]
nf <- mean(colSums(hoge))/colSums(hoge)
G1 <- sweep(hoge, 2, nf, "*")
colSums(G1)
hoge <- data[,data.cl==2]
nf <- mean(colSums(hoge))/colSums(hoge)
G2 <- sweep(hoge, 2, nf, "*")
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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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()
4. サンプルデータ8の26,221 genes×6 samplesのリアルデータ(data_arab.txt; mock 3サンプル vs. hrcc 3サンプル)の場合：
3.と基本的に同じデータですが、ファイルの読み込みから行う一般的なやり方です。
in_f <- "data_arab.txt"
out_f1 <- "hoge4_G1.txt"
out_f2 <- "hoge4_G1.png"
out_f3 <- "hoge4_G2.txt"
out_f4 <- "hoge4_G2.png"
out_f5 <- "hoge4_all.png"
param_G1 <- 3
param_G2 <- 3
param_fig <- c(380, 420)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
hoge <- data[,data.cl==1]
nf <- mean(colSums(hoge))/colSums(hoge)
G1 <- sweep(hoge, 2, nf, "*")
colSums(G1)
hoge <- data[,data.cl==2]
nf <- mean(colSums(hoge))/colSums(hoge)
G2 <- sweep(hoge, 2, nf, "*")
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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), 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()
5. サンプルデータ8の26,221 genes×6 samplesのリアルデータ(data_arab.txt; mock 3サンプル vs. hrcc 3サンプル)の場合：
G1とG2群を混ぜてプロットしています。
in_f <- "data_arab.txt"
out_f <- "hoge5.png"
param_G1 <- 3
param_G2 <- 3
param_fig <- c(380, 420)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
nf <- mean(colSums(data))/colSums(data)
normalized.count <- sweep(data, 2, nf, "*")
colSums(normalized.count)
hoge <- normalized.count
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1, ann=F,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="black")
par(new=T)
hoge <- normalized.count[,data.cl==1]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1, ann=F,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="blue")
par(new=T)
hoge <- normalized.count[,data.cl==2]
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="red")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("topright", c("(G1+G2)", "G1", "G2"), col=c("black", "blue", "red"), pch=20)
dev.off()
6. サンプルデータ8の26,221 genes×6 samplesのリアルデータ(data_arab.txt; mock 3サンプル vs. hrcc 3サンプル)の場合：
TCCパッケージ中のiDEGES/edgeR正規化後のデータを用いて、2つの群をまとめてプロットしています。
iDEGES/edgeR-edgeR解析パイプライン適用後のFDR < 0.05を満たす遺伝子をマゼンタで色づけしています。
in_f <- "data_arab.txt"
out_f <- "hoge6.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_fig <- c(380, 420)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized.count <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
obj <- as.logical(tcc$stat$q.value < param_FDR)
sum(tcc$stat$q.value < param_FDR)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
hoge <- normalized.count
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="black")
points(MEAN[obj], VARIANCE[obj], col="magenta", cex=0.1, pch=20)
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
legend("bottomright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
reference-based methodsというカテゴリに含まれるものたちです。
ゲノム配列にRNA-seqデータのマッピングを行ってどこに遺伝子領域があるかなどの座標（アノテーション）情報を取得する遺伝子構造推定用です。
実質的にde novo transcriptome assemblyと目指すところは同じですが、
やはりゲノムというリファレンス配列を用いるほうがより正確であるため、ゲノム配列が利用可能な場合は利用するのが一般的です。
一般にこの種のプログラムは遺伝子構造推定だけでなく、発現量推定まで行ってくれます。
とりあえずリストアップしただけのものもあったと思いますので、間違いもいくつか含まれていると思います。
R以外:
- Scripture：Guttman et al., Nat Biotechnol., 2010
- Cufflinks：Trapnell et al., Nat Biotechnol., 2010
- rQuant: Bohnert and Ratsch, Nucleic Acids Res., 2010
- STM：Surget-Groba and Montoya-Burgos, Genome Res., 2010
- ALEXA-seq：Griffith et al., Nat Methods, 2010
- MISO: Katz et al., Nat. Methods, 2010
- MMSEQ: Turro et al., Genome Biol., 2011
- IsoEM: Nicolae et al., Algorithms Mol. Biol., 2011
- IsoformEx: Kim et al., BMC Bioinformatics, 2011
- RSEM: Li and Dewey, BMC Bioinformatics, 2011
- SLIDE: Li et al., PNAS, 2011
- IQSeq: Du et al., PLoS One, 2012
- BitSeq: Glaus et al., Bioinformatics, 2012
- ARTADE2：Kawaguchi et al., Bioinformatics, 2012
- RD：Wan et al., Biostatistics, 2012
- Plntron：Pirola et al., BMC Bioinformatics, 2012
- CEM：Li and Jiang, Bioinformatics, 2012
- iReckon：Mezlini et al., Genome Res., 2013
- TrueSight：Li et al., Nucleic Acids Res., 2013(p3)
- PASTA：Tang et al., BMC Bioinformatics, 2013
- CLASS：Song and Florea, BMC Bioinformatics, 2013
- GeneScissors：Zhang et al., Bioinformatics, 2013
- PSGInfer：LeGault et al., Bioinformatics, 2013
- NURD：Ma et al., BMC Bioinformatics, 2013
- MITIE：Behr et al., Bioinformatics, 2013
- ORMAN：Dao et al., Bioinformatics, 2014
- UnSplicer：Burns et al., Nucleic Acids Res., 2014
- PennSeq：Hu et al., Nucleic Acids Res., 2014
- Parseq：Mirauta et al., Bioinformatics, 2014
新規転写物(新規isoform)の発見などが目的でなく、既知転写物の発現量を知りたいだけの場合には、やたらと時間がかかるゲノム配列へのマッピングを避けるのが一般的です。
有名なCufflinksも一応GTF形式のアノテーションファイルを与えることでゲノム全体にマップするのを避けるモードがあるらしいので、一応リストアップしています。
転写物へのマッピングの場合には、splice-aware alignerを用いたジャンクションリードのマッピングを行う必要がないので、高速にマッピング可能なbasic alignerで十分です。
但し、複数個所にマップされるリードは考慮する必要があり、確率モデルのパラメータを最尤法に基づいて推定するexpectation-maximization (EM)アルゴリズムがよく用いられます。
マッピングを行わずに、k-merを用いてalignment-freeで行う発現量推定を行うSailfishやRNA-Skimは従来法に比べて劇的に高速化がなされているようです。
間違いがいくつか含まれているとは思います。
2014年6月に調べた結果をリストアップします：
プログラム:
- Cufflinks：Trapnell et al., Nat Biotechnol., 2010
- NEUMA：Lee et al., Nucleic Acids Res., 2011
- IsoEM: Nicolae et al., Algorithms Mol. Biol., 2011
- RSEM: Li and Dewey, BMC Bioinformatics, 2011
- eXpress：Roberts and Pachter, Nat Methods, 2013
- ReXpress: Roberts et al., Bioinformatics, 2013
- TIGAR：Nariai et al., Bioinformatics, 2013
- eXpress-D：Roberts et al., BMC Bioinformatics, 2013
- Sailfish: Patro et al., Nat Biotechnol., 2014
- RNA-Skim: Zhang and Wang, Bioinformatics, 2014
ここで紹介するのは実質的にRNA-seqカウントデータ用ですが、ぽつぽつと出始めているようです。
RNA-seqカウントデータのクラスタリング結果は、特にゼロカウント(0カウント; zero count)を多く含む場合に(もちろん距離の定義の仕方によっても変わってきますが)
低発現データのフィルタリングの閾値次第で結果が変わる傾向にあります。
ここでは、上記閾値問題に悩まされることなく頑健なサンプル間クラスタリングを行うやり方を示します。
内部的に行っていることは、1)全サンプルで0カウントとなる行(遺伝子)をフィルタリングした後、unique関数を用いて同一発現パターンのものを１つのパターンとしてまとめ、
2)「1 - Spearman順位相関係数」でサンプル間距離を定義、3)Average-linkage clusteringの実行、です。
順位相関係数を用いてサンプルベクトル間の類似度として定義するので、サンプル間正規化の問題に悩まされません。
また、低発現遺伝子にありがちな同一発現パターンの遺伝子をまとめることで、(変動しやすい)同順位となる大量の遺伝子が集約されるため、
結果的に「総カウント数がx個以下のものをフィルタリング...」という閾値問題をクリアしたことになります。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.png"
param_fig <- c(500, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
obj <- as.logical(rowSums(data) > 0)
data <- unique(data[obj,])
dim(data)
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method="average")
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。non-DEGデータのみでクラスタリングを行っています。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.png"
param_fig <- c(500, 400)
param_nonDEG <- 2001:10000
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
data <- data[param_nonDEG,]
dim(data)
obj <- as.logical(rowSums(data) > 0)
data <- unique(data[obj,])
dim(data)
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method="average")
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
Study列が"bodymap"データのクラスタリングを行います。"Count table"列のカウントデータファイル(bodymap_count_table.txt)
のみではサンプル名がIDとして与えられているため、"Phenotype table"列のサンプル名情報ファイル(bodymap_phenodata.txt)
も利用してbrain, liver, heartなどに変換した上でクラスタリング結果を表示させています。
in_f1 <- "bodymap_count_table.txt"
in_f2 <- "bodymap_phenodata.txt"
out_f <- "hoge3.png"
param_fig <- c(500, 400)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
phenotype <- read.table(in_f2, header=TRUE, row.names=1, sep=" ", quote="")
colnames(data) <- phenotype$tissue.type
dim(data)
obj <- as.logical(rowSums(data) > 0)
data <- unique(data[obj,])
dim(data)
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method="average")
png(out_f, pointsize=15, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
4. サンプルデータ8の26,221 genes×6 samplesのリアルデータ(data_arab.txt; mock 3サンプル vs. hrcc 3サンプル)の場合：
in_f <- "data_arab.txt"
out_f <- "hoge4.png"
param_fig <- c(500, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
obj <- as.logical(rowSums(data) > 0)
data <- unique(data[obj,])
dim(data)
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method="average")
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
5. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
Neyret-Kahn et al., Genome Res., 2013の2群間比較用ヒトRNA-seqカウントデータです。
パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)から得られます。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge5.png"
param_fig <- c(500, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
obj <- as.logical(rowSums(data) > 0)
data <- unique(data[obj,])
dim(data)
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method="average")
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
TCCパッケージを用いてサンプル間クラスタリングを行うやり方を示します。
clusterSample関数を利用した頑健なクラスタリング結果を返します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Neyret-Kahn et al., Genome Res., 2013の2群間比較用(3 proliferative samples vs. 3 Ras samples)ヒトRNA-seqカウントデータです。
パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)から得られます。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge1.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
1.との違いはplot関数実行時のオプションの部分のみです。sub=""で、下のほうの「hclust(*, "average")」という文字を消しています。
xlab=""で、下のほうの「d」という文字を消しています。cex.lab=1.5で、表示されているy軸名「Height」の文字の大きさを通常の0.6倍にし、
入力ファイル中のサンプル名の文字の大きさを通常の1.3倍にしています。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge2.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, sub="", xlab="", cex.lab=0.6, cex=1.3)
dev.off()
2.との違いはplot関数実行時のオプションの部分のみです。
ylab="height kamo"で、y軸名を通常の1.2倍の「height kamo」にしています。
main=""で、図の上のほうのメインタイトル名が表示されないようにしてます。
par(mar=c(0, 4, 1, 0))で、図の上下の余白を狭くして、図の左側のみ4行分、上を1行分空け、下と右を0行分だけ開けるように指定しています。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge3.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="height kamo")
dev.off()
このデータは2つの大きなクラスターに分かれていることが分かります。
ここでは指定したクラスター数に分けた場合に、含まれるメンバーなどを得るやり方を示します。
in_f <- "srp017142_count_bowtie.txt"
out_f1 <- "hoge4.txt"
out_f2 <- "hoge4.png"
param_fig <- c(500, 400)
param_clust_num <- 3
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
hoge <- cutree(out, k=param_clust_num)
hoge
tmp <- cbind(colnames(data), hoge)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F, col.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="Height")
dev.off()
Neyret-Kahn et al., Genome Res., 2013のgene-levelの2群間比較用(3 proliferative samples vs. 3 Ras samples)ヒトRNA-seqカウントデータです。
マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)から得られます。
in_f <- "hoge9_count_gene.txt"
out_f <- "hoge5.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="Height")
dev.off()
Neyret-Kahn et al., Genome Res., 2013のexon-levelの2群間比較用(3 proliferative samples vs. 3 Ras samples)ヒトRNA-seqカウントデータです。
マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)から得られます。
in_f <- "hoge9_count_exon.txt"
out_f <- "hoge6.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="Height")
dev.off()
Blekhman et al., Genome Res., 2010の
20,689 genes×36 samplesのカウントデータです。
in_f <- "sample_blekhman_36.txt"
out_f <- "hoge7.png"
param_fig <- c(700, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="Height")
dev.off()
Blekhman et al., Genome Res., 2010の
20,689 genes×18 samplesのカウントデータです。
in_f <- "sample_blekhman_18.txt"
out_f <- "hoge8.png"
param_fig <- c(700, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="Height")
dev.off()
MBCluster.Seqパッケージを用いたやり方を示します。
最適なクラスター数周辺までかなりいろいろとできるようなことを書いてあったような気がします。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
RNA-seq発現変動解析は、一般にゲノム配列（またはトランスクリプトーム配列）にリードをマップし、 遺伝子領域、エクソン（exon）領域など
特定の領域にマップされたリード数をカウントして得られた「カウントデータ（count data; count matrix）」を入力として用います。
しかし、使い慣れないパッケージだと正しい手順で実行できたかどうか不明なため、不安を覚えることもあると思います。
1つの解決策は「これが発現変動の上位に来ていないと絶対におかしい!」というような人工的なデータを作成し、それを入力として試すのです。
TCCは、2,3, 多群間, multi-factorにも対応しています。
compcodeRは2群間のみだがrandom effectにも対応し、任意の割合のoutlierを導入することができます。
実験系ユーザで動作確認用程度であれば、様々な実験デザインに対応しているTCCで極端なデータを作成して入力として用いるので十分だと思います。
ポアソン分布（Poisson distribution）に従うデータとは、任意の値（λ）を与えたときに、分散がλとなるような分布になるようなデータのことです。
以下では、1.ポアソン分布の感覚をつかみながら、2.Marioni et al., Genome Res., 2008の実際のデータを
経験分布（empirical distribution of read countsに相当）として与えてシミュレーションカウントデータの作成を行います。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1-1. ポアソン分布の感覚をつかむ（初級）：
任意のλ（> 0）を与え、任意の数の乱数を発生させ、その分散がλに近い値になっているかどうか調べる。
param1 <- 8
param2 <- 100
out <- rpois(param2, lambda=param1)
out
var(out)
1-2. ポアソン分布の感覚をつかむ（中級）：
λを1から100までにし、各λの値について発生させる乱数の数を増やし、λの値ごとの平均と分散を計算した結果をプロット
out <- NULL
for(i in 1:100){
x <- rpois(n=2000, lambda=i)
out <- rbind(out, c(mean(x), var(x)))
}
colnames(out) <- c("MEAN", "VARIANCE")
plot(out)
param1 <- c(5, 60, 200)
param2 <- 10000
out <- rpois(param2*length(param1), lambda=param1)
hist(out)
2. シミュレーションデータの作成本番（7サンプル分の行列データとして作成）：
サンプルデータ2のSupplementaryTable2_changed.txtの「kidney 5サンプル vs. liver 5サンプル」のデータに相当しますが、このうちkidneyのデータを入力として与えることにします。
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge2.txt"
param1 <- 7
tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
tmp <- rowSums(tmp[,1:5])
RPM <- tmp*1000000/sum(tmp)
LAMBDA <- RPM[RPM > 0]
out <- NULL
for(i in 1:param1){
out <- cbind(out, rpois(n=length(LAMBDA), lambda=LAMBDA))
}
obj <- rowSums(out) > 0
out2 <- out[obj,]
MEAN <- apply(out2, 1, mean)
VARIANCE <- apply(out2, 1, var)
plot(MEAN, VARIANCE, log="xy")
grid(col="gray", lty="dotted")
tmp <- cbind(out2, LAMBDA[obj], MEAN, VARIANCE)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3. シミュレーションデータの作成本番（遺伝子数（行数）を任意に与える場合）：
サンプルデータ2のSupplementaryTable2_changed.txtの「kidney 5サンプル vs. liver 5サンプル」のデータに相当しますが、このうちkidneyのデータを入力として与えることにします。
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge3.txt"
param1 <- 7
param_Ngene <- 5000
tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
tmp <- rowSums(tmp[,1:5])
LAMBDA <- tmp[tmp > 0]
LAMBDA <- sample(LAMBDA, param_Ngene, replace=TRUE)
LAMBDA <- LAMBDA*1000000/sum(LAMBDA)
out <- NULL
for(i in 1:param1){
out <- cbind(out, rpois(n=length(LAMBDA), lambda=LAMBDA))
}
obj <- apply(out, 1, var) > 0
out2 <- out[obj,]
MEAN <- apply(out2, 1, mean)
VARIANCE <- apply(out2, 1, var)
plot(MEAN, VARIANCE, log="xy")
grid(col="gray", lty="dotted")
tmp <- cbind(LAMBDA, out)
colnames(tmp) <- c("LAMBDA", paste("replicate",1:param1,sep=""))
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
4. シミュレーションデータの作成本番（G1群3サンプル vs. G2群3サンプルのデータで、全遺伝子の10%がG1群で2倍高発現というデータにしたい場合）：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge4.txt"
param_G1 <- 3
param_G2 <- 3
param_Ngene <- 10000
param_PDEG <- 0.1
param_FC <- 2
tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
tmp <- rowSums(tmp[,1:5])
LAMBDA <- tmp[tmp > 0]
LAMBDA <- sample(LAMBDA, param_Ngene, replace=TRUE)
LAMBDA <- LAMBDA*1000000/sum(LAMBDA)
DEG_degree <- rep(1, param_Ngene)
DEG_degree[1:(param_Ngene*param_PDEG)] <- param_FC
DEG_posi <- DEG_degree == param_FC
LAMBDA_A <- LAMBDA*DEG_degree
LAMBDA_B <- LAMBDA
outA <- NULL
for(i in 1:param_G1){
outA <- cbind(outA, rpois(n=length(LAMBDA_A), lambda=LAMBDA_A))
}
outB <- NULL
for(i in 1:param_G2){
outB <- cbind(outB, rpois(n=length(LAMBDA_B), lambda=LAMBDA_B))
}
tmp <- cbind(outA, outB)
colnames(tmp) <- c(paste("G1_rep",1:param_G1,sep=""),paste("G2_rep",1:param_G2,sep=""))
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
data <- tmp
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
param_xrange <- c(0.5, 10000)
plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)
grid(col="gray", lty="dotted")
legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)
5. シミュレーションデータの作成本番（G1群3サンプル vs. G2群3サンプルのデータで、全遺伝子の10%がDEG。DEGのうちの80%がG1群で高発現、残りの20%がG2群で高発現というデータにしたい場合）：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param_Ngene <- 10000
param_PDEG <- 0.1
param_FC <- 2
param_PG1 <- 0.8
tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
tmp <- rowSums(tmp[,1:5])
LAMBDA <- tmp[tmp > 0]
LAMBDA <- sample(LAMBDA, param_Ngene, replace=TRUE)
LAMBDA <- LAMBDA*1000000/sum(LAMBDA)
DEG_degree_A <- rep(1, param_Ngene)
DEG_degree_A[1:(param_Ngene*param_PDEG*param_PG1)] <- param_FC
LAMBDA_A <- LAMBDA*DEG_degree_A
DEG_degree_B <- rep(1, param_Ngene)
DEG_degree_B[(param_Ngene*param_PDEG*param_PG1+1):param_Ngene*param_PDEG)] <- param_FC
LAMBDA_B <- LAMBDA*DEG_degree_B
DEG_posi <- (DEG_degree_A*DEG_degree_B) > 1
outA <- NULL
for(i in 1:param_G1){
outA <- cbind(outA, rpois(n=length(LAMBDA_A), lambda=LAMBDA_A))
}
outB <- NULL
for(i in 1:param_G2){
outB <- cbind(outB, rpois(n=length(LAMBDA_B), lambda=LAMBDA_B))
}
tmp <- cbind(outA, outB)
colnames(tmp) <- c(paste("G1_rep",1:param_G1,sep=""),paste("G2_rep",1:param_G2,sep=""))
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
data <- tmp
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
param_xrange <- c(0.5, 10000)
plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)
grid(col="gray", lty="dotted")
legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)
6. シミュレーションデータの作成本番：
Robinson and Oshlack, 2010のFig. 2のデータとほとんど同じものを作りたい場合。違いはG1群およびG2群でuniqueに発現しているものを入れてないだけ
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge6.txt"
param_G1 <- 1
param_G2 <- 1
param_Ngene <- 20000
param_PDEG <- 0.1
param_FC <- 2
param_PG1 <- 0.8
tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
tmp <- rowSums(tmp[,1:5])
LAMBDA <- tmp[tmp > 0]
LAMBDA <- sample(LAMBDA, param_Ngene, replace=TRUE)
LAMBDA <- LAMBDA*1000000/sum(LAMBDA)
DEG_degree_A <- rep(1, param_Ngene)
DEG_degree_A[1:(param_Ngene*param_PDEG*param_PG1)] <- param_FC
LAMBDA_A <- LAMBDA*DEG_degree_A
DEG_degree_B <- rep(1, param_Ngene)
DEG_degree_B[(param_Ngene*param_PDEG*param_PG1+1):(param_Ngene*param_PDEG)] <- param_FC
LAMBDA_B <- LAMBDA*DEG_degree_B
DEG_posi <- (DEG_degree_A*DEG_degree_B) > 1
outA <- NULL
for(i in 1:param_G1){
outA <- cbind(outA, rpois(n=length(LAMBDA_A), lambda=LAMBDA_A))
}
outB <- NULL
for(i in 1:param_G2){
outB <- cbind(outB, rpois(n=length(LAMBDA_B), lambda=LAMBDA_B))
}
tmp <- cbind(outA, outB)
colnames(tmp) <- c(paste("G1_rep",1:param_G1,sep=""),paste("G2_rep",1:param_G2,sep=""))
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
data <- tmp
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
param_xrange <- c(0.5, 10000)
plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)
grid(col="gray", lty="dotted")
legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)
誰が最初か今のところ把握していませんがBiological replicatesのカウントデータが負の二項分布（negative binomial distribution; NB分布）
に従うというのがこの業界のコンセンサスです。つまり、ポアソン分布よりももっとばらつき(dispersion)が大きいということを言っています。
ここではまず、NB modelの一般式としてVARIANCE = MEAN + φ×(MEAN)^2において、MEAN=10 and φ=0.1
のNBモデルに従う乱数を発生させて発現変動解析との関連のイメージをつかみます。
このときのVARIANCEの期待値はVARIANCE = 10 + 0.1×(10)^2 = 20となります。このほかにも様々な例を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. MEAN=10 and φ=0.1の場合（基本形）：
(MEAN-VARIANCE plotをファイルpngファイルに保存しています)
out_f <- "hoge1.png"
param_MEAN <- 10
param_dispersion <- 0.1
param_Ngene <- 1000
param_G1 <- 3
param_G2 <- 3
param_fig <- c(380, 420)
rnbinom(n=100, mu=param_MEAN, size=1/param_dispersion)
hoge <- rnbinom(n=10000, mu=param_MEAN, size=1/param_dispersion)
var(hoge)
hoge1 <-param_Ngene*(param_G1 + param_G2)
hoge2 <- rnbinom(n=hoge1, mu=param_MEAN, size=1/param_dispersion)
data <- matrix(hoge2, nrow=param_Ngene)
head(data)
dim(data)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
MEAN <- apply(data, 1, mean)
VARIANCE <- apply(data, 1, var)
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="black")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
DEG <- c(rep(0, param_G1), rep(param_MEAN*2, param_G2))
DEG
mean(DEG)
var(DEG)
points(mean(DEG), var(DEG), col="red", cex=1.0, pch=20)
legend("topright", c("DEG", "non-DEG"), col=c("red", "black"), pch=20)
dev.off()
2. G1群2サンプル vs. G2群2サンプルのデータで、全遺伝子の15%がDEG。DEGのうちの20%がG1群で4倍高発現、残りの80%がG2群で4倍高発現というデータにしたい場合：
out_f <- "hoge2.txt"
param_G1 <- 2
param_G2 <- 2
param_Ngene <- 20000
param_PDEG <- 0.15
param_FC <- 4
param_PG1 <- 0.2
library(NBPSeq)
data(arab)
data <- arab
data.cl <- c(rep(1, 3), rep(2, 3))
RPM <- sweep(data, 2, 1000000/colSums(data), "*")
RPM_A <- RPM[,data.cl == 1]
RPM_B <- RPM[,data.cl == 2]
RPM_A <- RPM_A[apply(RPM_A, 1, var) > 0,]
RPM_B <- RPM_B[apply(RPM_B, 1, var) > 0,]
MEAN <- c(apply(RPM_A, 1, mean), apply(RPM_B, 1, mean))
VARIANCE <- c(apply(RPM_A, 1, var), apply(RPM_B, 1, var))
DISPERSION <- (VARIANCE - MEAN)/(MEAN*MEAN)
mean_disp_tmp <- cbind(MEAN, DISPERSION)
mean_disp_tmp <- mean_disp_tmp[mean_disp_tmp[,2] > 0,]
hoge <- sample(1:nrow(mean_disp_tmp), param_Ngene, replace=TRUE)
mean_disp <- mean_disp_tmp[hoge,]
mu <- mean_disp[,1]
DEG_degree_A <- rep(1, param_Ngene)
DEG_degree_A[1:(param_Ngene*param_PDEG*param_PG1)] <- param_FC
mu_A <- mu*DEG_degree_A
DEG_degree_B <- rep(1, param_Ngene)
DEG_degree_B[(param_Ngene*param_PDEG*param_PG1+1):(param_Ngene*param_PDEG)] <- param_FC
mu_B <- mu*DEG_degree_B
DEG_posi_org <- (DEG_degree_A*DEG_degree_B) > 1
nonDEG_posi_org <- (DEG_degree_A*DEG_degree_B) == 1
outA <- NULL
for(i in 1:param_G1){
outA <- cbind(outA, rnbinom(n=length(mu_A), mu=mu_A, size=1/mean_disp[,2]))
}
outB <- NULL
for(i in 1:param_G2){
outB <- cbind(outB, rnbinom(n=length(mu_B), mu=mu_B, size=1/mean_disp[,2]))
}
out <- cbind(outA, outB)
obj <- rowSums(out) > 0
RAW <- out[obj,]
DEG_posi <- DEG_posi_org[obj]
nonDEG_posi <- nonDEG_posi_org[obj]
tmp <- cbind(RAW, DEG_posi)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
data <- RAW
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
#param_xrange <- c(0.5, 10000)
#plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)")
plot(x_axis, y_axis, pch=20, cex=0.1, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)
grid(col="gray", lty="dotted")
legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)
3. G1群1サンプル vs. G2群1サンプルのデータで、全遺伝子の15%がDEG。DEGのうちの20%がG1群で4倍高発現、残りの80%がG2群で4倍高発現というデータにしたい場合：
out_f <- "hoge3.txt"
param_G1 <- 1
param_G2 <- 1
param_Ngene <- 20000
param_PDEG <- 0.15
param_FC <- 4
param_PG1 <- 0.2
library(NBPSeq)
data(arab)
data <- arab
data.cl <- c(rep(1, 3), rep(2, 3))
RPM <- sweep(data, 2, 1000000/colSums(data), "*")
RPM_A <- RPM[,data.cl == 1]
RPM_B <- RPM[,data.cl == 2]
RPM_A <- RPM_A[apply(RPM_A,1,var) > 0,]
RPM_B <- RPM_B[apply(RPM_B,1,var) > 0,]
MEAN <- c(apply(RPM_A, 1, mean), apply(RPM_B, 1, mean))
VARIANCE <- c(apply(RPM_A, 1, var), apply(RPM_B, 1, var))
DISPERSION <- (VARIANCE - MEAN)/(MEAN*MEAN)
mean_disp_tmp <- cbind(MEAN, DISPERSION)
mean_disp_tmp <- mean_disp_tmp[mean_disp_tmp[,2] > 0,]
hoge <- sample(1:nrow(mean_disp_tmp), param_Ngene, replace=TRUE)
mean_disp <- mean_disp_tmp[hoge,]
mu <- mean_disp[,1]
DEG_degree_A <- rep(1, param_Ngene)
DEG_degree_A[1:(param_Ngene*param_PDEG*param_PG1)] <- param_FC
mu_A <- mu*DEG_degree_A
DEG_degree_B <- rep(1, param_Ngene)
DEG_degree_B[(param_Ngene*param_PDEG*param_PG1+1):(param_Ngene*param_PDEG)] <- param_FC
mu_B <- mu*DEG_degree_B
DEG_posi_org <- (DEG_degree_A*DEG_degree_B) > 1
nonDEG_posi_org <- (DEG_degree_A*DEG_degree_B) == 1
outA <- NULL
for(i in 1:param_G1){
outA <- cbind(outA, rnbinom(n=length(mu_A), mu=mu_A, size=1/mean_disp[,2]))
}
outB <- NULL
for(i in 1:param_G2){
outB <- cbind(outB, rnbinom(n=length(mu_B), mu=mu_B, size=1/mean_disp[,2]))
}
out <- cbind(outA, outB)
obj <- rowSums(out) > 0
RAW <- out[obj,]
DEG_posi <- DEG_posi_org[obj]
nonDEG_posi <- nonDEG_posi_org[obj]
tmp <- cbind(RAW, DEG_posi)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
data <- RAW
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
#param_xrange <- c(0.5, 10000)
#plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)")
plot(x_axis, y_axis, pch=20, cex=0.1, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)
grid(col="gray", lty="dotted")
legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)
- TCC：Sun et al., BMC Bioinformatics, 2013
- Di et al., SAGMB, 2011
- GENE-counter：Cumbie et al., PLoS One, 2011
- Anders and Huber, Genome Biol., 2010
- Robinson et al., Bioinformatics, 2010
TCCパッケージ中のsimulateReadCounts関数を用いて
2群間比較用のシミュレーションカウントデータを作成するやり方を示します。
特に、以下に示すようなTbT論文(Kadota et al., Algorithms Mol. Biol., 2012)
の図1とほぼ同じシミュレーション条件に固定して、TCCパッケージの使い方に慣れることに重点を置きます：
G1群 vs. G2群で各群の反復数を3に固定、 、つまり「G1_rep1, G1_rep2, G1_rep3, G2_rep1, G2_rep2, G2_rep3」の計6サンプル。
全10,000遺伝子、最初の20%分(gene_1〜gene_2000)が発現変動遺伝子(DEG)、
全2,000 DEGsの内訳：最初の90%分(gene_1〜gene_1800)がG1群で4倍高発現、残りの10%分(gene_1801〜gene_2000)がG2群で4倍高発現。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータを作成する場合：
基本形。
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_Ngene <- 10000
param_PDEG <- 0.2
param_FC <- 4
param_PG1 <- 0.9
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=c(param_PG1, 1-param_PG1),
DEG.foldchange=c(param_FC, param_FC),
replicates=c(param_G1, param_G2))
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータを作成する場合：
1. と基本的に同じですが、set.seed(1000)の行頭に#を入れてコメントアウトしているので、得られる数値自体は毎回変わるようになります。
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_Ngene <- 10000
param_PDEG <- 0.2
param_FC <- 4
param_PG1 <- 0.9
library(TCC)
#set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=c(param_PG1, 1-param_PG1),
DEG.foldchange=c(param_FC, param_FC),
replicates=c(param_G1, param_G2))
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータを作成する場合：
1.と同じですが、記述形式を変えてます。
out_f <- "hoge3.txt"
param_replicates <- c(3, 3)
param_Ngene <- 10000
param_PDEG <- 0.2
param_FC <- c(4, 4)
param_DEGassign <- c(0.9, 0.1)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
4. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータを作成する場合：
2. と基本的に同じですが、set.seed(1000)の行頭に#を入れてコメントアウトしているので、得られる数値自体は毎回変わるようになります。
out_f <- "hoge4.txt"
param_replicates <- c(3, 3)
param_Ngene <- 10000
param_PDEG <- 0.2
param_FC <- c(4, 4)
param_DEGassign <- c(0.9, 0.1)
library(TCC)
#set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
5. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータを作成する場合：
3.と同じですが、それにプラスアルファの情報として、シミュレーション条件の概要が分かるようにpseudo-colorイメージのpngファイルを生成しています。
out_f1 <- "hoge5.txt"
out_f2 <- "hoge5.png"
param_replicates <- c(3, 3)
param_Ngene <- 10000
param_PDEG <- 0.2
param_FC <- c(4, 4)
param_DEGassign <- c(0.9, 0.1)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
6. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータを作成する場合：
3.と同じですが、それにプラスアルファの情報として、M-A plotのpngファイルを生成しています。
out_f1 <- "hoge6.txt"
out_f2 <- "hoge6.png"
param_replicates <- c(3, 3)
param_Ngene <- 10000
param_PDEG <- 0.2
param_FC <- c(4, 4)
param_DEGassign <- c(0.9, 0.1)
param_fig <- c(602, 450)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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(tcc, normalize=F, median.lines=T, col=c("black","red"))
dev.off()
7. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータを作成する場合：
6.と同じですが、それにプラスアルファの情報として、シミュレーション条件の概要を一望できるpseudo-colorイメージのpngファイルも生成しています。
out_f1 <- "hoge7.txt"
out_f2 <- "hoge7_MAplot.png"
out_f3 <- "hoge7_pseudo.png"
param_replicates <- c(3, 3)
param_Ngene <- 10000
param_PDEG <- 0.2
param_FC <- c(4, 4)
param_DEGassign <- c(0.9, 0.1)
param_fig2 <- c(602, 450)
param_fig3 <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig2[1], height=param_fig2[2])
plot(tcc, normalize=F, median.lines=T, col=c("black","red"))
dev.off()
png(out_f3, pointsize=13, width=param_fig3[1], height=param_fig3[2])
plotFCPseudocolor(tcc)
dev.off()
TCCパッケージ中のsimulateReadCounts関数を用いて
2群間比較用のシミュレーションカウントデータを作成するやり方を示します。
ここでは、基礎の7.のコードを基本として、各群の反復数、全遺伝子数、発現変動遺伝子(DEG)数の割合、各群のDEGの発現変動の度合い、DEG数の各群への割り振りをいろいろ変えます。
試行(trial)ごとに得られる数値が変わるようにしたい場合はset.seed(1000)の前に#を入れましょう。つまり「set.seed(1000)」->「#set.seed(1000)」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 12,500 genes×6 samplesのシミュレーションデータを作成する場合：
全遺伝子数(12500)、反復数(G1が2, G2が4)、DEGの割合が0.32 (12500*0.32=4000)、
DEGの発現変動の度合い(G1が5.3, G2が0.25)、DEG数の各群への割り振り(G1が0.2, G2が0.8)。
これは全部で4,000 DEGsのうち、gene_1からgene_800までがG1群で5.3倍高発現、gene_801からgene_4000までがG2群で0.25倍高発現(つまりG1群で4倍高発現)を意味し、
事実上全DEGがG1群で高発現というシミュレーション条件になります。M-A plot実行時にmedian.lines=Fとして、水平線や右側に数値が出ないようにしています。
out_f1 <- "hoge1.txt"
out_f2 <- "hoge1_MAplot.png"
out_f3 <- "hoge1_pseudo.png"
param_replicates <- c(2, 4)
param_Ngene <- 12500
param_PDEG <- 0.32
param_FC <- c(5.3, 0.25)
param_DEGassign <- c(0.2, 0.8)
param_fig2 <- c(602, 450)
param_fig3 <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig2[1], height=param_fig2[2])
plot(tcc, normalize=F, median.lines=F, col=c("black","red"))
dev.off()
png(out_f3, pointsize=13, width=param_fig3[1], height=param_fig3[2])
plotFCPseudocolor(tcc)
dev.off()
2. 20,023 genes×11 samplesのシミュレーションデータを作成する場合：
全遺伝子数(200023)、反復数(G1が4, G2が7)、DEGの割合が0.27、
DEGの発現変動の度合い(G1が3.2, G2が4.7)、DEG数の各群への割り振り(G1が0.65, G2が0.35)。
これは全部で5,406 DEGsのうち、gene_1からgene_3514までがG1群で3.2倍高発現、gene_3515からgene_5406までがG2群で4.7倍高発現を意味します。
M-A plot実行時にmedian.lines=Tとして、水平線や右側に数値が出るようにしています。
out_f1 <- "hoge2.txt"
out_f2 <- "hoge2_MAplot.png"
out_f3 <- "hoge2_pseudo.png"
param_replicates <- c(4, 7)
param_Ngene <- 20023
param_PDEG <- 0.27
param_FC <- c(3.2, 4.7)
param_DEGassign <- c(0.65, 0.35)
param_fig2 <- c(602, 450)
param_fig3 <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig2[1], height=param_fig2[2])
plot(tcc, normalize=F, median.lines=T, col=c("black","red"))
dev.off()
png(out_f3, pointsize=13, width=param_fig3[1], height=param_fig3[2])
plotFCPseudocolor(tcc)
dev.off()
3. 20,023 genes×2 samplesのシミュレーションデータを作成する場合：
全遺伝子数(200023)、反復数(G1が1, G2が1)、DEGの割合が0.27、
DEGの発現変動の度合い(G1が3.2, G2が4.7)、DEG数の各群への割り振り(G1が0.65, G2が0.35)。
これは全部で5,406 DEGsのうち、gene_1からgene_3514までがG1群で3.2倍高発現、gene_3515からgene_5406までがG2群で4.7倍高発現を意味します。
M-A plot実行時にmedian.lines=Tとして、水平線や右側に数値が出るようにしています。
out_f1 <- "hoge3.txt"
out_f2 <- "hoge3_MAplot.png"
out_f3 <- "hoge3_pseudo.png"
param_replicates <- c(1, 1)
param_Ngene <- 20023
param_PDEG <- 0.27
param_FC <- c(3.2, 4.7)
param_DEGassign <- c(0.65, 0.35)
param_fig2 <- c(602, 450)
param_fig3 <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig2[1], height=param_fig2[2])
plot(tcc, normalize=F, median.lines=T, col=c("black","red"))
dev.off()
png(out_f3, pointsize=13, width=param_fig3[1], height=param_fig3[2])
plotFCPseudocolor(tcc)
dev.off()
TCCパッケージ中のsimulateReadCounts関数を用いて
3群間比較用のシミュレーションカウントデータを作成するやり方を示します。
ここでは、G1, G2, G3群で各群の反復数を3に固定、 、つまり「G1_rep1, G1_rep2, G1_rep3, G2_rep1, G2_rep2, G2_rep3, G3_rep1, G3_rep2, G3_rep3」の計9サンプル。
全10,000遺伝子、最初の25%分(gene_1〜gene_2500)が発現変動遺伝子(DEG)。
試行(trial)ごとに得られる数値が変わるようにしたい場合はset.seed(1000)の前に#を入れましょう。つまり「set.seed(1000)」->「#set.seed(1000)」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 10,000 genes×9 samplesのシミュレーションデータを作成する場合：
全遺伝子数が10000、反復数(G1が3, G2が3, G3が3)、DEGの割合が0.25 (10000*0.25=2500)、
DEGの発現変動の度合い(G1が4, G2が4, G3が4)、DEG数の各群への割り振り(G1が1/3, G2が1/3, G3が1/3)。
これは全部で2,500 DEGsのうち、gene_1からgene_833までがG1群で4倍高発現、gene_834からgene_1666までがG2群で4倍高発現、gene_1667からgene_2500までがG3群で4倍高発現を意味します。
out_f1 <- "hoge1.txt"
out_f2 <- "hoge1.png"
param_replicates <- c(3, 3, 3)
param_Ngene <- 10000
param_PDEG <- 0.25
param_FC <- c(4, 4, 4)
param_DEGassign <- c(1/3, 1/3, 1/3)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
2. 10,000 genes×9 samplesのシミュレーションデータを作成する場合：
全遺伝子数が10000、反復数(G1が3, G2が3, G3が3)、
DEGの割合が0.25 (10000*0.25=2500)、
DEGの発現変動の度合い(G1が4, G2が4, G3が4)、
DEG数の各群への割り振り(G1が0.5, G2が0.3, G3が0.2)。
これは全部で2,500 DEGsのうち、gene_1からgene_1250までがG1群で4倍高発現、gene_1251からgene_2000までがG2群で4倍高発現、gene_2001からgene_2500までがG3群で4倍高発現を意味します。
out_f1 <- "hoge2.txt"
out_f2 <- "hoge2.png"
param_replicates <- c(3, 3, 3)
param_Ngene <- 10000
param_PDEG <- 0.25
param_FC <- c(4, 4, 4)
param_DEGassign <- c(0.5, 0.3, 0.2)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
3. 10,000 genes×9 samplesのシミュレーションデータを作成する場合：
全遺伝子数が10000、反復数(G1が3, G2が3, G3が3)、
DEGの割合が0.25 (10000*0.25=2500)、
DEGの発現変動の度合い(G1が4, G2が4, G3が4)、
DEG数の各群への割り振り(G1が0.5, G2が0.4, G3が0.1)。
これは全部で2,500 DEGsのうち、gene_1からgene_1250までがG1群で4倍高発現、gene_1251からgene_2250までがG2群で4倍高発現、gene_2251からgene_2500までがG3群で4倍高発現を意味します。
out_f1 <- "hoge3.txt"
out_f2 <- "hoge3.png"
param_replicates <- c(3, 3, 3)
param_Ngene <- 10000
param_PDEG <- 0.25
param_FC <- c(4, 4, 4)
param_DEGassign <- c(0.5, 0.4, 0.1)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
4. 10,000 genes×9 samplesのシミュレーションデータを作成する場合：
全遺伝子数が10000、反復数(G1が3, G2が3, G3が3)、
DEGの割合が0.25 (10000*0.25=2500)、
DEGの発現変動の度合い(G1が4, G2が4, G3が4)、
DEG数の各群への割り振り(G1が0.6, G2が0.2, G3が0.2)。
これは全部で2,500 DEGsのうち、gene_1からgene_1500までがG1群で4倍高発現、gene_1501からgene_2000までがG2群で4倍高発現、gene_2001からgene_2500までがG3群で4倍高発現を意味します。
out_f1 <- "hoge4.txt"
out_f2 <- "hoge4.png"
param_replicates <- c(3, 3, 3)
param_Ngene <- 10000
param_PDEG <- 0.25
param_FC <- c(4, 4, 4)
param_DEGassign <- c(0.6, 0.2, 0.2)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
5. 10,000 genes×9 samplesのシミュレーションデータを作成する場合：
全遺伝子数が10000、反復数(G1が3, G2が3, G3が3)、
DEGの割合が0.25 (10000*0.25=2500)、
DEGの発現変動の度合い(G1が4, G2が4, G3が4)、
DEG数の各群への割り振り(G1が0.6, G2が0.3, G3が0.1)。
これは全部で2,500 DEGsのうち、gene_1からgene_1500までがG1群で4倍高発現、gene_1501からgene_2250までがG2群で4倍高発現、gene_2251からgene_2500までがG3群で4倍高発現を意味します。
out_f1 <- "hoge5.txt"
out_f2 <- "hoge5.png"
param_replicates <- c(3, 3, 3)
param_Ngene <- 10000
param_PDEG <- 0.25
param_FC <- c(4, 4, 4)
param_DEGassign <- c(0.6, 0.3, 0.1)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
6. 10,000 genes×9 samplesのシミュレーションデータを作成する場合：
全遺伝子数が10000、反復数(G1が3, G2が3, G3が3)、
DEGの割合が0.25 (10000*0.25=2500)、
DEGの発現変動の度合い(G1が4, G2が4, G3が4)、
DEG数の各群への割り振り(G1が0.7, G2が0.2, G3が0.1)。
これは全部で2,500 DEGsのうち、gene_1からgene_1750までがG1群で4倍高発現、gene_1751からgene_2250までがG2群で4倍高発現、gene_2251からgene_2500までがG3群で4倍高発現を意味します。
out_f1 <- "hoge6.txt"
out_f2 <- "hoge6.png"
param_replicates <- c(3, 3, 3)
param_Ngene <- 10000
param_PDEG <- 0.25
param_FC <- c(4, 4, 4)
param_DEGassign <- c(0.7, 0.2, 0.1)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
7. 10,000 genes×9 samplesのシミュレーションデータを作成する場合：
全遺伝子数が10000、反復数(G1が3, G2が3, G3が3)、
DEGの割合が0.25 (10000*0.25=2500)、
DEGの発現変動の度合い(G1が4, G2が4, G3が4)、
DEG数の各群への割り振り(G1が0.8, G2が0.1, G3が0.1)。
これは全部で2,500 DEGsのうち、gene_1からgene_2000までがG1群で4倍高発現、gene_2001からgene_2250までがG2群で4倍高発現、gene_2251からgene_2500までがG3群で4倍高発現を意味します。
out_f1 <- "hoge7.txt"
out_f2 <- "hoge7.png"
param_replicates <- c(3, 3, 3)
param_Ngene <- 10000
param_PDEG <- 0.25
param_FC <- c(4, 4, 4)
param_DEGassign <- c(0.8, 0.1, 0.1)
param_fig <- c(450, 600)
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=param_Ngene,
PDEG=param_PDEG,
DEG.assign=param_DEGassign,
DEG.foldchange=param_FC,
replicates=param_replicates)
tmp <- cbind(rownames(tcc$count), tcc$count)
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])
plotFCPseudocolor(tcc)
dev.off()
ここでは、RNA-seqから得られるカウントデータの特徴や、実験デザイン、モデルなどについて基本的なところを述べています。
しかし、以下の記述内容は2012年頃までの知識に基づいているため結構古くなっています。参考程度にしてください。
2014年7月現在の印象としては、ReExpressのような新規転写物を同定しつつ、
既知転写物とそれらの新規転写物配列情報をアップデートしながら発現量推定を行い、
かつ発現変動解析まで行う、あるいはそれを繰り返すという方向性に移行しつつあるような感じです。
つまり、これまでの行数一定の"遺伝子"発現行列データを入力として解析するのではなく、
逐次転写物の発現量の数値や行数が変化しながら解析を行うようなイメージです。
カウントデータとモデル
私のマイクロアレイの論文（Kadota et al., 2009）では、「データ正規化法」と「発現変動遺伝子検出法」の組合せに相性がある、ということを述べています。NGSデータ解析時にも同様な注意が必要です。
ここでの入力データは「遺伝子発現行列」です。「raw countsのもの」か「正規化後」の遺伝子発現行列のどちらを入力データとして用いるのかは用いる方法によりますが、特に指定のない限り「raw countsのデータ」を入力として下さい。
NGSデータは測定値が何回sequenceされたかというcount情報に基づくもので、digital gene expression (DGE)データなどと呼ばれます。
そして、生のカウントデータは当然ながら、integer (整数；小数点以下の数値を含むはずがない)です。
ある遺伝子由来のsequenceされたリード数は二項分布(binomial distribution)に従うと様々な論文中で言及されています。つまり、
- 一般的な二項分布の説明：1(成功)か0(失敗)かのいずれかのn回の独立な試行を行ったときの1の数で表現される離散確率分布で、1が出る確率をpとしている。
- NGSに置き換えた説明：マップされたトータルのリード数がnで、あるリードに着目したときにある特定の遺伝子由来のものである確率がp、ということになります。
ポアソン分布(Poisson distribution)に従う、という記述もよくみかけますが本質的に同じ意味(ポアソン分布や正規分布は二項分布の近似)です。
つまり、nが大きいのがNGSの特徴であるので、pが小さくても、np(sequenceされたある特定の遺伝子由来のリード数の期待値、に相当; λ=np)がそこそこ大きな値になることが期待されるわけです。
というわけですので、このような二項分布を仮定したモデルに基づく「発現変動遺伝子検出法」を用いる際には、
へたに正規化を行ってそのモデルを仮定することができなくなるような墓穴を掘ることはないでしょう、ということです。
ちなみに「負の二項分布(negative bionomial distribution)」というキーワードを目にすることもあろうかと思いますが、これは二項分布の拡張版です。
いわゆるtechnical variation (技術的なばらつき)は「ポアソン分布」として考えることができるが、
biological variation (生物学的なばらつき；もう少し正確にはbiological replicatesのvariation)は一般にそれよりも大きいので(サンプル間の変動係数(coefficient of variation; CV)を)additional variationとして取り扱うべく「負の二項(Negative Binomial; NB)分布」として考える必要性があるのでしょうね。(Robinson and Oshlack, 2010)
technical replicatesとbiological replicatesの意味合い
technical replicatesとbiological replicatesの意味合いについて、もうすこしざっくりと説明します。
例えば「人間である私の体内の二つの組織間（例えば大脳(Brain; B)と皮膚(Skin; S)）で発現変動している遺伝子を検出したい」という目的があったとします。
同じ組織でもばらつきを考慮する必要があるので大脳由来サンプルをいくつかに分割して(これがtechnical replicatesという意味)データを取得します。
皮膚由来サンプルについても同様です。これで得られたデータは(B1, B2, ...) vs. (S1, S2, ...)のようなreplicatesありのデータになります。
この私一個人のtechnical replicatesデータから発現変動遺伝子が得られたとします。
一般的に「私一個人内でのデータのばらつき(technical variation)」は「同じ人間だけど複数の別人の大脳(or 皮膚)由来サンプル間のばらつき(biological variation)」よりも小さいです。
ですので、technical replicates由来データで発現変動遺伝子(Differentially Expressed Genes; DEGs)を同定した結果は「そんなあほな！！」というくらいのDEGs数がレポートされます。
ここで注意しなければいけないのは、この結果は「私一個人の二つのサンプル間で発現変動している遺伝子がこれだけあった」ということを言っているだけで、
「(私が所属する)人間全般に言えることではない！」という点です。そしてもちろん一般には「私個人の事象についてではなく人間(ある特定の生物種)全般にいえる事象に興味がある」わけです。
それゆえ(biological replicatesのデータでないとユニバーサルな事象を理解するのが難しいために)ある程度理解が進んだ人はbiological replicatesが重要だと言っているわけです。
「モデルだ〜分布だ〜」ということと「ユーザーがプログラムを実行して得られる結果(発現変動遺伝子数や特徴)」との関係
「モデルだ〜分布だ〜」ということと「ユーザーがプログラムを実行して得られる結果(発現変動遺伝子数や特徴)」との関係についてですが、重要なのは「比較している二群間でどの程度差があれば発現変動していると判断するか？」です。
これをうまく表現するために、同一サンプルの(biological) replicatesデータから発現変動していないデータがどの程度ばらついているかをまず見積もります。
(このときにどういう数式でばらつきを見積もるのか？というところでいろんな選択肢が存在するがために沢山のRパッケージが存在しうるというわけですが、、、まあこれはおいといて)
負の二項分布モデル(negative binomial model; NB model)では分散VARをVAR = MEAN + φMEAN^2という数式(φ > 0)で表現するのが一般的です。
ちなみにポアソンモデルというのはNBモデルのφ = 0の場合(つまりVAR = MEAN; ある遺伝子の平均発現量がわかるとその遺伝子の分散が概ね平均と同じ、という意味)です。
計算手順としては、同一サンプルの(biological) replicatesデータからφがどの程度の値かを見積もります(推定します)。
ここまでで「ある発現変動していない遺伝子(non-DEGs)の平均発現量がこれくらいのときの分散はこれくらい」という情報が得られます。
これで発現変動していないものの分布(モデル)が決まります。その後、比較する二つのサンプルのカウント（発現量）データを一緒にして分散を計算し、
non-DEGsの分布のどの程度の位置にいるか(p値)を計算し、形式的には帰無仮説(Null Hypothesis)を棄却するかどうかという手順を経てDEG or non-DEGの判定をします。
用いる正規化法の違いが(non-DEGの)モデル構築にどう影響するか？どう関係するのか？
用いる正規化法の違いが(non-DEGの)モデル構築にどう影響するか？どう関係するのか？についてですが、これは極めてシンプルで、DEGかどうかの判定をする際に「比較する二つのサンプルのカウント（発現量）データを一緒にして分散を計算し...」を行う際に、サンプル間の正規化がうまくできていなければバラツキ(分散)を正しく計算できません。
ただそれだけですが、用いる正規化法次第で結果が大きく異なりうるのです(Robinson and Oshlack, 2010)。そして発現変動解析結果はその後の解析(GO解析など)にほとんどそのまま反映されますので私を含む多くのグループが正規化法の開発や性能評価といったあたりの研究を行っています。
正規化 | についてのところでも述べていますが、大抵の場合、
パッケージ独自の「正規化法」と「発現変動遺伝子検出法」が実装されており、「どの正規化法を使うか？」ということが「どの発現変動遺伝子検出法を使うか？」ということよりも結果に与える影響が大きい(Bullard et al., 2010; Kadota et al., 2012; Garmire and Subramanian, 2012)ことがわかりつつあります。
従来のサンプル間正規化法（RPMやTMM法）は比較する二群間（G1群 vs. G2群）でDEG数に大きな偏りがないことを前提にしています。
つまり、「(G1群 >> G2群)のDEG数と(G1群 << G2群)のDEG数が同程度」という前提条件がありますが、実際には大きく偏りがある場合も想定すべきで、偏りがあるなしにかかわらずロバストに正規化を行ってくれるのがTbT正規化法(Kadota et al., 2012)です。
偏りがあるなしの主な原因はDEGの分布にあるわけです。よって、TbT論文では、「正規化中にDEG検出を行い、DEGを除き、non-DEGのみで再度正規化係数を決める」というDEG elimination strategyに基づく正規化法を提案しています。
そして、TbT法を含むDEG elimination strategyに基づくいくつかの正規化法をTCCというRパッケージ中に実装しています(TCC論文中ではこの戦略をDEGES「でげす」と呼んでいます; Sun et al., 2013)。TCCパッケージ中に実装されている主な方法および入力データは以下の通りです：
- DEGES/TbT：オリジナルのTbT法そのもの。TMM-baySeq-TMMという3ステップで正規化を行う方法。step 2のDEG同定のところで計算時間のかかるbaySeqを採用しているため、他のパッケージでは数秒で終わる正規化ステップが数十分程度はかかるのがネック。また、biological replicatesがあることを前提としている。（A1, A2, ...） vs. (B1, B2, ...)のようなデータという意味。
- iDEGES/edgeR：DEGES/TbT法の超高速版(100倍程度高速)。TMM-(edgeR-TMM)nというステップで正規化を行う方法(デフォルトはn = 3)。step 2のDEG同定のところでedgeRパッケージ中のexact test (Robinson and Smyth, 2008)を採用しているためDEG同定の高速化が可能。
したがって、(step2 - step3)のサイクルをiterative (それゆえDEGESの頭にiterativeの意味を示すiがついたiDEGESとなっている)に行ってよりロバストな正規化係数を得ることが理論的に可能な方法です。
それゆえreplicatesのある二群間比較を行いたい場合にはDEGES/TbTよりもiDEGES/edgeRのほうがおすすめ。
- iDEGES/DESeq：一連のmulti-stepの正規化手順をすべてDESeqパッケージ中の関数のみで実装したパイプライン。複製実験のない二群間比較時(i.e., A1 vs. B1など)にはこちらを利用します。
TCCパッケージでは、内部的にedgeR, baySeq, DESeqを利用しています。
- an exact test：Robinson and Smyth, Biostatistics, 2008
- Kadota et al., Algorithms Mol., Biol., 2009
- Bullard et al., BMC Bioinformatics, 2010
- TMM正規化法：Robinson and Oshlack, Genome Biol., 2010
- TbT正規化法：Kadota et al., Algorithms Mol., Biol., 2012
- Garmire and Subramanian, RNA, 2012
- TCC：Sun et al., BMC Bioinformatics, 2013
実験デザインが以下のような場合にこのカテゴリーに属す方法を適用します：
Aさんの正常サンプル
Bさんの正常サンプル
Cさんの正常サンプル
Dさんの腫瘍サンプル
Eさんの腫瘍サンプル
Fさんの腫瘍サンプル
Gさんの腫瘍サンプル
2015年2月に調査した結果をリストアップします。PoissonSeqのリンク先がなかったので追加しました(2015/02/02)。
R用:
- DEGSeq：Wang et al., Bioinformatics, 2010
- edgeR：Robinson et al., Bioinformatics, 2010
- GPseq：Srivastava et al., Nucleic Acids Res., 2010
- baySeq：Hardcastle and Kelly, BMC Bioinformatics, 2010
- DESeq：Anders and Huber, Genome Biol., 2010
- NBPSeq：Di et al., SAGMB, 2011
- BBSeq：Zhou et al., Bioinformatics, 2011
- NOISeq：Tarazona et al., Genome Res., 2011
- PoissonSeq：Li et al., Biostatistics, 2012
- SAMseq：Li and Tibshirani, Stat Methods Med Res., 2013
- BitSeq：Glaus et al., Bioinformatics, 2012
- easyRNASeq：Delhomme et al., Bioinformatics, 2012
- DSS：Wu et al., Biostatistics, 2012
- DSGseq：Wang et al., Gene, 2013
- EBSeq：Leng et al., Bioinformatics, 2013
- sSeq：Yu et al., Bioinformatics, 2013
- TCC：Sun et al., BMC Bioinformatics, 2013
- tweeDEseq：Esnaola et al., BMC Bioinformatics, 2013
- NPEBseq：Bi et al., BMC Bioinformatics, 2013
- DER Finder：Frazee et al., Biostatistics, 2014
- Characteristic Direction(CD)：Clark et al., BMC Bioinformatics, 2014
- edgeR_robust：Zhou et al., Nucleic Acids Res., 2014
- ShrinkBayes：Van De Wiel et al., BMC Bioinformatics, 2014
- DESeq2：Love et al., Genome Biol., 2014
Review、ガイドライン、パイプライン系:
- プロトコル：Anders et al., Nat Protoc., 2013
- 手法比較(反復を増やすほうがdepthを増やすよりも効果的)：Rapaport et al., Genome Biol., 2013
- 手法比較(DESeqが無難という結論)：Seyednasrollah et al., Brief Bioinform., 2013
- 手法比較(edgeRがいいという結論)：Guo et al., BMC Genomics, 2013
- compcodeR(benchmarking; 手法比較)：Soneson C., Bioinformatics, 2014
- 手法比較(edgeRがいいという結論)：Zhang et al., PLoS One, 2014
- 手法比較(DESeq2とedgeRがいいという結論)：Ching et al., RNA, 2014
TCCを用いたやり方を示します。
内部的にiDEGES/edgeR(Sun_2013)正規化を実行したのち、
edgeRパッケージ中のexact testで発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行っています。TCC原著論文中のiDEGES/edgeR-edgeRという解析パイプラインに相当します。
全てTCCパッケージ(Sun et al., BMC Bioinformatics, 2013)内で完結します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge1.txt"
out_f2 <- "hoge1.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_fig <- c(400, 380)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
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(tcc, FDR=param_FDR)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
正規化後のテキストファイルデータを出力し、平均-分散プロットのpngファイルを出力しています。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge2.txt"
out_f2 <- "hoge2.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_fig <- c(380, 420)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), normalized, result)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
hoge <- normalized
MEAN <- apply(hoge, 1, mean)
VARIANCE <- apply(hoge, 1, var)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(MEAN, VARIANCE, log="xy", pch=20, cex=.1,
xlim=c(1e-02, 1e+08), ylim=c(1e-02, 1e+08), col="black")
grid(col="gray", lty="dotted")
abline(a=0, b=1, col="gray")
obj <- (result$q.value < param_FDR)
points(MEAN[obj], VARIANCE[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()
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
DEG検出後に任意のFDR閾値を満たす遺伝子数を調べたり、色分けしたりx, y軸の範囲を限定するなどする様々なテクニックを示しています。
in_f <- "data_hypodata_3vs3.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.1
param_nonDEG <- 2001:10000
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
sum(tcc$estimatedDEG)
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
sum(tcc$DEGES$potentialDEG)
tcc$norm.factors
out_f1 <- "hoge3_all_010.png"
param_fig <- c(400, 380)
M <- getResult(tcc)$m.value
A <- getResult(tcc)$a.value
png(out_f1, 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)",
xlim=c(-2, 16), ylim=c(-8, 6), pch=20, cex=.1)
grid(col="gray", lty="dotted")
obj <- tcc$stat$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()
sum(M[obj] < 0)
sum(M[obj] > 0)
tcc <- tcc[param_nonDEG]
out_f2 <- "hoge3_nonDEG_010.png"
M <- getResult(tcc)$m.value
A <- getResult(tcc)$a.value
png(out_f2, 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)",
xlim=c(-2, 16), ylim=c(-8, 6), pch=20, cex=.1)
grid(col="gray", lty="dotted")
obj <- tcc$stat$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()
sum(M[obj] < 0)
sum(M[obj] > 0)
param_FDR <- 0.2
out_f3 <- "hoge3_nonDEG_020.png"
M <- getResult(tcc)$m.value
A <- getResult(tcc)$a.value
png(out_f3, 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)",
xlim=c(-2, 16), ylim=c(-8, 6), pch=20, cex=.1)
grid(col="gray", lty="dotted")
obj <- tcc$stat$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()
sum(M[obj] < 0)
sum(M[obj] > 0)
param_FDR <- 0.4
out_f4 <- "hoge3_nonDEG_040.png"
M <- getResult(tcc)$m.value
A <- getResult(tcc)$a.value
png(out_f4, 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)",
xlim=c(-2, 16), ylim=c(-8, 6), pch=20, cex=.1)
grid(col="gray", lty="dotted")
obj <- tcc$stat$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()
sum(M[obj] < 0)
sum(M[obj] > 0)
param_FDR <- 0.6
out_f5 <- "hoge3_nonDEG_060.png"
M <- getResult(tcc)$m.value
A <- getResult(tcc)$a.value
png(out_f5, 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)",
xlim=c(-2, 16), ylim=c(-8, 6), pch=20, cex=.1)
grid(col="gray", lty="dotted")
obj <- tcc$stat$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()
sum(M[obj] < 0)
sum(M[obj] > 0)
4. サンプルデータ4の18,110 genes×10 samplesのリアルデータ(data_marioni.txt; kidney 5サンプル vs. liver 5サンプル)の場合：
「FDR閾値を満たすもの」と「fold-change閾値を満たすもの」それぞれのM-A plotを作成しています。
in_f <- "data_marioni.txt"
out_f1 <- "hoge4.txt"
out_f2 <- "hoge4_FDR.png"
out_f3 <- "hoge4_FC.png"
param_G1 <- 5
param_G2 <- 5
param_FDR <- 0.05
param_FC <- 2
param_fig <- c(400, 380)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
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(tcc, FDR=param_FDR, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
param_FC <- 2
M <- getResult(tcc)$m.value
hoge <- rep(1, length(M))
hoge[abs(M) > log2(param_FC)] <- 2
cols <- c("black", "magenta")
png(out_f3, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(tcc, col=cols, col.tag=hoge, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(", param_FC, "-fold)", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(abs(M) > log2(16))
sum(abs(M) > log2(8))
sum(abs(M) > log2(4))
sum(abs(M) > log2(2))
5. サンプルデータ4の18,110 genes×10 samplesのリアルデータ(data_marioni.txt; kidney 5サンプル vs. liver 5サンプル)の最初の4サンプルを比較する場合：
「FDR閾値を満たすもの」と「fold-change閾値を満たすもの」それぞれのM-A plotを作成しています。
in_f <- "data_marioni.txt"
out_f1 <- "hoge5.txt"
out_f2 <- "hoge5_FDR.png"
out_f3 <- "hoge5_FC.png"
param_G1 <- 2
param_G2 <- 2
param_FDR <- 0.05
param_FC <- 2
param_fig <- c(400, 380)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- data[,1:(param_G1+param_G2)]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
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(tcc, FDR=param_FDR, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
param_FC <- 2
M <- getResult(tcc)$m.value
hoge <- rep(1, length(M))
hoge[abs(M) > log2(param_FC)] <- 2
cols <- c("black", "magenta")
png(out_f3, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(tcc, col=cols, col.tag=hoge, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(", param_FC, "-fold)", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(abs(M) > log2(16))
sum(abs(M) > log2(8))
sum(abs(M) > log2(4))
sum(abs(M) > log2(2))
6. サンプルデータ8の26,221 genes×6 samplesのリアルデータ(data_arab.txt; mock 3サンプル vs. hrcc 3サンプル)の場合：
「FDR閾値を満たすもの」と「fold-change閾値を満たすもの」それぞれのM-A plotを作成しています。
in_f <- "data_arab.txt"
out_f1 <- "hoge6.txt"
out_f2 <- "hoge6_FDR.png"
out_f3 <- "hoge6_FC.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_FC <- 2
param_fig <- c(400, 380)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- data[,1:(param_G1+param_G2)]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
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(tcc, FDR=param_FDR, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
param_FC <- 2
M <- getResult(tcc)$m.value
hoge <- rep(1, length(M))
hoge[abs(M) > log2(param_FC)] <- 2
cols <- c("black", "magenta")
png(out_f3, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(tcc, col=cols, col.tag=hoge, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(", param_FC, "-fold)", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(abs(M) > log2(16))
sum(abs(M) > log2(8))
sum(abs(M) > log2(4))
sum(abs(M) > log2(2))
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
1.と基本的に同じで、出力のテキストファイルが正規化前のデータではなく正規化後のデータになっていて、発現変動順にソートしたものになっています。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge7.txt"
out_f2 <- "hoge7.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_fig <- c(400, 380)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
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(tcc, FDR=param_FDR)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
Neyret-Kahn et al., Genome Res., 2013のgene-levelの2群間比較用(3 proliferative samples vs. 3 Ras samples)ヒトRNA-seqカウントデータです。
マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)から得られます。
in_f <- "hoge9_count_gene.txt"
out_f1 <- "hoge8.txt"
out_f2 <- "hoge8.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_fig <- c(430, 390)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
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(tcc, FDR=param_FDR)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
8.の入力ファイル(hoge9_count_gene.txt)と本質的に同じもの(アノテーション情報が2014年3月ごろと若干古いだけ)です。
パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)から得られます。
in_f <- "srp017142_count_bowtie.txt"
out_f1 <- "hoge9.txt"
out_f2 <- "hoge9.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_fig <- c(430, 390)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
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(tcc, FDR=param_FDR, xlim=c(-3, 17), ylim=c(-8, 15))
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
samrパッケージ中のSAMseq (Li and Tibshirani, 2013)を用いて
発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
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))
out <- SAMseq(data, data.cl, resp.type="Two class unpaired")
p.value <- samr.pvalues.from.perms(out$samr.obj$tt, out$samr.obj$ttstar)
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.10)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
1.と基本的に同じで、DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_DEG <- 1:2000
library(samr)
library(ROC)
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 <- SAMseq(data, data.cl, resp.type="Two class unpaired")
p.value <- samr.pvalues.from.perms(out$samr.obj$tt, out$samr.obj$ttstar)
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.10)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
3. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータの作成から行う場合：
「G1_rep1, G1_rep2, G1_rep3, G2_rep1, G2_rep2, G2_rep3」の計6サンプル分からなります。
全10,000遺伝子中の最初の2,000個(gene_1〜gene_2000まで)が発現変動遺伝子(DEG)です。
全2,000 DEGsの内訳：最初の90%分(gene_1〜gene_1800)がG1群で4倍高発現、残りの10%分(gene_1801〜gene_2000)がG2群で4倍高発現
このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
out_f <- "hoge3.txt"
library(TCC)
library(samr)
library(ROC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=10000, PDEG=0.2,
DEG.assign=c(0.9, 0.1),
DEG.foldchange=c(4, 4),
replicates=c(3, 3))
data <- tcc$count
data.cl <- tcc$group$group
out <- SAMseq(data, data.cl, resp.type="Two class unpaired")
p.value <- samr.pvalues.from.perms(out$samr.obj$tt, out$samr.obj$ttstar)
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < 0.10)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- as.numeric(tcc$simulation$trueDEG != 0)
AUC(rocdemo.sca(truth=obj, data=-ranking))
4. サンプルデータ13と同じ10,000 genes×6 samplesのシミュレーションデータの作成から行う場合：
「G1_rep1, G1_rep2, G1_rep3, G2_rep1, G2_rep2, G2_rep3」の計6サンプル分からなります。
全10,000遺伝子中の最初の2,000個(gene_1〜gene_2000まで)が発現変動遺伝子(DEG)です。
全2,000 DEGsの内訳：最初の90%分(gene_1〜gene_1800)がG1群で4倍高発現、残りの10%分(gene_1801〜gene_2000)がG2群で4倍高発現
このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
samrパッケージではなくTCCパッケージを用いています。
out_f <- "hoge4.txt"
library(TCC)
library(samr)
library(ROC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene=10000, PDEG=0.2,
DEG.assign=c(0.9, 0.1),
DEG.foldchange=c(4, 4),
replicates=c(3, 3))
tcc <- estimateDE(tcc, test.method="samseq")
result <- getResult(tcc, sort=FALSE)
sum(q.value < 0.10)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
edgeRパッケージを用いて発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描くやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plotSmear(d)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描き、FDR < 0.05を満たすものを赤色で示すやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
hoge <- rownames(data)[q.value < param_FDR]
plotSmear(d, de.tags=hoge)
length(hoge)
length(hoge)/nrow(data)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描き、FDR値で発現変動順に並べた上位300個を赤色で示すやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge4.txt"
param_G1 <- 3
param_G2 <- 3
param3 <- 300
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
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)
hoge <- rownames(data)[ranking <= param3]
plotSmear(d, de.tags=hoge)
length(hoge)
length(hoge)/nrow(data)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描き、2倍以上発現変化しているものを赤色で示すやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param3 <- 2
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
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)
hoge <- rownames(data)[abs(out$table$logFC) >= log2(param3)]
plotSmear(d, de.tags=hoge)
length(hoge)
length(hoge)/nrow(data)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描き、MA-plotで大きさを指定してpng形式ファイルに保存するやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge6.txt"
out_f2 <- "hoge6.png"
param_G1 <- 3
param_G2 <- 3
param3 <- 2
param_fig <- c(600, 400)
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
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_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
hoge <- rownames(data)[abs(out$table$logFC) >= log2(param3)]
plotSmear(d, de.tags=hoge)
dev.off()
length(hoge)
length(hoge)/nrow(data)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描き、FDR < 0.01を満たすものを赤色で示したMA-plotをファイルに保存するやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge7.txt"
out_f2 <- "hoge7.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.01
param_fig <- c(600, 400)
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
#write.table(tmp[order(ranking),], out_f1, sep="\t", append=F, quote=F, row.names=F)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
hoge <- rownames(data)[q.value < param_FDR]
plotSmear(d, de.tags=hoge)
dev.off()
length(hoge)
length(hoge)/nrow(data)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描き、FDR < 0.01を満たすものを赤色で示したMA-plotをファイルに保存するやり方です。
基本は7と同じで、MA-plotの描画をplotSmear関数を用いないで行うやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge8.txt"
out_f2 <- "hoge8.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.01
param_fig <- c(600, 400)
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (q.value < param_FDR)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A=(log2(G2)+log2(G1))/2", ylab="M=log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
MA-plotも描き、FDR < 0.01を満たすものを赤色で示したMA-plotをファイルに保存するやり方です。
基本は8と同じで、MA-plotの描画をRPMではなくTMM正規化後のデータで行うやり方です。
in_f <- "data_hypodata_3vs3.txt"
out_f1 <- "hoge9.txt"
out_f2 <- "hoge9.png"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.01
param_fig <- c(600, 400)
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
d <- estimateTagwiseDisp(d)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
norm_f_TMM <- d$samples$norm.factors
names(norm_f_TMM) <- colnames(data)
effective_libsizes <- colSums(data) * norm_f_TMM
RPM_TMM <- sweep(data, 2, 1000000/effective_libsizes, "*")
data <- RPM_TMM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_edgeR < param_FDR)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A=(log2(G2)+log2(G1))/2", ylab="M=log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
- edgeR：Robinson et al., Bioinformatics, 2010
- TMM正規化法：Robinson and Oshlack, Genome Biol., 2010
- an exact test for negative binomial distribution：Robinson and Smyth, Biostatistics, 2008
- Robinson and Smyth, Bioinformatics, 2007
- McCarthy et al., Nucleic Acids Res., 2012
- edgeRをstem cell biologyに適用したという論文(QuasRを引用している)：Nikolayeva and Robinson, Methods Mol Biol., 2014
TCCを用いたやり方を示します。
内部的にiDEGES/DESeq(Sun_2013)正規化を実行したのち、
DESeqパッケージ中のnegative binomial testで発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行っています。
TCC原著論文中のiDEGES/DESeq-DESeqという解析パイプラインに相当します。
全てTCCパッケージ内で完結します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群1サンプル vs. G2群1サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge1.txt"
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.05
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", test.method="deseq",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
head(result, n=3)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画したり、
DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge2.txt"
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.05
param_DEG <- 1:2000
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", test.method="deseq",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
head(result, n=3)
sum(tcc$stat$q.value < param_FDR)
ranking <- rank(tcc$stat$p.value)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc, FDR=param_FDR)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
3. サンプルデータ8の26,221 genes×6 samplesのリアルデータ(data_arab.txt; mock 3サンプル vs. hrcc 3サンプル)の場合：
mock群の1番目(mock1)と3番目(mock3)のサブセットを抽出して複製なしデータとして取り扱っています。
「FDR閾値を満たすもの」と「fold-change閾値を満たすもの」それぞれのM-A plotを作成しています。
in_f <- "data_arab.txt"
out_f1 <- "hoge3.txt"
out_f2 <- "hoge3_FDR.png"
out_f3 <- "hoge3_FC.png"
param_subset <- c(1, 3)
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.05
param_FC <- 2
param_fig <- c(400, 380)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <-data[,param_subset]
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", test.method="deseq",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
head(result, n=3)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
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(tcc, FDR=param_FDR, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
param_FC <- 2
M <- getResult(tcc)$m.value
hoge <- rep(1, length(M))
hoge[abs(M) > log2(param_FC)] <- 2
cols <- c("black", "magenta")
png(out_f3, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(tcc, col=cols, col.tag=hoge, xlim=c(-3, 13), ylim=c(-10, 10))
legend("bottomright", c(paste("DEG(", param_FC, "-fold)", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(abs(M) > log2(16))
sum(abs(M) > log2(8))
sum(abs(M) > log2(4))
sum(abs(M) > log2(2))
シミュレーションデータ(G1群1サンプル vs. G2群1サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
1.と基本的に同じで、出力のテキストファイルが正規化前のデータではなく正規化後のデータになっていて、発現変動順にソートしたものになっています。
in_f <- "data_hypodata_1vs1.txt"
out_f1 <- "hoge4.txt"
out_f2 <- "hoge4.png"
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.05
param_fig <- c(400, 380)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", test.method="deseq",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
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(tcc, FDR=param_FDR)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
Anders and Huberの(AH)正規化(Anders_2010)を実行したのち、
DESeqパッケージ中のnegative binomial testで発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うDESeqパッケージ内のオリジナルの手順を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群1サンプル vs. G2群1サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge1.txt"
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.05
library(DESeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
cds <- newCountDataSet(data, data.cl)
cds <- estimateSizeFactors(cds)
sizeFactors(cds)
cds <- estimateDispersions(cds, method="blind", sharingMode="fit-only")
out <- nbinomTest(cds, 1, 2)
p.value <- out$pval
p.value[is.na(p.value)] <- 1
q.value <- out$padj
q.value[is.na(q.value)] <- 1
ranking <- rank(p.value)
logratio <- out$log2FoldChange
head(out, n=3)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking, logratio)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
1.と基本的に同じで、param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画したり、
このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge2.txt"
param_G1 <- 1
param_G2 <- 1
param_DEG <- 1:2000
param_FDR <- 0.1
library(DESeq)
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
cds <- newCountDataSet(data, data.cl)
cds <- estimateSizeFactors(cds)
sizeFactors(cds)
cds <- estimateDispersions(cds, method="blind", sharingMode="fit-only")
out <- nbinomTest(cds, 1, 2)
p.value <- out$pval
p.value[is.na(p.value)] <- 1
q.value <- out$padj
q.value[is.na(q.value)] <- 1
ranking <- rank(p.value)
logratio <- out$log2FoldChange
head(out, n=3)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking, logratio)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plotMA(out)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
TCCパッケージを用いて同様の解析を行うやり方です。
出力ファイルのa.value列がlogratioに相当し、q.value列上でFDR閾値を決めます。(内部的な細かい話ですが...)estimateDispersions関数実行時に、fitType="parametric"を最初に試して、エラーが出たら自動的に"local"に変更しています。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge3.txt"
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.10
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc,iteration=0)
tcc <- estimateDE(tcc, FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
head(result, n=3)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
TCCパッケージを用いて同様の解析を行うやり方です。
出力ファイルのa.value列がlogratioに相当し、q.value列上でFDR閾値を決めます。(内部的な細かい話ですが...)estimateDispersions関数実行時に、fitType="parametric"を最初に試して、
エラーが出たら自動的に"local"に変更しています。param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画したり、
このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge4.txt"
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.10
param_DEG <- 1:2000
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc,iteration=0)
tcc <- estimateDE(tcc, FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
head(result, n=3)
sum(tcc$stat$q.value < param_FDR)
ranking <- tcc$stat$rank
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
plot(tcc, FDR=param_FDR)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
edgeRパッケージを用いて発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群1サンプル vs. G2群1サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_1vs1.txt"
out_f <- "hoge1.txt"
param_G1 <- 1
param_G2 <- 1
param_FDR <- 0.05
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
d <- DGEList(counts=data,group=data.cl)
d <- calcNormFactors(d)
d <- estimateGLMCommonDisp(d, method="deviance", robust=TRUE, subset=NULL)
out <- exactTest(d)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
- edgeR：Robinson et al., Bioinformatics, 2010
- TMM正規化法：Robinson and Oshlack, Genome Biol., 2010
- an exact test for negative binomial distribution：Robinson and Smyth, Biostatistics, 2008
- Robinson and Smyth, Bioinformatics, 2007
- McCarthy et al., Nucleic Acids Res., 2012
NOISeq(参考文献1)のやり方を示します。二群間比較用です。
ここでは、以下の3つのデータセットに対するやり方を示します：
- Technical replicatesデータ(G1群5サンプル vs. G2群5サンプル)
- Biological replicatesデータ(G1群3サンプル vs. G2群3サンプル: data_arab.txt)
- Biological replicatesシミュレーションデータ(G1群3サンプル vs. G2群3サンプル: simdata_3vs3.txt)
Technical replicatesのほうは、サンプルデータ2のSupplementaryTable2_changed.txtのデータです。
Biological replicatesのほうは、NBPSeqパッケージに同梱されているArabidopsis(シロイヌナズナ)のデータ(サンプルデータ8のdata_arab.txt)です。
この方法は負の二項分布（negative-binomial distribution；biological replicates用）やポアソン分布（Poisson distribution；technical replicates用）などの何らかの分布を仮定したパラメトリックな方法（edgeR, DESeq, baySeq, NBPSeq, GPseqなどが該当）とは異なり、ノンパラメトリックな方法です。
replicateがないデータ（G1群1サンプル vs. G2群1サンプル）場合には（technical replicatesを想定して?!）noise distributionを作成し、replicatesがある場合には同一群内のデータを用いてnoise distributionを作成することでDEG or non-DEGの判定をするような仕組みになっています。
また、この方法は転写物の長さ情報も（RPKM補正後のデータを使いたい場合には）使います。マニュアル中にはここでは長さ情報がない場合には"NA"という情報を含むファイル（SupplementaryTable2_changed_length.txt）を入力として与えるという選択肢を提供していますが、私が2012/06/19に試した限りではうまく動きません。
よって、以下では長さ情報を含むファイルを読み込まずに実行するやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. Technical replicatesデータ(G1群5サンプル vs. G2群5サンプル)の場合（データの正規化はTMM法を採用する場合）：
in_f <- "SupplementaryTable2_changed.txt"
out_f1 <- "hoge1.txt"
out_f2 <- "hoge1.png"
param_G1 <- 5
param_G2 <- 5
param3 <- "tech"
param4 <- "tmm"
param5 <- 0.8
param_fig <- c(600, 400)
source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")
data <- readData(file=in_f, header=TRUE, cond1=c(2:(param_G1+1)), cond2=c((param_G1+2):(param_G1+1+param_G2)))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
RAW <- cbind(data[[1]], data[[2]])
rownames(RAW) <- rownames(data[[1]])
out <- noiseq(data[[1]], data[[2]], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)
stat_NOISeq <- out$probab
stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq)
rank_NOISeq <- rank(-stat_NOISeq)
hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq)
tmp <- hoge[order(rank_NOISeq),]
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NOISeq > param5)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
2. Biological replicatesデータ(G1群3サンプル vs. G2群3サンプル)の場合：
in_f <- "data_arab.txt"
out_f1 <- "hoge2.txt"
out_f2 <- "hoge2.png"
param_G1 <- 3
param_G2 <- 3
param3 <- "bio"
param4 <- "tmm"
param5 <- 0.8
param_fig <- c(600, 400)
source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")
data <- readData(file=in_f, header=TRUE, cond1=c(2:(param_G1+1)), cond2=c((param_G1+2):(param_G1+1+param_G2)))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
RAW <- cbind(data[[1]], data[[2]])
rownames(RAW) <- rownames(data[[1]])
out <- noiseq(data[[1]], data[[2]], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)
stat_NOISeq <- out$probab
stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq)
rank_NOISeq <- rank(-stat_NOISeq)
hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq)
tmp <- hoge[order(rank_NOISeq),]
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NOISeq > param5)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
3. Biological replicatesのシミュレーションデータデータ(G1群3サンプル vs. G2群3サンプル、simdata_3vs3.txt)の場合：
in_f <- "simdata_3vs3.txt"
out_f1 <- "hoge3.txt"
out_f2 <- "hoge3.png"
param_G1 <- 3
param_G2 <- 3
param3 <- "bio"
param4 <- "tmm"
param5 <- 0.8
param_fig <- c(600, 400)
source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")
data <- readData(file=in_f, header=TRUE, cond1=c(2:(param_G1+1)), cond2=c((param_G1+2):(param_G1+1+param_G2)))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
RAW <- cbind(data[[1]], data[[2]])
rownames(RAW) <- rownames(data[[1]])
out <- noiseq(data[[1]], data[[2]], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)
stat_NOISeq <- out$probab
stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq)
rank_NOISeq <- rank(-stat_NOISeq)
hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq)
tmp <- hoge[order(rank_NOISeq),]
write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NOISeq > param5)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
4. Biological replicatesのシミュレーションデータデータ(G1群3サンプル vs. G2群3サンプル、simdata_3vs3.txt)の場合
どこがDEGがわかっているのでAUC値を計算するところまでやる：
in_f <- "simdata_3vs3.txt"
out_f1 <- "hoge4.txt"
out_f2 <- "hoge4.png"
param_G1 <- 3
param_G2 <- 3
param3 <- "bio"
param4 <- "tmm"
param5 <- 0.8
param_fig <- c(600, 400)
source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")
library(ROC)
data.tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
DEG_posi <- data.tmp$DEG_posi
nonDEG_posi <- data.tmp$nonDEG_posi
data <- data.tmp[,1:(param_G1+param_G2)]
RAW <- data
out <- noiseq(data[,data.cl==1], data[,data.cl==2], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)
stat_NOISeq <- out$probab
stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq)
rank_NOISeq <- rank(-stat_NOISeq)
hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq, DEG_posi)
write.table(hoge, out_f1, sep="\t", append=F, quote=F, row.names=F)
AUC(rocdemo.sca(truth=DEG_posi, data=-rank_NOISeq))
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NOISeq > param5)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
5. Biological replicatesのシミュレーションデータデータ(G1群3サンプル vs. G2群3サンプル、simdata_3vs3.txt)の場合
どこがDEGがわかっているのでAUC値を計算するところまでやり、予めTMM正規化したデータをNOISeqで解析する：
in_f <- "simdata_3vs3.txt"
out_f1 <- "hoge5.txt"
out_f2 <- "hoge5.png"
param_G1 <- 3
param_G2 <- 3
param3 <- "bio"
param4 <- "n"
param5 <- 0.8
param_fig <- c(600, 400)
source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")
library(edgeR)
library(ROC)
data.tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
DEG_posi <- data.tmp$DEG_posi
nonDEG_posi <- data.tmp$nonDEG_posi
data <- data.tmp[,1:(param_G1+param_G2)]
RAW <- data
data <- RAW
d <- DGEList(counts=data, group=data.cl)
d <- calcNormFactors(d)
norm_f_TMM <- d$samples$norm.factors
effective_libsizes <- colSums(data) * norm_f_TMM
RPM_TMM <- sweep(data, 2, 1000000/effective_libsizes, "*")
data <- RPM_TMM
out <- noiseq(data[,data.cl==1], data[,data.cl==2], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)
stat_NOISeq <- out$probab
stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq)
rank_NOISeq <- rank(-stat_NOISeq)
hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq, DEG_posi)
write.table(hoge, out_f1, sep="\t", append=F, quote=F, row.names=F)
AUC(rocdemo.sca(truth=DEG_posi, data=-rank_NOISeq))
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NOISeq > param5)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
6. Biological replicatesのシミュレーションデータデータ(G1群3サンプル vs. G2群3サンプル、simdata_3vs3.txt)の場合
どこがDEGがわかっているのでAUC値を計算するところまでやり、予めTbT正規化したデータをNOISeqで解析する：
in_f <- "simdata_3vs3.txt"
out_f1 <- "hoge6.txt"
out_f2 <- "hoge6.png"
param_G1 <- 3
param_G2 <- 3
param3 <- "bio"
param4 <- "n"
param5 <- 0.8
param_fig <- c(600, 400)
source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")
library(edgeR)
library(ROC)
library(TCC)
data.tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
DEG_posi <- data.tmp$DEG_posi
nonDEG_posi <- data.tmp$nonDEG_posi
data <- data.tmp[,1:(param_G1+param_G2)]
RAW <- data
data <- RAW
TbTout <- do_TbT(data, data.cl, sample_num=10000)
norm_f_TbT <- TbTout$norm_f_TbT
effective_libsizes <- colSums(data) * norm_f_TbT
RPM_TbT <- sweep(data, 2, 1000000/effective_libsizes, "*")
data <- RPM_TbT
out <- noiseq(data[,data.cl==1], data[,data.cl==2], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)
stat_NOISeq <- out$probab
stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq)
rank_NOISeq <- rank(-stat_NOISeq)
hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq, DEG_posi)
write.table(hoge, out_f1, sep="\t", append=F, quote=F, row.names=F)
AUC(rocdemo.sca(truth=DEG_posi, data=-rank_NOISeq))
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NOISeq > param5)
png(out_f2, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
dev.off()
sum(DEG_posi)
sum(DEG_posi)/nrow(data)
NBPSeqを用いてるやり方を行います。
このパッケージは、任意の正規化法によって得られた正規化係数を組み込むことができます。
このパッケージは、基本的にBiological replicatesのデータを入力として想定しています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. デフォルト（たぶんRPM補正）の場合：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge.txt"
param_G1 <- 5
param_G2 <- 5
param3 <- 0.01
library(NBPSeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
RAW <- data
out <- nbp.test(data, data.cl, 1, 2)
stat_NBPSeq <- out$p.values
rank_NBPSeq <- rank(stat_NBPSeq)
tmp <- cbind(rownames(data), data, stat_NBPSeq, rank_NBPSeq)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NBPSeq < param3)
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
2. TMM正規化法を組み合わせた場合：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge2.txt"
param_G1 <- 5
param_G2 <- 5
param3 <- 0.01
library(NBPSeq)
library(edgeR)
library(DEGseq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data <- as.matrix(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
RAW <- data
d <- DGEList(counts=data, group=data.cl)
d <- calcNormFactors(d)
norm_f_TMM <- d$samples$norm.factors
out <- nbp.test(data, data.cl, 1, 2, norm.factors=norm_f_TMM)
stat_NBPSeq <- out$p.values
rank_NBPSeq <- rank(stat_NBPSeq)
tmp <- cbind(rownames(data), data, stat_NBPSeq, rank_NBPSeq)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
data <- RAW
norm_f_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, norm_f_RPM, "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
DEG_posi <- (stat_NBPSeq < param3)
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid(col="gray", lty="dotted")
points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)
実験デザインが以下のような場合にこのカテゴリーに属す方法を適用します：
Aさんの正常サンプル(or "time_point1" or "Group1")
Bさんの正常サンプル(or "time_point1" or "Group1")
Cさんの正常サンプル(or "time_point1" or "Group1")
Aさんの腫瘍サンプル(or "time_point2" or "Group2")
Bさんの腫瘍サンプル(or "time_point2" or "Group2")
Cさんの腫瘍サンプル(or "time_point2" or "Group2")
2014年12月に調査した結果をリストアップします。
- edgeR：Robinson et al., Bioinformatics, 2010
- DESeq：Anders and Huber, Genome Biol, 2010
- baySeq：Hardcastle and Kelly, BMC Bioinformatics, 2013
- TCC：Sun et al., BMC Bioinformatics, 2013
- DESeq2：Love et al., Genome Biol., 2014
DEGES/edgeR正規化(Sun et al., 2013)を実行したのち、
edgeRパッケージ中のGLM (一般化線形モデル; Generalized Linear Model)に基づく方法
(McCarthy et al., 2012)で発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方を示します。
TCC原著論文中のDEGES/edgeR-edgeRという解析パイプラインに相当します。
Bioconductor ver. 2.13で利用可能なTCC ver. 1.2.0ではまだ実装されていないので、
ここでは、edgeRパッケージ中の関数のみを用いて対応のあるサンプル(paired samples)データ解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
d <- DGEList(counts=data)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ pair + cl)
FDR <- 0.1
floorPDEG <- 0.05
### STEP 1 ###
d <- calcNormFactors(d)
d$samples$norm.factors
### STEP 2 ###
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
if (sum(q.value < FDR) > (floorPDEG * nrow(data))){
is.DEG <- as.logical(q.value < FDR)
} else {
is.DEG <- as.logical(rank(p.value, ties.method="min") <= nrow(data)*floorPDEG)
}
### STEP 3 ###
d <- DGEList(counts=data[!is.DEG, ])
d <- calcNormFactors(d)
norm.factors <- d$samples$norm.factors*colSums(data[!is.DEG, ])/colSums(data)
norm.factors <- norm.factors/mean(norm.factors)
norm.factors
d <- DGEList(counts=data)
d$samples$norm.factors <- norm.factors
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
1.と全く同じ結果が得られますが、デザイン行列designの作成のところで順番を入れ替えています。
それに伴い、検定時のglmLRT関数実行時に、coefで指定する列情報を2列目に変更しています。1.ではデフォルトがdesign行列の最後の列なので、何も指定しなくていいのです。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
d <- DGEList(counts=data)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ cl + pair)
FDR <- 0.1
floorPDEG <- 0.05
### STEP 1 ###
d <- calcNormFactors(d)
d$samples$norm.factors
### STEP 2 ###
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit, coef=2)
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
if (sum(q.value < FDR) > (floorPDEG * nrow(data))){
is.DEG <- as.logical(q.value < FDR)
} else {
is.DEG <- as.logical(rank(p.value, ties.method="min") <= nrow(data)*floorPDEG)
}
### STEP 3 ###
d <- DGEList(counts=data[!is.DEG, ])
d <- calcNormFactors(d)
norm.factors <- d$samples$norm.factors*colSums(data[!is.DEG, ])/colSums(data)
norm.factors <- norm.factors/mean(norm.factors)
norm.factors
d <- DGEList(counts=data)
d$samples$norm.factors <- norm.factors
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit, coef=2)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
DEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_DEG <- 1:2000
library(edgeR)
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
d <- DGEList(counts=data)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ pair + cl)
FDR <- 0.1
floorPDEG <- 0.05
### STEP 1 ###
d <- calcNormFactors(d)
d$samples$norm.factors
### STEP 2 ###
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
if (sum(q.value < FDR) > (floorPDEG * nrow(data))){
is.DEG <- as.logical(q.value < FDR)
} else {
is.DEG <- as.logical(rank(p.value, ties.method="min") <= nrow(data)*floorPDEG)
}
### STEP 3 ###
d <- DGEList(counts=data[!is.DEG, ])
d <- calcNormFactors(d)
norm.factors <- d$samples$norm.factors*colSums(data[!is.DEG, ])/colSums(data)
norm.factors <- norm.factors/mean(norm.factors)
norm.factors
d <- DGEList(counts=data)
d$samples$norm.factors <- norm.factors
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
4. TCCパッケージ中の1,000 genes×6 samplesのカウントデータ(hypoData)の場合：
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_200までがDEG (最初の180個がG1群で高発現、残りの20個がG2群で高発現)
gene_201〜gene_1000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
out_f <- "hoge4.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
library(TCC)
data(hypoData)
data <- hypoData
d <- DGEList(counts=data)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ pair + cl)
FDR <- 0.1
floorPDEG <- 0.05
### STEP 1 ###
d <- calcNormFactors(d)
d$samples$norm.factors
### STEP 2 ###
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
if (sum(q.value < FDR) > (floorPDEG * nrow(data))){
is.DEG <- as.logical(q.value < FDR)
} else {
is.DEG <- as.logical(rank(p.value, ties.method="min") <= nrow(data)*floorPDEG)
}
### STEP 3 ###
d <- DGEList(counts=data[!is.DEG, ])
d <- calcNormFactors(d)
norm.factors <- d$samples$norm.factors*colSums(data[!is.DEG, ])/colSums(data)
norm.factors <- norm.factors/mean(norm.factors)
norm.factors
d <- DGEList(counts=data)
d$samples$norm.factors <- norm.factors
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
5. TCCパッケージ中の1,000 genes×6 samplesのカウントデータ(hypoData)の場合：
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_200までがDEG (最初の180個がG1群で高発現、残りの20個がG2群で高発現)
gene_201〜gene_1000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
4.と全く同じ結果が得られますが、デザイン行列designの作成のところで順番を入れ替えています。
それに伴い、検定時のglmLRT関数実行時に、coefで指定する列情報を2列目に変更しています。1.ではデフォルトがdesign行列の最後の列なので、何も指定しなくていいのです。
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
library(TCC)
data(hypoData)
data <- hypoData
d <- DGEList(counts=data)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ cl + pair)
FDR <- 0.1
floorPDEG <- 0.05
### STEP 1 ###
d <- calcNormFactors(d)
d$samples$norm.factors
### STEP 2 ###
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit, coef=2)
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
if (sum(q.value < FDR) > (floorPDEG * nrow(data))){
is.DEG <- as.logical(q.value < FDR)
} else {
is.DEG <- as.logical(rank(p.value, ties.method="min") <= nrow(data)*floorPDEG)
}
### STEP 3 ###
d <- DGEList(counts=data[!is.DEG, ])
d <- calcNormFactors(d)
norm.factors <- d$samples$norm.factors*colSums(data[!is.DEG, ])/colSums(data)
norm.factors <- norm.factors/mean(norm.factors)
norm.factors
d <- DGEList(counts=data)
d$samples$norm.factors <- norm.factors
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit, coef=2)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
書きかけです。
DEGES/DESeq正規化(Sun et al., 2013)を実行したのち、
DESeqパッケージ中のGLM (一般化線形モデル; Generalized Linear Model)に基づく方法
で発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方を示します。
TCC原著論文中のDEGES/DESeq-DESeqという解析パイプラインに相当します。
Bioconductor ver. 2.13で利用可能なTCC ver. 1.2.0ではまだ実装されていないので、
ここでは、DESeqパッケージ中の関数のみを用いて対応のあるサンプル(paired samples)データ解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
TCC ver. 1.3.2で2014年4月に利用可能予定のコードです。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(DESeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
d <- DGEList(counts=data)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ pair + cl)
FDR <- 0.1
floorPDEG <- 0.05
### STEP 1 ###
d <- calcNormFactors(d)
d$samples$norm.factors
### STEP 2 ###
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
if (sum(q.value < FDR) > (floorPDEG * nrow(data))){
is.DEG <- as.logical(q.value < FDR)
} else {
is.DEG <- as.logical(rank(p.value, ties.method="min") <= nrow(data)*floorPDEG)
}
### STEP 3 ###
d <- DGEList(counts=data[!is.DEG, ])
d <- calcNormFactors(d)
norm.factors <- d$samples$norm.factors*colSums(data[!is.DEG, ])/colSums(data)
norm.factors <- norm.factors/mean(norm.factors)
norm.factors
d <- DGEList(counts=data)
d$samples$norm.factors <- norm.factors
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
edgeRパッケージを用いて対応のあるサンプル(paired samples)データ解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(edgeR)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
d <- DGEList(data)
d <- calcNormFactors(d)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ pair + cl)
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
DEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_DEG <- 1:2000
library(edgeR)
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
d <- DGEList(data)
d <- calcNormFactors(d)
pair <- as.factor(c(1:param_G1, 1:param_G2))
cl <- as.factor(c(rep(1, param_G1), rep(2, param_G2)))
design <- model.matrix(~ pair + cl)
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
out <- glmLRT(fit)
#tmp <- topTags(out, n=nrow(data), sort.by="none")
p.value <- out$table$PValue
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
DESeqパッケージを用いて対応のあるサンプル(paired samples)データ解析を行うやり方を示します。
TCCパッケージでも内部的にDESeqを呼び出して実行可能なので、そのやり方も示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
TCC ver. 1.3.2で2014年4月に利用可能予定のコードです。getResult関数のところでエラーが出るようですね。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
design.cl <- data.frame(
group=c(rep(1, param_G1), rep(2, param_G2)),
pair=c(1:param_G1, 1:param_G2)
)
tcc <- new("TCC", data, design.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0, paired=T)
tcc$norm.factors
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR, paired=T)
#result <- getResult(tcc, sort=FALSE)
#sum(tcc$stat$q.value < param_FDR)
p.value <- tcc$stat$p.value
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
#tmp <- cbind(rownames(tcc$count), tcc$count, result)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
DEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
TCC ver. 1.3.2で2014年4月に利用可能予定のコードです。getResult関数のところでエラーが出るようですね。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_DEG <- 1:2000
library(TCC)
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
design.cl <- data.frame(
group=c(rep(1, param_G1), rep(2, param_G2)),
pair=c(1:param_G1, 1:param_G2)
)
tcc <- new("TCC", data, design.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0, paired=T)
tcc$norm.factors
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR, paired=T)
#result <- getResult(tcc, sort=FALSE)
#sum(tcc$stat$q.value < param_FDR)
p.value <- tcc$stat$p.value
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
#tmp <- cbind(rownames(tcc$count), tcc$count, result)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_2000までがDEG (最初の1800個がG1群で高発現、残りの200個がG2群で高発現)
gene_2001〜gene_10000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
1.と同じ入力形式で、TCCパッケージを使わずにDESeqパッケージ中の関数のみで行うやり方です。TCCのほうが手順的にも簡便であることがわかります。
in_f <- "data_hypodata_3vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(DESeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
pair <- c(1:param_G1, 1:param_G2)
design.cl <- data.frame(
group=as.factor(data.cl),
pair=as.factor(pair)
)
cds <- newCountDataSet(data, design.cl)
cds <- estimateSizeFactors(cds)
sizeFactors(cds)
cds <- estimateDispersions(cds, method="blind", sharingMode="fit-only")
fit1 <- fitNbinomGLMs(cds, count ~ as.factor(data.cl) + as.factor(pair))
fit0 <- fitNbinomGLMs(cds, count ~ as.factor(pair))
p.value <- nbinomGLMTest(fit1, fit0)
p.value[is.na(p.value)] <- 1
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
4. TCCパッケージ中の1,000 genes×6 samplesのカウントデータ(hypoData)の場合：
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_200までがDEG (最初の180個がG1群で高発現、残りの20個がG2群で高発現)
gene_201〜gene_1000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
TCC ver. 1.3.2で2014年4月に利用可能予定のコードです。getResult関数のところでエラーが出るようですね。
out_f <- "hoge4.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(TCC)
library(DESeq)
data(hypoData)
data <- hypoData
design.cl <- data.frame(
group=c(rep(1, param_G1), rep(2, param_G2)),
pair=c(1:param_G1, 1:param_G2)
)
tcc <- new("TCC", data, design.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0, paired=T)
tcc$norm.factors
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR, paired=T)
#result <- getResult(tcc, sort=FALSE)
#sum(tcc$stat$q.value < param_FDR)
p.value <- tcc$stat$p.value
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
#tmp <- cbind(rownames(tcc$count), tcc$count, result)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
5. TCCパッケージ中の1,000 genes×6 samplesのカウントデータ(hypoData)の場合：
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_200までがDEG (最初の180個がG1群で高発現、残りの20個がG2群で高発現)
gene_201〜gene_1000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
DEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算を行う例です。
TCC ver. 1.3.2で2014年4月に利用可能予定のコードです。getResult関数のところでエラーが出るようですね。
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_DEG <- 1:200
library(TCC)
library(ROC)
library(DESeq)
data(hypoData)
data <- hypoData
design.cl <- data.frame(
group=c(rep(1, param_G1), rep(2, param_G2)),
pair=c(1:param_G1, 1:param_G2)
)
tcc <- new("TCC", data, design.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0, paired=T)
tcc$norm.factors
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR, paired=T)
#result <- getResult(tcc, sort=FALSE)
#sum(tcc$stat$q.value < param_FDR)
p.value <- tcc$stat$p.value
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
#tmp <- cbind(rownames(tcc$count), tcc$count, result)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
6. TCCパッケージ中の1,000 genes×6 samplesのカウントデータ(hypoData)の場合：
Biological replicatesを模倣したシミュレーションデータ(G1群3サンプル vs. G2群3サンプル)です。
gene_1〜gene_200までがDEG (最初の180個がG1群で高発現、残りの20個がG2群で高発現)
gene_201〜gene_1000までがnon-DEGであることが既知です。
G1群の3つのサンプル(G1_1, G1_2, G1_3)とG2群の3つのサンプル(G2_1, G2_2, G2_3)が対応しているという仮定で解析を行います。
例えば、G1_1とG2_1がAさん、G1_2とG2_2がBさん、そしてG1_3とG2_3がCさんというイメージです。したがって、G1群とG2群のサンプル数が異なることはアリエマセン。
4.と同じ入力形式で、TCCパッケージを使わずにDESeqパッケージ中の関数のみで行うやり方です。TCCのほうが手順的にも簡便であることがわかります。
out_f <- "hoge6.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
library(DESeq)
library(TCC)
data(hypoData)
data <- hypoData
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
pair <- c(1:param_G1, 1:param_G2)
design.cl <- data.frame(
group=as.factor(data.cl),
pair=as.factor(pair)
)
cds <- newCountDataSet(data, design.cl)
cds <- estimateSizeFactors(cds)
sizeFactors(cds)
cds <- estimateDispersions(cds, method="blind", sharingMode="fit-only")
fit1 <- fitNbinomGLMs(cds, count ~ as.factor(data.cl) + as.factor(pair))
fit0 <- fitNbinomGLMs(cds, count ~ as.factor(pair))
p.value <- nbinomGLMTest(fit1, fit0)
p.value[is.na(p.value)] <- 1
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
実験デザインが以下のような場合にこのカテゴリーに属す方法を適用します：
Aさんの肝臓サンプル(or "time_point1" or "Group1")
Bさんの肝臓サンプル(or "time_point1" or "Group1")
Cさんの肝臓サンプル(or "time_point1" or "Group1")
Dさんの腎臓サンプル(or "time_point2" or "Group2")
Eさんの腎臓サンプル(or "time_point2" or "Group2")
Fさんの腎臓サンプル(or "time_point2" or "Group2")
Gさんの大腸サンプル(or "time_point3" or "Group3")
Hさんの大腸サンプル(or "time_point3" or "Group3")
Iさんの大腸サンプル(or "time_point3" or "Group3")
基礎では、ANOVAのような「どこかの群間で発現に差がある遺伝子の検出」のやり方を示します。
応用では、「指定した群間で発現に差がある遺伝子の検出」のやり方を示します。
GLM LRT法などが有名です。GLMは一般化線形モデル(generalized linear model)の略、そしてLRTは尤度比検定(log-likelihood ratio test)の略です。
基本的には、「全ての群の情報を含むfull model」と「特定の情報を除くreduced model」の2つモデルを作成し、その二つのモデルの尤度に差があるかどうかを検定するやり方です。
designというオブジェクトがfull modelに相当します。基本的には、デザイン行列中のparam_coefで指定した列を除くことでreduced modelを作成してLRTを行っています。
EBSeqやbaySeqは、考えられる様々なパターンのうちどのパターンへの当てはまりが最も良いかというposterior probabilityを出力します。
2015年2月に調査した結果をリストアップします。
R用：
- edgeR：Robinson et al., Bioinformatics, 2010
- baySeq：Hardcastle and Kelly, BMC Bioinformatics, 2010
- DESeq：Anders and Huber, Genome Biol, 2010
- PoissonSeq：Li et al., Biostatistics, 2012
- SAMseq：Li and Tibshirani, Stat Methods Med Res., 2013
- EBSeq：Leng et al., Bioinformatics, 2013
- TCC：Sun et al., BMC Bioinformatics, 2013
- DESeq2：Love et al., Genome Biol., 2014
DESeq2パッケージ (Love et al., Genome Biol., 2014)を用いるやり方を示します。
DESeq2はTCCパッケージ (Sun et al., BMC Bioinformatics, 2013)内で用いることができるので、そのやり方を中心に述べます。
デフォルトのDESeq2の手順に相当します。
ここでやっていることはANOVAのような「どこかの群間で発現に差がある遺伝子を検出」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。TCCパッケージを用いるやり方です。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq2", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq2", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ15の10,000 genes×9 samplesのシミュレーションデータ(data_hypodata_3vs3vs3.txt)と同じものをTCCパッケージ内部で作成する場合：
1.と同じ結果が得られます。
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="deseq2", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq2", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq2", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq2", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3.と同じ結果が得られます。
out_f <- "hoge4.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="deseq2", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq2", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
1.と基本的に同じで、出力のテキストファイルが正規化前のデータではなく正規化後のデータになっていて、発現変動順にソートしたものになっています。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq2", iteration=0)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="deseq2", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
1.と基本的に同じですが、full modelとreduced modelを情報を明示的に指定しています。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge6.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq2", iteration=0)
tcc$group <- data.frame(condition = as.factor(data.cl))
tcc <- estimateDE(tcc, test.method="deseq2", FDR=param_FDR,
full= ~condition, reduced= ~1)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3.と基本的に同じで、TCCパッケージを使わずにDESeq2パッケージ中の関数のみで行うやり方です。
TCCのほうが手順的にも簡便であることがわかります。
指定したFDR閾値を満たす遺伝子数が異なるのは、q-value算出方法の違いに起因します。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge7.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
library(DESeq2)
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))
colData <- data.frame(condition=as.factor(data.cl))
d <- DESeqDataSetFromMatrix(countData=data, colData=colData, design=~condition)
d <- estimateSizeFactors(d)
sizeFactors(d) <- sizeFactors(d)/mean(sizeFactors(d))
d <- estimateDispersions(d)
d <- nbinomLRT(d, full= ~condition, reduced= ~1)
tmp <- results(d)
p.value <- tmp$pvalue
p.value[is.na(p.value)] <- 1
q.value <- tmp$padj
q.value[is.na(q.value)] <- 1
ranking <- rank(p.value)
sum(q.value < param_FDR)
sum(p.adjust(p.value, method="BH") < param_FDR)
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群4サンプル vs. G2群4サンプル vs. G3群4サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_2000がG2群で5倍高発現、gene_2001〜gene_3000がG3群で5倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算も行っています。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge8.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(TCC)
library(ROC)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq2", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq2", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
ranking <- rank(tcc$stat$p.value)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
8.と基本的に同じですが、TCCパッケージではなくDESeq2パッケージ中の関数を利用しています。
指定したFDR閾値を満たす遺伝子数が異なるのは、q-value算出方法の違いに起因します。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge9.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(DESeq2)
library(ROC)
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))
colData <- data.frame(condition=as.factor(data.cl))
d <- DESeqDataSetFromMatrix(countData=data, colData=colData, design=~condition)
d <- estimateSizeFactors(d)
sizeFactors(d) <- sizeFactors(d)/mean(sizeFactors(d))
d <- estimateDispersions(d)
d <- nbinomLRT(d, full= ~condition, reduced= ~1)
tmp <- results(d)
p.value <- tmp$pvalue
p.value[is.na(p.value)] <- 1
q.value <- tmp$padj
q.value[is.na(q.value)] <- 1
ranking <- rank(p.value)
sum(q.value < param_FDR)
sum(p.adjust(p.value, method="BH") < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
TCCを用いたやり方を示します。
内部的にiDEGES/edgeR(Sun_2013)正規化を実行したのち、
edgeRパッケージ中のGLM LRT法で発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行っています。
TCC原著論文中のiDEGES/edgeR-edgeRという解析パイプラインに相当します。ここでやっていることはANOVAのような「どこかの群間で発現に差がある遺伝子を検出」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
1.と同じ結果が得られます。
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3.と同じ結果が得られます。
out_f <- "hoge4.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
1.と基本的に同じで、出力のテキストファイルが正規化前のデータではなく正規化後のデータになっていて、発現変動順にソートしたものになっています。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
1.と基本的に同じですが、デザイン行列designと係数coefを明示的に作成および指定しています。
coefに入っている数値は、length(unique(data.cl))の値が3になるので、2:3、つまり2と3になります。
これがANOVA的などこかの群間で発現変動しているものを検出するときに指定する値です。
感覚的にはdesign[,2] - design[,3]をやっていることになり、「G1で-1, G2で0, G3で1」と全ての群で異なる数値が割り振られることになります。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge6.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
design <- model.matrix(~ as.factor(data.cl))
coef <- 2:length(unique(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, coef=coef)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
5.と基本的に同じで、入力ファイルが違うだけです。Blekhman et al., Genome Res., 2010の
20,689 genes×18 samplesのカウントデータです。ヒト(HS)、チンパンジー(PT)、アカゲザル(RM)の3生物種間比較です。
in_f <- "sample_blekhman_18.txt"
out_f <- "hoge7.txt"
param_G1 <- 6
param_G2 <- 6
param_G3 <- 6
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
EBSeqパッケージ(Leng et al., 2013)を用いて
発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群4サンプル vs. G2群4サンプル vs. G3群4サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_2000がG2群で5倍高発現、gene_2001〜gene_3000がG3群で5倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。出力結果ファイルを眺めると
Pattern1, Pattern2, ..., Pattern5までの列のところに遺伝子ごとのPosterior Probability (PP)値が与えられています。
PP値が一番大きい(つまり1に近い)パターンに、その遺伝子が属するということになります。
Pattern1は(1, 1, 1)なのでnon-DEGの発現パターンに相当。Pattern2は(1, 1, 2)なのでG3群で発現変動(高発現または低発現)。
Pattern3は(1, 2, 1)なのでG2群で発現変動。Pattern4は(1, 2, 2)なのでG1群で発現変動。
そしてPattern5は(1, 2, 3)なので、全ての群間で発現が異なるものです。
一番右側の列を見る方が手っ取り早いかもしれません。どの遺伝子がどのパターンに属するかが一目瞭然です。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
library(EBSeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep("G1", param_G1), rep("G2", param_G2), rep("G3", param_G3))
PosParti <- GetPatterns(data.cl)
Parti <- PosParti
Parti
MultiSize <- MedianNorm(data)
hoge <- EBMultiTest(as.matrix(data), NgVector=NULL,
Conditions=data.cl, AllParti=Parti,
sizeFactors=MultiSize, maxround=5,
Qtrm=1.0, QtrmCut=-1)
out <- GetMultiPP(hoge)
tmp <- cbind(rownames(data), data, out$PP, out$MAP)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out$Patterns
1.と基本的に同じですが、調べるパターンの中からPattern5を排除するやり方です。
DegPack (An et al., 2014)
はまさにPattern5のような「どの群間でも同じパターンではない遺伝子」の検出を目的としていますが、
そういうものは興味の対象外という場合にここを利用します。尚、param_patternで指定している1:4は
c(1, 2, 3, 4)と同じ意味です。
1.でPattern5への当てはまりがよいとされていたgene_32が、Pattern4になっていることがわかります。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge2.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_pattern <- 1:4
library(EBSeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep("G1", param_G1), rep("G2", param_G2), rep("G3", param_G3))
PosParti <- GetPatterns(data.cl)
Parti <- PosParti[param_pattern, ]
Parti
MultiSize <- MedianNorm(data)
hoge <- EBMultiTest(as.matrix(data), NgVector=NULL,
Conditions=data.cl, AllParti=Parti,
sizeFactors=MultiSize, maxround=5,
Qtrm=1.0, QtrmCut=-1)
out <- GetMultiPP(hoge)
tmp <- cbind(rownames(data), data, out$PP, out$MAP)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out$Patterns
1.と基本的に同じですが、調べるパターンの中からPattern2, 3, 4を排除して、Pattern1と5のみを想定するやり方です。
DegPack (An et al., 2014)
と似た解析である「どの群間でも同じパターンではない遺伝子」の検出をやっていることに相当します。
私は通常の解析ではやりません。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge3.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_pattern <- c(1, 5)
library(EBSeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep("G1", param_G1), rep("G2", param_G2), rep("G3", param_G3))
PosParti <- GetPatterns(data.cl)
Parti <- PosParti[param_pattern, ]
Parti
MultiSize <- MedianNorm(data)
hoge <- EBMultiTest(as.matrix(data), NgVector=NULL,
Conditions=data.cl, AllParti=Parti,
sizeFactors=MultiSize, maxround=5,
Qtrm=1.0, QtrmCut=-1)
out <- GetMultiPP(hoge)
tmp <- cbind(rownames(data), data, out$PP, out$MAP)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
out$Patterns
samrパッケージ中のSAMseq (Li and Tibshirani, 2013)を用いて
発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群4サンプル vs. G2群4サンプル vs. G3群4サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_2000がG2群で5倍高発現、gene_2001〜gene_3000がG3群で5倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。TCCパッケージでSAMseqを実行するやり方です。
このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算も行っています。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(TCC)
library(ROC)
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))
tcc <- new("TCC", data, data.cl)
set.seed(2015)
tcc <- estimateDE(tcc, test.method="samseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
ranking <- rank(tcc$stat$p.value)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
tcc$private$simulation <- TRUE
tcc$simulation$trueDEG <- obj
calcAUCValue(tcc)
シミュレーションデータ(G1群4サンプル vs. G2群4サンプル vs. G3群4サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_2000がG2群で5倍高発現、gene_2001〜gene_3000がG3群で5倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。samrパッケージでSAMseqを実行する通常のやり方です。
このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算も行っています。同じAUC値(=0.8965379)が得られることが分かります。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge2.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(samr)
library(ROC)
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))
set.seed(2015)
out <- SAMseq(data, data.cl, resp.type="Multiclass")
p.value <- samr.pvalues.from.perms(out$samr.obj$tt, out$samr.obj$ttstar)
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
シミュレーションデータ(G1群4サンプル vs. G2群4サンプル vs. G3群4サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_2000がG2群で5倍高発現、gene_2001〜gene_3000がG3群で5倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。samrパッケージでSAMseqを実行する通常のやり方です。
このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算も行っています。1.や2.と若干異なるAUC値(=0.896619)が得られることが分かります。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge3.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(samr)
library(ROC)
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))
set.seed(2015)
out <- SAMseq(data, data.cl, resp.type="Multiclass", fdr.output=1)
hoge <- rbind(out$siggenes.table$genes.up, out$siggenes.table$genes.lo)
q.value <- rep(1, nrow(data))
names(q.value) <- rownames(data)
q.value[as.numeric(hoge[, "Gene Name"])] <- as.numeric(hoge[, "q-value(%)"])/100
ranking <- rank(q.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
3.と基本的に同じで、記述形式をちょっと変更しているだけです。
SAMseq関数実行時の「nperms = 100, nresamp = 20」はデフォルトの数値を明示しているだけです。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge4.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(samr)
library(ROC)
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))
set.seed(2015)
out <- SAMseq(data, data.cl, nperms = 100, nresamp = 20,
geneid = rownames(data), genenames = rownames(data),
resp.type="Multiclass", fdr.output=1)
hoge <- rbind(out$siggenes.table$genes.up, out$siggenes.table$genes.lo)
q.value <- rep(1, nrow(data))
names(q.value) <- rownames(data)
q.value[match(hoge[,1], rownames(data))] <- as.numeric(hoge[, "q-value(%)"])/100
ranking <- rank(q.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
TMM正規化(Robinson_2010)を実行したのち、
edgeRパッケージ中のGLM LRT法で発現変動遺伝子(Differentially expressed Genes; DEGs)
検出を行うやり方(edgeR coupled with TMM normalization; TMM-edgeR)を示します。デフォルトのedgeRの手順に相当します。
こでやっていることはANOVAのような「どこかの群間で発現に差がある遺伝子を検出」です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ15の10,000 genes×9 samplesのシミュレーションデータ(data_hypodata_3vs3vs3.txt)と同じものをTCCパッケージ内部で作成する場合：
1.と同じ結果が得られます。
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3.と同じ結果が得られます。
out_f <- "hoge4.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
1.と基本的に同じで、出力のテキストファイルが正規化前のデータではなく正規化後のデータになっていて、発現変動順にソートしたものになっています。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge5.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
normalized <- getNormalizedData(tcc)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
tmp <- cbind(rownames(tcc$count), normalized, result)
tmp <- tmp[order(tmp$rank),]
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
sum(tcc$stat$q.value < 0.05)
sum(tcc$stat$q.value < 0.10)
sum(tcc$stat$q.value < 0.20)
sum(tcc$stat$q.value < 0.30)
1.と基本的に同じですが、デザイン行列designと係数coefを明示的に作成および指定しています。
coefに入っている数値は、length(unique(data.cl))の値が3になるので、2:3、つまり2と3になります。
これがANOVA的などこかの群間で発現変動しているものを検出するときに指定する値です。
感覚的にはdesign[,2] - design[,3]をやっていることになり、「G1で-1, G2で0, G3で1」と全ての群で異なる数値が割り振られることになります。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge6.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
design <- model.matrix(~ as.factor(data.cl))
coef <- 2:length(unique(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, coef=coef)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
3.と基本的に同じで、TCCパッケージを使わずにedgeRパッケージ中の関数のみで行うやり方です。TCCのほうが手順的にも簡便であることがわかります。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge7.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
library(edgeR)
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))
d <- DGEList(data, group=data.cl)
d <- calcNormFactors(d)
design <- model.matrix(~ as.factor(data.cl))
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
coef <- 2:length(unique(data.cl))
lrt <- glmLRT(fit, coef=coef)
tmp <- topTags(lrt, n=nrow(data), sort.by="none")
p.value <- tmp$table$PValue
q.value <- tmp$table$FDR
result <- cbind(p.value, q.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
シミュレーションデータ(G1群4サンプル vs. G2群4サンプル vs. G3群4サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_2000がG2群で5倍高発現、gene_2001〜gene_3000がG3群で5倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。このDEG or non-DEGの位置情報と実際のランキング結果情報を用いてAUC値の計算も行っています。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge8.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(TCC)
library(ROC)
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))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
8.と基本的に同じですが、TCCパッケージではなくedgeRパッケージ中の関数を利用しています。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge9.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_DEG <- 1:3000
library(edgeR)
library(ROC)
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))
d <- DGEList(data, group=data.cl)
d <- calcNormFactors(d)
design <- model.matrix(~ as.factor(data.cl))
d <- estimateGLMCommonDisp(d, design)
d <- estimateGLMTrendedDisp(d, design)
d <- estimateGLMTagwiseDisp(d, design)
fit <- glmFit(d, design)
coef <- 2:length(unique(data.cl))
lrt <- glmLRT(fit, coef=coef)
tmp <- topTags(lrt, n=nrow(data), sort.by="none")
p.value <- tmp$table$PValue
q.value <- tmp$table$FDR
result <- cbind(p.value, q.value)
sum(q.value < param_FDR)
ranking <- rank(p.value)
tmp <- cbind(rownames(data), data, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
obj <- rep(0, nrow(data))
obj[param_DEG] <- 1
AUC(rocdemo.sca(truth=obj, data=-ranking))
DESeqパッケージを用いて発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行うやり方(DESeq coupled with DESeq normalization; DESeq-DESeq)を示します。
デフォルトのDESeqの手順に相当します。TCCパッケージを用いても同様のことができますので、動作確認も兼ねて両方のやり方を示しています。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
2. サンプルデータ15の10,000 genes×9 samplesのシミュレーションデータ(data_hypodata_3vs3vs3.txt)と同じものをTCCパッケージ内部で作成する場合：
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
1.と同じ入力形式で、TCCパッケージを使わずにDESeqパッケージ中の関数のみで行うやり方です。TCCのほうが手順的にも簡便であることがわかります。
in_f <- "data_hypodata_3vs3vs3.txt"
out_f <- "hoge3.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_FDR <- 0.05
library(DESeq)
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))
cds <- newCountDataSet(data, data.cl)
cds <- estimateSizeFactors(cds)
sizeFactors(cds)
cds <- estimateDispersions(cds, method="pooled")
fit1 <- fitNbinomGLMs(cds, count ~ as.factor(data.cl))
fit0 <- fitNbinomGLMs(cds, count ~ 1)
p.value <- nbinomGLMTest(fit1, fit0)
p.value[is.na(p.value)] <- 1
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
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群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge4.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
out_f <- "hoge5.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
library(TCC)
set.seed(1000)
tcc <- simulateReadCounts(Ngene = 10000, PDEG = 0.3,
DEG.assign = c(0.7, 0.2, 0.1),
DEG.foldchange = c(3, 10, 6),
replicates = c(param_G1, param_G2, param_G3))
tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=0)
tcc <- estimateDE(tcc, test.method="deseq", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
calcAUCValue(tcc)
シミュレーションデータ(G1群2サンプル vs. G2群4サンプル vs. G3群3サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_2100がG1群で3倍高発現、gene_2101〜gene_2700がG2群で10倍高発現、gene_2701〜gene_3000がG3群で6倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。
3.と同じ入力形式で、TCCパッケージを使わずにDESeqパッケージ中の関数のみで行うやり方です。TCCのほうが手順的にも簡便であることがわかります。
in_f <- "data_hypodata_2vs4vs3.txt"
out_f <- "hoge6.txt"
param_G1 <- 2
param_G2 <- 4
param_G3 <- 3
param_FDR <- 0.05
library(DESeq)
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))
cds <- newCountDataSet(data, data.cl)
cds <- estimateSizeFactors(cds)
sizeFactors(cds)
cds <- estimateDispersions(cds, method="pooled")
fit1 <- fitNbinomGLMs(cds, count ~ as.factor(data.cl))
fit0 <- fitNbinomGLMs(cds, count ~ 1)
p.value <- nbinomGLMTest(fit1, fit0)
p.value[is.na(p.value)] <- 1
q.value <- p.adjust(p.value, method="BH")
ranking <- rank(p.value)
sum(q.value < param_FDR)
tmp <- cbind(rownames(data), data, p.value, q.value, ranking)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
TCCを用いたやり方を示します。
内部的にiDEGES/edgeR(Sun_2013)正規化を実行したのち、
edgeRパッケージ中のGLM LRT法で発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行っています。
TCC原著論文中のiDEGES/edgeR-edgeRという解析パイプラインに相当します。応用でやりたいことは「指定した群間で発現に差がある遺伝子の検出」です。
デザイン行列design中のparam_coefで指定した列を除くことでreduced modelを作成します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群4サンプル vs. G2群4サンプル vs. G3群4サンプル)です。
gene_1〜gene_3000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_2000がG2群で5倍高発現、gene_2001〜gene_3000がG3群で5倍高発現)
gene_3001〜gene_10000までがnon-DEGであることが既知です。ANOVAと同じく、どこかの群間で発現変動しているものを検出するやり方(帰無仮説: G1 = G2 = G3)です。
出力ファイルのestimatedDEG列を眺めると、DEGに相当する最初の1行目から3000行目のところのほとんどが1,
それ以外の3001から10000行のほとんどが0になっていることからparam_coefでの指定方法が妥当であることが分かります。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge1.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_coef <- c(2, 3)
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
design <- model.matrix(~ as.factor(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, coef=param_coef)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
design
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G2群」の比較を行いたいときの指定方法(帰無仮説: G1 = G2)です。
出力ファイルのestimatedDEG列を眺めると、DEGに相当する最初の1行目から2000行目のところのほとんどが1である一方、
G3群で高発現DEGの2001から3000行目のほとんどが0となっていることから、param_coefでの指定方法が妥当であることが分かります。
「full modelに相当するデザイン行列designの2列目のパラメータを除いたものをreduced modelとする」という指定に相当します。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge2.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_coef <- 2
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
design <- model.matrix(~ as.factor(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, coef=param_coef)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
design
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G3群」の比較を行いたいときの指定方法(帰無仮説: G1 = G3)です。
出力ファイルのestimatedDEG列を眺めると、DEGに相当する最初の1-1000行目および2001-3000行目のところのほとんどが1である一方、
G2群で高発現DEGの1001から2000行目のほとんどが0となっていることから、param_coefでの指定方法が妥当であることが分かります。
「full modelに相当するデザイン行列designの3列目のパラメータを除いたものをreduced modelとする」という指定に相当します。
in_f <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge3.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_coef <- 3
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
design <- model.matrix(~ as.factor(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, coef=param_coef)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
design
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G2群 vs. G3群」の比較を行いたいときの指定方法(帰無仮説: G2 = G3)です。
出力ファイルのestimatedDEG列を眺めると、DEGに相当する最初の1001-3000行目のところのほとんどが1である一方、
G1群で高発現DEGの1から1000行目のほとんどが0となっていることから、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 <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge4.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_contrast <- c(0, -1, 1)
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
design <- model.matrix(~ 0 + as.factor(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, contrast=param_contrast)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
design
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G2群」の比較を行いたいときの指定方法(帰無仮説: G1 = G2)です。
出力ファイルのestimatedDEG列を眺めると、DEGに相当する最初の1行目から2000行目のところのほとんどが1である一方、
G3群で高発現DEGの2001から3000行目のほとんどが0となっていることから、param_contrastでの指定方法が妥当であることが分かります。
思考回路としては、「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 <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge5.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_contrast <- c(1, -1, 0)
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
design <- model.matrix(~ 0 + as.factor(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, contrast=param_contrast)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
design
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
「G1群 vs. G3群」の比較を行いたいときの指定方法(帰無仮説: G1 = G3)です。
出力ファイルのestimatedDEG列を眺めると、DEGに相当する最初の1-1000行目および2001-3000行目のところのほとんどが1である一方、
G2群で高発現DEGの1001から2000行目のほとんどが0となっていることから、param_contrastでの指定方法が妥当であることが分かります。
思考回路としては、「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 <- "data_hypodata_4vs4vs4.txt"
out_f <- "hoge6.txt"
param_G1 <- 4
param_G2 <- 4
param_G3 <- 4
param_FDR <- 0.1
param_contrast <- c(1, 0, -1)
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), rep(3, param_G3))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
design <- model.matrix(~ 0 + as.factor(data.cl))
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR,
design=design, contrast=param_contrast)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
design
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
- TCC：Sun et al., BMC Bioinformatics, 2013
- edgeR：Robinson et al., Bioinformatics, 2010
- TMM正規化法：Robinson and Oshlack, Genome Biol., 2010
- edgeR中のGLM論文：McCarthy et al., Nucleic Acids Res., 2012
- シリーズ Useful R 第7巻 トランスクリプトーム解析, 共立出版, 2014の4.2.2あたりにも解説あり
TCCを用いたやり方を示します。
内部的にiDEGES/edgeR(Sun_2013)正規化を実行したのち、
edgeRパッケージ中のexact testで発現変動遺伝子(Differentially expressed Genes; DEGs)検出を行っています。
TCC原著論文中のiDEGES/edgeR-edgeRという解析パイプラインに相当します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
シミュレーションデータ(G1群3サンプル vs. G2群3サンプル vs. G3群3サンプル vs. G4群3サンプル vs. G5群3サンプル)です。
gene_1〜gene_2000までがDEG (gene_1〜gene_1000がG1群で5倍高発現、gene_1001〜gene_1400がG2群で10倍高発現、gene_1401〜gene_1700がG3群で8倍高発現、
gene_1701〜gene_1900がG4群で12倍高発現、gene_1901〜gene_2000がG5群で7倍高発現)、gene_2001〜gene_10000までがnon-DEGであることが既知です。
in_f <- "data_hypodata_3vs3vs3vs3vs3.txt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_G3 <- 3
param_G4 <- 3
param_G5 <- 3
param_FDR <- 0.05
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), rep(3,param_G3), rep(4,param_G4), rep(5,param_G5))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
tmp <- cbind(rownames(tcc$count), tcc$count, result)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
時系列(time-series)解析用のものたちです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
maSigProパッケージを用いた時系列データ解析を示します。
西岡輔 氏提供情報ですm(_ _)m
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
選択的スプライシング(alternative splicing; AS)とは、ある共通の前駆体mRNAからエクソン(exon)のextending, shortening, skipping, includingやイントロン(intron)
配列の保持(retaining)によって異なるmRNAバリアントを作り出すメカニズムのことを指します。
これらのイベントはalternative exon events (AEEs)と総称されるようです。
ちなみに全ヒト遺伝子の75-92%が複数のアイソフォーム(multiple isoforms)となりうるという報告もあるようです
（言い換えると8-25%がsingle isoform genesだということ）。
複数のサンプル間で発現に違いのあるエクソン(Differential Exon Usage; DEU)を同定するためのプログラムです。
DEU以外にdifferential isoform usage用の方法が含まれます。
2015年01月に調査した結果をリストアップします。
R用：
- Solas(Windows版はなし；2010年以降アップデートなし)：Richard et al., Nucleic Acids Res., 2010
- DEXSeq：Anders et al., Genome Res., 2012
- EBSeq：Leng et al., Bioinformatics, 2013
- SplicingCompass(Windows版なし)：Aschoff et al., Bioinformatics, 2013
- NPEBseq：Bi et al., BMC Bioinformatics, 2013
- rSeqDiff(Windowsありだが、通常の手順とは異なる)：Shi and Jiang, PLoS One, 2013
- IUTA：Niu et al., BMC Genomics, 2014
DEXSeqパッケージを用いてサンプル間で発現に違いのあるエクソン(exon)を同定するやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
RNA-seqなどのタグカウントデータから遺伝子オントロジー(GO)解析を行うためのパッケージもいくつか出ています。
遺伝子セット解析という枠組みではGO解析もパスウェイ解析も同じなので、そちらもチェックするといいかもしれません。
2015年2月に調査した結果をリストアップします。
R用:
- GAGE：Luo et al., BMC Bioinformatics, 2009
- goseq：Young et al., Genome Biol., 2010
- GOSemSim：Yu et al., Bioinformatics, 2010
- Rスクリプト：Gao et al., Bioinformatics, 2011
- RamiGO：Schröder et al., Bioinformatics, 2013
- GSVA：Hänzelmann et al., BMC Bioinformatics, 2013
- SeqGSEA：Wang et al., Bioinformatics, 2014
- GSAASeqSP：Xiong et al., Sci Rep., 2014
SeqGSEAを用いてGO解析を行うやり方を示します。
このパッケージは、exonレベルのカウントデータを入力として、発現変動遺伝子セットに相当する有意に発現変動したGO termsを出力するのが基本ですが、geneレベルのカウントデータを入力として解析することも可能です。
統計的有意性の評価にサンプルラベル情報の並べ替え(permutation)戦略を採用しているため、
各グループあたりの反復数が5以上のデータを想定しているようです(Wang et al., 2014)。また、計算時間が半端なくかかります。
例えば、並べ替え回数がたったの20回でも2時間ちょっとかかります(Panasonic Let's note CF-SX3本郷モデルの場合)のでご注意ください。
推奨は1000回以上と書いてますが、10日ほどかかることになるので個人的にはアリエナイですね...。
SeqGSEAでの機能解析の基本は、exonレベルとgeneレベルの発現変動解析結果を組み合わせてGSEAを行うというものです(Wang and Cairns, 2013)。
SeqGSEA著者たちは、exonレベルの発現変動解析のことをDifferential splicing (DS) analysisと呼んでいて、
おそらくDSGseq (Wang et al., 2013)はSeqGSEA中に組み込まれています。
そしてgeneレベルの発現変動解析をDifferential expression (DE) analysisとして、SeqGSEA中では
DESeqを利用しています。
GSEAに代表される発現変動遺伝子セット解析は、基本的にGSEAの開発者らが作成した様々な遺伝子セット情報を収めた
Molecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
*gmt形式ファイルのダウンロード方法は、基本的に以下の通りです：
- Molecular Signatures Database (MSigDB)の
「register」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
「c5: gene ontology gene sets」の「bp: biological process」を解析したい場合はc5.bp.v4.0.symbols.gmtファイルをダウンロードしておく。
「c5: gene ontology gene sets」の「cc: cellular components」を解析したい場合はc5.cc.v4.0.symbols.gmtファイルをダウンロードしておく。
「c5: gene ontology gene sets」の「mf: molecular functions」を解析したい場合はc5.mf.v4.0.symbols.gmtファイルをダウンロードしておく。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
パイプライン | ゲノム | 機能解析 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)
のStep2の出力結果ファイルです。SeqGSEA内部でReadCountSetクラスオブジェクトというものを作成する必要がありますが、
これはexonレベルのカウントデータと遺伝子アノテーション情報(Ensembl gene IDおよびexon ID)を対応づけるためのものです。
カウントデータ自体は、ヒトゲノム("hg19")のEnsembl Genes ("ensGene")情報を利用して取得しているので、
アノテーション情報も同じ条件でオンライン上でTranscriptDbオブジェクトとして取得しています(Lawrence et al., 2013)。
以下のスクリプト中の前処理のところでごちゃごちゃと計算しているのは、複数のEnsembl gene IDによって共有されているexon (shared exon)の情報のみ解析から除外しています。
その後、shared exonを除く残りのexonレベルのカウントデータ情報を用いてDifferential splicing (DS) analysisを行い、exonレベルの発現変動解析(Wang et al., Gene, 2013)を行っています。
計算のボトルネックはこの部分です。
次に、exonレベルのカウントデータからgeneレベルのカウントデータを作成したのち、DESeqパッケージを用いて
遺伝子レベルの発現変動解析(Anders and Huber, 2010)を行っています。
SeqGSEA (Wang and Cairns, BMC Bioinformatics)は、これら2つのレベルの発現変動解析結果の情報を統合して
よりよい遺伝子セット解析(Gene Set Enrichment Analysis; GSEA; Subramanian et al., 2005)を行うという手法です。
ヒト遺伝子の90%以上は選択的スプライシングが起こっている(Wang et al., Nature, 2008)ので、
geneレベルのみの発現変動解析結果をもとにするやり方であるGOSeq
(Young et al., Genome Biol., 2010)よりもいいだろう、という思想です。
以下では"c5.bp.v4.0.symbols.gmt"の解析を行っています。
また、並べ替え回数がたったの20回でも2時間ちょっとかかります(Panasonic Let's note CF-SX3本郷モデルの場合)のでご注意ください。
並べ替えを200回行って得られた
srp017142_SeqGSEA_c5bp_exon200.txtでは、FDR < 0.01を満たすGO termは26個であることがわかります。
in_f1 <- "srp017142_count_bowtie2.txt"
in_f2 <- "c5.bp.v4.0.symbols.gmt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_perm <- 20
param1 <- "hg19"
param2 <- "ensGene"
library(SeqGSEA)
library(GenomicFeatures)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
tmp_colname <- colnames(data)
colnames(data) <- c(paste("E", 1:param_G1, sep=""), paste("C", 1:param_G2, sep=""))
txdb <- makeTranscriptDbFromUCSC(genome=param1, tablename=param2)
hoge1 <- exonsBy(txdb, by=c("gene"))
hoge2 <- unlist(hoge1)
hoge2
hoge3 <- table(hoge2$exon_id)
hoge4 <- names(hoge3)[hoge3 == 1]
obj <- is.element(as.character(hoge2$exon_id), hoge4)
exonIDs <- as.character(hoge2$exon_id)[obj]
geneIDs <- names(hoge2)[obj]
data <- data[exonIDs,]
dim(data)
exonIDs <- paste("E", exonIDs, sep="")
RCS <- newReadCountSet(data, exonIDs, geneIDs)
RCS
RCS <- exonTestability(RCS, cutoff = 5)
geneTestable <- geneTestability(RCS)
RCS <- subsetByGenes(RCS, unique(geneID(RCS))[geneTestable])
RCS
time_DS_s <- proc.time()
RCS <- estiExonNBstat(RCS)
RCS <- estiGeneNBstat(RCS)
head(fData(RCS)[, c("exonIDs", "geneIDs", "testable", "NBstat")])
permuteMat <- genpermuteMat(RCS, times=param_perm)
RCS <- DSpermute4GSEA(RCS, permuteMat)
DSscore.normFac <- normFactor(RCS@permute_NBstat_gene)
DSscore <- scoreNormalization(RCS@featureData_gene$NBstat, DSscore.normFac)
DSscore.perm <- scoreNormalization(RCS@permute_NBstat_gene, DSscore.normFac)
RCS <- DSpermutePval(RCS, permuteMat)
head(DSresultGeneTable(RCS))
time_DS_e <- proc.time()
time_DS_e - time_DS_s
time_DE_s <- proc.time()
geneCounts <- getGeneCount(RCS)
head(geneCounts)
DEG <- runDESeq(geneCounts, label(RCS))
DEGres <- DENBStat4GSEA(DEG)
DEpermNBstat <- DENBStatPermut4GSEA(DEG, permuteMat)
DEscore.normFac <- normFactor(DEpermNBstat)
DEscore <- scoreNormalization(DEGres$NBstat, DEscore.normFac)
DEscore.perm <- scoreNormalization(DEpermNBstat, DEscore.normFac)
DEGres <- DEpermutePval(DEGres, DEpermNBstat)
head(DEGres)
time_DE_e <- proc.time()
time_DE_e - time_DE_s
combine <- rankCombine(DEscore, DSscore, DEscore.perm, DSscore.perm, DEweight = 0.3)
gene.score <- combine$geneScore
gene.score.perm <- combine$genePermuteScore
GS <- loadGenesets(in_f2, unique(geneID(RCS)), geneID.type = "ensembl")
GS <- GSEnrichAnalyze(GS, gene.score, gene.score.perm)
#tmp <- GSEAresultTable(GS, GSDesc = TRUE)
tmp <- topGeneSets(GS, n=length(GS@GSNames), sortBy="FDR")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)
のStep2の出力結果ファイルです。
SeqGSEA (Wang et al., 2014)は、
exonレベル(Differential Splicing; DS)とgeneレベル(Differential Expression; DE)の2つの発現変動解析結果を統合して
よりよい遺伝子セット解析(Gene Set Enrichment Analysis; GSEA; Subramanian et al., 2005)を行うという手法ですが、
選択的スプライシング(Alternative Splicing; AS)が少ないあるいはない高等生物以外にも適用可能です。
ここでは、geneレベルの発現変動解析のみに基づくDE-only GSEAのやり方を示します。計算時間のボトルネックになっていたexonレベルの発現変動解析を含まないので高速に計算可能なため、
並べ替え回数を多くすることが可能です(500回で100分程度)。
以下では"c5.bp.v4.0.symbols.gmt"の解析を行っています。並べ替えを500回行って得られた
srp017142_SeqGSEA_c5bp_gene500.txtでは、FDR < 0.05を満たすGO termは10個であることがわかります。
in_f1 <- "srp017142_count_bowtie.txt"
in_f2 <- "c5.bp.v4.0.symbols.gmt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_perm <- 40
library(SeqGSEA)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
tmp_colname <- colnames(data)
colnames(data) <- c(paste("E", 1:param_G1, sep=""), paste("C", 1:param_G2, sep=""))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
time_s <- proc.time()
DEG <- runDESeq(data, as.factor(data.cl))
DEGres <- DENBStat4GSEA(DEG)
permuteMat <- genpermuteMat(as.factor(data.cl), times=param_perm)
DEpermNBstat <- DENBStatPermut4GSEA(DEG, permuteMat)
DEscore.normFac <- normFactor(DEpermNBstat)
DEscore <- scoreNormalization(DEGres$NBstat, DEscore.normFac)
DEscore.perm <- scoreNormalization(DEpermNBstat, DEscore.normFac)
gene.score <- geneScore(DEscore, DEweight=1)
gene.score.perm <- genePermuteScore(DEscore.perm, DEweight=1)
GS <- loadGenesets(in_f2, rownames(data), geneID.type = "ensembl")
GS <- GSEnrichAnalyze(GS, gene.score, gene.score.perm, weighted.type=1)
time_e <- proc.time()
time_e - time_s
#tmp <- GSEAresultTable(GS, GSDesc = TRUE)
tmp <- topGeneSets(GS, n=length(GS@GSNames), sortBy="FDR")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
- GenomicFeatures：Lawrence et al., PLoS Comput. Biol., 2013
- SeqGSEA(パッケージの論文)：Wang et al., Bioinformatics, 2014
- SeqGSEA(の原著論文)：Wang and Cairns, BMC Bioinformatics, 2013
- DSGseq：Wang et al., Gene, 2013
- Molecular Signatures Database (MSigDB)：Subramanian et al., PNAS, 2005
- DESeq：Anders and Huber, Genome Biol, 2010
GOseqを用いてGO解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
RNA-seqなどのタグカウントデータからパスウェイ(Pathway)解析を行うためのパッケージもいくつか出ています。このページでは、
SeqGSEAの解析が一通りできるようにしてあります(2014/03/30)。
入力のカウントデータは、Ensembl (Flicek et al., Nucleic Acids Res., 2014)
のアノテーション情報がおそらくデファクトスタンダードだと思います。
遺伝子セット解析という枠組みではGO解析もパスウェイ解析も同じなので、そちらもチェックするといいかもしれません。
2015年2月に調査した結果をリストアップします。
R用:
- KEGGgraph：Zhang et al., Bioinformatics, 2009
- GAGE：Luo et al., BMC Bioinformatics, 2009
- Pathview：Luo et al., Bioinformatics, 2013
- SeqGSEA：Wang et al., Bioinformatics, 2014
- GSAASeqSP：Xiong et al., Sci Rep., 2014
SeqGSEAを用いてPathway解析を行うやり方を示します。
このパッケージは、exonレベルのカウントデータを入力として、発現変動遺伝子セットに相当する有意に発現変動したKEGG Pathway名などを出力するのが基本ですが、geneレベルのカウントデータを入力として解析することも可能です。
統計的有意性の評価にサンプルラベル情報の並べ替え(permutation)戦略を採用しているため、
各グループあたりの反復数が5以上のデータを想定しているようです(Wang et al., 2014)。また、計算時間が半端なくかかります。
例えば、並べ替え回数がたったの20回でも2時間ちょっとかかります(Panasonic Let's note CF-SX3本郷モデルの場合)のでご注意ください。
推奨は1000回以上と書いてますが、10日ほどかかることになるので個人的にはアリエナイですね...。
>SeqGSEAでの機能解析の基本は、exonレベルとgeneレベルの発現変動解析結果を組み合わせてGSEAを行うというものです(Wang and Cairns, 2013)。
SeqGSEA著者たちは、exonレベルの発現変動解析のことをDifferential splicing (DS) analysisと呼んでいて、
おそらくDSGseq (Wang et al., 2013)はSeqGSEA中に組み込まれています。
そしてgeneレベルの発現変動解析をDifferential expression (DE) analysisとして、SeqGSEA中では
DESeqを利用しています。
GSEAに代表される発現変動遺伝子セット解析は、基本的にGSEAの開発者らが作成した様々な遺伝子セット情報を収めた
Molecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
*gmt形式ファイルのダウンロード方法は、基本的に以下の通りです：
- Molecular Signatures Database (MSigDB)の
「register」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
「c2: curated gene sets」の「all canonical pathways」を解析したい場合はc2.cp.v4.0.symbols.gmtファイルをダウンロードしておく。
「c2: curated gene sets」の「BioCarta gene sets」を解析したい場合はc2.cp.biocarta.v4.0.symbols.gmtファイルをダウンロードしておく。
「c2: curated gene sets」の「KEGG gene sets」を解析したい場合はc2.cp.kegg.v4.0.symbols.gmtファイルをダウンロードしておく。
「c2: curated gene sets」の「Reactome gene sets」を解析したい場合はc2.cp.reactome.v4.0.symbols.gmtファイルをダウンロードしておく。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
パイプライン | ゲノム | 機能解析 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)
のStep2の出力結果ファイルです。SeqGSEA内部でReadCountSetクラスオブジェクトというものを作成する必要がありますが、
これはexonレベルのカウントデータと遺伝子アノテーション情報(Ensembl gene IDおよびexon ID)を対応づけるためのものです。
カウントデータ自体は、ヒトゲノム("hg19")のEnsembl Genes ("ensGene")情報を利用して取得しているので、
アノテーション情報も同じ条件でオンライン上でTranscriptDbオブジェクトとして取得しています(Lawrence et al., 2013)。
以下のスクリプト中の前処理のところでごちゃごちゃと計算しているのは、複数のEnsembl gene IDによって共有されているexon (shared exon)の情報のみ解析から除外しています。
その後、shared exonを除く残りのexonレベルのカウントデータ情報を用いてDifferential splicing (DS) analysisを行い、exonレベルの発現変動解析(Wang et al., Gene, 2013)を行っています。
計算のボトルネックはこの部分です。
次に、exonレベルのカウントデータからgeneレベルのカウントデータを作成したのち、DESeqパッケージを用いて
遺伝子レベルの発現変動解析(Anders and Huber, 2010)を行っています。
SeqGSEA (Wang and Cairns, BMC Bioinformatics)は、これら2つのレベルの発現変動解析結果の情報を統合して
よりよい遺伝子セット解析(Gene Set Enrichment Analysis; GSEA; Subramanian et al., 2005)を行うという手法です。
ヒト遺伝子の90%以上は選択的スプライシングが起こっている(Wang et al., Nature, 2008)ので、
geneレベルのみの発現変動解析結果をもとにするやり方であるGOSeq
(Young et al., Genome Biol., 2010)よりもいいだろう、という思想です。
以下では"c2.cp.kegg.v4.0.symbols.gmt"の解析を行っています。
また、並べ替え回数がたったの20回でも2時間ちょっとかかります(Panasonic Let's note CF-SX3本郷モデルの場合)のでご注意ください。
並べ替えを200回行って得られた
srp017142_SeqGSEA_c2cp_exon200.txtでは、FDR < 0.02を満たすパスウェイIDは21個であることがわかります（計算時間は20時間ほどでした）。
in_f1 <- "srp017142_count_bowtie2.txt"
in_f2 <- "c2.cp.kegg.v4.0.symbols.gmt"
out_f <- "hoge1.txt"
param_G1 <- 3
param_G2 <- 3
param_perm <- 20
param1 <- "hg19"
param2 <- "ensGene"
library(SeqGSEA)
library(GenomicFeatures)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
tmp_colname <- colnames(data)
colnames(data) <- c(paste("E", 1:param_G1, sep=""), paste("C", 1:param_G2, sep=""))
txdb <- makeTranscriptDbFromUCSC(genome=param1, tablename=param2)
hoge1 <- exonsBy(txdb, by=c("gene"))
hoge2 <- unlist(hoge1)
hoge2
hoge3 <- table(hoge2$exon_id)
hoge4 <- names(hoge3)[hoge3 == 1]
obj <- is.element(as.character(hoge2$exon_id), hoge4)
exonIDs <- as.character(hoge2$exon_id)[obj]
geneIDs <- names(hoge2)[obj]
data <- data[exonIDs,]
dim(data)
exonIDs <- paste("E", exonIDs, sep="")
RCS <- newReadCountSet(data, exonIDs, geneIDs)
RCS
RCS <- exonTestability(RCS, cutoff = 5)
geneTestable <- geneTestability(RCS)
RCS <- subsetByGenes(RCS, unique(geneID(RCS))[geneTestable])
RCS
time_DS_s <- proc.time()
RCS <- estiExonNBstat(RCS)
RCS <- estiGeneNBstat(RCS)
head(fData(RCS)[, c("exonIDs", "geneIDs", "testable", "NBstat")])
permuteMat <- genpermuteMat(RCS, times=param_perm)
RCS <- DSpermute4GSEA(RCS, permuteMat)
DSscore.normFac <- normFactor(RCS@permute_NBstat_gene)
DSscore <- scoreNormalization(RCS@featureData_gene$NBstat, DSscore.normFac)
DSscore.perm <- scoreNormalization(RCS@permute_NBstat_gene, DSscore.normFac)
RCS <- DSpermutePval(RCS, permuteMat)
head(DSresultGeneTable(RCS))
time_DS_e <- proc.time()
time_DS_e - time_DS_s
time_DE_s <- proc.time()
geneCounts <- getGeneCount(RCS)
head(geneCounts)
DEG <- runDESeq(geneCounts, label(RCS))
DEGres <- DENBStat4GSEA(DEG)
DEpermNBstat <- DENBStatPermut4GSEA(DEG, permuteMat)
DEscore.normFac <- normFactor(DEpermNBstat)
DEscore <- scoreNormalization(DEGres$NBstat, DEscore.normFac)
DEscore.perm <- scoreNormalization(DEpermNBstat, DEscore.normFac)
DEGres <- DEpermutePval(DEGres, DEpermNBstat)
head(DEGres)
time_DE_e <- proc.time()
combine <- rankCombine(DEscore, DSscore, DEscore.perm, DSscore.perm, DEweight = 0.3)
gene.score <- combine$geneScore
gene.score.perm <- combine$genePermuteScore
GS <- loadGenesets(in_f2, unique(geneID(RCS)), geneID.type = "ensembl")
GS <- GSEnrichAnalyze(GS, gene.score, gene.score.perm)
#tmp <- GSEAresultTable(GS, GSDesc = TRUE)
tmp <- topGeneSets(GS, n=length(GS@GSNames), sortBy="FDR")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)
のStep2の出力結果ファイルです。
SeqGSEA (Wang and Cairns, BMC Bioinformatics)は、
exonレベル(Differential Splicing; DS)とgeneレベル(Differential Expression; DE)の2つの発現変動解析結果を統合して
よりよい遺伝子セット解析(Gene Set Enrichment Analysis; GSEA; Subramanian et al., 2005)を行うという手法ですが、
選択的スプライシング(Alternative Splicing; AS)が少ないあるいはない高等生物以外にも適用可能です。
ここでは、geneレベルの発現変動解析のみに基づくDE-only GSEAのやり方を示します。計算時間のボトルネックになっていたexonレベルの発現変動解析を含まないので高速に計算可能なため、
並べ替え回数を多くすることが可能です(500回で100分程度)。
以下では"c2.cp.kegg.v4.0.symbols.gmt"の解析を行っています。並べ替えを500回行って得られた
srp017142_SeqGSEA_c2cpkegg_gene1000.txtでは、FDR < 0.02を満たすPathwayは44個であることがわかります。
in_f1 <- "srp017142_count_bowtie.txt"
in_f2 <- "c2.cp.kegg.v4.0.symbols.gmt"
out_f <- "hoge2.txt"
param_G1 <- 3
param_G2 <- 3
param_perm <- 40
library(SeqGSEA)
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
tmp_colname <- colnames(data)
colnames(data) <- c(paste("E", 1:param_G1, sep=""), paste("C", 1:param_G2, sep=""))
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
time_s <- proc.time()
DEG <- runDESeq(data, as.factor(data.cl))
DEGres <- DENBStat4GSEA(DEG)
permuteMat <- genpermuteMat(as.factor(data.cl), times=param_perm)
DEpermNBstat <- DENBStatPermut4GSEA(DEG, permuteMat)
DEscore.normFac <- normFactor(DEpermNBstat)
DEscore <- scoreNormalization(DEGres$NBstat, DEscore.normFac)
DEscore.perm <- scoreNormalization(DEpermNBstat, DEscore.normFac)
gene.score <- geneScore(DEscore, DEweight=1)
gene.score.perm <- genePermuteScore(DEscore.perm, DEweight=1)
GS <- loadGenesets(in_f2, rownames(data), geneID.type = "ensembl")
GS <- GSEnrichAnalyze(GS, gene.score, gene.score.perm, weighted.type=1)
time_e <- proc.time()
time_e - time_s
#tmp <- GSEAresultTable(GS, GSDesc = TRUE)
tmp <- topGeneSets(GS, n=length(GS@GSNames), sortBy="FDR")
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
- GenomicFeatures：Lawrence et al., PLoS Comput. Biol., 2013
- SeqGSEA(パッケージの論文)：Wang et al., Bioinformatics, 2014
- SeqGSEA(の原著論文)：Wang and Cairns, BMC Bioinformatics, 2013
- DSGseq：Wang et al., Gene, 2013
- Molecular Signatures Database (MSigDB)：Subramanian et al., PNAS, 2005
- DESeq：Anders and Huber, Genome Biol, 2010
このあたりはほとんどノータッチです。菌叢解析(microbiome analysis)といういわゆるメタゲノム解析用のRパッケージもあるようです。
分類が正しいのかどうかもよくわかりません。
2014年12月に調査した結果をリストアップします。
phyloseqを用いて菌叢解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
目的のエクソン領域のみ効率的に濃縮してシークエンスすることで、SNPやインデル(indel)などエクソン(exon)領域中のの変異を検出するものです。
1,000人ゲノムプロジェクト(1000 Genomes Project Consortium, Nature, 2012)の解析などがこの範疇に含まれます。
basic alignerの一つであるBWAでマッピング後にGenome Analysis Toolkit (GATK)という変異検出プログラムを適用する解析パイプラインが王道のようです。
1,000人ゲノムのようなデータが出てきているのでこれらのpopulation (a collection of genomes)に対して効率的にマッピングを行うBWBBLEというプログラムなどが出始めています。
また、exome sequencingとexome microarrayの比較を行った論文(Wang et al., Front Genet., 2013)なども出ています。
2014年7月に調査した結果をリストアップします。
プログラム:
- BWA：Li and Durbin, Bioinformatics, 2009(BWA-shortの論文)
- BWA：Li and Durbin, Bioinformatics, 2010(BWA-SWの論文)
- GATK：McKenna et al., Genome Res., 2010
- Isaac：Raczy et al., Bioinformatics, 2013
- BWBBLE：Huang et al., Bioinformatics, 2013
- BAYSIC：Cantarel et al., BMC Bioinformatics, 2014
このあたりはほとんどノータッチです。
SraTailor (Oki et al., 2014)は、実験医学2014年12月号の「Close Up実験法」中で日本語による解説記事があります（沖 真弥氏提供情報）。
2015年2月に調査した結果をリストアップします。
R用:
- ChIPsim：Zhang et al., PLoS Comput. Biol., 2008
- PeakSeq法：Rozowsky et al., Nat Biotechnol., 2009
- CSAR：Kaufmann et al., PLoS Biol., 2009
- rMAT：Droit et al., Bioinformatics, 2010
- ChIPpeakAnno：Zhu et al., BMC Bioinformatics, 2010
- PICS：Zhang et al., Biometrics, 2011
- ChIPseqR：Humburg et al., BMC Bioinformatics, 2011
- DiffBind：Ross-Innes et al., Nature, 2012
- MEDIPS：Lienhard et al., Bioinformatics, 2014
- DSS：Feng et al., Nucleic Acids Res., 2014
- methylSig：Park et al., Bioinformatics, 2014
DiffBindを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
ChIPseqRを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
chipseqを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
PICSを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
ChIPpeakAnnoを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
rMATを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
CSARを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
ChIPsimを用いてChIP-seq解析を行うやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
rGADEMを用いたやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
cosmoを用いたやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
"chromosome conformation capture" (3C)は、DNAが細胞中でどのような立体的な配置(染色体の高次構造; chromosome conformation)をとっているか、
またどのような長距離ゲノム間相互作用(long-range genomic interactions)がなされているかを網羅的に調べるための実験技術です(Dekker et al., Science, 2002)。
その後、circular "chromosome conformation capture" (4C;
Zhao et al., Nat. Genet., 2006)、
"chromosome conformation capture" carbon copy (5C;
Dostie et al., Genome Res., 2006)、
Hi-C (
Lieberman-Aiden et al., Science, 2009)、
single-cell Hi-C (
Nagano et al., Nature, 2013)などの関連手法が提案されています。
ReviewとしてはDekker et al., Nat. Rev. Genet., 2013などが参考になると思います。
これらのクロマチン間の相互作用(chromatin interaction)を網羅的に検出すべく、NGSと組み合わされた"3C-seq"由来データが出てきています。
Rパッケージは、マップ後のBAM形式ファイルなどを入力として、統計的に有意な相互作用をレポートします。
2014年12月に調査した結果をリストアップします。
r3Cseqを用いたやり方を示します。
BAM形式ファイルを入力として、シス相互作用(cis-interaction; 同じ染色体上の異なる部位同士の相互作用)や
トランス相互作用(trans-interaction; 異なる染色体間の相互作用)を統計解析結果として出力します。
出力は、シンプルテキストファイルとbedGraphファイル(Kent et al., Genome Res., 2002)のようです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
Bisulfite sequencing (BS-seq; Bisulfite-seq)は、ゲノムDNAに対してbisulfite (重亜硫酸ナトリウム)処理を行った後にシーケンスを行う実験技術です。
BS-seqは、メチル化状態を検出するためのものです。bisulfite処理すると、メチル化されていないシトシン(C)はウラシル(U)に変換されます。
しかし、メチル化シトシンはUに変換されません。この性質を利用して、bisulfite処理後のDNAを鋳型にしてsequenceすれば、
メチル化シトシンのみCとして読まれ、それ以外はTとして読まれるので、メチル化の有無を区別することができるというものです。
但し、一般にマイクログラム程度のDNA量を必要とするため、一連の処理はPCR増幅のステップを含みます。
その後、アダプター付加(adapter ligation)後にbisulfite処理を行うのではなく、bisulfite処理後にアダプター付加を行うことでPCR増幅のステップを省いた
PBAT法(post-bisulfite adaptor tagging; Miura et al., Nucleic Acids Res., 2012)などの関連手法が開発されているようです。
2014年2月に調査した結果をリストアップします。
R以外：
- QDMR：Zhang et al., Nucleic Acids Res., 2011
- BiQ Analyzer HT：Lutsik et al., Nucleic Acids Res., 2011
- SAAP-RRBS：Sun et al.,Bioinformatics, 2012
- CpG_MPs：Su et al., Nucleic Acids Res., 2013
- DMEAS：He et al., Bioinformatics, 2013
BiSeqを用いたやり方を示します。
Bismark (Krueger et al., Bioinformatics, 2011)というBS-seq用マッピングプログラムの出力ファイルを入力として、
比較するグループ間でメチル化状態の異なる領域(Differentially Methylated Regions; DMRs)を出力します。
一般に、検定に供されるCpGサイトは100万(one million)以上になります。そのため、多重比較補正(multiple testing correction)後には、
ごく一部の明らかに差のある個所しか有意と判定されない傾向にあります(Bock C., Nat Rev Genet., 2012)。
BiSeqでは、階層的な検定手順(a hierarchical testing procedure; Benjamini and Heller, J Am Stat Assoc., 2007)を採用しています。
具体的には、最初のステップとして「領域(regions)」を単位として検定を行った後、検定の結果棄却された領域(rejected regions)内でより詳細な「個所(locations)」の検定を行う戦略を採用しています。
このように階層的に行うことで、検定数(number of hypothesis tests)を減らすことができ、ひいては検出力(statistical power)を上げることができるわけです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
bsseqを用いたやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
制限酵素消化（restriction enzyme digestion; RED）でアプローチ可能なところと不可能なところを区別できるとうれしいようです。
この制限酵素認識部位を調べるためのRパッケージだそうです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
segmentSeqパッケージを用いたやり方を示します。
ゲノム上のsmall interfering RNAs (siRNAs)が結合?!する場所を探してくれるようです。
主な特徴としては、従来の発見的な方法(heuristic method)では、siRNAsの複数個所の"loci"としてレポートしてしまっていたものを、
提案手法の経験ベイズ(empirical Bayesian methods)を用いることで必要以上に分割してしまうことなく"locus"としてレポートしてくれるようです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
ggplot2という美しい図を作成できるパッケージが存在します。私自身はまだ使ったことがありませんが、デフォルトの作図で気に入らない方は是非お試しください。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
マイクロアレイ解析のときにもよく見かけましたが、NGSデータでもデータの分布を示す目的などで用いられます。
解析 | 発現変動 | 2群間 | DESeq (Anders_2010)中でもM-A plotの描画法を示していますが、
ここではサンプルデータ2のSupplementaryTable2_changed.txtの
「G1群 5サンプル vs. G2群 5サンプル」の二群間比較データ(raw count; 特定の遺伝子領域にいくつリードがマップされたかをただカウントした数値データ)を用いていくつかの例を示します。
また、ここでは各群の値の平均値を用いています。
M-A plotについてよくわからない方は私の「2010/12/28のセミナー＠金沢」のスライドをごらんください。
この入力データファイルはver.48のEnsembl Gene IDのものであり、
各IDに対応するGene symbol情報などはイントロ | NGS | アノテーション情報取得(BioMart and biomaRt)の3を行って得られたens_gene_48.txt中に存在します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. raw countのデータ：
in_f <- "SupplementaryTable2_changed.txt"
param_G1 <- 5
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))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
param3 <- 1
abline(h=param3, col="red", lwd=1)
2. raw countのデータ(サイズを指定してpng形式で保存したいとき)：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge2.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(600, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid()
dev.off()
3. raw countのデータ(2を基本としてy軸の範囲をparam5で指定したいとき)：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge3.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(600, 400)
param5 <- c(-5, 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))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1, ylim=param5)
dev.off()
4. raw countのデータ(3を基本としてグリッドをparam6で指定した色およびparam7で指定した線のタイプで表示させたいとき)：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge4.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(600, 400)
param5 <- c(-5, 5)
param6 <- "gray"
param7 <- "solid"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1, ylim=param5)
grid(col=param6, lty=param7)
dev.off()
5. raw countのデータ(4を基本としてparam8で指定した任意のIDがどのあたりにあるかをparam9で指定した色で表示)：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge5.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(600, 400)
param5 <- c(-8, 8)
param6 <- "gray"
param7 <- "dotted"
param8 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")
param9 <- "red"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
obj <- is.element(rownames(data), param8)
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1, ylim=param5)
grid(col=param6, lty=param7)
points(x_axis[obj], y_axis[obj], col=param9)
dev.off()
data[obj,]
6. raw countのデータ(4を基本としてparam8で指定した原著論文中でRT-PCRで発現変動が確認された7遺伝子のGene symbolsがどのあたりにあるかをparam9で指定した色で表示)：
一見ややこしくて回りくどい感じですが、以下のような事柄に対処するために、ここで記述しているような集合演算テクニック(intersect, is.element (or %in%))を駆使することは非常に大事です：
- 一つのgene symbolが複数のEnsembl Gene IDsに対応することがよくある。
- BioMartなどから取得したIDの対応関係情報を含むアノテーションファイル(ens_gene_48.txt)中に、原著論文で言及されparam8で指定したgene symbolsが存在しない。
- 読み込んだ発現データファイル中にはあるがアノテーションファイル中には存在しないIDがある。
in_f1 <- "SupplementaryTable2_changed.txt"
in_f2 <- "ens_gene_48.txt"
out_f <- "hoge6.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(600, 400)
param5 <- c(-8, 8)
param6 <- "gray"
param7 <- "dotted"
param8 <- c("MMP25","SLC5A1","MDK","GPR64","CD38","GLOD5","FBXL6")
param9 <- "red"
data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="")
gs_annot <- tmp[,5]
names(gs_annot) <- tmp[,1]
gs_annot_sub <- intersect(gs_annot, param8)
obj_annot <- is.element(gs_annot, gs_annot_sub)
ensembl_annot_gs <- unique(names(gs_annot)[obj_annot])
ensembl_data_gs <- intersect(rownames(data), ensembl_annot_gs)
obj <- is.element(rownames(data), ensembl_data_gs)
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1, ylim=param5)
grid(col=param6, lty=param7)
points(x_axis[obj], y_axis[obj], col=param9)
dev.off()
ensembl_data_gs
data[obj,]
7. RPMデータ(library size normalizationを行ったデータでMA-plot)の場合：
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge7.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(600, 400)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
RPM <- sweep(data, 2, 1000000/colSums(data), "*")
data <- RPM
mean_G1 <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean))
mean_G2 <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean))
x_axis <- (mean_G1 + mean_G2)/2
y_axis <- mean_G2 - mean_G1
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(x_axis, y_axis, xlab="A = (log2(G2)+log2(G1))/2", ylab="M = log2(G2)-log2(G1)", pch=20, cex=.1)
grid()
dev.off()
ここではサンプルデータ2のSupplementaryTable2_changed.txtの
「G1群 5サンプル vs. G2群 5サンプル」の二群間比較データ(raw count; 特定の遺伝子領域にいくつリードがマップされたかをただカウントした数値データ)
とTCCパッケージから生成したシミュレーションデータとを用いて2例を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. raw countのデータ
in_f <- "SupplementaryTable2_changed.txt"
out_f <- "hoge1.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(380, 420)
library(ggplot2)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
colSums(data)
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
hoge <- data[,data.cl==1]
nf <- mean(colSums(hoge))/colSums(hoge)
G1 <- sweep(hoge, 2, nf, "*")
colSums(G1)
hoge <- data[,data.cl==2]
nf <- mean(colSums(hoge))/colSums(hoge)
G2 <- sweep(hoge, 2, nf, "*")
colSums(G2)
mean_G1 <- log2(apply(G1, 1, mean))
mean_G2 <- log2(apply(G2, 1, mean))
df <- data.frame(
A = (mean_G1 + mean_G2) / 2,
M = mean_G2 - mean_G1
)
head(df)
l <- ggplot(df, aes(x = A, y = M))
l <- l + geom_point(size = 2, pch = 20, na.rm = T)
l <- l + xlab("A value")
l <- l + ylab("M value")
plot(l)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(l)
dev.off()
2. シミュレーションデータ
TCCパッケージで生成される2群間比較用のシミュレーションデータを描きます。
シミュレーションデータの場合G1群で高発現しているDEGか、G2群で高発現しているDEGか、non-DEGかわかっいるため、それぞれ別々の色に塗ります。
out_f <- "hoge2.png"
param_G1 <- 5
param_G2 <- 5
param_fig <- c(380, 420)
library(TCC)
library(ggplot2)
tcc <- simulateReadCounts(replicates = c(param_G1, param_G2))
ma <- plot(tcc)
tag <- tcc$simulation$trueDEG
tag[tag == 0] <- "non-DEG"
tag[tag == 1] <- "DEG (G1)"
tag[tag == 2] <- "DEG (G2)"
df <- data.frame(
A = ma$a.value,
M = ma$m.value,
TYPE = as.factor(tag)
)
l <- ggplot(df, aes(x = A, y = M))
l <- l + geom_point(aes(colour = TYPE), size = 2, pch = 20, na.rm = T)
l <- l + xlab("A value")
l <- l + ylab("M value")
plot(l)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(l)
dev.off()
TCCパッケージ中の
clusterSample関数を利用したサンプル間クラスタリング結果をいろいろ整形するやり方を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
Neyret-Kahn et al., Genome Res., 2013の2群間比較用ヒトRNA-seqカウントデータです。
パイプライン | ゲノム | 発現変動 | 2群間 | 対応なし | 複製あり | SRP017142(Neyret-Kahn_2013)から得られます。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge1.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
2. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
1.との違いはplot関数実行時のオプションの部分のみです。下のほうの「hclust(*, "average")」という文字が消えていることが分かります。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge2.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, sub="")
dev.off()
3. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
2.との違いはplot関数実行時のオプションの部分のみです。下のほうの「d」という文字が消えていることが分かります。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge3.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, sub="", xlab="")
dev.off()
4. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
3.との違いはplot関数実行時のオプションの部分のみです。表示されているy軸名「Height」の文字の大きさを通常の1.5倍にしています。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge4.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, sub="", xlab="", cex.lab=1.5)
dev.off()
5. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
4.との違いはplot関数実行時のオプションの部分のみです。
表示されているy軸名「Height」の文字の大きさを通常の0.6倍にし、入力ファイル中のサンプル名の文字の大きさを通常の1.3倍にしています。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge5.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, sub="", xlab="", cex.lab=0.6, cex=1.3)
dev.off()
6. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
5.との違いはplot関数実行時のオプションの部分のみです。
y軸名を通常の1.2倍の「height kamo」に、そして図の上のほうのタイトル名が表示されないようにしてます。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge6.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="height kamo")
dev.off()
7. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
6.との違いはpar関数部分のみです。図の上下の余白を狭くして、図の左側のみ4行分空け、それ以外を1行分だけ開けるように指定しています。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge7.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(1, 4, 1, 1))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="height kamo")
dev.off()
8. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
7.との違いはpar関数実行時のオプションの部分のみです。
図の上下の余白を狭くして、図の左側のみ4行分、上を1行分空け、下と右を0行分だけ開けるように指定しています。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge8.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="height kamo")
dev.off()
9. 59,857 genes×6 samplesのリアルデータ(srp017142_count_bowtie.txt; 3 proliferative samples vs. 3 Ras samples)の場合：
8.との違いはpar関数実行時のオプションの部分のみです。
縦軸(y軸)の範囲はデフォルトでよきに計らってくれるので、8の結果から0.06未満であることがわかりますが、
ylim=c(0, 0.2)で縦軸の範囲を0から0.2と明示的に指定していますがうまく反映されないようです(爆)。
in_f <- "srp017142_count_bowtie.txt"
out_f <- "hoge9.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(0, 4, 1, 0))
plot(out, sub="", xlab="", cex.lab=1.2,
cex=1.3, main="", ylab="height kamo",
ylim=c(0.0, 0.2))
dev.off()
発現変動解析の手法比較系(バイオインフォマティクス系)の論文では、「真の発現変動遺伝子(true DEGs)」を予め決めておき、
どのDEG検出法が「真の発現変動遺伝子」をより上位にすることができるかを示す指標として、
「ROC曲線の下部面積(Area Under the ROC curve; AUC)」で方法の比較を行っています。このAUC値を計算するための基礎情報がROC曲線です。
必要な情報は2つのベクトルです。1つは何らかのランキング法を用いて発現変動の度合いで遺伝子をランキングした順位情報、
そしてもう1つはどの遺伝子が「真の発現変動遺伝子」かを示す0 or 1の情報です。
この項目では、全部で10遺伝子(gene1, gene2, ..., gene10)、そのうちgene1, 3, 5が真のDEGsという仮定で、様々なランキング結果でのROC曲線とAUC値、
および範囲を限定したAUC値(partial AUC)を考えます。
ここでは、ROC曲線の「横軸を"1-specificity"、縦軸を"sensitivity"」としていますが、同じ意味なので「横軸を"False Positive Rate (FPR)"、縦軸を"True Positive Rate (TPR)"」としてもよいです。
「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し以下をコピペ。
1. 真のDEGsに相当するgene1が2位、gene3が3位、gene5が1位の場合：
DEGsとnon-DEGsを完璧に区別できている理想的なランキング結果(AUC = 1)の例です。
param_rankで指定する際に1, 3, 5番目の要素のところのいずれかが1, 2, 3となっていればいいです。
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(2, 8, 3, 7, 1, 10, 5, 4, 9, 6)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
2. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
現実によく見かけるROC曲線やAUC値(=0.857)の一例です。
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
3. 真のDEGsに相当するgene1が2位、gene3が4位、gene5が3位の場合：
2.と同じAUC値(=0.857)ですが、ROC曲線が異なります。
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(2, 8, 4, 7, 3, 10, 5, 1, 9, 6)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
4. 真のDEGsに相当するgene1が2位、gene3が6位、gene5が1位の場合：
2.と同じAUC値(=0.857)ですが、ROC曲線が異なります。
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(2, 8, 6, 7, 1, 10, 5, 4, 9, 3)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
5. 真のDEGsに相当するgene1が2位、gene3が6位、gene5が1位の場合：
4.と同じですが、x軸が全範囲のfull AUC値(=0.857)だけでなく、param_thresで指定した範囲までに限定したpartial AUC値(=0.13333)も計算しています。
out_f <- "hoge5.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(2, 8, 6, 7, 1, 10, 5, 4, 9, 3)
param_fig <- c(400, 400)
param_thres <- 0.2
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
pAUC(out, t0 = param_thres)
6. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が10位の場合：
3つのDEGの平均順位が(1+5+10)/3 = 5.33位、7つのnon-DEGの平均順位が(2+3+4+6+7+8+9)/7 = 5.57位であることからも、full AUC値(=0.5238)が0.5付近にあることの妥当性が分かります。
out_f <- "hoge6.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 10, 2, 6, 4, 9, 3)
param_fig <- c(400, 400)
param_thres <- 0.2
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
pAUC(out, t0 = param_thres)
7. 真のDEGsに相当するgene1が8位、gene3が9位、gene5が10位の場合：
DEG検出を行っているつもりで、全non-DEGsが上位を占めている最悪のランキング結果(AUC = 0)の例です。
通常はこのようなことは起こりません。解析手順が間違っていると考えるのが妥当です。
out_f <- "hoge7.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(8, 1, 9, 7, 10, 2, 6, 4, 5, 3)
param_fig <- c(400, 400)
param_thres <- 0.2
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
pAUC(out, t0 = param_thres)
8. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
2.と基本的に同じで、ROC曲線の図を描くための感度(sensitivity)と特異度(specificity)の元の数値情報をテキストファイル形式で取得する例です。
out_f1 <- "hoge8.txt"
out_f2 <- "hoge8.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
tmp <- cbind(1 - out@spec, out@sens)
tmp <- tmp[order(tmp[, 1]), ]
colnames(tmp) <- c("1-sensitivity", "specificity")
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(out, xlab="1-specificity", ylab="sensitivity", main="ROC curve")
grid(col="gray", lty="dotted")
dev.off()
AUC(out)
「基礎1」では、主にDEGの順位情報を変えて、ROC曲線やAUC値がどのように変わっていくのかを中心に述べました。
この項目では、プロットの色、軸の数値の色、タイトル、x軸やy軸ラベルの色を様々な手段で指定するやり方を示します。
全部で10遺伝子(gene1, gene2, ..., gene10)、そのうちgene1, 3, 5が真のDEGsという仮定はそのままです。
R Console画面上で「?par」と打つとplot関数実行時に利用可能なオプションを調べることができます。
「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し以下をコピペ。
1. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
ROC曲線の色を赤色("red")で指定しています。デフォルトは"black"で、"green",
"blue", "orange", "yellow", "gray"などが指定できます。
R Console画面上で「colors()」と打つと、指定可能な色名をリストアップできます。
実際の色も同時に調べたい場合は「demo("colors")」と打ち込めばよい。
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity",
main="ROC curve", col=param_col)
grid(col="gray", lty="dotted")
dev.off()
2. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
色を数値で表しています。黒("black", 1), 赤("red", 2), 緑("green3", 3), 青("blue", 4), シアン("cyan", 5), マゼンタ("magenta", 6), 黄色("yellow", 7), 灰色("gray", 8)です。
R Console画面上で「palette()」と打つと、色名と要素番号の対応関係がわかりますが、8までで終わりなようです。
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- 7
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity", ylab="sensitivity",
main="ROC curve", col=param_col)
grid(col="gray", lty="dotted")
dev.off()
3. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
色をRGB (red, green, blue)の0-255の数値で指定するやり方です。
黒(0, 0, 0), 赤(255, 0, 0), 緑(0, 255, 0), 青(0, 0, 255), 黄色(255, 255, 0), マゼンタ(255, 0, 255), シアン(0, 255, 255), 白(255, 255, 255)です。
例えば、灰色でも(20, 0, 0)とすれば白に近い色となり、(200, 0, 0)とすれば黒に近い色になります。
黄緑色は黄色と緑の中間なので(123, 255, 0)、オレンジ色は赤と黄色の中間なので(255, 123, 0)のような感じで表現できます。
RGBで指定するときは、param_colの箇所以外にも、plot関数中のcolオプションのところの記述形式も変える必要がありますのでご注意ください。
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- c(255, 123, 0)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, xlab="1-specificity",
ylab="sensitivity",
main="ROC curve",
col=rgb(param_col[1], param_col[2], param_col[3], max=255))
grid(col="gray", lty="dotted")
dev.off()
4. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
ROC曲線の色をオレンジ色("orange")で指定しています。
それ以外にも、軸(col.axisオプション)、x軸とy軸のラベル(col.lab)、メインタイトル(col.main)、
ここでは出ていませんが図の下のほうにあるサブタイトル(col.sub)の色も任意に与えることができます。
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "orange"
param_col_axis <- "blue"
param_col_lab <- "cyan"
param_col_main <- "magenta"
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out,
main="ROC curve", col.main=param_col_main,
xlab="1-specificity", ylab="sensitivity",
col.lab=param_col_lab,
col.axis=param_col_axis,
col=param_col)
grid(col="gray", lty="dotted")
dev.off()
この項目では、プロット(cex)、軸の数値(cex.axis)、メインタイトル(cex.main)、x軸やy軸ラベル(cex.lab)、
サブタイトル(cex.sub)についての大きさの倍率を指定するやり方を示します。
基本的には1.0が通常の大きさで、0.5だと通常の0.5倍、
1.7だと通常の1.7倍の大きさで描画してくれます。
文字関連の大きさ調整を行うcexの他に、線分の幅を指定するlwd、線分の種類(実線やダッシュなど)を指定するltyの指定も行います。
全部で10遺伝子(gene1, gene2, ..., gene10)、そのうちgene1, 3, 5が真のDEGsという仮定はそのままです。
R Console画面上で「?par」と打つとplot関数実行時に利用可能なオプションを調べることができます。
「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し以下をコピペ。
1. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
param_colでROC曲線の色をオレンジ色("orange")で指定している他、
軸(cex.axisオプション)、x軸とy軸のラベル(cex.lab)、メインタイトル(cex.main)、
ここでは出ていませんが図の下のほうにあるサブタイトル(cex.sub)の大きさも任意に与えることができます。
尚、以下のparam_cexは実際には機能していません。理由はここではROC曲線の線のみであり、
param_cexはプロット中のtextやsymbolの大きさを指定するものだからです。
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "orange"
param_cex <- 2.0
param_cex_axis <- 1.2
param_cex_lab <- 0.7
param_cex_main <- 2.3
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out,
main="ROC curve", cex.main=param_cex_main,
xlab="1-specificity", ylab="sensitivity",
cex.lab=param_cex_lab,
cex.axis=param_cex_axis,
cex=param_cex, col=param_col)
grid(col="gray", lty="dotted")
dev.off()
2. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
ROC曲線の線分の幅を指定するlwdオプションの数値を変更しています。おそらくここで指定している数値は倍率に相当するものです。
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "orange"
param_lwd <- 2.5
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve",
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col)
grid(col="gray", lty="dotted")
dev.off()
3. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
ROC曲線の線分の種類をltyオプションで指定しています。colオプション同様、数値でも文字でも指定可能です。
実線("solid", 1), ダッシュ("dashed", 2), ドット("dotted", 3)あたりが基本だと思います。
他にも、透明("blank", 0), ドットとダッシュ両方("dotdash", 4), ("longdash", 5), ("twodash", 6)などがあります。
以下の例はロングダッシュを数値で指定しています。
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "orange"
param_lwd <- 4.6
param_lty <- 5
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve",
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
4. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
ROC曲線の線分の種類をltyオプションで指定しています。colオプション同様、数値でも文字でも指定可能です。
実線("solid", 1), ダッシュ("dashed", 2), ドット("dotted", 3)あたりが基本だと思います。
他にも、透明("blank", 0), ドットとダッシュ両方("dotdash", 4), ("longdash", 5), ("twodash", 6)などがあります。
以下の例は色を"blue"、幅を2.0、種類を"dashed"にしています。
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "blue"
param_lwd <- 2.0
param_lty <- "dashed"
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve",
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
この項目では、図の重ね書き時に必要なテクニックとして、annとaxesオプションの挙動を示します。
「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し以下をコピペ。
1. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
param_colでROC曲線の色を赤色("red")、線分の幅を1.5倍、
線分の種類を実線("solid")で示す他に、main, xlab, and ylabオプションを明記しなかった場合の結果を示しています。
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out,
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
2. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
plot関数実行時に、ann=Fオプションをつけるとxlabやylabを指定していても無視されることがわかります。
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, ann=F,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
3. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
メインタイトルのみ表示させたい場合のやり方です。
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve",
xlab="", ylab="",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
4. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
axes=Fとすると軸ラベルの数値が消えます。
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve", axes=F,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
この項目では、軸ラベルの表示角度を指定するlasオプションを示します。
「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し以下をコピペ。
1. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
las=0はデフォルト(ラベルを各軸に対して平行に描く)なので特に指定しないときと比べて変化はありません。
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
param_las <- 0
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve", las=param_las,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
2. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
las=1とすると、ラベルを全て水平に描くことができます。この場合、y軸の数値が時計回りに90度回っていることが分かります。
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
param_las <- 1
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve", las=param_las,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
3. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
las=2とすると、ラベルを各軸に対して垂直に描くことができます。特にx軸上のラベルを垂直に描けるので全て表示させたい場合に重宝します。
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
param_las <- 2
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve", las=param_las,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
4. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
las=3とすると、ラベルを全て垂直に描くことができます。
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
param_las <- 3
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out, main="ROC curve", las=param_las,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
この項目では、図の余白を指定するpar関数内で用いるmarオプションを示します。
「下、左、上、右」の順で余白を指定します。単位は「行」で、0が最も余白が小さく、大体5程度が最大です。
私の通常の使い方は「左以外は0に近い数値にする」です。
「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し以下をコピペ。
1. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
左側以外の余白を0行にした例です。上側のメインタイトル(ROC curveの文字)が切れていることが分かります。
また、下側の軸ラベルや軸タイトルも余白の関係上消えていることがわかります。
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
param_las <- 0
param_mar <- c(0, 4, 0, 0)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=param_mar)
plot(out, main="ROC curve", las=param_las,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
2. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
左側の余白を4行、下側の余白を2行にした例です。main=""として上側のメインタイトルの文字も消しています。
下側の余白が2行では、x軸タイトルの表示スペースがないことがわかります。
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
param_las <- 0
param_mar <- c(2, 4, 0, 0)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=param_mar)
plot(out, main="", las=param_las,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
3. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
左側の余白を4行、下側の余白を4行、それ以外の余白を0.5行にした例です。小数点の数値も指定できるようですね。
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
param_col <- "red"
param_lwd <- 1.5
param_lty <- "solid"
param_las <- 0
param_mar <- c(4, 4, 0.5, 0.5)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=param_mar)
plot(out, main="", las=param_las,
xlab="1-specificity", ylab="sensitivity",
lwd=param_lwd, col=param_col, lty=param_lty)
grid(col="gray", lty="dotted")
dev.off()
4. 真のDEGsに相当するgene1が5位、gene3が1位、gene5が3位の場合：
3.と同じです、私の普段使いでは、図のパラメータはこのようにそのまま書いちゃいます。
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_rank <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank))
obj[param_DEG] <- 1
out <- rocdemo.sca(truth = obj, data = -param_rank)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0.5, 0.5))
plot(out, main="", las=0,
xlab="1-specificity", ylab="sensitivity",
lwd=1.5, col="red", lty="solid")
grid(col="gray", lty="dotted")
dev.off()
この項目では、図の重ね書き時に指定するpar関数内で用いるnewオプションを示します。
基本的には、par(new=T)を書くだけです。
ここでは、ランキング結果1の数値ベクトルがc(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)、
ランキング結果2がc(3, 1, 6, 2, 5, 10, 7, 4, 9, 8)、
ランキング結果3がc(4, 8, 1, 3, 2, 10, 7, 5, 9, 6)
として2つのランキング結果の重ね合わせや3つの結果の重ね合わせの例を示します。
「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し以下をコピペ。
1. 2つのランキング結果の重ね書きを行う場合：
ランキング結果1("red")とランキング結果2("blue")の重ね合わせの基本形です。
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_rank1 <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_rank2 <- c(3, 1, 6, 2, 5, 10, 7, 4, 9, 8)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -param_rank1)
out2 <- rocdemo.sca(truth = obj, data = -param_rank2)
AUC(out1)
AUC(out2)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out1, axes=F, ann=F, col="red")
par(new=T)
plot(out2, col="blue")
dev.off()
2. 2つのランキング結果の重ね書きを行う場合：
x軸、y軸ラベル情報とグリッドを追加しています。
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_rank1 <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_rank2 <- c(3, 1, 6, 2, 5, 10, 7, 4, 9, 8)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -param_rank1)
out2 <- rocdemo.sca(truth = obj, data = -param_rank2)
AUC(out1)
AUC(out2)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out1, axes=F, ann=F, col="red")
par(new=T)
plot(out2, col="blue",
xlab="1-specificity", ylab="sensitivity")
grid(col="gray", lty="dotted")
dev.off()
3. 2つのランキング結果の重ね書きを行う場合：
図の余白を指定しているほか、lwdで線分の幅をランキング結果1(3.9倍)とランキング結果2(2.3倍)でそれぞれ指定しています。
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_rank1 <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_rank2 <- c(3, 1, 6, 2, 5, 10, 7, 4, 9, 8)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -param_rank1)
out2 <- rocdemo.sca(truth = obj, data = -param_rank2)
AUC(out1)
AUC(out2)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0.3, 0.3))
plot(out1, axes=F, ann=F,
col="red", lwd=3.9)
par(new=T)
plot(out2, col="blue", lwd=2.3,
xlab="1-specificity", ylab="sensitivity")
grid(col="gray", lty="dotted")
dev.off()
4. 3つのランキング結果の重ね書きを行う場合：
ランキング結果1("red")とランキング結果2("blue")とランキング結果3("magenta")の重ね合わせの基本形です。
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_rank1 <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_rank2 <- c(3, 1, 6, 2, 5, 10, 7, 4, 9, 8)
param_rank3 <- c(4, 8, 1, 3, 2, 10, 7, 5, 9, 6)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -param_rank1)
out2 <- rocdemo.sca(truth = obj, data = -param_rank2)
out3 <- rocdemo.sca(truth = obj, data = -param_rank3)
AUC(out1)
AUC(out2)
AUC(out3)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out1, axes=F, ann=F, col="red")
par(new=T)
plot(out2, axes=F, ann=F, col="blue")
par(new=T)
plot(out3, col="magenta")
dev.off()
5. 3つのランキング結果の重ね書きを行う場合：
図の余白、ltyで線分の種類、lwdで線分の幅などいろいろ指定しています。
out_f <- "hoge5.png"
param_DEG <- c(1, 3, 5)
param_rank1 <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_rank2 <- c(3, 1, 6, 2, 5, 10, 7, 4, 9, 8)
param_rank3 <- c(4, 8, 1, 3, 2, 10, 7, 5, 9, 6)
param_fig <- c(400, 400)
library(ROC)
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -param_rank1)
out2 <- rocdemo.sca(truth = obj, data = -param_rank2)
out3 <- rocdemo.sca(truth = obj, data = -param_rank3)
AUC(out1)
AUC(out2)
AUC(out3)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0, 0))
plot(out1, axes=F, ann=F,
col="red", lwd=2.0, lty="dotted")
par(new=T)
plot(out2, axes=F, ann=F,
col="blue", lwd=3.0, lty="dashed")
par(new=T)
plot(out3, col="magenta",
lwd=1.0, lty="solid",
xlab="1-specificity", ylab="sensitivity")
grid(col="gray", lty="dotted")
dev.off()
6. 3つのランキング結果の重ね書きを行う場合：
5.と基本的に同じです。このくらいの数になってくるとparamのところで最初に書き込んでおくほうがミスが少なくなります。
cex.lab=1.5は軸ラベルの文字の大きさを通常の1.5倍にするという意味です。
out_f <- "hoge6.png"
param_DEG <- c(1, 3, 5)
param_rank1 <- c(5, 8, 1, 7, 3, 10, 2, 4, 9, 6)
param_rank2 <- c(3, 1, 6, 2, 5, 10, 7, 4, 9, 8)
param_rank3 <- c(4, 8, 1, 3, 2, 10, 7, 5, 9, 6)
param_fig <- c(400, 400)
param_col <- c("red", "blue", "magenta")
param_lwd <- c(2.0, 3.0, 1.0)
param_lty <- c("dotted", "dashed", "solid")
library(ROC)
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -param_rank1)
out2 <- rocdemo.sca(truth = obj, data = -param_rank2)
out3 <- rocdemo.sca(truth = obj, data = -param_rank3)
AUC(out1)
AUC(out2)
AUC(out3)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0, 0))
plot(out1, axes=F, ann=F,
col=param_col[1], lwd=param_lwd[1], lty=param_lty[1])
par(new=T)
plot(out2, axes=F, ann=F,
col=param_col[2], lwd=param_lwd[2], lty=param_lty[2])
par(new=T)
plot(out3, col=param_col[3],
lwd=param_lwd[3], lty=param_lty[3],
xlab="1-specificity", ylab="sensitivity",
cex.lab=1.5)
grid(col="gray", lty="dotted")
dev.off()
7. 3つのランキング結果の重ね書きを行う場合：
6.と基本的に同じです。ランキング結果のタブ区切りテキストファイル(roc_ranking.txt)から読み込むやり方です。
in_f <- "roc_ranking.txt"
out_f <- "hoge7.png"
param_DEG <- c(1, 3, 5)
param_fig <- c(400, 400)
param_col <- c("red", "blue", "magenta")
param_lwd <- c(2.0, 3.0, 1.0)
param_lty <- c("dotted", "dashed", "solid")
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -data[, 1])
out2 <- rocdemo.sca(truth = obj, data = -data[, 2])
out3 <- rocdemo.sca(truth = obj, data = -data[, 3])
AUC(out1)
AUC(out2)
AUC(out3)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0, 0))
plot(out1, axes=F, ann=F,
col=param_col[1], lwd=param_lwd[1], lty=param_lty[1])
par(new=T)
plot(out2, axes=F, ann=F,
col=param_col[2], lwd=param_lwd[2], lty=param_lty[2])
par(new=T)
plot(out3, col=param_col[3],
lwd=param_lwd[3], lty=param_lty[3],
xlab="1-specificity", ylab="sensitivity",
cex.lab=1.5)
grid(col="gray", lty="dotted")
dev.off()
この項目では、凡例を追加するlegend関数の基本的な使用法を示します。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
1. 3つのランキング結果のタブ区切りテキストファイル(roc_ranking.txt)の場合：
入力ファイル中にランキング法の名前が書きこまれているのでそれを利用しています。
ROC曲線は右上には必ず曲線が描かれるので、右下("bottomright")に描いています。
bottomright以外に"bottom", "bottomleft", "left", "topleft", "top", "topright", "right", "center"を指定可能です。
in_f <- "roc_ranking.txt"
out_f <- "hoge1.png"
param_DEG <- c(1, 3, 5)
param_fig <- c(400, 400)
param_col <- c("red", "blue", "magenta")
param_lwd <- c(2.0, 3.0, 1.0)
param_lty <- c("dotted", "dashed", "solid")
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -data[, 1])
out2 <- rocdemo.sca(truth = obj, data = -data[, 2])
out3 <- rocdemo.sca(truth = obj, data = -data[, 3])
AUC(out1)
AUC(out2)
AUC(out3)
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0, 0))
plot(out1, axes=F, ann=F,
col=param_col[1], lwd=param_lwd[1], lty=param_lty[1])
par(new=T)
plot(out2, axes=F, ann=F,
col=param_col[2], lwd=param_lwd[2], lty=param_lty[2])
par(new=T)
plot(out3, col=param_col[3],
lwd=param_lwd[3], lty=param_lty[3],
xlab="1-specificity", ylab="sensitivity",
cex.lab=1.5)
grid(col="gray", lty="dotted")
legend(x="bottomright",
legend=colnames(data),
col=param_col,
lwd=param_lwd,
lty=param_lty,
merge=T)
dev.off()
2. 3つのランキング結果のタブ区切りテキストファイル(roc_ranking.txt)の場合：
legendの位置を右側("right")にし、AUC値も一緒に凡例の中に示すやり方の基本形です。
AUC値の小数点以下の桁数がそのまま表示されています。また、方法名とAUC値の間に"_"を入れています。
in_f <- "roc_ranking.txt"
out_f <- "hoge2.png"
param_DEG <- c(1, 3, 5)
param_fig <- c(400, 400)
param_col <- c("red", "blue", "magenta")
param_lwd <- c(2.0, 3.0, 1.0)
param_lty <- c("dotted", "dashed", "solid")
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -data[, 1])
out2 <- rocdemo.sca(truth = obj, data = -data[, 2])
out3 <- rocdemo.sca(truth = obj, data = -data[, 3])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0, 0))
plot(out1, axes=F, ann=F,
col=param_col[1], lwd=param_lwd[1], lty=param_lty[1])
par(new=T)
plot(out2, axes=F, ann=F,
col=param_col[2], lwd=param_lwd[2], lty=param_lty[2])
par(new=T)
plot(out3, col=param_col[3],
lwd=param_lwd[3], lty=param_lty[3],
xlab="1-specificity", ylab="sensitivity",
cex.lab=1.5)
grid(col="gray", lty="dotted")
auc <- c(AUC(out1), AUC(out2), AUC(out3))
colnames(data)
hoge <- paste(colnames(data), auc, sep="_")
legend(x="right",
legend=hoge,
col=param_col,
lwd=param_lwd,
lty=param_lty,
merge=T)
dev.off()
3. 3つのランキング結果のタブ区切りテキストファイル(roc_ranking.txt)の場合：
legendの位置を右側("bottomright")にし、「方法名(AUC=XX)」のような書き方にする基本形です。
in_f <- "roc_ranking.txt"
out_f <- "hoge3.png"
param_DEG <- c(1, 3, 5)
param_fig <- c(400, 400)
param_col <- c("red", "blue", "magenta")
param_lwd <- c(2.0, 3.0, 1.0)
param_lty <- c("dotted", "dashed", "solid")
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -data[, 1])
out2 <- rocdemo.sca(truth = obj, data = -data[, 2])
out3 <- rocdemo.sca(truth = obj, data = -data[, 3])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0, 0))
plot(out1, axes=F, ann=F,
col=param_col[1], lwd=param_lwd[1], lty=param_lty[1])
par(new=T)
plot(out2, axes=F, ann=F,
col=param_col[2], lwd=param_lwd[2], lty=param_lty[2])
par(new=T)
plot(out3, col=param_col[3],
lwd=param_lwd[3], lty=param_lty[3],
xlab="1-specificity", ylab="sensitivity",
cex.lab=1.5)
grid(col="gray", lty="dotted")
auc <- c(AUC(out1), AUC(out2), AUC(out3))
hoge <- paste(colnames(data), "(AUC=", auc, ")", sep="")
hoge
legend(x="bottomright",
legend=hoge,
col=param_col,
lwd=param_lwd,
lty=param_lty,
merge=T)
dev.off()
4. 3つのランキング結果のタブ区切りテキストファイル(roc_ranking.txt)の場合：
AUC値の表示桁数を小数点以下3桁までにするやり方です。
in_f <- "roc_ranking.txt"
out_f <- "hoge4.png"
param_DEG <- c(1, 3, 5)
param_fig <- c(400, 400)
param_col <- c("red", "blue", "magenta")
param_lwd <- c(2.0, 3.0, 1.0)
param_lty <- c("dotted", "dashed", "solid")
library(ROC)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
obj <- rep(0, length(param_rank1))
obj[param_DEG] <- 1
out1 <- rocdemo.sca(truth = obj, data = -data[, 1])
out2 <- rocdemo.sca(truth = obj, data = -data[, 2])
out3 <- rocdemo.sca(truth = obj, data = -data[, 3])
png(out_f, pointsize=13, width=param_fig[1], height=param_fig[2])
par(mar=c(4, 4, 0, 0))
plot(out1, axes=F, ann=F,
col=param_col[1], lwd=param_lwd[1], lty=param_lty[1])
par(new=T)
plot(out2, axes=F, ann=F,
col=param_col[2], lwd=param_lwd[2], lty=param_lty[2])
par(new=T)
plot(out3, col=param_col[3],
lwd=param_lwd[3], lty=param_lty[3],
xlab="1-specificity", ylab="sensitivity",
cex.lab=1.5)
grid(col="gray", lty="dotted")
auc <- c(AUC(out1), AUC(out2), AUC(out3))
sprintf("%.4f", auc)
sprintf("%6.2f", auc)
hoge <- paste(colnames(data), "(AUC=", sprintf("%.3f", auc), ")", sep="")
hoge
legend(x="bottomright",
legend=hoge,
col=param_col,
lwd=param_lwd,
lty=param_lty,
merge=T)
dev.off()
私の2008,2009年の論文では、
主にRT-PCRで発現変動が確認された遺伝子を「真の発現変動遺伝子(true DEGs)」とし、どの発現変動遺伝子のランキング法が「真の発現変動遺伝子」をより上位にすることができるかを示す指標として、
「ROC曲線の下部面積(Area Under the ROC curve; AUC)」で方法の比較を行っています。このAUC値を計算するための基礎情報がROC曲線です。
必要な情報は2つのベクトルです。1つは何らかのランキング法を用いて発現変動の度合いで遺伝子をランキングした順位情報、
そしてもう1つはどの遺伝子が「真の発現変動遺伝子」かを示す0 or 1の情報です。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
「G1群 5サンプル vs. G2群 5サンプル」の2群間比較データです。「真の発現変動遺伝子」の情報をparam3で指定するやり方です。
in_f <- "SupplementaryTable2_changed.txt"
param_G1 <- 5
param_G2 <- 5
param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")
param4 <- "False Positive Rate (FPR)"
param5 <- "True Positive Rate (TPR)"
param6 <- "ROC curves for raw count data"
library(ROC)
library(baySeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
groups <- list(NDE=rep(1, (param_G1+param_G2)), DE=data.cl)
data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)
data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)
out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL)
out@estProps
stat_bayseq <- out@posteriors[,2]
rank_bayseq <- rank(-stat_bayseq, ties.method="min")
obj <- is.element(rownames(data), param3)
obj[obj == "TRUE"] <- 1
out <- rocdemo.sca(truth = obj, data =-rank_bayseq)
plot(out, xlab=param4, ylab=param5, main=param6)
AUC(out)
2. 「1.を基本としつつ、さらにもう一つのランキング法を実行して、二つのROC曲線を重ね書きしたい」場合：
in_f <- "SupplementaryTable2_changed.txt"
param_G1 <- 5
param_G2 <- 5
param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")
param4 <- "False Positive Rate (FPR)"
param5 <- "True Positive Rate (TPR)"
param6 <- "ROC curves for raw count data"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
library(ROC)
library(baySeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
groups <- list(NDE=rep(1, (param_G1+param_G2)), DE=data.cl)
data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)
data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)
out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL)
out@estProps
stat_bayseq <- out@posteriors[,2]
rank_bayseq <- rank(-stat_bayseq, ties.method="min")
datalog <- log2(data + 1)
stat_AD <- AD(data=datalog, data.cl=data.cl)
rank_AD <- rank(-abs(stat_AD), ties.method="min")
obj <- is.element(rownames(data), param3)
obj[obj == "TRUE"] <- 1
out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq)
plot(out1, axes=F, ann=F)
par(new=T)
out2 <- rocdemo.sca(truth = obj, data =-rank_AD)
plot(out2, xlab=param4, ylab=param5, main=param6)
AUC(out)
3. 「2.を基本としつつ、ランキング法ごとに指定した色にしたい」場合：
in_f <- "SupplementaryTable2_changed.txt"
param_G1 <- 5
param_G2 <- 5
param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")
param4 <- "False Positive Rate (FPR)"
param5 <- "True Positive Rate (TPR)"
param6 <- "ROC curves for raw count data"
param7 <- c( 0, 0, 0)
param8 <- c(255, 0, 0)
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
library(ROC)
library(baySeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
groups <- list(NDE=rep(1, (param_G1+param_G2)), DE=data.cl)
data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)
data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)
out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL)
out@estProps
stat_bayseq <- out@posteriors[,2]
rank_bayseq <- rank(-stat_bayseq, ties.method="min")
datalog <- log2(data + 1)
stat_AD <- AD(data=datalog, data.cl=data.cl)
rank_AD <- rank(-abs(stat_AD), ties.method="min")
obj <- is.element(rownames(data), param3)
obj[obj == "TRUE"] <- 1
out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq)
plot(out1, axes=F, ann=F, col=rgb(param7[1], param7[2], param7[3], max=255))
par(new=T)
out2 <- rocdemo.sca(truth = obj, data =-rank_AD)
plot(out2, xlab=param4, ylab=param5, main=param6, col=rgb(param8[1], param8[2], param8[3], max=255))
AUC(out1)
AUC(out2)
4. 「3.を基本としつつ、legendも追加したい(ここではとりあえず「lwd=1」としてますが線分の形式をいろいろ変えることができます(詳細はこちら))」場合：
in_f <- "SupplementaryTable2_changed.txt"
param_G1 <- 5
param_G2 <- 5
param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")
param4 <- "False Positive Rate (FPR)"
param5 <- "True Positive Rate (TPR)"
param6 <- "ROC curves for raw count data"
param7 <- c( 0, 0, 0)
param8 <- c(255, 0, 0)
param9 <- "baySeq"
param10 <- "AD"
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
library(ROC)
library(baySeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
groups <- list(NDE=rep(1, (param_G1+param_G2)), DE=data.cl)
data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)
data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)
out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL)
out@estProps
stat_bayseq <- out@posteriors[,2]
rank_bayseq <- rank(-stat_bayseq, ties.method="min")
datalog <- log2(data + 1)
stat_AD <- AD(data=datalog, data.cl=data.cl)
rank_AD <- rank(-abs(stat_AD), ties.method="min")
obj <- is.element(rownames(data), param3)
obj[obj == "TRUE"] <- 1
out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq)
plot(out1, axes=F, ann=F, col=rgb(param7[1], param7[2], param7[3], max=255))
par(new=T)
out2 <- rocdemo.sca(truth = obj, data =-rank_AD)
plot(out2, xlab=param4, ylab=param5, main=param6, col=rgb(param8[1], param8[2], param8[3], max=255))
legend(0.6, 0.3,
c(param9, param10),
col=c(rgb(param7[1], param7[2], param7[3], max=255),
rgb(param8[1], param8[2], param8[3], max=255)
),
lwd=1,
merge=TRUE
)
AUC(out1)
AUC(out2)
5. 「4」と同じ結果だがパラメータの指定法が違う場合(多数の方法を一度に描画するときに便利です)：
in_f <- "SupplementaryTable2_changed.txt"
param_G1 <- 5
param_G2 <- 5
param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")
param4 <- "False Positive Rate (FPR)"
param5 <- "True Positive Rate (TPR)"
param6 <- "ROC curves for raw count data"
param7 <- list("baySeq", c( 0, 0, 0))
param8 <- list("AD", c(255, 0, 0))
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")
library(ROC)
library(baySeq)
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
groups <- list(NDE=rep(1, (param_G1+param_G2)), DE=data.cl)
data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)
data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)
out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL)
out@estProps
stat_bayseq <- out@posteriors[,2]
rank_bayseq <- rank(-stat_bayseq, ties.method="min")
datalog <- log2(data + 1)
stat_AD <- AD(data=datalog, data.cl=data.cl)
rank_AD <- rank(-abs(stat_AD), ties.method="min")
obj <- is.element(rownames(data), param3)
obj[obj == "TRUE"] <- 1
out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq)
plot(out1, axes=F, ann=F, col=rgb(param7[[2]][1], param7[[2]][2], param7[[2]][3], max=255))
par(new=T)
out2 <- rocdemo.sca(truth = obj, data =-rank_AD)
plot(out2, xlab=param4, ylab=param5, main=param6, col=rgb(param8[[2]][1], param8[[2]][2], param8[[2]][3], max=255))
legend(0.6, 0.3,
c(param7[[1]], param8[[1]]),
col=c(rgb(param7[[2]][1], param7[[2]][2], param7[[2]][3], max=255),
rgb(param8[[2]][1], param8[[2]][2], param8[[2]][3], max=255)
),
lwd=1,
merge=TRUE
)
AUC(out1)
AUC(out2)
選択的スプライシング（Alternative Splicing; AS）はグラフで表現可能です（Sammeth, 2009）。
SplicingGraphsというパッケージはそれをうまく作成できるようです。
「ファイル」−「ディレクトリの変更」で解析したいファイルを置いてあるディレクトリに移動し以下をコピペ。
ここの項目では、公共DBからのRNA-seqデータ取得から、マッピング、カウントデータ取得、発現変動解析までの一連のコマンドを示します。
2013年秋頃にRのみで一通り行えるようにしたので記述内容を大幅に変更しています。
Neyret-Kahn et al., Genome Res., 2013の2群間比較用ヒトRNA-seqデータ (3 proliferative samples vs. 3 Ras samples)が
GSE42213に登録されています。
ここでは、SRAdbパッケージを用いたそのFASTQ形式ファイルのダウンロードから、
QuasRパッケージを用いたマッピングおよびカウントデータ取得、
そしてTCCパッケージを用いた発現変動遺伝子(DEG)検出までを行う一連の手順を示します。
原著論文(Neyret-Kahn et al., Genome Res., 2013)では72-baseと書いてますが、取得ファイルは54-baseしかありません。
また、ヒトサンプルなのになぜかマウスゲノム("mm9")にマップしたと書いているのも意味不明です。
ちなみ54 bpと比較的長いリードであり、原著論文中でもsplice-aware alignerの一つであるTopHat (Trapnell et al., Bioinformatics, 2009)を用いてマッピングを行ったと記述していますが、
ここでは、(計算時間短縮のため)basic alignerの一つであるBowtieをQuasRの内部で用いています。
多数のファイルが作成されるので、ここでは「デスクトップ」上に「SRP017142」というフォルダを作成しておき、そこで作業を行うことにします。
Step1. RNA-seqデータのgzip圧縮済みのFASTQファイルをダウンロード：
論文中の記述からGSE42213を頼りに、
RNA-seqデータがGSE42212として収められていることを見出し、
その情報からSRP017142にたどり着いています。
したがって、ここで指定するのは"SRP017142"となります。
計6ファイル、合計6Gb程度の容量のファイルがダウンロードされます。東大の有線LANで一時間弱程度かかります。
早く終わらせたい場合は、最後のgetFASTQfile関数のオプションを'ftp'から'fasp'に変更すると時間短縮可能です。
イントロ | NGS | 配列取得 | FASTQ or SRA | SRAdb(Zhu_2013)の記述内容と基本的に同じです。
param <- "SRP017142"
library(SRAdb)
#sqlfile <- "SRAmetadb.sqlite"
sqlfile <- getSRAdbFile()
sra_con <- dbConnect(SQLite(), sqlfile)
hoge <- sraConvert(param, sra_con=sra_con)
hoge
apply(hoge, 2, unique)
getFASTQinfo(in_acc=hoge$run)
getFASTQfile(hoge$run, srcType='ftp')
無事ダウンロードが終了すると、作業ディレクトリ（「デスクトップ」上の「SRP017142」フォルダ）中に7つのファイルが存在するはずです。
4Gb程度ある"SRAmetadb.sqlite"ファイルは無視して構いません。残りの"SRR"からはじまる6つのファイルがダウンロードしたRNA-seqデータです。
オリジナルのサンプル名(の略称)で対応関係を表すとsrp017142_samplename.txtのようになっていることがわかります。
尚このファイルはマッピング時の入力ファイルとしても用います。
Step2. ヒトゲノムへのマッピングおよびカウントデータ取得：
マップしたいFASTQファイルリストおよびそのサンプル名を記述したsrp017142_samplename.txtを作業ディレクトリに保存したうえで、下記を実行します。
BSgenomeパッケージで利用可能なBSgenome.Hsapiens.UCSC.hg19へマッピングしています。
名前から推測できるように"UCSC"の"hg19"にマップしているのと同じです。basic alignerの一つであるBowtieを内部的に用いており、ここではマッピング時のオプションをデフォルトにしています。
原著論文中で用いられたTopHatと同じsplice-aware alignerののカテゴリに含まれるSpliceMap (Au et al., Nucleic Acids Res., 2010)
を利用したい場合は、qAlign関数実行のところでsplicedAlignmentオプションをBowtieに対応する"F"からSpliceMapに対応する"T"に変更してください。hg19にマップした結果であり、TranscriptDbオブジェクト取得時のゲノム情報もそれを基本として
Ensembl Genes ("ensGene")を指定しているので、Ensembl Gene IDに対するカウントデータ取得になっています。
マシンパワーにもよりますが、ノートPCでも10時間程度で終わると思います。
マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)の記述内容と基本的に同じです。
in_f1 <- "srp017142_samplename.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f1 <- "srp017142_QC_bowtie.pdf"
out_f2 <- "srp017142_count_bowtie.txt"
out_f3 <- "srp017142_genelength.txt"
out_f4 <- "srp017142_RPKM_bowtie.txt"
out_f5 <- "srp017142_transcript_seq.fa"
out_f6 <- "srp017142_other_info1.txt"
param1 <- "hg19"
param2 <- "ensGene"
param3 <- "gene"
library(QuasR)
library(GenomicFeatures)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2,
splicedAlignment=F)
time_e <- proc.time()
qQCReport(out, pdfFilename=out_f1)
palette("default")
txdb <- makeTranscriptDbFromUCSC(genome=param1, tablename=param2)
count <- qCount(out, txdb, reportLevel=param3)
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
genelength <- count[,1]
tmp <- cbind(names(genelength), genelength)
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
nf_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, nf_RPM, "*")
nf_RPK <- 1000/genelength
RPKM <- sweep(RPM, 1, nf_RPK, "*")
tmp <- cbind(rownames(RPKM), RPKM)
write.table(tmp, out_f4, sep="\t", append=F, quote=F, row.names=F)
library(in_f2, character.only=T)
tmp <- ls(paste("package", in_f2, sep=":"))
genome <- eval(parse(text=tmp))
fasta <- extractTranscriptSeqs(genome, txdb)
fasta
writeXStringSet(fasta, file=out_f5, format="fasta", width=50)
sink(out_f6)
cat("1. Computation time for mapping (in second).\n")
time_e - time_s
cat("\n\n2. Options used for mapping.\n")
out@alignmentParameter
cat("\n\n3. Alignment statistics.\n")
alignmentStats(out)
cat("\n\n4. Gene annotation info.\n")
txdb
cat("\n\n5. Session info.\n")
sessionInfo()
sink()
無事マッピングが終了すると、指定した6つのファイルが生成されているはずです。
- QCレポートファイル(srp017142_QC_bowtie.pdf)：Quality Controlレポートです。よく利用されるFastQCのようなものです。
- カウントデータファイル(srp017142_count_bowtie.txt)：グループ(サンプル)間での発現変動遺伝子同定に用います。
- 遺伝子配列長情報ファイル(srp017142_genelength.txt)：配列長とカウント数の関係を調べたいときなどに用います。これはおまけです。
- RPKM補正後のファイル(srp017142_RPKM_bowtie.txt)：同一サンプル内での発現レベルの大小関係を知りたいときなどに用います。
- 転写物塩基配列ファイル(srp017142_transcript_seq.fa)：(遺伝子ではなく)転写物の塩基配列のmulti-FASTAファイルです。参考まで。
- その他の各種情報ファイル(srp017142_other_info1.txt)：論文作成時に必要な、マッピング時に用いたオプション情報、マップされたリード数、Rおよび用いたパッケージのバージョン情報などを含みます。
Step3. サンプル間クラスタリング：
カウントデータ(srp017142_count_bowtie.txt)を用いてサンプル間の全体的な類似度を眺めることを目的として、
サンプル間クラスタリングを行います。類似度は「1-Spearman相関係数」、方法は平均連結法で行っています。
TCC論文(Sun et al., 2013)のFig.3でも同じ枠組みでクラスタリングを行った結果を示していますので、英語論文執筆時の参考にどうぞ。
PearsonではなくSpearmanで行っているのは、ダイナミックレンジが広いので、順序尺度程度にしておいたほうがいいだろうという思想が一番大きいです。
log2変換してダイナミックレンジを圧縮してPearsonにするのも一般的には「アリ」だとは思いますが、マップされたリード数が100万以上あるにも関わらずRPKMデータを用いると、RPKM補正後の値が1未満のものがかなり存在すること、
そしてlogをとれるようにゼロカウントデータの処理が必要ですがやりかた次第で結果がころころかわりうるという状況が嫌なので、RNA-seqデータの場合には私はSpearman相関係数にしています。
また、ベクトルの要素間の差を基本とするdistance metrics (例：ユークリッド距離やマンハッタン距離など)は、比較的最近のRNA-seqデータ正規化法
(TMM: Robinson and Oshlack, 2010, TbT: Kadota et al., 2012, TCC; Sun et al., 2013)論文の重要性が理解できれば、その類似度は少なくともfirst choiceにならないと思われます。
つまり、サンプルごとに転写物の組成比が異なるため、RPMやCPMのような総リード数を補正しただけのデータを用いて「サンプル間の数値の差」に基づいて距離を定めるのはいかがなものか？という思想です。
逆に、ユークリッド距離などを用いてクラスタリングを行った結果と比較することで、転写物の組成比に関する知見が得られるのかもしれません。
さらに、全体的な発現レベルが低いものを予めフィルタリングしておく必要もあるのだろうとは思います。このあたりは、真の回答はありませんので、
(手持ちのデータにこの類似度を適用したときの理論上の短所をきちんと理解したうえで)いろいろ試すというのは重要だとは思います。
ここではカウントデータでクラスタリングをしていますが、おそらく配列長補正後のRPKMデータ(srp017142_RPKM_bowtie.txt)
でも得られる樹形図のトポロジー(相対的な位置関係)はほぼ同じになるのではないかと思っています。配列長補正の有無で、サンプル間の相関係数の値自体は変わりますが、
同じグループに属するサンプルであれば反復実験間でそれほど違わないので、多少順位に変動があっても全体としては相殺されるはずです...が確証はありません。
in_f3 <- "srp017142_count_bowtie.txt"
out_f6 <- "srp017142_count_cluster.png"
param_fig <- c(500, 400)
data <- read.table(in_f3, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
obj <- as.logical(rowSums(data) > 0)
data <- unique(data[obj,])
dim(data)
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method="average")
png(out_f6, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
無事計算が終了すると、指定したファイル(srp017142_count_cluster.png)が生成されているはずです。
Step4. 発現変動遺伝子(DEG)同定：
カウントデータファイル(srp017142_count_bowtie.txt)を入力として2群間で発現の異なる遺伝子の検出を行います。
このデータはbiological replicatesありのデータなので、TCCパッケージ(Sun et al., 2013)の推奨ガイドラインに従って、
iDEGES/edgeR正規化(Sun et al., 2013; Robinson et al., 2010; Robinson and Oshlack, 2010; Robinson and Smyth, 2008)を行ったのち、
edgeRパッケージ中のan exact test (Robinson and Smyth, 2008)を行って、DEG検出を行っています。
解析 | 発現変動 | 2群間 | 対応なし | 複製あり | TCC(Sun_2013)および
正規化 | サンプル間 | 2群間 | 複製あり | iDEGES/edgeR(Sun_2013)の記述内容と基本的に同じです。
in_f4 <- "srp017142_count_bowtie.txt"
out_f7 <- "srp017142_DEG_bowtie.txt"
out_f8 <- "srp017142_MAplot_bowtie.png"
out_f9 <- "srp017142_other_info2.txt"
param_G1 <- 3
param_G2 <- 3
param_FDR <- 0.05
param_fig <- c(430, 390)
library(TCC)
data <- read.table(in_f4, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
normalized <- getNormalizedData(tcc)
tmp <- cbind(rownames(tcc$count), normalized, result)
write.table(tmp, out_f7, sep="\t", append=F, quote=F, row.names=F)
png(out_f8, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(tcc, FDR=param_FDR)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sink(out_f9)
cat("1. Numbers of DEGs satisfying several FDR thresholds.\n")
cat("FDR < 0.05:");print(sum(tcc$stat$q.value < 0.05))
cat("FDR < 0.10:");print(sum(tcc$stat$q.value < 0.10))
cat("FDR < 0.20:");print(sum(tcc$stat$q.value < 0.20))
cat("FDR < 0.30:");print(sum(tcc$stat$q.value < 0.30))
cat("\n\n2. Session info.\n")
sessionInfo()
sink()
無事計算が終了すると、指定した3つのファイルが生成されているはずです。
- 発現変動解析結果ファイル(srp017142_DEG_bowtie.txt)：iDEGES/edgeR-edgeRパイプラインによるDEG同定結果です。
"rank"列でソートすると発現変動の度合い順になります。"q.value"列の情報は任意のFDR閾値を満たす遺伝子数を調べるときに用います。
尚、左側の実数の数値データはiDEGES/edgeR正規化後のデータです。M-A plotはこの数値データに基づいて作成されています。尚、配列長補正は掛かっておりませんのでご注意ください。
- M-A plotファイル(srp017142_MAplot_bowtie.png)：M versus A plotです。横軸が平均発現レベル(右側が高発現、左側が低発現)。縦軸がlog(G2/G1)で、0より下がG1群で高発現、0より上がG2群で高発現です。
- その他の各種情報ファイル(srp017142_other_info2.txt)：FDR < 0.05, 0.1, 0.2, 0.3を満たす遺伝子数、論文作成時に必要な、Rおよび用いたパッケージのバージョン情報(特にTCC)などを含みます。
Step5. iDEGES/edgeR正規化後のデータに配列長補正を実行：
カウントデータファイル(srp017142_count_bowtie.txt)と遺伝子配列長情報ファイル(srp017142_genelength.txt)を入力として
TCCパッケージ(Sun et al., 2013)の推奨ガイドラインに従って、
iDEGES/edgeR正規化(Sun et al., 2013; Robinson et al., 2010; Robinson and Oshlack, 2010; Robinson and Smyth, 2008)を行ったのち、
配列長補正(Reads per kilobase (RPK) or Counts per kilobase (CPK))を実行した結果を返します。
そろそろ誰かが論文で公式に言い出すかもしれません(既にどこかで書かれているかも...)が、RPM (Reads per million)が提唱されたのは、総リード数が100万程度だった時代です。
今はマップされた総リード数が数千万リードという時代ですので、RPM or RPKMのような100万にするような補正後のデータだと、
(細かい点をすっとばすと)せっかく読んだ総リード数の桁が増えてもダイナミックレンジが広くなりようがありません。
iDEGES/edgeR正規化後のデータは、マップされた総リード数の中央値(median)に合わせているので、リード数が増えるほどダイナミックレンジは広くなります。
しかし、これ自体は配列長補正がかかっていないため、RPKMデータと似たような「配列長補正まで行った後のiDEGES/edgeR正規化データ」があったほうが嬉しいヒトがいるのかな、ということで提供しています。
利用法としては、サンプル間クラスタリングを行う際に、順位相関係数以外のサンプルベクトル中の要素間の差に基づくユークリッド距離やマンハッタン距離をどうしても使いたい場合には
RPKMのようなデータを使うよりはこちらの正規化データのほうがnon-DEG間の距離がより0に近い値になるから直感的にはいいのではと思っています。
ただし、iDEGES/edgeR正規化を行うときにサンプルのラベル情報を用いていながら(supervised learningみたいなことを行っている)、
unsupervised learningの一種であるクラスタリングを行う、ということの妥当性についてはよくわかりません。
正規化 | サンプル間 | 2群間 | 複製あり | iDEGES/edgeR(Sun_2013)と
正規化 | 基礎 | RPK or CPK (配列長補正)の記述内容と基本的に同じです。
in_f4 <- "srp017142_count_bowtie.txt"
in_f5 <- "srp017142_genelength.txt"
out_f10 <- "srp017142_normalized_bowtie.txt"
param_G1 <- 3
param_G2 <- 3
library(TCC)
data <- read.table(in_f4, header=TRUE, row.names=1, sep="\t", quote="")
len <- read.table(in_f5, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
normalized <- getNormalizedData(tcc)
nf <- 1000/len[,1]
normalizedK <- sweep(normalized, 1, nf, "*")
tmp <- cbind(rownames(tcc$count), normalizedK)
write.table(tmp, out_f10, sep="\t", append=F, quote=F, row.names=F)
無事計算が終了すると、配列長補正まで行った後のiDEGES/edgeR正規化データファイル(srp017142_normalized_bowtie.txt)が生成されているはずです。
- SRP017142：Neyret-Kahn et al., Genome Res., 2013
- SRAdb：Zhu et al., BMC Bioinformatics, 2013
- QuasR：Gaidatzis et al., Bioinformatics, 2014
- TCC：Sun et al., BMC Bioinformatics, 2013
- Bowtie：Langmead et al., Genome Biol., 2009
- SpliceMap：Au et al., Nucleic Acids Res., 2010
- GenomicFeatures：Lawrence et al., PLoS Comput. Biol., 2013
- edgeR：Robinson et al., Bioinformatics, 2010
- TMM正規化法：Robinson and Oshlack, Genome Biol., 2010
- an exact test for negative binomial distribution：Robinson and Smyth, Biostatistics, 2008
Neyret-Kahn et al., Genome Res., 2013の2群間比較用ヒトRNA-seqデータ (3 proliferative samples vs. 3 Ras samples)が
GSE42213に登録されています。
ここでは、ファイルのダウンロードから、マッピング、カウントデータ取得、機能解析までを行う一連の手順を示します。
多数のファイルが作成されるので、ここでは「デスクトップ」上に「SRP017142」というフォルダを作成しておき、そこで作業を行うことにします。
Step1. RNA-seqデータのgzip圧縮済みのFASTQファイルをダウンロード：
論文中の記述からGSE42213を頼りに、
RNA-seqデータがGSE42212として収められていることを見出し、
その情報からSRP017142にたどり着いています。
したがって、ここで指定するのは"SRP017142"となります。
計6ファイル、合計6Gb程度の容量のファイルがダウンロードされます。東大の有線LANで一時間弱程度かかります。
早く終わらせたい場合は、最後のgetFASTQfile関数のオプションを'ftp'から'fasp'に変更すると時間短縮可能です。
イントロ | NGS | 配列取得 | FASTQ or SRA | SRAdb(Zhu_2013)の記述内容と基本的に同じです。
param <- "SRP017142"
library(SRAdb)
#sqlfile <- "SRAmetadb.sqlite"
sqlfile <- getSRAdbFile()
sra_con <- dbConnect(SQLite(), sqlfile)
hoge <- sraConvert(param, sra_con=sra_con)
hoge
apply(hoge, 2, unique)
getFASTQinfo(in_acc=hoge$run)
getFASTQfile(hoge$run, srcType='ftp')
無事ダウンロードが終了すると、作業ディレクトリ（「デスクトップ」上の「SRP017142」フォルダ）中に7つのファイルが存在するはずです。
4Gb程度ある"SRAmetadb.sqlite"ファイルは無視して構いません。残りの"SRR"からはじまる6つのファイルがダウンロードしたRNA-seqデータです。
オリジナルのサンプル名(の略称)で対応関係を表すとsrp017142_samplename.txtのようになっていることがわかります。
尚このファイルはマッピング時の入力ファイルとしても用います。
Step2. ヒトゲノムへのマッピングおよびカウントデータ取得：
マップしたいFASTQファイルリストおよびそのサンプル名を記述したsrp017142_samplename.txtを作業ディレクトリに保存したうえで、下記を実行します。
BSgenomeパッケージで利用可能なBSgenome.Hsapiens.UCSC.hg19へマッピングしています。
名前から推測できるように"UCSC"の"hg19"にマップしているのと同じです。
basic alignerの一つであるBowtieを内部的に用いており、
ここではマッピング時のオプションを"-m 1 --best --strata -v 2"にしています。
hg19にマップした結果なので、TranscriptDbオブジェクト取得時のゲノム情報もそれを基本として
Ensembl Genes ("ensGene")を指定しているので、Ensembl Gene IDに対するカウントデータ取得になっています。
但し、機能解析で用いるSeqGSEAパッケージの入力に合わせて、
exonレベルのカウントデータとして取得しています。マシンパワーにもよりますが、ノートPCでも10時間程度で終わると思います。
マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)の記述内容と基本的に同じです。
in_f1 <- "srp017142_samplename.txt"
in_f2 <- "BSgenome.Hsapiens.UCSC.hg19"
out_f1 <- "srp017142_QC_bowtie2.pdf"
out_f2 <- "srp017142_count_bowtie2.txt"
out_f3 <- "srp017142_genelength2.txt"
out_f4 <- "srp017142_RPKM_bowtie2.txt"
out_f5 <- "srp017142_transcript_seq2.fa"
out_f6 <- "srp017142_other_info1_2.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param1 <- "hg19"
param2 <- "ensGene"
param3 <- "exon"
library(QuasR)
library(GenomicFeatures)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping)
time_e <- proc.time()
qQCReport(out, pdfFilename=out_f1)
palette("default")
txdb <- makeTranscriptDbFromUCSC(genome=param1, tablename=param2)
count <- qCount(out, txdb, reportLevel=param3)
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
genelength <- count[,1]
tmp <- cbind(names(genelength), genelength)
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
nf_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, nf_RPM, "*")
nf_RPK <- 1000/genelength
RPKM <- sweep(RPM, 1, nf_RPK, "*")
tmp <- cbind(rownames(RPKM), RPKM)
write.table(tmp, out_f4, sep="\t", append=F, quote=F, row.names=F)
library(in_f2, character.only=T)
tmp <- ls(paste("package", in_f2, sep=":"))
genome <- eval(parse(text=tmp))
fasta <- extractTranscriptSeqs(genome, txdb)
fasta
writeXStringSet(fasta, file=out_f5, format="fasta", width=50)
sink(out_f6)
cat("1. Computation time for mapping (in second).\n")
time_e - time_s
cat("\n\n2. Options used for mapping.\n")
out@alignmentParameter
cat("\n\n3. Alignment statistics.\n")
alignmentStats(out)
cat("\n\n4. Gene annotation info.\n")
txdb
cat("\n\n5. Session info.\n")
sessionInfo()
sink()
無事マッピングが終了すると、指定した6つのファイルが生成されているはずです。
- QCレポートファイル(srp017142_QC_bowtie2.pdf)：Quality Controlレポートです。よく利用されるFastQCのようなものです。
- カウントデータファイル(srp017142_count_bowtie2.txt)：グループ(サンプル)間での発現変動遺伝子同定に用います。
- 遺伝子配列長情報ファイル(srp017142_genelength2.txt)：配列長とカウント数の関係を調べたいときなどに用います。これはおまけです。
- RPKM補正後のファイル(srp017142_RPKM_bowtie2.txt)：同一サンプル内での発現レベルの大小関係を知りたいときなどに用います。
- 転写物塩基配列ファイル(srp017142_transcript_seq2.fa)：(遺伝子ではなく)転写物の塩基配列のmulti-FASTAファイルです。参考まで。
- その他の各種情報ファイル(srp017142_other_info1_2.txt)：論文作成時に必要な、マッピング時に用いたオプション情報、マップされたリード数、Rおよび用いたパッケージのバージョン情報などを含みます。
Step3. 機能解析：
カウントデータファイル(srp017142_count_bowtie2.txt)を入力として
SeqGSEAを用いて機能解析を行います。
このパッケージは基本的にexonレベルのカウントデータを入力とするので、その前提で行っています。
また、統計的有意性の評価にサンプルラベル情報の並べ替え(permutation)戦略を採用しているため、
各グループあたりの反復数が5以上のデータを想定しているようです。また、計算時間を半端なく要します（10時間とか）。
それゆえ、本来このデータセットはグループあたりの反復数が3しかないので、適用外ということになります。
Step2に引き続いて行う場合には、dataとtxdbオブジェクトの構築を行う必要は本来ありません。
同様の理由でtxdbオブジェクトの作成に必要なparam1とparam2も必要ありませんが、
これらのアノテーション情報を利用していることが既知であるという前提のもとで行っています。
最終的に欲しいReadCountSetクラスオブジェクトは、「カウントデータ、gene ID、exon ID」の3つの情報から構築されます。
しかし、txdbオブジェクトから得られるgene IDとexon IDはshared exonを含むので、曖昧性を排除するためこれらを除去する必要があります。
それゆえ、hoge2中のexon IDを抽出して一回しか出現しなかったIDをhoge4として取得し、
もとのhoge2オブジェクトの並びで取得しなおしたものがexonIDsとgeneIDsオブジェクトです。
exonレベルカウントデータもshared exonの情報を含むので、それらを除いたものを取得しています。
SeqGSEAでの機能解析の基本はexonレベルとgeneレベルの発現変動解析結果を組み合わせてGSEAを行うというものです(Wang and Cairns, 2013)。
SeqGSEA著者たちは、exonレベルの発現変動解析のことをDifferential splicing (DS) analysisと呼んでいて、
おそらくDSGseqはSeqGSEA中に組み込まれていると思います。
そしてgeneレベルの発現変動解析をdifferential expression (DE) analysisとして、SeqGSEA中では
DESeqを利用しています。
GSEAに代表される発現変動遺伝子セット解析は、基本的にGSEAの開発者らが作成した様々な遺伝子セット情報を収めたMolecular Signatures Database (MSigDB)からダウンロードした.gmt形式ファイルを読み込んで解析を行います。
*gmt形式ファイルのダウンロード方法は、基本的に以下の通りです：
- Molecular Signatures Database (MSigDB)の
「register」のページで登録し、遺伝子セットをダウンロード可能な状態にする。
- Molecular Signatures Database (MSigDB)の
「Download gene sets」の"Download"のところをクリックし、Loginページで登録したe-mail addressを入力。
- これでMSigDBのダウンロードページに行けるので、
「c5: gene ontology gene sets」の「BP: biological process」を解析したい場合はc5.bp.v4.0.symbols.gmtファイルをダウンロードしておく。
「c2: curated gene sets」の「KEGG gene sets」を解析したい場合はc2.cp.kegg.v4.0.symbols.gmtファイルをダウンロードしておく。
「c3: motif gene sets」を解析したい場合はc3.all.v4.0.symbols.gmtファイルをダウンロードしておく。
以下ではc5.bp.v4.0.symbols.gmtの解析を行っています。
また、並べ替え回数がたったの20回でも2時間ちょっとかかります(Panasonic Let's note CF-SX3本郷モデルの場合)のでご注意ください。
推奨は1000回以上と書いてますが、個人的にはアリエナイですね。。。
in_f4 <- "srp017142_count_bowtie2.txt"
in_f5 <- "c5.bp.v4.0.symbols.gmt"
out_f7 <- "srp017142_SeqGSEA_c5bp.txt"
param_G1 <- 3
param_G2 <- 3
param_perm <- 20
param1 <- "hg19"
param2 <- "ensGene"
library(SeqGSEA)
library(GenomicFeatures)
data <- read.table(in_f4, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
tmp_colname <- colnames(data)
colnames(data) <- c(paste("E", 1:param_G1, sep=""), paste("C", 1:param_G2, sep=""))
txdb <- makeTranscriptDbFromUCSC(genome=param1, tablename=param2)
hoge1 <- exonsBy(txdb, by=c("gene"))
hoge2 <- unlist(hoge1)
hoge2
hoge3 <- table(hoge2$exon_id)
hoge4 <- names(hoge3)[hoge3 == 1]
obj <- is.element(as.character(hoge2$exon_id), hoge4)
exonIDs <- as.character(hoge2$exon_id)[obj]
geneIDs <- names(hoge2)[obj]
data <- data[exonIDs,]
#rownames(data) <- paste(geneIDs, exonIDs, sep=":")
dim(data)
exonIDs <- paste("E", exonIDs, sep="")
RCS <- newReadCountSet(data, exonIDs, geneIDs)
RCS
RCS <- exonTestability(RCS, cutoff = 5)
geneTestable <- geneTestability(RCS)
RCS <- subsetByGenes(RCS, unique(geneID(RCS))[geneTestable])
RCS
time_DS_s <- proc.time()
RCS <- estiExonNBstat(RCS)
RCS <- estiGeneNBstat(RCS)
head(fData(RCS)[, c("exonIDs", "geneIDs", "testable", "NBstat")])
permuteMat <- genpermuteMat(RCS, times=param_perm)
RCS <- DSpermute4GSEA(RCS, permuteMat)
DSscore.normFac <- normFactor(RCS@permute_NBstat_gene)
DSscore <- scoreNormalization(RCS@featureData_gene$NBstat, DSscore.normFac)
DSscore.perm <- scoreNormalization(RCS@permute_NBstat_gene, DSscore.normFac)
RCS <- DSpermutePval(RCS, permuteMat)
head(DSresultGeneTable(RCS))
time_DS_e <- proc.time()
time_DS_e - time_DS_s
time_DE_s <- proc.time()
geneCounts <- getGeneCount(RCS)
head(geneCounts)
DEG <- runDESeq(geneCounts, label(RCS))
DEGres <- DENBStat4GSEA(DEG)
DEpermNBstat <- DENBStatPermut4GSEA(DEG, permuteMat)
DEscore.normFac <- normFactor(DEpermNBstat)
DEscore <- scoreNormalization(DEGres$NBstat, DEscore.normFac)
DEscore.perm <- scoreNormalization(DEpermNBstat, DEscore.normFac)
DEGres <- DEpermutePval(DEGres, DEpermNBstat)
head(DEGres)
time_DE_e <- proc.time()
time_DE_e - time_DE_s
combine <- rankCombine(DEscore, DSscore, DEscore.perm, DSscore.perm, DEweight = 0.3)
gene.score <- combine$geneScore
gene.score.perm <- combine$genePermuteScore
GS <- loadGenesets(in_f5, unique(geneID(RCS)), geneID.type = "ensembl")
GS <- GSEnrichAnalyze(GS, gene.score, gene.score.perm)
#tmp <- GSEAresultTable(GS, GSDesc = TRUE)
tmp <- topGeneSets(GS, n=length(GS@GSNames), sortBy="FDR")
write.table(tmp, out_f7, sep="\t", append=F, quote=F, row.names=F)
無事計算が終了すると、指定したファイル(srp017142_SeqGSEA_c5bp.txt)が生成されているはずです。
このファイルは並べ替え回数を30回(param_perm <- 30)にして実行した結果です。
permutation p-valueに基づく結果であり並べ替え回数が少ないので、同じ数値を指定した計算結果でも、全く同じ数値や並びになっているとは限りませんのでご注意ください。
例えば、このファイルの場合は、FDR < 0.05未満のものが22個(遺伝子セット名が"CYTOKINESIS"から"INNATE_IMMUNE_RESPONSE"まで)あると解釈します。
- SRP017142：Neyret-Kahn et al., Genome Res., 2013
- DDBJ Sequence Read Archive (DRA)：Kodama et al., Nucleic Acids Res., 2012
- QuasR：Gaidatzis et al., Bioinformatics, 2014
- Bowtie：Langmead et al., Genome Biol., 2009
- GenomicFeatures：Lawrence et al., PLoS Comput. Biol., 2013
- SeqGSEA(パッケージの論文)：Wang et al., Bioinformatics, 2014
- SeqGSEA(の原著論文)：Wang and Cairns, BMC Bioinformatics, 2013
- DSGseq：Wang et al., Gene, 2013
- Molecular Signatures Database (MSigDB)：Subramanian et al., PNAS, 2005
Huang et al., Development, 2012の2群間比較用シロイヌナズナRNA-seqデータ (4 DEX-treated vs. 4 mock-treated)が
GSE36469に登録されています。
ここでは、SRAdbパッケージを用いたそのFASTQ形式ファイルのダウンロードから、
QuasRパッケージを用いたマッピングおよびカウントデータ取得、
そしてTCCパッケージを用いた発現変動遺伝子(DEG)検出までを行う一連の手順を示します。
多数のファイルが作成されるので、ここでは「デスクトップ」上に「SRP011435」というフォルダを作成しておき、そこで作業を行うことにします。
Step1. RNA-seqデータのgzip圧縮済みのFASTQファイルをダウンロード：
論文中の記述からGSE36469を頼りに、
RNA-seqデータがGSE36469として収められていることを見出し、
その情報からSRP011435にたどり着いています。
したがって、ここで指定するのは"SRP011435"となります。
計8ファイル、合計10Gb程度の容量のファイルがダウンロードされます。東大の有線LANで2時間程度かかります。
早く終わらせたい場合は、最後のgetFASTQfile関数のオプションを'ftp'から'fasp'に変更すると時間短縮可能です。
イントロ | NGS | 配列取得 | FASTQ or SRA | SRAdb(Zhu_2013)の記述内容と基本的に同じです。
param <- "SRP011435"
library(SRAdb)
#sqlfile <- "SRAmetadb.sqlite"
sqlfile <- getSRAdbFile()
sra_con <- dbConnect(SQLite(), sqlfile)
hoge <- sraConvert(param, sra_con=sra_con)
hoge
apply(hoge, 2, unique)
getFASTQinfo(in_acc=hoge$run)
getFASTQfile(hoge$run, srcType='ftp')
無事ダウンロードが終了すると、作業ディレクトリ（「デスクトップ」上の「SRP011435」フォルダ）中に9つのファイルが存在するはずです。
4Gb程度ある"SRAmetadb.sqlite"ファイルは無視して構いません。残りの"SRR"からはじまる8つのファイルがダウンロードしたRNA-seqデータです。
オリジナルのサンプル名(の略称)で対応関係を表すとsrp011435_samplename.txtのようになっていることがわかります。
尚このファイルはマッピング時の入力ファイルとしても用います。
Step2. シロイヌナズナ(A. thaliana)ゲノムへのマッピングおよびカウントデータ取得：
マップしたいFASTQファイルリストおよびそのサンプル名を記述したsrp011435_samplename.txtを作業ディレクトリに保存したうえで、下記を実行します。
BSgenomeパッケージで利用可能なBSgenome.Athaliana.TAIR.TAIR9へマッピングしています。
名前から推測できるように"TAIR"の"TAIR9"にマップしているのと同じです。BSgenome.Athaliana.TAIR.TAIR9パッケージインストールされていない場合は自動でインストールしてくれるので特に気にする必要はありません。
basic alignerの一つであるBowtieを内部的に用いており、ここではマッピング時のオプションをデフォルトにしています。
原著論文中で用いられたTopHatと同じsplice-aware alignerののカテゴリに含まれるSpliceMap (Au et al., Nucleic Acids Res., 2010)
を利用したい場合は、qAlign関数実行のところでsplicedAlignmentオプションをBowtieに対応する"F"からSpliceMapに対応する"T"に変更してください。
TAIR9にマップした結果であり、UCSCからはArabidopsisの遺伝子アノテーション情報が提供されていないため、
TAIR10_GFF3_genes.gffを予めダウンロードしておき、makeTranscriptDbFromGFF関数を用いてTranscriptDbオブジェクトを作成しています。
マシンパワーにもよりますが、ノートPCでも10時間程度で終わると思います。
マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)の記述内容と基本的に同じです。
in_f1 <- "srp011435_samplename.txt"
in_f2 <- "BSgenome.Athaliana.TAIR.TAIR9"
in_f3 <- "TAIR10_GFF3_genes.gff"
out_f1 <- "srp011435_QC_bowtie.pdf"
out_f2 <- "srp011435_count_bowtie.txt"
out_f3 <- "srp011435_genelength.txt"
out_f4 <- "srp011435_RPKM_bowtie.txt"
out_f5 <- "srp011435_transcript_seq.fa"
out_f6 <- "srp011435_other_info1.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param3 <- "gene"
library(QuasR)
library(GenomicFeatures)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping,
splicedAlignment=F)
time_e <- proc.time()
qQCReport(out, pdfFilename=out_f1)
palette("default")
time_e - time_s
txdb <- makeTranscriptDbFromGFF(in_f3)
count <- qCount(out, txdb, reportLevel=param3)
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
genelength <- count[,1]
tmp <- cbind(names(genelength), genelength)
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
nf_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, nf_RPM, "*")
nf_RPK <- 1000/genelength
RPKM <- sweep(RPM, 1, nf_RPK, "*")
tmp <- cbind(rownames(RPKM), RPKM)
write.table(tmp, out_f4, sep="\t", append=F, quote=F, row.names=F)
library(in_f2, character.only=T)
tmp <- ls(paste("package", in_f2, sep=":"))
genome <- eval(parse(text=tmp))
fasta <- extractTranscriptSeqs(genome, txdb)
fasta
writeXStringSet(fasta, file=out_f5, format="fasta", width=50)
sink(out_f6)
cat("1. Computation time for mapping (in second).\n")
time_e - time_s
cat("\n\n2. Options used for mapping.\n")
out@alignmentParameter
cat("\n\n3. Alignment statistics.\n")
alignmentStats(out)
cat("\n\n4. Gene annotation info.\n")
txdb
cat("\n\n5. Session info.\n")
sessionInfo()
sink()
無事マッピングが終了すると、指定した6つのファイルが生成されているはずです。
- QCレポートファイル(srp011435_QC_bowtie.pdf)：Quality Controlレポートです。よく利用されるFastQCのようなものです。
- カウントデータファイル(srp011435_count_bowtie.txt)：グループ(サンプル)間での発現変動遺伝子同定に用います。
- 遺伝子配列長情報ファイル(srp011435_genelength.txt)：配列長とカウント数の関係を調べたいときなどに用います。これはおまけです。
- RPKM補正後のファイル(srp011435_RPKM_bowtie.txt)：同一サンプル内での発現レベルの大小関係を知りたいときなどに用います。
- 転写物塩基配列ファイル(srp011435_transcript_seq.fa)：(遺伝子ではなく)転写物の塩基配列のmulti-FASTAファイルです。参考まで。
- その他の各種情報ファイル(srp011435_other_info1.txt)：論文作成時に必要な、マッピング時に用いたオプション情報、マップされたリード数、Rおよび用いたパッケージのバージョン情報などを含みます。
Step2. シロイヌナズナ(A. thaliana)ゲノムへのマッピングおよびカウントデータ取得(リファレンスがmulti-FASTAファイルの場合)：
マップしたいFASTQファイルリストおよびそのサンプル名を記述したsrp011435_samplename.txtを作業ディレクトリに保存したうえで、下記を実行します。
シロイヌナズナのゲノム配列ファイル(TAIR10_chr_all.fas)へマッピングしています。
但し、マッピングに用いるQuasRパッケージ中のqAlign関数がリファレンス配列ファイルの拡張子として"*.fasta", "*.fa", "*.fna"しか認識してくれません。
また、カウントデータを取得するために遺伝子アノテーションファイル(TAIR10_GFF3_genes.gff)を利用する必要がありますが、
このファイル中の染色体名と揃える必要があるため、TAIR10_chr_all.fasファイル中のdescription部分をparamで指定した文字列に置換したファイル(tmp_genome.fasta)を中間ファイルとして作成しています。
TAIR10_GFF3_genes.gffを予めダウンロードしておき、makeTranscriptDbFromGFF関数を用いてTranscriptDbオブジェクトを作成しています。
マシンパワーにもよりますが、ノートPCでも10時間程度で終わると思います。マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)の記述内容と基本的に同じです。
2014年5月2日までextractTranscriptsFromGenome関数を用いて転写物配列情報を取得していましたが、「'extractTranscriptsFromGenome' is deprecated. Use 'extractTranscriptSeqs' instead.」
という警告メッセージが出たので、extractTranscriptSeqs関数に変更しています。尚、Step2のトータル計算時間はノートPCで7時間程度です。
in_f <- "TAIR10_chr_all.fas"
out_f <- "tmp_genome.fasta"
param <- c("Chr1","Chr2","Chr3","Chr4","Chr5","ChrM","ChrC")
library(Biostrings)
fasta <- readDNAStringSet(in_f, format="fasta")
fasta
names(fasta) <- param
fasta
writeXStringSet(fasta, file=out_f, format="fasta", width=50)
in_f1 <- "srp011435_samplename.txt"
in_f2 <- "tmp_genome.fasta"
in_f3 <- "TAIR10_GFF3_genes.gff"
out_f1 <- "srp011435_QC_bowtie_2.pdf"
out_f2 <- "srp011435_count_bowtie_2.txt"
out_f3 <- "srp011435_genelength_2.txt"
out_f4 <- "srp011435_RPKM_bowtie_2.txt"
#out_f5 <- "srp011435_transcript_seq_2.fa"
out_f6 <- "srp011435_other_info1_2.txt"
param_mapping <- "-m 1 --best --strata -v 2"
param3 <- "gene"
library(QuasR)
library(GenomicFeatures)
#library(Rsamtools)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2, alignmentParameter=param_mapping,
splicedAlignment=F)
time_e <- proc.time()
qQCReport(out, pdfFilename=out_f1)
palette("default")
time_e - time_s
txdb <- makeTranscriptDbFromGFF(in_f3)
count <- qCount(out, txdb, reportLevel=param3)
data <- count[,-1]
tmp <- cbind(rownames(data), data)
write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)
genelength <- count[,1]
tmp <- cbind(names(genelength), genelength)
write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)
nf_RPM <- 1000000/colSums(data)
RPM <- sweep(data, 2, nf_RPM, "*")
nf_RPK <- 1000/genelength
RPKM <- sweep(RPM, 1, nf_RPK, "*")
tmp <- cbind(rownames(RPKM), RPKM)
write.table(tmp, out_f4, sep="\t", append=F, quote=F, row.names=F)
#fasta_trans <- extractTranscriptSeqs(FaFile(in_f2), txdb)
#fasta_trans <- extractTranscriptSeqs(FaFile(in_f2), exonsBy(txdb, by="tx", use.names=TRUE))
#fasta_trans <- extractTranscriptSeqs(FaFile(in_f2), cdsBy(txdb, by="tx", use.names=TRUE))
#fasta_trans <- extractTranscriptSeqs(fasta, txdb)
#fasta_trans <- extractTranscriptSeqs(fasta, exonsBy(txdb, by="tx", use.names=TRUE))
#fasta_trans
#writeXStringSet(fasta_trans, file=out_f5, format="fasta", width=50)
sink(out_f6)
cat("1. Computation time for mapping (in second).\n")
time_e - time_s
cat("\n\n2. Options used for mapping.\n")
out@alignmentParameter
cat("\n\n3. Alignment statistics.\n")
alignmentStats(out)
cat("\n\n4. Gene annotation info.\n")
txdb
cat("\n\n5. Session info.\n")
sessionInfo()
sink()
無事マッピングが終了すると、指定した6つのファイルが生成されているはずです。
- QCレポートファイル(srp011435_QC_bowtie_2.pdf)：Quality Controlレポートです。よく利用されるFastQCのようなものです。
- カウントデータファイル(srp011435_count_bowtie_2.txt)：グループ(サンプル)間での発現変動遺伝子同定に用います。
- 遺伝子配列長情報ファイル(srp011435_genelength_2.txt)：配列長とカウント数の関係を調べたいときなどに用います。これはおまけです。
- RPKM補正後のファイル(srp011435_RPKM_bowtie_2.txt)：同一サンプル内での発現レベルの大小関係を知りたいときなどに用います。
- その他の各種情報ファイル(srp011435_other_info1_2.txt)：論文作成時に必要な、マッピング時に用いたオプション情報、マップされたリード数、Rおよび用いたパッケージのバージョン情報などを含みます。
Step3. サンプル間クラスタリング：
カウントデータ(srp011435_count_bowtie_2.txt)を用いてサンプル間の全体的な類似度を眺めることを目的として、サンプル間クラスタリングを行います。
類似度は「1-Spearman相関係数」、方法は平均連結法で行っています。
TCC論文(Sun et al., 2013)のFig.3でも同じ枠組みでクラスタリングを行った結果を示していますので、英語論文執筆時の参考にどうぞ。
PearsonではなくSpearmanで行っているのは、ダイナミックレンジが広いので、順序尺度程度にしておいたほうがいいだろうという思想が一番大きいです。
log2変換してダイナミックレンジを圧縮してPearsonにするのも一般的には「アリ」だとは思いますが、マップされたリード数が100万以上あるにも関わらずRPKMデータを用いると、RPKM補正後の値が1未満のものがかなり存在すること、
そしてlogをとれるようにゼロカウントデータの処理が必要ですがやりかた次第で結果がころころかわりうるという状況が嫌なので、RNA-seqデータの場合には私はSpearman相関係数にしています。
また、ベクトルの要素間の差を基本とするdistance metrics (例：ユークリッド距離やマンハッタン距離など)は、比較的最近のRNA-seqデータ正規化法
(TMM: Robinson and Oshlack, 2010, TbT: Kadota et al., 2012, TCC; Sun et al., 2013)論文の重要性が理解できれば、その類似度は少なくともfirst choiceにならないと思われます。
つまり、サンプルごとに転写物の組成比が異なるため、RPMやCPMのような総リード数を補正しただけのデータを用いて「サンプル間の数値の差」に基づいて距離を定めるのはいかがなものか？という思想です。
逆に、ユークリッド距離などを用いてクラスタリングを行った結果と比較することで、転写物の組成比に関する知見が得られるのかもしれません。
さらに、全体的な発現レベルが低いものを予めフィルタリングしておく必要もあるのだろうとは思います。このあたりは、真の回答はありませんので、
(手持ちのデータにこの類似度を適用したときの理論上の短所をきちんと理解したうえで)いろいろ試すというのは重要だとは思います。
ここではカウントデータでクラスタリングをしていますが、おそらく配列長補正後のRPKMデータ(srp011435_RPKM_bowtie_2.txt)
でも得られる樹形図のトポロジー(相対的な位置関係)はほぼ同じになるのではないかと思っています。配列長補正の有無で、サンプル間の相関係数の値自体は変わりますが、
同じグループに属するサンプルであれば反復実験間でそれほど違わないので、多少順位に変動があっても全体としては相殺されるはずです...が確証はありません。
in_f3 <- "srp011435_count_bowtie_2.txt"
out_f6 <- "srp011435_count_cluster.png"
param_fig <- c(500, 400)
data <- read.table(in_f3, header=TRUE, row.names=1, sep="\t", quote="")
dim(data)
obj <- as.logical(rowSums(data) > 0)
data <- unique(data[obj,])
dim(data)
data.dist <- as.dist(1 - cor(data, method="spearman"))
out <- hclust(data.dist, method="average")
png(out_f6, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
上と同じ結果は、TCC ver. 1.4.0以降で
clusterSample関数を用いて得ることができます。
in_f3 <- "srp011435_count_bowtie_2.txt"
out_f6 <- "hoge.png"
param_fig <- c(500, 400)
library(TCC)
data <- read.table(in_f3, header=TRUE, row.names=1, sep="\t", quote="")
out <- clusterSample(data, dist.method="spearman",
hclust.method="average", unique.pattern=TRUE)
png(out_f6, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(out)
dev.off()
無事計算が終了すると、指定したファイル(srp011435_count_cluster.png)が生成されているはずです。
Step4. 発現変動遺伝子(DEG)同定：
カウントデータファイル(srp011435_count_bowtie_2.txt)を入力として2群間で発現の異なる遺伝子の検出を行います。
このデータはtechnical replicatesを含むので、それをマージしたのちbiological replicatesのデータにしてからTCCパッケージ(Sun et al., 2013)の推奨ガイドラインに従って、
iDEGES/edgeR正規化(Sun et al., 2013; Robinson et al., 2010; Robinson and Oshlack, 2010; Robinson and Smyth, 2008)を行ったのち、
edgeRパッケージ中のan exact test (Robinson and Smyth, 2008)を行って、DEG検出を行っています。
解析 | 発現変動 | 2群間 | 対応なし | 複製あり | TCC(Sun_2013)の記述内容と基本的に同じです。
technical replicatesデータのマージ。ここでは、アドホックに2列分ごとのサブセットを抽出し、行の総和を計算したのち、結合しています。
in_f <- "srp011435_count_bowtie_2.txt"
out_f <- "srp011435_count_bowtie_3.txt"
data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")
head(data)
DEX_bio1 <- rowSums(data[,1:2])
DEX_bio2 <- rowSums(data[,3:4])
mock_bio1 <- rowSums(data[,5:6])
mock_bio2 <- rowSums(data[,7:8])
out <- cbind(DEX_bio1, DEX_bio2, mock_bio1, mock_bio2)
head(out)
tmp <- cbind(rownames(out), out)
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)
in_f4 <- "srp011435_count_bowtie_3.txt"
out_f7 <- "srp011435_DEG_bowtie.txt"
out_f8 <- "srp011435_MAplot_bowtie.png"
out_f9 <- "srp011435_other_info2.txt"
param_G1 <- 2
param_G2 <- 2
param_FDR <- 0.05
param_fig <- c(430, 390)
library(TCC)
data <- read.table(in_f4, header=TRUE, row.names=1, sep="\t", quote="")
data.cl <- c(rep(1, param_G1), rep(2, param_G2))
tcc <- new("TCC", data, data.cl)
tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",
iteration=3, FDR=0.1, floorPDEG=0.05)
tcc <- estimateDE(tcc, test.method="edger", FDR=param_FDR)
result <- getResult(tcc, sort=FALSE)
sum(tcc$stat$q.value < param_FDR)
normalized <- getNormalizedData(tcc)
tmp <- cbind(rownames(tcc$count), normalized, result)
write.table(tmp, out_f7, sep="\t", append=F, quote=F, row.names=F)
png(out_f8, pointsize=13, width=param_fig[1], height=param_fig[2])
plot(tcc, FDR=param_FDR)
legend("topright", c(paste("DEG(FDR<", param_FDR, ")", sep=""), "non-DEG"),
col=c("magenta", "black"), pch=20)
dev.off()
sink(out_f9)
cat("1. Numbers of DEGs satisfying several FDR thresholds.\n")
cat("FDR < 0.05:");print(sum(tcc$stat$q.value < 0.05))
cat("FDR < 0.10:");print(sum(tcc$stat$q.value < 0.10))
cat("FDR < 0.20:");print(sum(tcc$stat$q.value < 0.20))
cat("FDR < 0.30:");print(sum(tcc$stat$q.value < 0.30))
cat("\n\n2. Session info.\n")
sessionInfo()
sink()
無事計算が終了すると、指定した3つのファイルが生成されているはずです。
- 発現変動解析結果ファイル(srp011435_DEG_bowtie.txt)：iDEGES/edgeR-edgeRパイプラインによるDEG同定結果です。
"rank"列でソートすると発現変動の度合い順になります。"q.value"列の情報は任意のFDR閾値を満たす遺伝子数を調べるときに用います。
尚、左側の実数の数値データはiDEGES/edgeR正規化後のデータです。M-A plotはこの数値データに基づいて作成されています。尚、配列長補正は掛かっておりませんのでご注意ください。
- M-A plotファイル(srp011435_MAplot_bowtie.png)：M versus A plotです。横軸が平均発現レベル(右側が高発現、左側が低発現)。縦軸がlog(G2/G1)で、0より下がG1群で高発現、0より上がG2群で高発現です。
- その他の各種情報ファイル(srp011435_other_info2.txt)：FDR < 0.05, 0.1, 0.2, 0.3を満たす遺伝子数、論文作成時に必要な、Rおよび用いたパッケージのバージョン情報(特にTCC)などを含みます。
- SRAdb：Zhu et al., BMC Bioinformatics, 2013
- SRP017142：Neyret-Kahn et al., Genome Res., 2013
- QuasR：Gaidatzis et al., Bioinformatics, 2014
- Bowtie：Langmead et al., Genome Biol., 2009
- GenomicFeatures：Lawrence et al., PLoS Comput. Biol., 2013
- TCC：Sun et al., BMC Bioinformatics, 2013
Nie et al., BMC Genomics, 2013のカイコ (Bombyx mori) small RNA-seqデータが
GSE41841に登録されています。
(そしてリンク先のGSM1025527からも様々な情報を得ることができます。)
ここでは、SRAdbパッケージを用いたそのFASTQ形式ファイルのダウンロードから、
QuasRパッケージを用いたマッピングまでを行う一連の手順を示します。
basic alignerの一つであるBowtieをQuasRの内部で用いています。
ここでは「デスクトップ」上に「SRP016842」というフォルダを作成しておき、そこで作業を行うことにします。
Step1. RNA-seqデータのgzip圧縮済みのFASTQファイルをダウンロード：
論文中の記述からGSE41841を頼りに、
SRP016842にたどり着いています。
したがって、ここで指定するのは"SRP016842"となります。
以下を実行して得られるsmall RNA-seqファイルは一つ(SRR609266.fastq.gz)で、ファイルサイズは400Mb弱、11928428リードであることがわかります。
イントロ | NGS | 配列取得 | FASTQ or SRA | SRAdb(Zhu_2013)の記述内容と基本的に同じです。
param <- "SRP016842"
library(SRAdb)
#sqlfile <- "SRAmetadb.sqlite"
sqlfile <- getSRAdbFile()
sra_con <- dbConnect(SQLite(), sqlfile)
hoge <- sraConvert(param, sra_con=sra_con)
hoge
apply(hoge, 2, unique)
getFASTQinfo(in_acc=hoge$run)
getFASTQfile(hoge$run, srcType='ftp')
無事ダウンロードが終了すると、作業ディレクトリ（「デスクトップ」上の「SRP016842」フォルダ）中に2つのファイルが存在するはずです。
4Gb程度ある"SRAmetadb.sqlite"ファイルは無視して構いません。残りの"SRR"からはじまるファイル(SRR609266.fastq.gz)がダウンロードしたsRNA-seqデータです。
オリジナルのサンプル名(の略称)で対応関係を表すとsrp016842_samplename.txtのようになっていることがわかります。
尚このファイルはマッピング時の入力ファイルとしても用います。
Step2. カイコゲノム配列をダウンロード：
カイコゲノム配列はBSgenomeパッケージとして提供されていないため、自力で入手する必要があります。
手順としては、農業生物資源研究所(NIAS)が提供しているカイコゲノム配列のウェブページからIntegrated sequences (integretedseq.txt.gz)
をダウンロードし、解凍します。解凍後のファイル名は"integretedseq.txt"となりますが、拡張子を".txt"から".fa"に変更して、"integretedseq.fa"としたものを作業ディレクトリ(「デスクトップ」上の「SRP016842」フォルダ)上にコピーしておきます。
Step3. small RNA-seqデータの前処理：
原著論文(Nie et al., 2013)中では、アダプター配列やクオリティの低いリードを除去したのち、ゲノムにマッピングしたと書いてあります。
アダプター配列情報はどこにも書かれていませんでしたが、Table S2中のアダプター配列除去後の最も短いリードが18 nt (例："GCAGTCGTGGCCGAGCGG")であり、
「この18 nt」と「この配列を含む生リード配列の差分」がアダプター配列ということになります。
詳細な情報は書かれていませんでしたが、おそらくアダプター配列は"TGGAATTCTCGGGTGCCAAGGAACTCCAGTC..."という感じだろうと推測できます。
ここでは、ダウンロードした"SRR609266.fastq.gz"ファイルを入力として、
1塩基ミスマッチまで許容して(推定)アダプター配列除去を行ったのち、"ACGT"のみからなる配列(許容するN数が0)で、
配列長が18nt以上のものをフィルタリングして出力しています。
in_f <- "SRR609266.fastq.gz"
out_f <- "SRR609266_p.fastq.gz"
param_adapter <- "TGGAATTCTCGGGTGCCAAGGAACTCCAGTC"
param_mismatch <- 1
param_nBases <- 0
param_minLength <- 18
library(QuasR)
res <- preprocessReads(filename=in_f,
outputFilename=out_f,
Rpattern=param_adapter,
max.Rmismatch=rep(param_mismatch, nchar(param_adapter)),
nBases=param_nBases,
minLength=param_minLength)
res
前処理実行後のresオブジェクトを眺めると、入力ファイルのリード数が11928428であり、
アダプター配列除去後に18nt未満の長さになってしまったためにフィルタリングされたリード数が157229、
"N"を1つ以上含むためにフィルタリングされたリード数が21422あったことがわかります。ここでは配列長分布は得ておりませんが、
出力ファイルを展開して配列長分布を調べると原著論文中のTable S1と似た結果になっていることから、ここでの処理が妥当であることがわかります。
Step4. カイコゲノムへのマッピングおよびカウントデータ取得：
マップしたい前処理後のFASTQファイル名("SRR609266_p.fastq.gz")およびその任意のサンプル名を記述したsrp016842_samplename.txtを作業ディレクトリに保存したうえで、下記を実行します。
Step2でダウンロードしたintegretedseq.faへマッピングしています。
basic alignerの一つであるBowtieを内部的に用いており、
ここではマッピング時のオプションを"-m 1 -v 0"とし、「ミスマッチを許容せず1ヶ所にのみマップされるもの」をレポートしています。
ミスマッチを許容していないため、--best --strataというオプションは事実上意味をなさないためにつけていません。
QuasRのマニュアル中のようにalignmentParameterオプションは特に指定せず(デフォルト)、50ヶ所にマップされるリードまでをレポートする
"maxHits=50"オプションをつけるという思想もあります。
マシンパワーにもよりますが、20分程度で終わると思います。
マップ後 | カウント情報取得 | ゲノム | アノテーション有 | QuasR(Gaidatzis_2014)の記述内容と基本的に同じです。
in_f1 <- "srp016842_samplename.txt"
in_f2 <- "integretedseq.fa"
out_f1 <- "srp016842_QC.pdf"
out_f2 <- "srp016842_other_info1.txt"
param_mapping <- "-m 1 -v 0"
library(QuasR)
library(GenomicAlignments)
library(Rsamtools)
time_s <- proc.time()
out <- qAlign(in_f1, in_f2,
alignmentParameter=param_mapping)
time_e <- proc.time()
qQCReport(out, pdfFilename=out_f1)
tmpfname <- out@alignments[,1]
tmpsname <- out@alignments[,2]
for(i in 1:length(tmpfname)){
k <- readGAlignments(tmpfname[i])
m <- reduce(granges(k))
tmpcount <- summarizeOverlaps(m, tmpfname[i])
count <- assays(tmpcount)$counts
colnames(count) <- tmpsname[i]
tmp <- cbind(as.data.frame(m), count)
out_f <- sub(".bam", "_range.txt", tmpfname[i])
write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)
out_f <- sub(".bam", "_range.fa", tmpfname[i])
fasta <- getSeq(FaFile(in_f2), m)
h <- as.data.frame(m)
names(fasta) <- paste(h[,1],h[,2],h[,3],h[,4],h[,5], sep="_")
writeXStringSet(fasta, file=out_f, format="fasta", width=50)
}
sink(out_f2)
cat("1. Computation time for mapping (in second).\n")
time_e - time_s
cat("\n\n2. Options used for mapping.\n")
out@alignmentParameter
cat("\n\n3. Alignment statistics.\n")
alignmentStats(out)
cat("\n\n4. Session info.\n")
sessionInfo()
sink()
無事マッピングが終了すると、指定した2つのファイルが生成されているはずです。
- QCレポートファイル(srp016842_QC.pdf)：Quality Controlレポートです。よく利用されるFastQCのようなものです。
- その他の各種情報ファイル(srp016842_other_info1.txt)：論文作成時に必要な、マッピング時に用いたオプション情報、マップされたリード数、Rおよび用いたパッケージのバージョン情報などを含みます。
この他にも以下に示すような形式のファイルがサンプルごとに自動生成されます。以下に示すファイル名中の"fa03ced5b37"に相当する部分はランダムな文字列からなり、サンプルごと、そして実行するたびに異なります。
理由は、同じ入力ファイルを異なるパラメータやリファレンス配列にマッピングしたときに、間違って上書きしてしまうのを防ぐためです。
- SRP016842：Nie et al., BMC Genomics, 2013
- SRAdb：Zhu et al., BMC Bioinformatics, 2013
- QuasR：Gaidatzis et al., Bioinformatics, 2014
- Bowtie：Langmead et al., Genome Biol., 2009
- GenomicAlignments：Lawrence et al., PLoS Comput. Biol., 2013
- Biostrings
- Rsamtools
- R
- Bioconductor：Gentleman et al., Genome Biol., 2004
- CRAN
- RjpWiki
- R Tips(竹澤様)
- BioEdit（フリーの配列編集ソフト）
- BioMart：Smedley et al., BMC Genomics, 2009
- DDBJ Read Annotation Pipeline：Nagasaki et al., DNA Res., 2013
- EMBOSS explorer (EMBOSSのウェブ版)
- Biostar：Parnell et al., PLoS Comput Biol., 2011
- SEQanswers：Li et al., Bioinformatics, 2012
- NGS WikiBook：Li et al., Brief Bioinform., 2013
- HT Sequence Analysis with R and Bioconductor
- 次世代シーケンスデータ解析情報共有フォーラム
- NGS現場の会
- ライフサイエンスQA
- RNA-Seq Blog
SRA系
ソフト系
）をいただければ...
（実際問題として相当様々なことにトラップされてますので対応は難しいですが...）前向きに検討させていただきます。
もちろん、アグリバイオインフォマティクス教育研究プログラム被養成者からのリクエストは優先的に対応します。
