What's new?
install.packages(available.packages()[,1]) #CRAN中にある全てのパッケージをインストール source("http://www.bioconductor.org/biocLite.R") #おまじない biocLite(all_group()) #Bioconductor中にある全てのパッケージをインストール
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R")#門田が作成した関数群をロード source("http://www.bioconductor.org/biocLite.R") #おまじない install.packages("ascii",dep=T) #asciiパッケージのインストール install.packages("Epi",dep=T) #Epiパッケージのインストール install.packages("NBPSeq",dep=T) #NBPSeqパッケージのインストール biocLite("ArrayExpressHTS", dependencies=TRUE) #ArrayExpressHTSパッケージのインストール biocLite("baySeq", dependencies=TRUE) #baySeqパッケージのインストール biocLite("biomaRt", dependencies=TRUE) #biomaRtパッケージのインストール biocLite("Biostrings", dependencies=TRUE) #Biostringsパッケージのインストール biocLite("ChIPpeakAnno", dependencies=TRUE) #ChIPpeakAnnoパッケージのインストール biocLite("chipseq", dependencies=TRUE) #chipseqパッケージのインストール biocLite("ChIPseqR", dependencies=TRUE) #ChIPseqRパッケージのインストール biocLite("ChIPsim", dependencies=TRUE) #ChIPsimパッケージのインストール biocLite("cosmo", dependencies=TRUE) #cosmoパッケージのインストール biocLite("CSAR", dependencies=TRUE) #CSARパッケージのインストール biocLite("DEGseq", dependencies=TRUE) #DEGseqパッケージのインストール biocLite("DESeq", dependencies=TRUE) #DESeqパッケージのインストール biocLite("DEXSeq", dependencies=TRUE) #DEXSeqパッケージのインストール biocLite("DiffBind", dependencies=TRUE) #DiffBindパッケージのインストール biocLite("edgeR", dependencies=TRUE) #edgeRパッケージのインストール biocLite("GeneR", dependencies=TRUE) #GeneRパッケージのインストール biocLite("GenomicRanges", dependencies=TRUE) #GenomicRangesパッケージのインストール biocLite("girafe", dependencies=TRUE) #girafeパッケージのインストール biocLite("goseq", dependencies=TRUE) #goseqパッケージのインストール biocLite("pasilla", dependencies=TRUE) #pasillaパッケージのインストール biocLite("PICS", dependencies=TRUE) #PICSパッケージのインストール biocLite("qrqc", dependencies=TRUE) #qrqcパッケージのインストール biocLite("r3Cseq", dependencies=TRUE) #r3Cseqパッケージのインストール biocLite("RCurl", dependencies=TRUE) #RCurlパッケージのインストール biocLite("REDseq", dependencies=TRUE) #REDseqパッケージのインストール biocLite("rGADEM", dependencies=TRUE) #rGADEMパッケージのインストール biocLite("rMAT", dependencies=TRUE) #rMATパッケージのインストール biocLite("ROC", dependencies=TRUE) #ROCパッケージのインストール biocLite("Rsubread", dependencies=TRUE) #Rsubreadパッケージのインストール biocLite("Rsamtools", dependencies=TRUE) #Rsamtoolsパッケージのインストール biocLite("segmentSeq", dependencies=TRUE) #segmentSeqパッケージのインストール biocLite("seqLogo", dependencies=TRUE) #seqLogoパッケージのインストール biocLite("ShortRead", dependencies=TRUE) #ShortReadパッケージのインストール biocLite("SRAdb", dependencies=TRUE) #SRAdbパッケージのインストール
source("http://www.bioconductor.org/biocLite.R") #おまじない biocLite("yeastRNASeq") #yeastRNASeqパッケージのインストールb. yeastRNASeqパッケージがインストールされていれば以下のコピペでも取得可能:
library(yeastRNASeq) #パッケージの読み込み data(geneLevelData) #yeastRNASeqパッケージ中で提供されているデータをロード dim(geneLevelData) #行数と列数を表示 head(geneLevelData) #最初の数行を表示 #ファイルに出力 tmp <- cbind(rownames(geneLevelData), geneLevelData) #geneLevelDataの「rownames情報(i.e., 遺伝子名)」と「カウントデータ」の行列を列方向で結合した結果をtmpに格納 write.table(tmp, "data_yeast_7065.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存BioconductorのyeastRNASeqのwebページ
source("http://www.bioconductor.org/biocLite.R") #おまじない biocLite("EDASeq") #EDASeqパッケージのインストールb. EDASeqパッケージがインストールされていれば以下のコピペでも取得可能:
library(EDASeq) #パッケージの読み込み data(yeastGC) #yeastRNASeqパッケージ中で提供されているyeastのGC含量情報をロード length(yeastGC) #要素数を表示 head(yeastGC) #最初の数個を表示 data(yeastLength) #yeastRNASeqパッケージ中で提供されているyeastの配列長情報をロード length(yeastLength) #要素数を表示 head(yeastLength) #最初の数個を表示 #それぞれ別々のファイルに出力 tmp <- cbind(names(yeastGC), yeastGC) #yeastGCの「names属性情報」と「GC含量」のベクトルを列方向で結合した結果をtmpに格納 write.table(tmp, "yeastGC_6717.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存 tmp <- cbind(names(yeastLength), yeastLength) #yeastLengthの「names属性情報」と「配列長」のベクトルを列方向で結合した結果をtmpに格納 write.table(tmp, "yeastLength_6717.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存
EDASeq:Risso et al., BMC Bioinformatics, 2011
#必要なパッケージをロード library(yeastRNASeq) #パッケージの読み込み library(EDASeq) #パッケージの読み込み #count dataやGC含量情報(SGD ver. r64)の読み込みとラベル情報の作成 data(geneLevelData) #yeastRNASeqパッケージ中で提供されているカウントデータ(geneLevelData)をロード data(yeastGC) #EDASeqパッケージ中で提供されているyeastのGC含量情報(yeastGC)をロード data(yeastLength) #EDASeqパッケージ中で提供されているyeastの配列長情報(yeastLength)をロード #カウントデータ情報(geneLevelData)とGC含量情報(yeastGC)から共通して存在するサブセットを(同じ遺伝子名の並びで)取得 common <- intersect(rownames(geneLevelData), names(yeastGC)) #yeastRNASeqパッケージ中で提供されているデータをロード data <- as.data.frame(geneLevelData[common, ]) #6685個の共通遺伝子分のカウントデータ行列をデータフレーム形式でdataに格納 GC <- data.frame(GC = yeastGC[common]) #6685個の共通遺伝子分のGC含量ベクトルをデータフレーム形式でGCに格納 length <- data.frame(Length = yeastLength[common]) #6685個の共通遺伝子分の配列長ベクトルをデータフレーム形式でlengthに格納 head(rownames(data)) #行列dataの行名(rownames)情報の最初の数個を表示 head(rownames(GC)) #行列GCの行名(rownames)情報の最初の数個を表示 head(rownames(length)) #行列lengthの行名(rownames)情報の最初の数個を表示 #それぞれ別々のファイルに出力 tmp <- cbind(rownames(data), data) #「rownames情報」と「カウントデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, "data_yeast_common_6685.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存 tmp <- cbind(rownames(GC), GC) #「rownames情報」と「GC含量情報」を列方向で結合した結果をtmpに格納 write.table(tmp, "yeastGC_common_6685.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存 tmp <- cbind(rownames(length), length) #「rownames情報」と「配列長情報」を列方向で結合した結果をtmpに格納 write.table(tmp, "yeastLength_common_6685.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存
install.packages("TCC", type = "source") #TCCパッケージのインストール
b. TCCパッケージ(≥ ver. 1.1.99)がインストールされていれば以下のコピペでも取得可能:
library(TCC) #パッケージの読み込み data(hypoData) #TCCパッケージ中で提供されているシミュレーションデータをロード #ファイルに出力 tmp <- cbind(rownames(hypoData), hypoData) #「rownames情報」と「カウントデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, "data_hypodata_3vs3.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存
library(TCC) #パッケージの読み込み data(hypoData) #TCCパッケージ中で提供されているシミュレーションデータをロード #ファイルに出力 tmp <- cbind(rownames(hypoData), hypoData[, c(1, 4)]) #「rownames情報」と「カウントデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, "data_hypodata_1vs1.txt", sep="\t", append=F, quote=F, row.names=F)#tmpの中身を指定したファイル名で保存
in_f <- "ftp://ftp.ncbi.nih.gov/refseq/H_sapiens/mRNA_Prot/human.rna.fna.gz"#欲しいファイルのURLを指定 hoge <- unlist(strsplit(in_f, "/", fixed=TRUE)) #in_f中の文字列を"/"で分割した結果をhogeに保存 download.file(in_f, destfile=hoge[length(hoge)]) #in_fで指定したURLのファイルをhoge[length(hoge)]で指定したファイル名で保存#step2:本番
in_f <- "human.rna.fna" #解凍後のmulti-fastaファイルのファイル名human.rna.fnaを指定 out_f1 <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み hoge <- strsplit(names(reads), "|", fixed=TRUE) #names(reads)中の文字列を"|"で区切った結果をリスト形式でhogeに格納 refseq_with_v <- unlist(lapply(hoge, "[[", 4)) #hogeのリスト中の4番目の要素(RefSeq accession number部分に相当)のみ抽出してrefseq_with_vに格納 hoge2 <- strsplit(refseq_with_v, ".", fixed=TRUE) #refseq_with_v中の文字列を"."で区切った結果をリスト形式でhoge2に格納 refseq_without_v <- unlist(lapply(hoge2, "[[", 1)) #hoge2のリスト中の1番目の要素(RefSeq accession numberのバージョン番号でない部分に相当)のみ抽出してrefseq_without_vに格納 tmp <- cbind(refseq_without_v, width(reads)) #「バージョン情報なしのRefSeq accession number (refseq_without_v)」と「配列長情報(width(reads))」を結合してtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#「webの11」に相当。tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #description部分をRefSeq accession number(バージョン番号つき)のみにしてFASTA形式で保存したい場合: param1 <- 50 #一行あたりの塩基数を指定 out_f2 <- "hoge.fasta" #出力ファイル名を指定 reads #今現在のreadsオブジェクトを眺めているだけ(namesという列の部分がオリジナルのdescriptionのままになっていることがわかる) names(reads) <- refseq_with_v #names(reads)の中身をrefseq_with_vで置換(バージョン番号なしにしたければrefseq_without_vにすればいい) reads #今現在のreadsオブジェクトを眺めているだけ(namesという列の部分がrefseq_with_vでちゃんと置換されていることがわかる) writeXStringSet(reads, file=out_f2, format="fasta", width=param1)#一行あたりの塩基数をparam1で指定した数にして、out_f2で指定したファイル名でreadsというオブジェクトをfasta形式で保存 #param2で指定した配列長以上のもののみ抽出して保存したい場合: param1 <- 70 #一行あたりの塩基数を指定 param2 <- 200 #配列長の閾値を指定 out_f3 <- "hoge2.fasta" #出力ファイル名を指定 reads #今現在のreadsオブジェクトを眺めているだけ(namesという列の部分がrefseq_with_vでちゃんと置換されていることがわかる) reads <- reads[width(reads) >= param2] #readsオブジェクト中のwidth(reads)で表される配列長がparam2以上のもののみ抽出してoutに格納 reads #今現在のreadsオブジェクトを眺めているだけ(配列数が減っているのがわかる) writeXStringSet(reads, file=out_f3, format="fasta", width=param1)#一行あたりの塩基数をparam1で指定した数にして、out_f3で指定したファイル名でreadsというオブジェクトをfasta形式で保存BioconductorのBiostringsのwebページ
in_f <- "l1-contigs.fa" #multi-fastaファイルのファイル名を指定 param1 <- 300 #配列長の閾値を指定 param2 <- 60 #出力時の一行あたりの塩基数を指定 hoge <- unlist(strsplit(in_f, ".", fixed=TRUE)) #in_f中の文字列を"."で分割した結果をhogeに保存 out_f <- paste(hoge[1], "_", param1, ".", hoge[2], sep="") #出力ファイル名を自動生成 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み tmp <- readFASTA(in_f) #in_fで指定したファイルをreadFASTA関数を用いて読み込み tmp_desc <- unlist(lapply(tmp, "[[", 1)) #tmpのリスト中の1番目の要素(description情報)のみ抽出してtmp_descに格納 tmp_seq <- unlist(lapply(tmp, "[[", 2)) #tmpのリスト中の2番目の要素(配列情報)のみ抽出してtmp_seqに格納 reads <- DNAStringSet(tmp_seq) #character vector形式の配列情報であるtmp_seqをDNAStringSetオブジェクト形式にしてreadsに格納 names(reads) <- tmp_desc #readsオブジェクトのnamesのところにtmp_descの情報を代入 reads #今現在のreadsオブジェクトを表示 reads <- reads[width(reads) >= param1] #param1で指定した配列長以上のもののみ抽出してreadsに格納 reads #今現在のreadsオブジェクトを表示 writeXStringSet(reads, file=out_f, format="fasta", width=param2) #一行あたりの塩基数をparam2で指定した数にして、out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存やり方2(別の関数をつかっているだけです):
in_f <- "l1-contigs.fa" #multi-fastaファイルのファイル名を指定 param1 <- 300 #配列長の閾値を指定 param2 <- 60 #出力時の一行あたりの塩基数を指定 hoge <- unlist(strsplit(in_f, ".", fixed=TRUE)) #in_f中の文字列を"."で分割した結果をhogeに保存 out_f <- paste(hoge[1], "_", param1, ".", hoge[2], sep="") #出力ファイル名を自動生成 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み tmp <- readFASTA(in_f) #in_fで指定したファイルをreadFASTA関数を用いて読み込み tmp_desc <- sapply(tmp, "[[", 1) #tmpのリスト中の1番目の要素(description情報)のみ抽出してtmp_descに格納 tmp_seq <- sapply(tmp, "[[", 2) #tmpのリスト中の2番目の要素(配列情報)のみ抽出してtmp_seqに格納 reads <- DNAStringSet(tmp_seq) #character vector形式の配列情報であるtmp_seqをDNAStringSetオブジェクト形式にしてreadsに格納 names(reads) <- tmp_desc #readsオブジェクトのnamesのところにtmp_descの情報を代入 reads #今現在のreadsオブジェクトを表示 reads <- reads[width(reads) >= param1] #param1で指定した配列長以上のもののみ抽出してreadsに格納 reads #今現在のreadsオブジェクトを表示 writeXStringSet(reads, file=out_f, format="fasta", width=param2) #一行あたりの塩基数をparam2で指定した数にして、out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存やり方2に加えてdescription行を配列長のところまでの情報に制限したい場合:
in_f <- "l1-contigs.fa" #multi-fastaファイルのファイル名を指定 param1 <- 300 #配列長の閾値を指定 param2 <- 60 #出力時の一行あたりの塩基数を指定 hoge <- unlist(strsplit(in_f, ".", fixed=TRUE)) #in_f中の文字列を"."で分割した結果をhogeに保存 out_f <- paste(hoge[1], "_", param1, ".", hoge[2], sep="") #出力ファイル名を自動生成 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み tmp <- readFASTA(in_f) #in_fで指定したファイルをreadFASTA関数を用いて読み込み tmp_desc <- sapply(tmp, "[[", 1) #tmpのリスト中の1番目の要素(description情報)のみ抽出してtmp_descに格納 tmp_seq <- sapply(tmp, "[[", 2) #tmpのリスト中の2番目の要素(配列情報)のみ抽出してtmp_seqに格納 reads <- DNAStringSet(tmp_seq) #character vector形式の配列情報であるtmp_seqをDNAStringSetオブジェクト形式にしてreadsに格納 tmp_desc <- chartr(":", " ", tmp_desc) #description情報に相当するtmp_desc中の":"を"_"に置換した結果をまたtmp_descに格納 hoge <- strsplit(tmp_desc, " ", fixed=TRUE) #tmp_desc中の文字列を" "で区切った結果をhogeに格納 names(reads) <- paste(sapply(hoge,"[[",1), sapply(hoge,"[[",2), sapply(hoge,"[[",3),sep="_")#readsオブジェクトのnamesのところにhogeの1-3番目までの要素を"_"で連結したものを代入 reads #今現在のreadsオブジェクトを表示 reads <- reads[width(reads) >= param1] #param1で指定した配列長以上のもののみ抽出してreadsに格納 reads #今現在のreadsオブジェクトを表示 writeXStringSet(reads, file=out_f, format="fasta", width=param2) #一行あたりの塩基数をparam2で指定した数にして、out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存BioconductorのBiostringsのwebページ
0. http://uswest.ensembl.org/Help/ArchiveListをクリック 1. Ensembl 46: Aug 2007のところをクリック 2. Mine Ensembl with BioMartのところをクリック 3. 「- CHOOSE DATABASE-」のプルダウンメニューから「Ensembl 46」を選択 4. 「- CHOOSE DATASET-」のプルダウンメニューから「Homo sapiens genes (NCBI36)」を選択 5. 左側にある青文字の「Attibutes」をクリック 6. 「GENE」の左側にある+の記号をクリック 7. 「Ensembl Gene ID」,「Ensembl Transcript ID」,「Ensembl CDS length」,「Ensembl cDNA length」にチェックを入れる 8. 「EXTERNAL」の左側にある+の記号をクリック 9. 「HGNC symbol」, 「RefSeq DNA ID」にチェックを入れる 10. 左上のほうにある「Results」のところをクリック 11. 「Go 」ボタンをクリックして好きなファイル名(例:ens_gene_46.txt)で保存2. web経由(2011年8月15日現在の最新のバージョン)でやる場合(現状では、なぜか「Microsoft Internet Extensionで内部エラーが発生しました」などとなってファイルのダウンロードができません...):
1. BioMartをクリック 2. BioMart Central Portalのところをクリック 3. 「- CHOOSE DATABASE-」のプルダウンメニューから「Ensembl Genes 63 (SANGER UK)」を選択 4. 「- CHOOSE DATASET-」のプルダウンメニューから「Homo sapiens genes (GRCh37.p3)」を選択 5. 左側にある青文字の「Attibutes」をクリック 6. (デフォルトでは「Features」のところにチェックが入っている)「Sequences」のところにチェックを入れる 6. 「SEQUENCES」の左側にある+の記号をクリック 7. (デフォルトでは「Protein」のところにチェックが入っている)「cDNA sequences 」にチェックを入れる 8. 「Header Information 」の左側にある+の記号をクリック 9. 「Ensembl Gene ID」と「Ensembl Transcript ID」のみにチェックが入っていることを確認 10. 左上のほうにある「Results」のところをクリック 11. 「Unique results only」のところにチェックを入れて、 「Go 」ボタンをクリック 12. 好きなファイル名(例:ens_seq_63.txt)で保存参考文献1(Smedley et al., BMC Genomics, 2009)
1. BioMartをクリック 2. Ensemblのところをクリック 3. 「- CHOOSE DATABASE-」のプルダウンメニューから「Ensembl Genes 60」を選択 4. 「- CHOOSE DATASET-」のプルダウンメニューから「Homo sapiens genes (GRCh37.p2)」を選択 5. 左側にある青文字の「Attibutes」をクリック 6. 「GENE」の左側にある+の記号をクリック 7. 「Ensembl Gene ID」,「Chromosome Name」,「Gene Start (bp)」,「Gene End (bp)」にチェックを入れる 8. 「EXTERNAL」の左側にある+の記号をクリック 9. 「HGNC symbol」にチェックを入れる 10. 左上のほうにある「Results」のところをクリック 11. 「Go 」ボタンをクリックして好きなファイル名(例:ens_gene_60.txt)で保存2. Rでやる場合(以下は基本コピペですよ):
out_f <- "ens_gene_60_2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(biomaRt) #パッケージの読み込み listMarts() #「webの1」に相当し、利用可能なデータベースを表示している(ここでこのライブラリ中での名前を把握しておく。例えばEnsemblは"ensembl"という名前になっていることが分かる)。 mart <- useMart("ensembl") #「webの2」に相当 listDatasets(mart) #「webの3」に相当 mart <- useDataset("hsapiens_gene_ensembl", mart=mart) #「webの4」に相当 listFilters(mart) #「webの?」に相当。特定の染色体上だけ、とか特定のマイクロアレイ上に搭載されたものだけ、などのフィルター(Filters)の条件を指定することができるが今回は何も指定していないので。。。 listAttributes(mart) #「webの5-9」に相当。欲しい情報はそれぞれ"ensembl_gene_id", "chromosome_name", "start_position", "end_position", "hgnc_symbol"で取得可能であることが分かる(実際にはなかなかわかりずらいので、私はwebの表示順などから探し当てました。。。) attr <- c("ensembl_gene_id", "chromosome_name", "start_position", "end_position", "hgnc_symbol")#「webの5-9」に相当 out <- getBM(attributes=attr, filters="", values="", mart=mart) #「webの10」に相当 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#「webの11」に相当。outの中身をout_fで指定したファイル名で保存。3. web経由(Ensemblの任意のversion)でやる場合(以下はコピペじゃありませんよ):
0. EnsemblのArchiveをクリック 1. 任意のバージョン(例えばEnsembl 48: Dec 2007)をクリック 2. 「Mine Ensembl with BioMart」をクリック 3. 「- CHOOSE DATABASE-」のプルダウンメニューから「Ensembl 48」を選択 4. 「- CHOOSE DATASET-」のプルダウンメニューから「Homo sapiens genes (NCBI36)」を選択 5. 左側にある青文字の「Attibutes」をクリック 6. 「GENE」の左側にある+の記号をクリック 7. 「Ensembl Gene ID」,「Chromosome Name」,「Gene Start (bp)」,「Gene End (bp)」にチェックを入れる 8. 「EXTERNAL」の左側にある+の記号をクリック 9. 「HGNC symbol」にチェックを入れる 10. 左上のほうにある「Results」のところをクリック 11. 「Unique results only」のところにチェックを入れて、 「Go 」ボタンをクリックして好きなファイル名(例:ens_gene_48.txt)で保存4. Rでやる場合(対象がマウス:以下は基本コピペですよ):
out_f <- "ens_gene_60_mm.txt" #出力ファイル名を指定 #必要なパッケージをロード library(biomaRt) #パッケージの読み込み listMarts() #「webの1」に相当し、利用可能なデータベースを表示している(ここでこのライブラリ中での名前を把握しておく。例えばEnsemblは"ensembl"という名前になっていることが分かる)。 mart <- useMart("ensembl") #「webの2」に相当 listDatasets(mart) #「webの3」に相当 mart <- useDataset("mmusculus_gene_ensembl", mart=mart) #「webの4」に相当 listFilters(mart) #「webの?」に相当。特定の染色体上だけ、とか特定のマイクロアレイ上に搭載されたものだけ、などのフィルター(Filters)の条件を指定することができるが今回は何も指定していないので。。。 listAttributes(mart) #「webの5-9」に相当。欲しい情報はそれぞれ"ensembl_gene_id", "chromosome_name", "start_position", "end_position", "mgi_curated_gene_symbol", "refseq_dna"で取得可能であることが分かる(実際にはなかなかわかりずらいので、私はwebの表示順などから探し当てました。。。また、mgi_gene_symbolなるものもあって、どれがより正確なのかは不明です) attr <- c("ensembl_gene_id", "chromosome_name", "start_position", "end_position", "mgi_curated_gene_symbol", "refseq_dna")#「webの5-9」に相当 out <- getBM(attributes=attr, filters="", values="", mart=mart) #「webの10」に相当 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#「webの11」に相当。outの中身をout_fで指定したファイル名で保存。参考文献1(Smedley et al., BMC Genomics, 2009)
in_f1 <- "annotation.txt" #入力ファイル名(目的のタブ区切りテキストファイル)を指定 in_f2 <- "genelist1.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge1.txt" #出力ファイル名を指定 param <- 1 #in_f1で読み込む目的のファイルの何列目のデータに対してサーチしたいかを指定 #ファイルの読み込み data <- read.table(in_f1, header=TRUE, sep="\t", quote="") #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 dim(data) #オブジェクトdataの行数と列数を表示 #本番 obj <- is.element(as.character(data[,param]), keywords) #in_f1で読み込んだファイル中の(param)列目の文字列ベクトル中の各要素がベクトルkeywords中に含まれるか含まれないか(TRUE or FALSE)の情報をobjに格納(集合演算をしている) out <- data[obj,] #行列dataからobjがTRUEとなる行のみを抽出した結果をoutに格納 dim(out) #オブジェクトoutの行数と列数を表示 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存。2. 目的のタブ区切りテキストファイル(annotation.txt)中の第1列目をキーとして、リストファイル(genelist2.txt)中のものが含まれる行全体を出力したい場合:
in_f1 <- "annotation.txt" #入力ファイル名(目的のタブ区切りテキストファイル)を指定 in_f2 <- "genelist2.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge2.txt" #出力ファイル名を指定 param <- 1 #in_f1で読み込む目的のファイルの何列目のデータに対してサーチしたいかを指定 #ファイルの読み込み data <- read.table(in_f1, header=TRUE, sep="\t", quote="") #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番 obj <- is.element(as.character(data[,param]), keywords) #in_f1で読み込んだファイル中の(param)列目の文字列ベクトル中の各要素がベクトルkeywords中に含まれるか含まれないか(TRUE or FALSE)の情報をobjに格納(集合演算をしている) out <- data[obj,] #行列dataからobjがTRUEとなる行のみを抽出した結果をoutに格納 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存。3. 目的のタブ区切りテキストファイル(annotation.txt)中の第3列目をキーとして、リストファイル(genelist2.txt)中のものが含まれる行全体を出力したい場合:
in_f1 <- "annotation.txt" #入力ファイル名(目的のタブ区切りテキストファイル)を指定 in_f2 <- "genelist2.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge3.txt" #出力ファイル名を指定 param <- 3 #in_f1で読み込む目的のファイルの何列目のデータに対してサーチしたいかを指定 #ファイルの読み込み data <- read.table(in_f1, header=TRUE, sep="\t", quote="") #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番 obj <- is.element(as.character(data[,param]), keywords) #in_f1で読み込んだファイル中の(param)列目の文字列ベクトル中の各要素がベクトルkeywords中に含まれるか含まれないか(TRUE or FALSE)の情報をobjに格納(集合演算をしている) out <- data[obj,] #行列dataからobjがTRUEとなる行のみを抽出した結果をoutに格納 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存。4. 目的のタブ区切りテキストファイル(annotation.txt)に対して、リストファイル(genelist1.txt)中のものが含まれる行全体を出力したい場合:
in_f1 <- "annotation.txt" #入力ファイル名(目的のタブ区切りテキストファイル)を指定 in_f2 <- "genelist1.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge4.txt" #出力ファイル名を指定 #ファイルの読み込み data <- readLines(in_f1) #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番(リストファイル中の要素数分だけループを回して、要素中の文字列と一致する行番号情報を得て、その行のみ出力) keywords <- unique(keywords) #リストファイル中の要素が重複している可能性があるので、重複なしの状態にしている hoge <- NULL #最終的に欲しい行番号情報を格納するためのプレースホルダ for(i in 1:length(keywords)){ #length(keywords)で表現される要素数分だけループを回す hoge <- c(hoge, c(grep(keywords[i], data))) #リストファイル中の要素ごとに検索をかけて要素中の文字列と一致する行番号情報をhogeにどんどん格納している if(i%%10 == 0) cat(i, "/", length(keywords), "finished\n") #進行状況を表示させてるだけ } obj <- unique(hoge) #得られるhogeベクトルは重複している可能性があるのでunique関数もかけた結果をobjに格納 out <- data[obj] #ベクトルdataからobjがTRUEとなる要素のみを抽出した結果をoutに格納(dataオブジェクトは行列ではないことに注意!) writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #リストファイル中にあるキーワードごとに、それが見つかった行番号情報を出力 out_f2 <- "hoge4_hoge.txt" #出力ファイル名を指定 hoge2 <- NULL #欲しい行番号情報をリスト形式で格納するためのプレースホルダ for(i in 1:length(keywords)){ #length(keywords)で表現される要素数分だけループを回す hoge2 <- c(hoge2, list(grep(keywords[i], data))) #リストファイル中の要素ごとに検索をかけて要素中の文字列と一致する行番号情報を(キーワードごとに取り扱うため)リスト形式でhoge2にどんどん格納している } hoge3 <- sapply(hoge2, paste, collapse="\t") #hoge2はリスト形式になっているので、リストの各成分中の要素を"\t"で結合し、成分数が要素数になるようなベクトルhoge3を作成している(出力に用いるwriteLines関数がベクトル中の一要素を一行で出力する仕様になっている。それに合わせるための小細工です) hoge4 <- paste(keywords, hoge3, sep="\t") #一番左側が検索に用いたリストファイル中のキーワードになるようなベクトルhoge4を作成 writeLines(hoge4, out_f2) #hoge4の中身をout_f2で指定したファイル名で保存。5. 目的のタブ区切りテキストファイル(annotation.txt)中の第1列目をキーとして、リストファイル(genelist1.txt)中のものに対応するannotation.txt中の第4列目(subcellular_location列)のみを出力する場合:
in_f1 <- "annotation.txt" #入力ファイル名(目的のタブ区切りテキストファイル)を指定 in_f2 <- "genelist1.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge5.txt" #出力ファイル名を指定 param1 <- 1 #in_f1で読み込む目的のファイルの何列目のデータに対してサーチしたいかを指定 param2 <- 4 #in_f1で読み込む目的のファイルの何列目のデータを出力したいかを指定 #ファイルの読み込み data <- read.table(in_f1, header=TRUE, sep="\t", quote="") #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番 obj <- is.element(as.character(data[,param1]), keywords) #in_f1で読み込んだファイル中の(param1)列目の文字列ベクトル中の各要素がベクトルkeywords中に含まれるか含まれないか(TRUE or FALSE)の情報をobjに格納(集合演算をしている) out <- data[obj,param2] #行列dataからobjがTRUEとなる行の(param2)列目の情報のみを抽出した結果をoutに格納 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存。6. 4と同じことをsapply関数を用いてやる場合:
in_f1 <- "annotation.txt" #入力ファイル名(目的のタブ区切りテキストファイル)を指定 in_f2 <- "genelist1.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge6.txt" #出力ファイル名を指定 #ファイルの読み込み data <- readLines(in_f1) #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番(リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得て、その行のみ出力) keywords <- unique(keywords) #リストファイル中の要素が重複している可能性があるので、重複なしの状態にしている hoge <- sapply(keywords, grep, x=data) #リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得ている obj <- unique(hoge) #得られるhogeベクトルは重複している可能性があるのでunique関数をかけた結果をobjに格納 out <- data[obj] #ベクトルdataからobjがTRUEとなる要素のみを抽出した結果をoutに格納(dataオブジェクトは行列ではないことに注意!) writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。7. 6と同じことを別のファイルを用いてやる場合: ラットのアノテーション情報ファイル(GPL1355-14795.txt), 二群間比較で発現変動が確認された遺伝子IDリストファイル(result_rankprod_BAT_id.txt)
in_f1 <- "GPL1355-14795.txt" #入力ファイル名(アノテーション情報ファイル)を指定 in_f2 <- "result_rankprod_BAT_id.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge7.txt" #出力ファイル名を指定 #ファイルの読み込み data <- readLines(in_f1) #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番(リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得て、その行のみ出力) keywords <- unique(keywords) #リストファイル中の要素が重複している可能性があるので、重複なしの状態にしている hoge <- sapply(keywords, grep, x=data) #リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得ている obj <- unique(hoge) #得られるhogeベクトルは重複している可能性があるのでunique関数をかけた結果をobjに格納 out <- data[obj] #ベクトルdataからobjがTRUEとなる要素のみを抽出した結果をoutに格納(dataオブジェクトは行列ではないことに注意!) writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。8. 7と基本的には同じだが、「遺伝子IDリストファイル中の文字列」が「アノテーション情報ファイル中の一番左側」にしか存在しないという前提で高速に探索したい場合: ラットのアノテーション情報ファイル(GPL1355-14795.txt), 二群間比較で発現変動が確認された遺伝子IDリストファイル(result_rankprod_BAT_id.txt)
in_f1 <- "GPL1355-14795.txt" #入力ファイル名(アノテーション情報ファイル)を指定 in_f2 <- "result_rankprod_BAT_id.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge8.txt" #出力ファイル名を指定 #ファイルの読み込み data <- readLines(in_f1) #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番(リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得て、その行のみ出力) keywords <- unique(keywords) #リストファイル中の要素が重複している可能性があるので、重複なしの状態にしている hoge <- sapply(paste("^", keywords, sep=""), grep, x=data) #リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得ている obj <- unique(hoge) #得られるhogeベクトルは重複している可能性があるのでunique関数をかけた結果をobjに格納 out <- data[obj] #ベクトルdataからobjがTRUEとなる要素のみを抽出した結果をoutに格納(dataオブジェクトは行列ではないことに注意!) writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。9. 8を基本として、8の出力ファイルは対象の行の情報全てを出力するものであったが、13列目のRefSeq Transcript IDに相当するもののみ抽出したい場合: ラットのアノテーション情報ファイル(GPL1355-14795.txt), 二群間比較で発現変動が確認された遺伝子IDリストファイル(result_rankprod_BAT_id.txt)
in_f1 <- "GPL1355-14795.txt" #入力ファイル名(アノテーション情報ファイル)を指定 in_f2 <- "result_rankprod_BAT_id.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge9.txt" #出力ファイル名を指定 param <- 13 #in_f1で読み込むファイルの何列目のデータを出力したいかを指定 #ファイルの読み込み data <- readLines(in_f1) #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 #本番(リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得て、その行のみ出力) keywords <- unique(keywords) #リストファイル中の要素が重複している可能性があるので、重複なしの状態にしている hoge <- sapply(paste("^", keywords, sep=""), grep, x=data) #リストファイル中の要素一つ一つに対して、要素中の文字列と一致する行番号情報を得ている obj <- unique(hoge) #得られるhogeベクトルは重複している可能性があるのでunique関数をかけた結果をobjに格納 hoge2 <- data[obj] #ベクトルdataからobjがTRUEとなる要素のみを抽出した結果をhoge2に格納(dataオブジェクトは行列ではないことに注意!) hoge3 <- strsplit(hoge2, "\t") #hoge2ベクトル中の各要素を「タブ(\t)」で区切って分割した結果をhoge3に格納 out <- unlist(lapply(hoge3, "[[", param)) #hoge3のリスト中の(param)番目の要素のみ抽出してoutに格納 writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。10. 9を基本として、8の出力ファイルは対象の行の情報全てを出力するものであったが、13列目のRefSeq Transcript IDに相当するもののみ抽出したい場合: ラットのアノテーション情報ファイル(GPL1355-14795.txt), 二群間比較で発現変動が確認された遺伝子IDリストファイル(result_rankprod_BAT_id.txt) アノテーション情報ファイルの形式は"#"から始まる行以外は同じ列数なので、行列形式などにすることが可能なことを利用している(9に比べて一般性は劣るがより劇的に早い計算が可能)
in_f1 <- "GPL1355-14795.txt" #入力ファイル名(アノテーション情報ファイル)を指定 in_f2 <- "result_rankprod_BAT_id.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f <- "hoge10.txt" #出力ファイル名を指定 param <- 13 #in_f1で読み込むファイルの何列目のデータを出力したいかを指定 #ファイルの読み込み data <- readLines(in_f1) #入力ファイル(目的のファイル)を読み込んでdataに格納 keywords <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでkeywordsに格納 keywords <- unique(keywords) #リストファイル中の要素が重複している可能性があるので、重複なしの状態にしている #アノテーション情報ファイル中で"#"から始まる行を除いて(param)列目の情報を抽出している hoge <- grep("^#", data) #正規表現で"#"から始まる行の位置情報を抽出してhogeに格納 data <- data[-hoge] #ベクトルdataからhoge中の数値に対応する要素の除いた結果をdataに格納 hoge1 <- strsplit(data, "\t") #dataベクトル中の各要素を「タブ(\t)」で区切って分割した結果をhoge1に格納 hoge2 <- unlist(lapply(hoge1, "[[", param)) #hoge1のリスト中の(param)番目の要素のみ抽出してhoge2に格納 names(hoge2) <- unlist(lapply(hoge1, "[[", 1)) #hoge1のリスト中の1番目の要素が遺伝子IDと対応するので、これをhoge2のnames属性として割り当てる #本番(keywords中の要素に対応するRefSeq IDを取得) hoge3 <- hoge2[keywords] #hoge2ベクトルの中から、names(hoge2)がkeywordsと一致するものを抽出してhoge3に格納 out <- unique(hoge3) #重複を除去している writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。11. 10を基本として、遺伝子IDリストに対応するRefSeq Transcript IDを抽出ところまでは同じだが、RefSeq IDが同じで遺伝子IDリストにないもの(common)も存在するのでその分を考慮: ラットのアノテーション情報ファイル(GPL1355-14795.txt), 二群間比較で発現変動が確認された遺伝子IDリストファイル(result_rankprod_BAT_id.txt) アノテーション情報ファイルの形式は"#"から始まる行以外は同じ列数なので、行列形式などにすることが可能なことを利用している(9に比べて一般性は劣るがより劇的に早い計算が可能)
in_f1 <- "GPL1355-14795.txt" #入力ファイル名(アノテーション情報ファイル)を指定 in_f2 <- "result_rankprod_BAT_id.txt" #入力ファイル名(キーワードなどのリストファイル)を指定 out_f1 <- "result_rankprod_BAT_RefSeq_DEG.txt" #出力ファイル名1を指定 out_f2 <- "result_rankprod_BAT_RefSeq_nonDEG.txt" #出力ファイル名2を指定 param <- 13 #in_f1で読み込むファイルの何列目のデータを出力したいかを指定 #ファイルの読み込み data <- readLines(in_f1) #入力ファイル(目的のファイル)を読み込んでdataに格納 geneid_DEG <- readLines(in_f2) #入力ファイル(リストファイル)を読み込んでgeneid_DEGに格納 #アノテーション情報ファイル中で"#"から始まる行を除いて(param)列目の情報を抽出している hoge <- grep("^#", data) #正規表現で"#"から始まる行の位置情報を抽出してhogeに格納 data <- data[-hoge] #ベクトルdataからhoge中の数値に対応する要素の除いた結果をdataに格納 hoge1 <- strsplit(data, "\t") #dataベクトル中の各要素を「タブ(\t)」で区切って分割した結果をhoge1に格納 hoge2 <- unlist(lapply(hoge1, "[[", param)) #hoge1のリスト中の(param)番目の要素のみ抽出してhoge2に格納 names(hoge2) <- unlist(lapply(hoge1, "[[", 1)) #hoge1のリスト中の1番目の要素が遺伝子IDと対応するので、これをhoge2のnames属性として割り当てる #本番 tmp_DEG <- unique(hoge2[geneid_DEG]) #hoge2ベクトルの中から、names(hoge2)がgeneid_DEGと一致するものを抽出し、重複を除いてtmp_DEGに格納 geneid_nonDEG <- setdiff(names(hoge2), geneid_DEG) #読み込んだ遺伝子IDリストファイル中のID以外のものをgeneid_nonDEGに格納 tmp_nonDEG <- unique(hoge2[geneid_nonDEG]) #hoge2ベクトルの中から、names(hoge2)がgeneid_nonDEGと一致するものを抽出し、重複を除いてtmp_nonDEGに格納 common <- intersect(tmp_DEG, tmp_nonDEG) #tmp_DEGとtmp_nonDEGベクトル間の積集合をcommonに格納 out_DEG <- setdiff(tmp_DEG, common) #tmp_DEGとcommon間の差集合をout_DEGに格納 out_nonDEG <- setdiff(tmp_nonDEG, common) #tmp_nonDEGとcommon間の差集合をout_nonDEGに格納 #ファイルに出力 writeLines(out_DEG, out_f1) #out_DEGの中身をout_f1で指定したファイル名で保存。 writeLines(out_nonDEG, out_f2) #out_nonDEGの中身をout_f2で指定したファイル名で保存。
param1 <- 50 #配列長を指定 narabi <- c("A","C","G","T") #以下の数値指定時にACGTの並びを間違えないようにするために記述している(内部的にも使用してます) param2 <- c(20, 30, 30, 20) #(A,C,G,Tの並びで)各塩基の存在比率を指定 #param2で指定したACGTの比率で配列を生成しoutに格納するところ ACGTset <- rep(narabi, param2) #narabi中の塩基がparam2で指定した数だけ存在する文字列ベクトルACGTsetを作成 out <- paste(sample(ACGTset, param1, replace=T), collapse="") #ACGTsetの文字型ベクトルからparam1回分だけ復元抽出して得られた塩基配列をoutに格納2. 基本形(任意のdescription行つきのFASTA形式ファイルで保存):
param1 <- 50 #配列長を指定 narabi <- c("A","C","G","T") #以下の数値指定時にACGTの並びを間違えないようにするために記述している(内部的にも使用してます) param2 <- c(20, 30, 30, 20) #(A,C,G,Tの並びで)各塩基の存在比率を指定 param3 <- "kkk" #FASTA形式ファイルのdescription行に記述する内容 out_f <- "hoge2.fa" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #param2で指定したACGTの比率で配列を生成しoutに格納するところ ACGTset <- rep(narabi, param2) #narabi中の塩基がparam2で指定した数だけ存在する文字列ベクトルACGTsetを作成 out <- paste(sample(ACGTset, param1, replace=T), collapse="") #ACGTsetの文字型ベクトルからparam1回分だけ復元抽出して得られた塩基配列をoutに格納 #param2で指定したACGTの比率で配列を生成 reads <- DNAStringSet(out) #生成したoutオブジェクトはDNA塩基配列だと認識させるDNAStringSet関数を適用した結果をreadsに格納 names(reads) <- param3 #FASTA形式ファイルのdescription行に相当する記述を追加している writeXStringSet(reads, file=out_f, format="fasta", width=50) #一行あたりの塩基数を「widthオプションで指定した数」にして、out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存3. 任意の配列長をもつものを複数個作ってmulti-fastaファイルにしたい場合:
param1 <- c(24, 103, 65) #配列長を指定 narabi <- c("A","C","G","T") #以下の数値指定時にACGTの並びを間違えないようにするために記述している(内部的にも使用してます) param2 <- c(20, 30, 30, 20) #(A,C,G,Tの並びで)各塩基の存在比率を指定 param3 <- "contig" #FASTA形式ファイルのdescription行に記述する内容 out_f <- "hoge3.fa" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #param2で指定したACGTの比率で配列を生成 ACGTset <- rep(narabi, param2) #narabi中の塩基がparam2で指定した数だけ存在する文字列ベクトルACGTsetを作成 out <- NULL #outというプレースホルダの作成 for(i in 1:length(param1)){ #length(param1)で表現される配列数分だけループを回す out <- c(out, paste(sample(ACGTset, param1[i], replace=T), collapse=""))#ACGTsetの文字型ベクトルからparam1[i]回分だけ復元抽出して得られた塩基配列をoutに格納 } #DNAStringSetオブジェクト形式に変換してdescription情報を追加し、ファイルに出力するところ reads <- DNAStringSet(out) #生成したoutオブジェクトはDNA塩基配列だと認識させるDNAStringSet関数を適用した結果をreadsに格納 names(reads) <- paste(param3, 1:length(out), sep="_") #FASTA形式ファイルのdescription行に相当する記述を追加している writeXStringSet(reads, file=out_f, format="fasta", width=50) #一行あたりの塩基数を「widthオプションで指定した数」にして、out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存4. 配列長情報を含むファイル(seq_length.txt; 中身は「24, 103, 65, 49」という四行からなる数値情報)を読み込む場合:
in_f <- "seq_length.txt" #読み込みたい配列長情報を含むファイルの名前を指定 narabi <- c("A","C","G","T") #以下の数値指定時にACGTの並びを間違えないようにするために記述している(内部的にも使用してます) param2 <- c(20, 30, 30, 20) #(A,C,G,Tの並びで)各塩基の存在比率を指定 param3 <- "contig" #FASTA形式ファイルのdescription行に記述する内容 out_f <- "hoge4.fa" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み param1 <- readLines(in_f) #入力ファイル(in_fファイル)を読み込んでparam1に格納 #param2で指定したACGTの比率で配列を生成 ACGTset <- rep(narabi, param2) #narabi中の塩基がparam2で指定した数だけ存在する文字列ベクトルACGTsetを作成 out <- NULL #outというプレースホルダの作成 for(i in 1:length(param1)){ #length(param1)で表現される配列数分だけループを回す out <- c(out, paste(sample(ACGTset, param1[i], replace=T), collapse=""))#ACGTsetの文字型ベクトルからparam1[i]回分だけ復元抽出して得られた塩基配列をoutに格納 } #DNAStringSetオブジェクト形式に変換してdescription情報を追加し、ファイルに出力するところ reads <- DNAStringSet(out) #生成したoutオブジェクトはDNA塩基配列だと認識させるDNAStringSet関数を適用した結果をreadsに格納 names(reads) <- paste(param3, 1:length(out), sep="_") #FASTA形式ファイルのdescription行に相当する記述を追加している writeXStringSet(reads, file=out_f, format="fasta", width=50) #一行あたりの塩基数を「widthオプションで指定した数」にして、out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存BioconductorのBiostringsのwebページ
out_f <- "hoge.txt" #出力ファイル名を指定 param <- 3 #欲しい連続塩基の長さ情報を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み out <- mkAllStrings(c("A", "C", "G", "T"), param) #(param)連続塩基の全ての可能な配列情報をoutに格納 writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。2. n=5として、4^n = 4^5 = 1024通りの5塩基からなる可能な配列を作成したい場合:
out_f <- "hoge2.txt" #出力ファイル名を指定 param <- 5 #欲しい連続塩基の長さ情報を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み out <- mkAllStrings(c("A", "C", "G", "T"), param) #(param)連続塩基の全ての可能な配列情報をoutに格納 writeLines(out, out_f) #outの中身をout_fで指定したファイル名で保存。BioconductorのBiostringsのwebページ
param1 <- "NM_006256" #取得したい配列のアクセッション番号を指定 #必要なパッケージをロード library(GeneR) #パッケージの読み込み
in_f <- "sample1.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp1.fasta" #出力ファイル名を指定 param <- c(3, 9) #抽出したい範囲の始点と終点を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- subseq(reads, param[1], param[2]) #paramで指定した始点と終点の範囲の配列を抽出してoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存2. h_rna.fastaファイルの場合:
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp2.fasta" #出力ファイル名を指定 param1 <- "NM_203348.1" #取得したい配列のアクセッション番号を指定 param2 <- c(2, 5) #抽出したい範囲の始点と終点を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み head(reads) #readsオブジェクトの最初の一部を表示(ちなみに最後の一部を表示させたい場合は「tail(reads)」) names(reads) #readsオブジェクトのID (description部分)を表示させたい場合 obj <- names(reads) == param1 #param1で指定したIDの配列の位置情報(TRUE or FALSE)をobjに格納 out <- subseq(reads[obj], param2[1], param2[2]) #objがTRUEとなる塩基配列のもののみに対して、param2で指定した始点と終点の範囲の配列を抽出してoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存3. h_rna.fastaファイルで抽出したい情報をリストファイル(list_sub1.txt)で与える場合:
in_f1 <- "h_rna.fasta" #multi-fasta形式のファイルを指定 in_f2 <- "list_sub1.txt" #リストファイルを指定 out_f <- "tmp3.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルをFASTA形式で読み込み list_obj <- read.table(in_f2) #in_f2で指定したファイルの読み込み out <- NULL #最終的に得る結果を格納するためのプレースホルダoutを作成しているだけ for(i in 1:nrow(list_obj)){ #length(list_obj)回だけループを回す obj <- names(reads) == list_obj[i,1] #names(reads)中でlist_obj[i,1]と一致する位置をTRUE、それ以外をFALSEとしたベクトルobjを作成 out <- append(out, subseq(reads[obj], start=list_obj[i,2], end=list_obj[i,3]))#subseq関数を用いてobjがTRUEとなるもののみに対して、list_obj[i,2]とlist_obj[i,3]で与えた範囲に対応する部分配列を抽出した結果をoutにどんどん格納している } # writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存4. hoge4.faファイルで抽出したい情報をリストファイル(list_sub2.txt)で与える場合:
in_f1 <- "hoge4.fa" #multi-fasta形式のファイルを指定 in_f2 <- "list_sub2.txt" #リストファイルを指定 out_f <- "tmp4.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルをFASTA形式で読み込み list_obj <- read.table(in_f2) #in_f2で指定したファイルの読み込み out <- NULL #最終的に得る結果を格納するためのプレースホルダoutを作成しているだけ for(i in 1:nrow(list_obj)){ #nrow(list_obj)回だけループを回す obj <- names(reads) == list_obj[i,1] #names(reads)中でlist_obj[i,1]と一致する位置をTRUE、それ以外をFALSEとしたベクトルobjを作成 out <- append(out, subseq(reads[obj], start=list_obj[i,2], end=list_obj[i,3]))#subseq関数を用いてobjがTRUEとなるもののみに対して、list_obj[i,2]とlist_obj[i,3]で与えた範囲に対応する部分配列を抽出した結果をoutにどんどん格納している } # writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存
in_f <- "sample1.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp2.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- translate(reads) #readsをアミノ酸配列に翻訳したものをoutに格納 names(out) <- names(reads) #現状では翻訳した結果のオブジェクトoutのdescription行が消えてしまうようなので、description部分の情報に相当するnames(reads)をnames(out)に格納している writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存#例2:h_rna.fastaファイルの場合
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp2.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- translate(reads) #readsをアミノ酸配列に翻訳したものをoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存
in_f <- "sample1.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp3.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- complement(reads) #readsオブジェクトの相補鎖をoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存#例2:h_rna.fastaファイルの場合
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp3.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- complement(reads) #readsオブジェクトの相補鎖をoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存
in_f <- "sample1.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp4.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- reverseComplement(reads) #readsオブジェクトの逆相補鎖をoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存#例2:h_rna.fastaファイルの場合
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp4.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- reverseComplement(reads) #readsオブジェクトの逆相補鎖をoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存
in_f <- "sample1.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp4.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- reverse(reads) #readsオブジェクトの逆鎖をoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存#例2:h_rna.fastaファイルの場合
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "tmp4.fasta" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- reverse(reads) #readsオブジェクトの逆鎖をoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge1.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- dinucleotideFrequency(reads) #二連続塩基の出現頻度情報をoutに格納 tmp <- cbind(names(reads), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. h_rna.fastaファイルの場合:
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "hoge2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- dinucleotideFrequency(reads) #二連続塩基の出現頻度情報をoutに格納 tmp <- cbind(names(reads), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge1.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- trinucleotideFrequency(reads) #三連続塩基の出現頻度情報をoutに格納 tmp <- cbind(names(reads), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. h_rna.fastaファイルの場合:
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "hoge2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- trinucleotideFrequency(reads) #三連続塩基の出現頻度情報をoutに格納 tmp <- cbind(names(reads), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge1.txt" #出力ファイル名を指定 param <- 4 #欲しい連続塩基の長さ情報を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- oligonucleotideFrequency(reads, width=param) #(param)連続塩基の出現頻度情報をoutに格納 tmp <- cbind(names(reads), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. hoge4.faファイルで2連続塩基(n=2)の出現頻度情報がほしい場合:
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge2.txt" #出力ファイル名を指定 param <- 2 #欲しい連続塩基の長さ情報を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- oligonucleotideFrequency(reads, width=param) #(param)連続塩基の出現頻度情報をoutに格納 tmp <- cbind(names(reads), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. hoge4.faファイルで2連続塩基(n=2)の全コンティグをまとめた出現頻度情報がほしい場合:
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge3.txt" #出力ファイル名を指定 param <- 2 #欲しい連続塩基の長さ情報を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- oligonucleotideFrequency(reads, width=param, simplify.as="collapsed")#(param)連続塩基の全コンティグをまとめた出現頻度情報をoutに格納 tmp <- cbind(names(out), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。4. hoge4.faファイルで2連続塩基(n=2)の全コンティグをまとめた出現確率情報がほしい場合:
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge4.txt" #出力ファイル名を指定 param <- 2 #欲しい連続塩基の長さ情報を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み out <- oligonucleotideFrequency(reads, width=param, simplify.as="collapsed", as.prob=TRUE)#(param)連続塩基の全コンティグをまとめた出現確率情報をoutに格納 tmp <- cbind(names(out), out) #最初の列にID情報、そのあとに出現頻度情報のoutを結合したtmpを作成 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
param <- "SRX016359" #accession番号を指定してparamに格納 #必要なパッケージをロード library(SRAdb) #パッケージの読み込み sqlfile <- getSRAdbFile() #おまじない(SRAmetadb.sqliteファイルを取得してsqlfileというオブジェクト名とする) file.info(sqlfile) #おまじない(sqlfileの中身を表示させてるだけ) sra_con <- dbConnect(SQLite(), sqlfile) #おまじない rs <- listSRAfile(in_acc=param, sra_con=sra_con) #paramで指定したexperimentのaccessionから得られる"SRR"から始まるrunのaccession番号のURL情報を取得して、rsというオブジェクト名とする for(i in 1:length(rs$sra)){ #"SRR"のアクセッション番号分だけループを回す hoge <- unlist(strsplit(rs$sra[[i]], "/", fixed=TRUE)) #URLの文字列を"/"で分割した結果をhogeに保存 cat('downloading(',i, "/", length(rs$sra), ')', hoge[length(hoge)], "\n", sep="")#状況を表示 download.file(rs$sra[[i]], destfile=hoge[length(hoge)]) #rs$sra[[i]]で指定したURLのファイルをhoge[length(hoge)]で指定したファイル名で保存 } param <- "SRX016367" #accession番号を指定してparamに格納 sqlfile <- getSRAdbFile() #おまじない(SRAmetadb.sqliteファイルを取得してsqlfileというオブジェクト名とする) file.info(sqlfile) #おまじない(sqlfileの中身を表示させてるだけ) sra_con <- dbConnect(SQLite(), sqlfile) #おまじない rs <- listSRAfile(in_acc=param, sra_con=sra_con) #paramで指定したexperimentのaccessionから得られる"SRR"から始まるrunのaccession番号のURL情報を取得して、rsというオブジェクト名とする for(i in 1:length(rs$sra)){ #"SRR"のアクセッション番号分だけループを回す hoge <- unlist(strsplit(rs$sra[[i]], "/", fixed=TRUE)) #URLの文字列を"/"で分割した結果をhogeに保存 cat('downloading(',i, "/", length(rs$sra), ')', hoge[length(hoge)], "\n", sep="")#状況を表示 download.file(rs$sra[[i]], destfile=hoge[length(hoge)]) #rs$sra[[i]]で指定したURLのファイルをhoge[length(hoge)]で指定したファイル名で保存 }参考文献1(Bullard et al., BMC Bioinformatics, 2010)
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439_2.fastq" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 out <- ShortReadQ(sread(reads), quality(reads), BStringSet(sapply(hoge,"[[", 1)))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge1.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み Total_length <- sum(width(reads)) #コンティグの「トータルの長さ」の情報を取得 Number_of_contigs <- length(reads) #「コンティグ数」の情報を取得 Average_length <- mean(width(reads)) #コンティグの「平均長」の情報を取得 Median_length <- median(width(reads)) #コンティグの「中央値」の情報を取得 Max_length <- max(width(reads)) #コンティグの長さの「最大値」の情報を取得 Min_length <- min(width(reads)) #コンティグの長さの「最小値」の情報を取得 #N50計算のところ sorted_length <- rev(sort(width(reads))) #長さ情報を降順にソートした結果をsorted_lengthに格納 N50 <- sorted_length[cumsum(sorted_length) >= Total_length/2][1] #「N50」(長いものから足しこんでいってTotal_lengthの半分に達したときのコンティグの長さ、のこと)の情報を取得 #GC含量(GC content)計算のところ count <- alphabetFrequency(reads) #A,C,G,T,..の数を各配列ごとにカウントした結果をcountに格納 CG <- rowSums(count[,2:3]) #C,Gの総数を計算してCGに格納 ACGT <- rowSums(count[,1:4]) #A,C,G,Tの総数を計算してACGTに格納 GC_content <- sum(CG)/sum(ACGT) #トータルのGC含量の情報を取得 #出力用に結果をまとめている tmp <- NULL tmp <- rbind(tmp, c("Total length (bp)", Total_length)) tmp <- rbind(tmp, c("Number of contigs", Number_of_contigs)) tmp <- rbind(tmp, c("Average length", Average_length)) tmp <- rbind(tmp, c("Median length", Median_length)) tmp <- rbind(tmp, c("Max length", Max_length)) tmp <- rbind(tmp, c("Min length", Min_length)) tmp <- rbind(tmp, c("N50", N50)) tmp <- rbind(tmp, c("GC content", GC_content)) write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. h_rna.fastaファイルの場合:
in_f <- "h_rna.fasta" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み Total_length <- sum(width(reads)) #コンティグの「トータルの長さ」の情報を取得 Number_of_contigs <- length(reads) #「コンティグ数」の情報を取得 Average_length <- mean(width(reads)) #コンティグの「平均長」の情報を取得 Median_length <- median(width(reads)) #コンティグの「中央値」の情報を取得 Max_length <- max(width(reads)) #コンティグの長さの「最大値」の情報を取得 Min_length <- min(width(reads)) #コンティグの長さの「最小値」の情報を取得 #N50計算のところ sorted_length <- rev(sort(width(reads))) #長さ情報を降順にソートした結果をsorted_lengthに格納 N50 <- sorted_length[cumsum(sorted_length) >= Total_length/2][1] #「N50」(長いものから足しこんでいってTotal_lengthの半分に達したときのコンティグの長さ、のこと)の情報を取得 #GC含量(GC content)計算のところ count <- alphabetFrequency(reads) #A,C,G,T,..の数を各配列ごとにカウントした結果をcountに格納 CG <- rowSums(count[,2:3]) #C,Gの総数を計算してCGに格納 ACGT <- rowSums(count[,1:4]) #A,C,G,Tの総数を計算してACGTに格納 GC_content <- sum(CG)/sum(ACGT) #トータルのGC含量の情報を取得 #出力用に結果をまとめている tmp <- NULL tmp <- rbind(tmp, c("Total length (bp)", Total_length)) tmp <- rbind(tmp, c("Number of contigs", Number_of_contigs)) tmp <- rbind(tmp, c("Average length", Average_length)) tmp <- rbind(tmp, c("Median length", Median_length)) tmp <- rbind(tmp, c("Max length", Max_length)) tmp <- rbind(tmp, c("Min length", Min_length)) tmp <- rbind(tmp, c("N50", N50)) tmp <- rbind(tmp, c("GC content", GC_content)) write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fastq") #in_fで指定したファイルの読み込み reads #readsの中身を表示2. readFastq関数を用いてquality情報も取り扱いたい場合:
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み hoge <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge #hogeオブジェクトの中身を表示させてるだけ("ShortReadQ"というクラスのオブジェクトであることがわかる) showClass("ShortReadQ") #ShortReadQ"というクラスのオブジェクトからどのように情報を取得するかを調べたい場合 reads <- sread(hoge) #塩基配列情報を取り出してreadsに格納 qualities <- quality(hoge) #quality情報を取り出してqualitiesに格納 ids <- id(hoge) #id情報を取り出してidsに格納3. readFastq関数を用いて読み込み、description行の" "以降の文字を削除して、またFASTQ形式で保存したい場合:
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439_2.fastq" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 #id(reads) <- BStringSet(serial) #id(reads)中の文字列を「serialをBStringSetオブジェクト化したもの」で置き換えることはできないようだ...なのでとりあえず以下のようにしている out <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存
ShortRead:Morgan et al., Bioinformatics, 2009
参考文献1(Cock et al., Nucleic Acids Res., 2010)in_f <- "test1.fasta" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #以下は(こんなこともできますという)おまけ #description部分と配列長をファイルに保存 out_f <- "hoge.txt" #出力ファイル名を指定 width(reads) #配列長情報を表示 tmp <- cbind(names(reads), width(reads)) write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #description部分と配列長+アルファをファイルに保存 out_f <- "hoge2.txt" #出力ファイル名を指定 width(reads) #配列長情報を表示 tmp <- cbind("source", paste("1..", width(reads), sep=""), "note", paste("contig: ", names(reads), sep=""), "", paste("Bombyx mori DNA, W chromosome, contig: ", names(reads), sep="")) write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
param1 <- "s_1_.*_seq.txt" #"s_1_*_seq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 strsplit(readLines(files[[1]],1), "\t") #filesで読み込んだファイルのリストについて、最初のファイルの一行目をタブで区切って表示させているだけ。5列目のデータが塩基配列情報だということを確認しているにすぎない。 colClasses <- c(rep(list(NULL), 4), "DNAString") #DNAStringSetというオブジェクト形式にするための情報を予め作成している。最初の4列には"NULL"を、最後の5列目には"DNAString"というベクトルを作成してcolClassesに格納している reads <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をreadsに格納ShortRead:Morgan et al., Bioinformatics, 2009
param1 <- "s_._._.*_qseq.txt" #"s_*_*_*_qseq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 strsplit(readLines(files[1], 1), "\t") #全部で11列あり、9列目が塩基配列情報、10列目がquality情報だということを確認しているだけ colClasses <- rep(list(NULL), 11) #DNAStringSetというオブジェクト形式にするための情報を予め作成している。初期値として全11列に"NULL"を与えている colClasses[9:10] <- c("DNAString", "BString") #DNAStringSetというオブジェクト形式にするための情報を予め作成している。9, 10列目がそれぞれ"DNAString", "BString"だという情報を与えている hoge <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をhogeに格納2. Illumina FASTQ形式ファイルとして保存したい場合(descriptionのところが通常のqseq2fastq.plの出力結果とほぼ同等の形式にしたい場合): つまり、descriptionのところをqseq形式ファイルの「3列目(レーン番号)」:「4列目」:「5列目」:「6列目」:「11列目(pass filterフラグ情報)」で表す場合です。
param1 <- "s_._._.*_qseq.txt" #"s_*_*_****_qseq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) out_f <- "hoge_illumina.fq" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 strsplit(readLines(files[1], 1), "\t") #全部で11列あり、9列目が塩基配列情報、10列目がquality情報だということを確認しているだけ colClasses <- rep(list(NULL), 11) #DNAStringSetというオブジェクト形式にするための情報を予め作成している。初期値として全11列に"NULL"を与えている colClasses[c(3:6,9:11)] <- c("BString","BString","BString","BString","DNAString", "BString", "BString")#DNAStringSetというオブジェクト形式にするための情報を予め作成している。例えば9列目が"DNAString"だという情報を与えている hoge <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をhogeに格納 sequence <- hoge[[5]] #readの塩基配列情報部分をsequenceに格納 sequence <- chartr("-", "N", sequence) #"-"になっているものを"N"に置換 quality_s <- hoge[[6]] #readのquality情報部分をquality_sに格納 #FASTQ形式のdescription部分を作成 description <- paste(hoge[[1]], hoge[[2]], hoge[[3]], hoge[[4]], hoge[[7]], sep=":")#FASTQ形式のdescription部分を作成している out <- ShortReadQ(sequence, quality_s, BStringSet(description)) #ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存3. Illumina FASTQ形式ファイルとして保存したい場合(descriptionのところが通常のqseq2fastq.plの出力結果とほぼ同等の形式にしたい場合): つまり、descriptionのところをqseq形式ファイルの「3列目(レーン番号)」:「4列目」:「5列目」:「6列目」:「11列目(pass filteringフラグ情報)」で表す場合です。 2と異なる点は、paired-endのファイルをアセンブルするときにはdescriptionのところに"/1"とか"/2"という追加の記述をしておく必要がある場合(例では"/2"を追加したい場合)に以下のやり方を用います。
param1 <- "s_._._.*_qseq.txt" #"s_*_*_****_qseq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "/2" #"/2"という記述をdescription行に追加したい場合 out_f <- "hoge_illumina2.fq" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 strsplit(readLines(files[1], 1), "\t") #全部で11列あり、9列目が塩基配列情報、10列目がquality情報だということを確認しているだけ colClasses <- rep(list(NULL), 11) #DNAStringSetというオブジェクト形式にするための情報を予め作成している。初期値として全11列に"NULL"を与えている colClasses[c(3:6,9:11)] <- c("BString","BString","BString","BString","DNAString", "BString", "BString")#DNAStringSetというオブジェクト形式にするための情報を予め作成している。例えば9列目が"DNAString"だという情報を与えている hoge <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をhogeに格納 sequence <- hoge[[5]] #readの塩基配列情報部分をsequenceに格納 sequence <- chartr("-", "N", sequence) #"-"になっているものを"N"に置換 quality_s <- hoge[[6]] #readのquality情報部分をquality_sに格納 #FASTQ形式のdescription部分を作成 description <- paste(hoge[[1]], hoge[[2]], hoge[[3]], hoge[[4]], hoge[[7]], sep=":")#FASTQ形式のdescription部分を作成している description <- paste(description, param2, sep="") #param2で指定した記述内容の追加 out <- ShortReadQ(sequence, quality_s, BStringSet(description)) #ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存4. Sanger FASTQ形式ファイルとして保存したい場合:
param1 <- "s_._._.*_qseq.txt" #"s_*_*_****_qseq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "/2" #"/2"という記述をdescription行に追加したい場合 out_f <- "hoge_sanger2.fq" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 strsplit(readLines(files[1], 1), "\t") #全部で11列あり、9列目が塩基配列情報、10列目がquality情報だということを確認しているだけ colClasses <- rep(list(NULL), 11) #DNAStringSetというオブジェクト形式にするための情報を予め作成している。初期値として全11列に"NULL"を与えている colClasses[c(3:6,9:11)] <- c("BString","BString","BString","BString","DNAString", "BString", "BString")#DNAStringSetというオブジェクト形式にするための情報を予め作成している。例えば9列目が"DNAString"だという情報を与えている hoge <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をhogeに格納 sequence <- hoge[[5]] #readの塩基配列情報部分をsequenceに格納 sequence <- chartr("-", "N", sequence) #"-"になっているものを"N"に置換 quality_s <- hoge[[6]] #readのquality情報部分をquality_sに格納 #FASTQ形式のdescription部分を作成 description <- paste(hoge[[1]], hoge[[2]], hoge[[3]], hoge[[4]], hoge[[7]], sep=":")#FASTQ形式のdescription部分を作成している description <- paste(description, param2, sep="") #param2で指定した記述内容の追加 #Illumina qualityスコアをSanger qualityスコアに変換 quality_s <- chartr("@", "!", quality_s) #「Illumina ASCII 64」 = 「Sanger ASCII 33」 Phred score = 0に相当 quality_s <- chartr("A", "\"", quality_s) #「Illumina ASCII 65」 = 「Sanger ASCII 34」 Phred score = 1に相当 quality_s <- chartr("B", "#", quality_s) #「Illumina ASCII 66」 = 「Sanger ASCII 35」 Phred score = 2に相当 quality_s <- chartr("C", "$", quality_s) #「Illumina ASCII 67」 = 「Sanger ASCII 36」 Phred score = 3に相当 quality_s <- chartr("D", "%", quality_s) #「Illumina ASCII 68」 = 「Sanger ASCII 37」 Phred score = 4に相当 quality_s <- chartr("E", "&", quality_s) #「Illumina ASCII 69」 = 「Sanger ASCII 38」 Phred score = 5に相当 quality_s <- chartr("F", "'", quality_s) #「Illumina ASCII 70」 = 「Sanger ASCII 39」 Phred score = 6に相当 quality_s <- chartr("G", "(", quality_s) #「Illumina ASCII 71」 = 「Sanger ASCII 40」 Phred score = 7に相当 quality_s <- chartr("H", ")", quality_s) #「Illumina ASCII 72」 = 「Sanger ASCII 41」 Phred score = 8に相当 quality_s <- chartr("I", "*", quality_s) #「Illumina ASCII 73」 = 「Sanger ASCII 42」 Phred score = 9に相当 quality_s <- chartr("J", "+", quality_s) #「Illumina ASCII 74」 = 「Sanger ASCII 43」 Phred score =10に相当 quality_s <- chartr("K", ",", quality_s) #「Illumina ASCII 75」 = 「Sanger ASCII 44」 Phred score =11に相当 quality_s <- chartr("L", "-", quality_s) #「Illumina ASCII 76」 = 「Sanger ASCII 45」 Phred score =12に相当 quality_s <- chartr("M", ".", quality_s) #「Illumina ASCII 77」 = 「Sanger ASCII 46」 Phred score =13に相当 quality_s <- chartr("N", "/", quality_s) #「Illumina ASCII 78」 = 「Sanger ASCII 47」 Phred score =13に相当 quality_s <- chartr("O", "0", quality_s) #「Illumina ASCII 79」 = 「Sanger ASCII 48」 Phred score =14に相当 quality_s <- chartr("P", "1", quality_s) #「Illumina ASCII 80」 = 「Sanger ASCII 49」 Phred score =15に相当 quality_s <- chartr("Q", "2", quality_s) #「Illumina ASCII 81」 = 「Sanger ASCII 50」 Phred score =16に相当 quality_s <- chartr("R", "3", quality_s) #「Illumina ASCII 82」 = 「Sanger ASCII 51」 Phred score =17に相当 quality_s <- chartr("S", "4", quality_s) #「Illumina ASCII 83」 = 「Sanger ASCII 52」 Phred score =18に相当 quality_s <- chartr("T", "5", quality_s) #「Illumina ASCII 84」 = 「Sanger ASCII 53」 Phred score =19に相当 quality_s <- chartr("U", "6", quality_s) #「Illumina ASCII 85」 = 「Sanger ASCII 54」 Phred score =20に相当 quality_s <- chartr("V", "7", quality_s) #「Illumina ASCII 86」 = 「Sanger ASCII 55」 Phred score =21に相当 quality_s <- chartr("W", "8", quality_s) #「Illumina ASCII 87」 = 「Sanger ASCII 56」 Phred score =22に相当 quality_s <- chartr("X", "9", quality_s) #「Illumina ASCII 88」 = 「Sanger ASCII 57」 Phred score =23に相当 quality_s <- chartr("Y", ":", quality_s) #「Illumina ASCII 89」 = 「Sanger ASCII 58」 Phred score =24に相当 quality_s <- chartr("Z", ";", quality_s) #「Illumina ASCII 90」 = 「Sanger ASCII 59」 Phred score =25に相当 quality_s <- chartr("[", "<", quality_s) #「Illumina ASCII 91」 = 「Sanger ASCII 60」 Phred score =26に相当 quality_s <- chartr("\\", "=", quality_s) #「Illumina ASCII 92」 = 「Sanger ASCII 61」 Phred score =27に相当 quality_s <- chartr("]", ">", quality_s) #「Illumina ASCII 93」 = 「Sanger ASCII 62」 Phred score =28に相当 quality_s <- chartr("^", "?", quality_s) #「Illumina ASCII 94」 = 「Sanger ASCII 63」 Phred score =29に相当 quality_s <- chartr("_", "@", quality_s) #「Illumina ASCII 95」 = 「Sanger ASCII 64」 Phred score =30に相当 quality_s <- chartr("`", "A", quality_s) #「Illumina ASCII 96」 = 「Sanger ASCII 65」 Phred score =31に相当 quality_s <- chartr("a", "B", quality_s) #「Illumina ASCII 97」 = 「Sanger ASCII 66」 Phred score =32に相当 quality_s <- chartr("b", "C", quality_s) #「Illumina ASCII 98」 = 「Sanger ASCII 67」 Phred score =33に相当 quality_s <- chartr("c", "D", quality_s) #「Illumina ASCII 99」 = 「Sanger ASCII 68」 Phred score =34に相当 quality_s <- chartr("d", "E", quality_s) #「Illumina ASCII 100」= 「Sanger ASCII 69」 Phred score =35に相当 quality_s <- chartr("e", "F", quality_s) #「Illumina ASCII 101」= 「Sanger ASCII 70」 Phred score =36に相当 quality_s <- chartr("f", "G", quality_s) #「Illumina ASCII 102」= 「Sanger ASCII 71」 Phred score =37に相当 quality_s <- chartr("g", "H", quality_s) #「Illumina ASCII 103」= 「Sanger ASCII 72」 Phred score =38に相当 quality_s <- chartr("h", "I", quality_s) #「Illumina ASCII 104」= 「Sanger ASCII 73」 Phred score =39に相当 quality_s <- chartr("i", "J", quality_s) #「Illumina ASCII 105」= 「Sanger ASCII 74」 Phred score =40に相当 quality_s <- chartr("j", "K", quality_s) #「Illumina ASCII 106」= 「Sanger ASCII 75」 Phred score =41に相当 quality_s <- chartr("k", "L", quality_s) #「Illumina ASCII 107」= 「Sanger ASCII 76」 Phred score =42に相当 quality_s <- chartr("l", "M", quality_s) #「Illumina ASCII 108」= 「Sanger ASCII 77」 Phred score =43に相当 quality_s <- chartr("m", "N", quality_s) #「Illumina ASCII 109」= 「Sanger ASCII 78」 Phred score =44に相当 quality_s <- chartr("n", "O", quality_s) #「Illumina ASCII 110」= 「Sanger ASCII 79」 Phred score =45に相当 quality_s <- chartr("o", "P", quality_s) #「Illumina ASCII 111」= 「Sanger ASCII 80」 Phred score =46に相当 quality_s <- chartr("p", "Q", quality_s) #「Illumina ASCII 112」= 「Sanger ASCII 81」 Phred score =47に相当 quality_s <- chartr("q", "R", quality_s) #「Illumina ASCII 113」= 「Sanger ASCII 82」 Phred score =48に相当 quality_s <- chartr("r", "S", quality_s) #「Illumina ASCII 114」= 「Sanger ASCII 83」 Phred score =49に相当 quality_s <- chartr("s", "T", quality_s) #「Illumina ASCII 115」= 「Sanger ASCII 84」 Phred score =50に相当 quality_s <- chartr("t", "U", quality_s) #「Illumina ASCII 116」= 「Sanger ASCII 85」 Phred score =51に相当 quality_s <- chartr("u", "V", quality_s) #「Illumina ASCII 117」= 「Sanger ASCII 86」 Phred score =52に相当 quality_s <- chartr("v", "W", quality_s) #「Illumina ASCII 118」= 「Sanger ASCII 87」 Phred score =53に相当 quality_s <- chartr("w", "X", quality_s) #「Illumina ASCII 119」= 「Sanger ASCII 88」 Phred score =54に相当 quality_s <- chartr("x", "Y", quality_s) #「Illumina ASCII 120」= 「Sanger ASCII 89」 Phred score =55に相当 quality_s <- chartr("y", "Z", quality_s) #「Illumina ASCII 121」= 「Sanger ASCII 90」 Phred score =56に相当 quality_s <- chartr("z", "[", quality_s) #「Illumina ASCII 122」= 「Sanger ASCII 91」 Phred score =57に相当 quality_s <- chartr("{", "\\", quality_s) #「Illumina ASCII 123」= 「Sanger ASCII 92」 Phred score =58に相当 quality_s <- chartr("|", "]", quality_s) #「Illumina ASCII 124」= 「Sanger ASCII 93」 Phred score =59に相当 quality_s <- chartr("}", "^", quality_s) #「Illumina ASCII 125」= 「Sanger ASCII 94」 Phred score =60に相当 quality_s <- chartr("~", "_", quality_s) #「Illumina ASCII 126」= 「Sanger ASCII 95」 Phred score =61に相当 out <- ShortReadQ(sequence, quality_s, BStringSet(description)) #ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存5. Sanger FASTQ形式ファイルとして保存したい場合: 4.のやり方に加えて、*.qseq.txtファイルの最後の列にあるpass filteringフラグが1のもののみ抽出したい場合です。 このpass filteringはIllumina独自のquality情報で、「0のものはqualityが低く、1のものはqualityが高い」という0 or 1で表現されています。 注意点としては、paired-endの場合は、独立の二つのファイルとして得られることになりますが、両方で1という基準にする必要があります。 そのため、4で得た二つのpaired-endファイルを入力ファイルとして読み込んで両方で1というfiteringをやらないといけません。
param1 <- "s_._._.*_qseq.txt" #"s_*_*_****_qseq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "/2" #"/2"という記述をdescription行に追加したい場合 out_f <- "hoge_sanger2.fq" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 strsplit(readLines(files[1], 1), "\t") #全部で11列あり、9列目が塩基配列情報、10列目がquality情報だということを確認しているだけ colClasses <- rep(list(NULL), 11) #DNAStringSetというオブジェクト形式にするための情報を予め作成している。初期値として全11列に"NULL"を与えている colClasses[c(3:6,9:11)] <- c("BString","BString","BString","BString","DNAString", "BString", "BString")#DNAStringSetというオブジェクト形式にするための情報を予め作成している。例えば9列目が"DNAString"だという情報を与えている hoge <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をhogeに格納 sequence <- hoge[[5]] #readの塩基配列情報部分をsequenceに格納 sequence <- chartr("-", "N", sequence) #"-"になっているものを"N"に置換 quality_s <- hoge[[6]] #readのquality情報部分をquality_sに格納 pass_filter <- hoge[[7]] #pass filtering情報部分をpass_filterに格納 #FASTQ形式のdescription部分を作成 description <- paste(hoge[[1]], hoge[[2]], hoge[[3]], hoge[[4]], hoge[[7]], sep=":")#FASTQ形式のdescription部分を作成している description <- paste(description, param2, sep="") #param2で指定した記述内容の追加 #Illumina qualityスコアをSanger qualityスコアに変換 quality_s <- chartr("@", "!", quality_s) #「Illumina ASCII 64」 = 「Sanger ASCII 33」 Phred score = 0に相当 quality_s <- chartr("A", "\"", quality_s) #「Illumina ASCII 65」 = 「Sanger ASCII 34」 Phred score = 1に相当 quality_s <- chartr("B", "#", quality_s) #「Illumina ASCII 66」 = 「Sanger ASCII 35」 Phred score = 2に相当 quality_s <- chartr("C", "$", quality_s) #「Illumina ASCII 67」 = 「Sanger ASCII 36」 Phred score = 3に相当 quality_s <- chartr("D", "%", quality_s) #「Illumina ASCII 68」 = 「Sanger ASCII 37」 Phred score = 4に相当 quality_s <- chartr("E", "&", quality_s) #「Illumina ASCII 69」 = 「Sanger ASCII 38」 Phred score = 5に相当 quality_s <- chartr("F", "'", quality_s) #「Illumina ASCII 70」 = 「Sanger ASCII 39」 Phred score = 6に相当 quality_s <- chartr("G", "(", quality_s) #「Illumina ASCII 71」 = 「Sanger ASCII 40」 Phred score = 7に相当 quality_s <- chartr("H", ")", quality_s) #「Illumina ASCII 72」 = 「Sanger ASCII 41」 Phred score = 8に相当 quality_s <- chartr("I", "*", quality_s) #「Illumina ASCII 73」 = 「Sanger ASCII 42」 Phred score = 9に相当 quality_s <- chartr("J", "+", quality_s) #「Illumina ASCII 74」 = 「Sanger ASCII 43」 Phred score =10に相当 quality_s <- chartr("K", ",", quality_s) #「Illumina ASCII 75」 = 「Sanger ASCII 44」 Phred score =11に相当 quality_s <- chartr("L", "-", quality_s) #「Illumina ASCII 76」 = 「Sanger ASCII 45」 Phred score =12に相当 quality_s <- chartr("M", ".", quality_s) #「Illumina ASCII 77」 = 「Sanger ASCII 46」 Phred score =13に相当 quality_s <- chartr("N", "/", quality_s) #「Illumina ASCII 78」 = 「Sanger ASCII 47」 Phred score =13に相当 quality_s <- chartr("O", "0", quality_s) #「Illumina ASCII 79」 = 「Sanger ASCII 48」 Phred score =14に相当 quality_s <- chartr("P", "1", quality_s) #「Illumina ASCII 80」 = 「Sanger ASCII 49」 Phred score =15に相当 quality_s <- chartr("Q", "2", quality_s) #「Illumina ASCII 81」 = 「Sanger ASCII 50」 Phred score =16に相当 quality_s <- chartr("R", "3", quality_s) #「Illumina ASCII 82」 = 「Sanger ASCII 51」 Phred score =17に相当 quality_s <- chartr("S", "4", quality_s) #「Illumina ASCII 83」 = 「Sanger ASCII 52」 Phred score =18に相当 quality_s <- chartr("T", "5", quality_s) #「Illumina ASCII 84」 = 「Sanger ASCII 53」 Phred score =19に相当 quality_s <- chartr("U", "6", quality_s) #「Illumina ASCII 85」 = 「Sanger ASCII 54」 Phred score =20に相当 quality_s <- chartr("V", "7", quality_s) #「Illumina ASCII 86」 = 「Sanger ASCII 55」 Phred score =21に相当 quality_s <- chartr("W", "8", quality_s) #「Illumina ASCII 87」 = 「Sanger ASCII 56」 Phred score =22に相当 quality_s <- chartr("X", "9", quality_s) #「Illumina ASCII 88」 = 「Sanger ASCII 57」 Phred score =23に相当 quality_s <- chartr("Y", ":", quality_s) #「Illumina ASCII 89」 = 「Sanger ASCII 58」 Phred score =24に相当 quality_s <- chartr("Z", ";", quality_s) #「Illumina ASCII 90」 = 「Sanger ASCII 59」 Phred score =25に相当 quality_s <- chartr("[", "<", quality_s) #「Illumina ASCII 91」 = 「Sanger ASCII 60」 Phred score =26に相当 quality_s <- chartr("\\", "=", quality_s) #「Illumina ASCII 92」 = 「Sanger ASCII 61」 Phred score =27に相当 quality_s <- chartr("]", ">", quality_s) #「Illumina ASCII 93」 = 「Sanger ASCII 62」 Phred score =28に相当 quality_s <- chartr("^", "?", quality_s) #「Illumina ASCII 94」 = 「Sanger ASCII 63」 Phred score =29に相当 quality_s <- chartr("_", "@", quality_s) #「Illumina ASCII 95」 = 「Sanger ASCII 64」 Phred score =30に相当 quality_s <- chartr("`", "A", quality_s) #「Illumina ASCII 96」 = 「Sanger ASCII 65」 Phred score =31に相当 quality_s <- chartr("a", "B", quality_s) #「Illumina ASCII 97」 = 「Sanger ASCII 66」 Phred score =32に相当 quality_s <- chartr("b", "C", quality_s) #「Illumina ASCII 98」 = 「Sanger ASCII 67」 Phred score =33に相当 quality_s <- chartr("c", "D", quality_s) #「Illumina ASCII 99」 = 「Sanger ASCII 68」 Phred score =34に相当 quality_s <- chartr("d", "E", quality_s) #「Illumina ASCII 100」= 「Sanger ASCII 69」 Phred score =35に相当 quality_s <- chartr("e", "F", quality_s) #「Illumina ASCII 101」= 「Sanger ASCII 70」 Phred score =36に相当 quality_s <- chartr("f", "G", quality_s) #「Illumina ASCII 102」= 「Sanger ASCII 71」 Phred score =37に相当 quality_s <- chartr("g", "H", quality_s) #「Illumina ASCII 103」= 「Sanger ASCII 72」 Phred score =38に相当 quality_s <- chartr("h", "I", quality_s) #「Illumina ASCII 104」= 「Sanger ASCII 73」 Phred score =39に相当 quality_s <- chartr("i", "J", quality_s) #「Illumina ASCII 105」= 「Sanger ASCII 74」 Phred score =40に相当 quality_s <- chartr("j", "K", quality_s) #「Illumina ASCII 106」= 「Sanger ASCII 75」 Phred score =41に相当 quality_s <- chartr("k", "L", quality_s) #「Illumina ASCII 107」= 「Sanger ASCII 76」 Phred score =42に相当 quality_s <- chartr("l", "M", quality_s) #「Illumina ASCII 108」= 「Sanger ASCII 77」 Phred score =43に相当 quality_s <- chartr("m", "N", quality_s) #「Illumina ASCII 109」= 「Sanger ASCII 78」 Phred score =44に相当 quality_s <- chartr("n", "O", quality_s) #「Illumina ASCII 110」= 「Sanger ASCII 79」 Phred score =45に相当 quality_s <- chartr("o", "P", quality_s) #「Illumina ASCII 111」= 「Sanger ASCII 80」 Phred score =46に相当 quality_s <- chartr("p", "Q", quality_s) #「Illumina ASCII 112」= 「Sanger ASCII 81」 Phred score =47に相当 quality_s <- chartr("q", "R", quality_s) #「Illumina ASCII 113」= 「Sanger ASCII 82」 Phred score =48に相当 quality_s <- chartr("r", "S", quality_s) #「Illumina ASCII 114」= 「Sanger ASCII 83」 Phred score =49に相当 quality_s <- chartr("s", "T", quality_s) #「Illumina ASCII 115」= 「Sanger ASCII 84」 Phred score =50に相当 quality_s <- chartr("t", "U", quality_s) #「Illumina ASCII 116」= 「Sanger ASCII 85」 Phred score =51に相当 quality_s <- chartr("u", "V", quality_s) #「Illumina ASCII 117」= 「Sanger ASCII 86」 Phred score =52に相当 quality_s <- chartr("v", "W", quality_s) #「Illumina ASCII 118」= 「Sanger ASCII 87」 Phred score =53に相当 quality_s <- chartr("w", "X", quality_s) #「Illumina ASCII 119」= 「Sanger ASCII 88」 Phred score =54に相当 quality_s <- chartr("x", "Y", quality_s) #「Illumina ASCII 120」= 「Sanger ASCII 89」 Phred score =55に相当 quality_s <- chartr("y", "Z", quality_s) #「Illumina ASCII 121」= 「Sanger ASCII 90」 Phred score =56に相当 quality_s <- chartr("z", "[", quality_s) #「Illumina ASCII 122」= 「Sanger ASCII 91」 Phred score =57に相当 quality_s <- chartr("{", "\\", quality_s) #「Illumina ASCII 123」= 「Sanger ASCII 92」 Phred score =58に相当 quality_s <- chartr("|", "]", quality_s) #「Illumina ASCII 124」= 「Sanger ASCII 93」 Phred score =59に相当 quality_s <- chartr("}", "^", quality_s) #「Illumina ASCII 125」= 「Sanger ASCII 94」 Phred score =60に相当 quality_s <- chartr("~", "_", quality_s) #「Illumina ASCII 126」= 「Sanger ASCII 95」 Phred score =61に相当 out <- ShortReadQ(sequence, quality_s, BStringSet(description)) #ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 out <- out[as.character(pass_filter) == "1"] #pass_filter中の値が1のもののみ抽出 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "wt_1_f.bowtie.gz" #読み込みたいBowtie形式出力ファイル名を指定してin_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み output <- readAligned(in_f, type="Bowtie") #in_fで指定したファイルの読み込み output #読み込んだAlignedReadオブジェクトoutputを表示2. 任意のディレクトリ位置から、以下のようにして特定の場所にある目的のファイルを読み込むことも可能です: 「コンピュータ - OS(C:) - Program Files - R - R-2.15.2 - library - yeastRNASeq - reads」
in_f <- "wt_1_f.bowtie.gz" #読み込みたいBowtie形式出力ファイル名を指定してin_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #yeastRNASeqパッケージ中のreadsフォルダ中に目的のファイルがあることがわかっているので... path <- file.path(system.file(package = "yeastRNASeq", "reads")) output <- readAligned(path, in_f, type="Bowtie") #in_fで指定したファイルの読み込み output #読み込んだAlignedReadオブジェクトoutputを表示BioconductorのyeastRNASeqのwebページ
ShortRead:Morgan et al., Bioinformatics, 2009
yeastRNASeq:Lee et al., PLoS Genet., 2008#必要なパッケージをロード library(Rsamtools) #パッケージの読み込み
in_f <- "output.soap" #読み込みたいSOAP出力ファイル名を指定してin_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み output <- readAligned(in_f, type="SOAP") #in_fで指定したファイルの読み込みShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "SRR037439.fastq" #読み込みたいFASTQ形式のファイル名を指定してin_fに格納 #必要なパッケージをロード library(qrqc) #パッケージの読み込み reads <- readSeqFile(in_f, quality="phred") #FASTQ形式ファイルの読み込み(Sanger FASTQ形式の場合は"phred", Illumina FASTQ形式の場合は"illumina"にすればよい) makeReport(reads) #htmlレポートの作成Bioconductorのqrqcのwebページ
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 param1 <- "kkk" #(multi-)FASTA形式のdescription部分(の一部)を指定してparam1に格納 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #入力ファイルの読み込み reads <- readDNAStringSet(in_f, format="fastq") #in_fで指定したファイルの読み込み #本番 count <- rowSums(alphabetFrequency(DNAStringSet(reads))[,1:4]) #各readについてACGTの総数をカウントし、結果をcountに格納 out <- reads[width(reads) == count] #各readの長さ(width(reads))とcountの結果を比較して、同じ長さもののみoutに格納 #ファイルへの出力 names(out) <- paste(param1, 1:length(out), sep="_") #(multi-)FASTA形式のdescription部分を作成している writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 param1 <- "kkk" #(multi-)FASTA形式のdescription部分(の一部)を指定してparam1に格納 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #入力ファイルの読み込み reads <- readDNAStringSet(in_f, format="fastq") #in_fで指定したファイルの読み込み #本番 count <- rowSums(alphabetFrequency(DNAStringSet(reads))[,1:4]) #各readについてACGTの総数をカウントし、結果をcountに格納 out <- reads[width(reads) == count] #各readの長さ(width(reads))とcountの結果を比較して、同じ長さもののみoutに格納 out1 <- tables(out, n=length(unique(out))) #読まれた頻度順にsequenceをソートして結果をout1に格納 out2 <- DNAStringSet(names(out1$top)) #sequenceの配列情報(「names(out1$top)」)をDNAStringSetオブジェクトとしてout2に格納 names(out2) <- paste(param1, 1:length(out2), out1$top, sep="_") #(multi-)FASTA形式のdescription部分を作成している writeXStringSet(out2, file=out_f, format="fasta", width=80) #out2の中身をout_fで指定したファイル名で保存ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "rat_upstream_1000.fa" #multi-fastaファイル名を指定 out_f <- "hoge1.fa" #出力ファイル名(IDリストに一致する配列)を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルを読み込んでseqに格納 #本番 hoge <- strsplit(names(seq), "_up_", fixed=TRUE) #names(reads)中の文字列を"_up_"で区切った結果をリスト形式でhogeに格納 hoge2 <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素(これがRefSeq IDに相当)を抽出してhoge2に格納 names(seq) <- hoge2 #names(seq)の中身をhoge2で置換 #ファイルに保存 writeXStringSet(seq, file=out_f, format="fasta", width=60) #一行あたりの塩基数を60にして、out_fで指定したファイル名でfasta形式で保存2. Trinity.fastaから最初のスペースで区切られる前の文字列のみにしたい場合: 抽出例:「comp59_c0_seq1 len=537 ~FPKM=305.1 path=[0:0-536]」--> 「comp59_c0_seq1」 戦略:" "を区切り文字として分割("comp59_c0_seq1", "len=537", "~FPKM=305.1", "path=[0:0-536]")し、分割後の一つ目の要素を抽出
in_f <- "Trinity.fasta" #multi-fastaファイル名を指定 out_f <- "hoge2.fa" #出力ファイル名(IDリストに一致する配列)を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルを読み込んでseqに格納 #本番 hoge <- strsplit(names(seq), " ", fixed=TRUE) #names(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 hoge2 <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素(これがRefSeq IDに相当)を抽出してhoge2に格納 names(seq) <- hoge2 #names(seq)の中身をhoge2で置換 #ファイルに保存 writeXStringSet(seq, file=out_f, format="fasta", width=60) #一行あたりの塩基数を60にして、out_fで指定したファイル名でfasta形式で保存3. DHFR.fastaからRefSeq ID部分のみ抽出したい場合: 抽出例:「gi|68303806|ref|NM_000791.3| Homo sapiens dihydrofolate reductase (DHFR), mRNA」--> 「NM_000791.3」 戦略:"|"を区切り文字として分割("gi", "68303806", "ref", "NM_000791.3", " Homo sapiens dihydrofolate reductase (DHFR), mRNA")し、分割後の4番目の要素を抽出
in_f <- "DHFR.fasta" #multi-fastaファイル名を指定 out_f <- "hoge3.fa" #出力ファイル名(IDリストに一致する配列)を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルを読み込んでseqに格納 #本番 hoge <- strsplit(names(seq), "|", fixed=TRUE) #names(reads)中の文字列を"|"で区切った結果をリスト形式でhogeに格納 hoge2 <- unlist(lapply(hoge, "[[", 4)) #hogeのリスト中の4番目の要素(これがRefSeq IDに相当)を抽出してhoge2に格納 names(seq) <- hoge2 #names(seq)の中身をhoge2で置換 #ファイルに保存 writeXStringSet(seq, file=out_f, format="fasta", width=60) #一行あたりの塩基数を60にして、out_fで指定したファイル名でfasta形式で保存4. DHFR.fastaからバージョン番号を除いたRefSeq ID部分のみ抽出したい場合: 抽出例:「gi|68303806|ref|NM_000791.3| Homo sapiens dihydrofolate reductase (DHFR), mRNA」--> 「NM_000791」 戦略:"|"を区切り文字として分割("gi", "68303806", "ref", "NM_000791.3", " Homo sapiens dihydrofolate reductase (DHFR), mRNA")し、分割後の4番目の要素を抽出。 戦略:さらに今度は"."を区切り文字として分割("NM_000791", "3")し、分割後の1番目の要素を抽出。
in_f <- "DHFR.fasta" #multi-fastaファイル名を指定 out_f <- "hoge4.fa" #出力ファイル名(IDリストに一致する配列)を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルを読み込んでseqに格納 #本番 hoge <- strsplit(names(seq), "|", fixed=TRUE) #names(reads)中の文字列を"|"で区切った結果をリスト形式でhogeに格納 hoge2 <- unlist(lapply(hoge, "[[", 4)) #hogeのリスト中の4番目の要素(これがRefSeq IDに相当)を抽出してhoge2に格納 hoge3 <- strsplit(hoge2, ".", fixed=TRUE) #hoge2中の文字列を"."で区切った結果をリスト形式でhoge3に格納 hoge4 <- unlist(lapply(hoge3, "[[", 1)) #hoge3のリスト中の1番目の要素(これがRefSeq IDのバージョン部分以外に相当)を抽出してhoge4に格納 names(seq) <- hoge4 #names(seq)の中身をhoge4で置換 #ファイルに保存 writeXStringSet(seq, file=out_f, format="fasta", width=60) #一行あたりの塩基数を60にして、out_fで指定したファイル名でfasta形式で保存
in_f <- "rat_upstream_1000.fa" #multi-fastaファイル名を指定 out_f <- "hoge1.fa" #出力ファイル名(IDリストに一致する配列)を指定 param <- 0 #許容するACGT以外の文字数を指定(0の場合はACGTのみからなる配列のみ抽出することに相当。5の場合はACGT以外の文字が含まれるのを5個まで許容することに相当) #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルを読み込んでseqに格納 #ACGT以外の文字数をカウントしてフィルタリングするところ count <- rowSums(alphabetFrequency(DNAStringSet(seq))[,1:4]) #各塩基配列についてACGTの総数をカウントし、結果をcountに格納 obj <- (width(seq) - count) <= param #各塩基配列についてACGT以外の文字数が(param)個以下の場合にTRUE, それ以外をFALSEとしたベクトルobjを作成 out <- seq[obj] #seqという配列集合からobjがTRUEとなる要素のみ抽出してoutに格納 #ファイルに保存 writeXStringSet(out, file=out_f, format="fasta", width=60) #一行あたりの塩基数を60にして、out_fで指定したファイル名でfasta形式で保存
in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge1.fasta" #出力ファイル名を指定 param <- 50 #配列長の閾値を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み reads #今現在のreadsオブジェクトを表示 reads <- reads[width(reads) >= param] #paramで指定した配列長以上のもののみ抽出してreadsに格納 reads #今現在のreadsオブジェクトを表示 writeXStringSet(reads, file=out_f, format="fasta") #out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存2. h_rna.fastaファイルの場合:
in_f <- "h_rna.fasta" #multi-fasta形式のファイルを指定 out_f <- "hoge2.fasta" #出力ファイル名を指定 param <- 200 #配列長の閾値を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み reads #今現在のreadsオブジェクトを表示 reads <- reads[width(reads) >= param] #paramで指定した配列長以上のもののみ抽出してreadsに格納 reads #今現在のreadsオブジェクトを表示 writeXStringSet(reads, file=out_f, format="fasta") #out_fで指定したファイル名でreadsというオブジェクトをfasta形式で保存
in_f1 <- "rat_upstream_1000.fa" #multi-fastaファイル名を指定 in_f2 <- "result_rankprod_BAT_RefSeq_DEG.txt" #IDリストファイル名を指定 out_f <- "seq_BAT_DEG.fa" #出力ファイル名(IDリストに一致する配列)を指定 param <- 0 #許容するACGT以外の文字数を指定(0の場合はACGTのみからなる配列のみ抽出することに相当。5の場合はACGT以外の文字が含まれるのを5個まで許容することに相当) #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルを読み込んでseqに格納 keywords <- readLines(in_f2) #in_f2で指定したファイルを読み込んでkeywordsに格納 #(in_f2で読み込んだRefSeq ID情報からなるkeywordsベクトルと対応がとれるように)seq中のdescription部分を改変 hoge <- strsplit(names(seq), "_up_", fixed=TRUE) #names(reads)中の文字列を"_up_"で区切った結果をリスト形式でhogeに格納 hoge2 <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素(これがRefSeq IDに相当)を抽出してhoge2に格納 names(seq) <- hoge2 #names(seq)の中身をhoge2で置換 seq <- unique(seq) #重複を除去(13452 sequences --> 12998 sequences) seq <- seq[width(seq) == median(width(seq))] #この場合上流1000bpの配列集合を取り扱っているはずだが、まれにそうでないものが含まれるので配列集合の配列長の中央値と同じでないものを排除している(12998 sequences --> 12997 sequences) count <- rowSums(alphabetFrequency(DNAStringSet(seq))[,1:4]) #各塩基配列についてACGTの総数をカウントし、結果をcountに格納 obj <- (width(seq) - count) <= param #各塩基配列についてACGT以外の文字数が(param)個以下の場合にTRUE, それ以外をFALSEとしたベクトルobjを作成 seq <- seq[obj] #seqという配列集合からobjがTRUEとなる要素のみ抽出(12997 sequences --> 12261 sequences)してoutに格納 #本番(names(seq)中の各要素がベクトルkeywords中に含まれるものを抽出して保存。複数のRefSeq IDになっているものは無視の方向で...。) out <- seq[is.element(names(seq), keywords)] #names(seq)中の各要素がベクトルkeywords中に含まれるものをoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=60) #一行あたりの塩基数を60にして、out_fで指定したファイル名でfasta形式で保存
param1 <- DNAStringSet(c("GCTTTCCCCAAGTAGGT","TTCTGCTTGGATCGGAAG"))#アダプター配列を含む塩基配列を指定してparam1に格納 param2 <- "ACGTACGT" #アダプター配列情報を指定してparam2に格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #左側にアダプター配列が含まれている場合1(100%マッチ): trimLRPatterns(Lpattern=param2, subject=param1, max.Lmismatch=0) #max.Lmismatch=0はミスマッチが0個という意味。2番目の配列の左端のTがアダプター配列と認識されてトリミングされている #左側にアダプター配列が含まれている場合2(100%マッチ): trimLRPatterns(Lpattern=param2, subject=param1, max.Lmismatch=rep(0, nchar(param2)))#max.Lmismatch=0はミスマッチが0個という意味。2番目の配列の左端のTがアダプター配列と認識されてトリミングされている #右側にアダプター配列が含まれている場合1(100%マッチ): trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=0) #max.Rmismatch=0はミスマッチが0個という意味。100%マッチのところはないのでparam1の配列がそのまま表示されている #右側にアダプター配列が含まれている場合2(100%マッチ): trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=rep(0, nchar(param2)))#max.Rmismatch=0はミスマッチが0個という意味。100%マッチのところはないのでparam1の配列がそのまま表示されている #右側にアダプター配列が含まれている場合1(ミスマッチを2個まで許容): trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=2) #param1の1番目の配列の右側8塩基はちゃんとトリミングされているが、2番目の配列の右側3塩基はされてないのはなぜ? #右側にアダプター配列が含まれている場合2(ミスマッチを2個まで許容): trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=rep(2, nchar(param2)))#param1の1番目の配列の右側8塩基、2番目の配列の右側3塩基がトリミングされている2. RNA配列の右側をちょっと変えた場合:
param1 <- DNAStringSet(c("GCTTTCCCCAAGTAGAC","TTCTGCTTGGATCGGATG"))#アダプター配列を含む塩基配列を指定してparam1に格納 param2 <- "ACGTACGT" #アダプター配列情報を指定してparam2に格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #ミスマッチを2個まで許容: #rep(2, nchar(param2))の意味は以下のとおりです。 #param2の最初の1塩基分(A)を2塩基ミスマッチで探索 #param2の最初の2塩基分(AC)を2塩基ミスマッチで探索 #param2の最初の3塩基分(ACG)を2塩基ミスマッチで探索 #... #param2の最初のnchar(param2)塩基分(ACGTACGT)を2塩基ミスマッチで探索 trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=rep(2, nchar(param2)))#2塩基ミスマッチを許容とはいっても”常識的な”トリミングをしてくれるのね #ミスマッチを2個まで許容(失敗例): trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=2) #なんで違った結果になるんでしょうね?!3. 右側のアダプター配列が8塩基のままで許容ミスマッチを個数ではなく割合で指定する場合:
param1 <- DNAStringSet(c("GCTTTCCCCAAGTAGGT","GCTTTCCCCACGTAGGT","GCTTTCCCCTCGTAGGT"))#アダプター配列を含む塩基配列を指定してparam1に格納 param2 <- "ACGTACGT" #アダプター配列情報を指定してparam2に格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #ミスマッチの割合を0.3(アダプター30%)まで許容: trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=0.3)# #ミスマッチの割合を0.2(アダプター20%)まで許容: trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=0.2)# #ミスマッチの割合を0.1(アダプター10%)まで許容: trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=0.1)#4. アダプター除去後の配列がx塩基以上含むものという指定をしたい場合:
param1 <- DNAStringSet(c("GCTTTCCCCAAGTAGGT","GCTTTCCCCAAGTACGT","GCTTTCCCCAAGTAGAC"))#アダプター配列を含む塩基配列を指定してparam1に格納 param2 <- "ACGTACGT" #アダプター配列情報を指定してparam2に格納 param3 <- 15 #xの値を指定してparam3に格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #100%マッチ: hoge <- trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=rep(0, nchar(param2))) #max.Rmismatch=0はミスマッチが0個という意味。100%マッチのところはないのでparam1の配列がそのまま表示されている out <- hoge[hoge@ranges@width >= param3,] #条件を満たすものだけを抽出してoutに格納 out #outの中身を表示 #ミスマッチを2個まで許容: hoge <- trimLRPatterns(Rpattern=param2, subject=param1, max.Rmismatch=rep(2, nchar(param2)))#param1の1番目の配列の右側8塩基が、2番目の配列の右側3塩基(なぜ4塩基じゃない?!)がトリミングされている out <- hoge[hoge@ranges@width >= param3,] #条件を満たすものだけを抽出してoutに格納 out #outの中身を表示ShortRead:Morgan et al., Bioinformatics, 2009
param1 <- "s_1_.*_seq.txt" #"s_1_*_seq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam2に格納 param3 <- 0 #許容するミスマッチの数を指定してparam3に格納 param4 <- "kkk" #(multi-)FASTA形式のdescription部分(の一部)を指定してparam4に格納 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 strsplit(readLines(files[[1]],1), "\t") #filesで読み込んだファイルのリストについて、最初のファイルの一行目をタブで区切って表示させているだけ。5列目のデータが塩基配列情報だということを確認しているにすぎない。 colClasses <- c(rep(list(NULL), 4), "DNAString") #DNAStringSetというオブジェクト形式にするための情報を予め作成している。最初の4列には"NULL"を、最後の5列目には"DNAString"というベクトルを作成してcolClassesに格納している reads <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をreadsに格納 out <- trimLRPatterns(Rpattern=param2, subject=reads[[1]], max.Rmismatch = rep(param3, nchar(param2))) names(out) <- paste(param4, 1:length(out), sep="_") #(multi-)FASTA形式のdescription部分を作成している writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存(Xeon W5590 3.33GHz 98GBメモリマシンでも30秒程度かかります...)。 #以下は(こんなこともできますという)おまけ #同一配列(idensical reads)何回も読まれている場合があるので、 #out中の配列群について、一回しか出現していないreadが何個あったかという情報を得たい場合: tables(out)$distribution #k回出現したreadがn個あったという情報を表形式で出力(1回しか出現しなかったのが2125 reads、2回出現したのが19 reads、...) #out中の配列群について、配列長の最小と最大の情報を得たい場合1: range(out@ranges@width) #配列長のベクトル(out@ranges@width)に対してrange関数を適用 #out中の配列群について、配列長の最小と最大の情報を得たい場合2: c(min(out@ranges@width), max(out@ranges@width)) #配列長のベクトル(out@ranges@width)に対してmin関数とmax関数を適用 #out中の配列群について、配列長別に何readsあったかをカウントしてR Console上に表示したい場合: out2 <- NULL #最終的にout2という名前で結果を得るためのプレースホルダー(おまじない) hoge <- out@ranges@width #以下のプログラムを見やすくするために配列長のベクトル(out@ranges@width)をhogeに格納(hogeとして取り扱っているだけ) for(i in min(hoge):max(hoge)){ #配列長の最小値から最大値まで1刻みでループを回す out2 <- rbind(out2, c(i, sum(hoge == i))) #配列長iの数をカウントした結果をout2に格納している } #配列長の最小値から最大値まで1刻みでループを回す colnames(out2) <- c("length", "count") #得られたout2の1列目は配列長情報、2列目はその配列長だったread数に相当するので、列名をそのように与えている out2 #out中の配列群について、配列長別に何readsあったかをカウントしてファイルに出力したい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 out2 <- NULL #最終的にout2という名前で結果を得るためのプレースホルダー(おまじない) hoge <- out@ranges@width #以下のプログラムを見やすくするために配列長のベクトル(out@ranges@width)をhogeに格納(hogeとして取り扱っているだけ) for(i in min(hoge):max(hoge)){ #配列長の最小値から最大値まで1刻みでループを回す out2 <- rbind(out2, c(i, sum(hoge == i))) #配列長iの数をカウントした結果をout2に格納している } #配列長の最小値から最大値まで1刻みでループを回す colnames(out2) <- c("length", "count") #得られたout2の1列目は配列長情報、2列目はその配列長だったread数に相当するので、列名をそのように与えている write.table(out2, out_f2, sep="\t", append=F, quote=F, row.names=F)#out2の中身をout_f2で指定したファイル名で保存。ShortRead:Morgan et al., Bioinformatics, 2009
param1 <- "s_1_.*_seq.txt" #"s_1_*_seq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam2に格納 param3 <- 2 #許容するミスマッチの数を指定してparam3に格納 param4 <- "kkk" #(multi-)FASTA形式のdescription部分(の一部)を指定してparam4に格納 param5 <- 23:30 #RNA配列長の範囲を指定してparam5に格納 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 colClasses <- c(rep(list(NULL), 4), "DNAString") #DNAStringSetというオブジェクト形式にするための情報を予め作成している。最初の4列には"NULL"を、最後の5列目には"DNAString"というベクトルを作成してcolClassesに格納している reads <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をreadsに格納 hoge <- reads[[1]]@ranges@width #以下のプログラムを見やすくするためにアダプター配列除去前のベクトル(reads[[1]]@ranges@width)をhogeに格納 if(length(hoge) != sum(hoge == mean(hoge))){ #以下の4行分のif文で、hogeの各要素についてhogeの平均値(この場合mean(hoge)=36に相当) cat("Error: Lengths of reads with adapter are different!\n") #に等しいものをカウントした結果(右辺に相当;この場合2220)が、元々のhogeの要素数 cat("You cannot use this program!\n") #(左辺のlength(hoge)に相当;この場合も2220)と等しくなければError以下の文を表示させている。 }else{ #もしこの文が表示されたら、同じ配列長でないものが含まれていることを意味するので、RNA配列長を指定することはあきらめてください hoge2 <- trimLRPatterns(Rpattern=param2, subject=reads[[1]], max.Rmismatch = rep(param3, nchar(param2)))#アダプターを含む配列の長さが全部同じだった場合のみ、アダプター配列除去を行い、結果をhoge2に格納 out <- hoge2[((hoge2@ranges@width >= min(param5)) & (hoge2@ranges@width <= max(param5))),]#hoge2の中からparam5で指定した配列長の条件を満たすもののみ抽出してoutに格納 names(out) <- paste(param4, 1:length(out), sep="_") #(multi-)FASTA形式のdescription部分を作成している writeXStringSet(out, file=out_f, format="fasta", width=80) #outの中身をout_fで指定したファイル名で保存 } #以下は(こんなこともできますという)おまけ #out中の配列群について、配列長別に何readsあったかをカウントしてファイルに出力したい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 out2 <- NULL #最終的にout2という名前で結果を得るためのプレースホルダー(おまじない) hoge <- out@ranges@width #以下のプログラムを見やすくするために配列長のベクトル(out@ranges@width)をhogeに格納(hogeとして取り扱っているだけ) for(i in min(hoge):max(hoge)){ #配列長の最小値から最大値まで1刻みでループを回す out2 <- rbind(out2, c(i, sum(hoge == i))) #配列長iの数をカウントした結果をout2に格納している } #配列長の最小値から最大値まで1刻みでループを回す colnames(out2) <- c("length", "count") #得られたout2の1列目は配列長情報、2列目はその配列長だったread数に相当するので、列名をそのように与えている write.table(out2, out_f2, sep="\t", append=F, quote=F, row.names=F)#out2の中身をout_f2で指定したファイル名で保存。ShortRead:Morgan et al., Bioinformatics, 2009
param1 <- "s_1_.*_seq.txt" #"s_1_*_seq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam2に格納 param3 <- 2 #許容するミスマッチの数を指定してparam3に格納 param4 <- "kkk" #(multi-)FASTA形式のdescription部分(の一部)を指定してparam4に格納 param5 <- 23:30 #RNA配列長の範囲を指定してparam5に格納 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 colClasses <- c(rep(list(NULL), 4), "DNAString") #DNAStringSetというオブジェクト形式にするための情報を予め作成している。最初の4列には"NULL"を、最後の5列目には"DNAString"というベクトルを作成してcolClassesに格納している reads <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をreadsに格納 hoge <- reads[[1]]@ranges@width #以下のプログラムを見やすくするためにアダプター配列除去前のベクトル(reads[[1]]@ranges@width)をhogeに格納 if(length(hoge) != sum(hoge == mean(hoge))){ #以下の4行分のif文で、hogeの各要素についてhogeの平均値(この場合mean(hoge)=36に相当) cat("Error: Lengths of reads with adapter are different!\n") #に等しいものをカウントした結果(右辺に相当;この場合2220)が、元々のhogeの要素数 cat("You cannot use this program!\n") #(左辺のlength(hoge)に相当;この場合も2220)と等しくなければError以下の文を表示させている。 }else{ #もしこの文が表示されたら、同じ配列長でないものが含まれていることを意味するので、RNA配列長を指定することはあきらめてください hoge2 <- trimLRPatterns(Rpattern=param2, subject=reads[[1]], max.Rmismatch = rep(param3, nchar(param2)))#アダプターを含む配列の長さが全部同じだった場合のみ、アダプター配列除去を行い、結果をhoge2に格納 out <- hoge2[((hoge2@ranges@width >= min(param5)) & (hoge2@ranges@width <= max(param5))),]#hoge2の中からparam5で指定した配列長の条件を満たすもののみ抽出してoutに格納 count <- rowSums(alphabetFrequency(DNAStringSet(out))[,1:4]) #各readについてACGTの総数をカウントし、結果をcountに格納 out2 <- out[out@ranges@width == count] #各readの長さ(out@ranges@width)とcountの結果を比較して、同じ長さもののみout2に格納 names(out2) <- paste(param4, 1:length(out2), sep="_") #(multi-)FASTA形式のdescription部分を作成している writeXStringSet(out2, file=out_f, format="fasta", width=80) #out2の中身をout_fで指定したファイル名で保存 } #以下は(こんなこともできますという)おまけ #out中の配列群について、配列長別に何readsあったかをカウントしてファイルに出力したい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 out2 <- NULL #最終的にout2という名前で結果を得るためのプレースホルダー(おまじない) hoge <- out@ranges@width #以下のプログラムを見やすくするために配列長のベクトル(out@ranges@width)をhogeに格納(hogeとして取り扱っているだけ) for(i in min(hoge):max(hoge)){ #配列長の最小値から最大値まで1刻みでループを回す out2 <- rbind(out2, c(i, sum(hoge == i))) #配列長iの数をカウントした結果をout2に格納している } #配列長の最小値から最大値まで1刻みでループを回す colnames(out2) <- c("length", "count") #得られたout2の1列目は配列長情報、2列目はその配列長だったread数に相当するので、列名をそのように与えている write.table(out2, out_f2, sep="\t", append=F, quote=F, row.names=F)#out2の中身をout_f2で指定したファイル名で保存。ShortRead:Morgan et al., Bioinformatics, 2009
param1 <- "s_1_.*_seq.txt" #"s_1_*_seq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam2に格納 param3 <- 2 #許容するミスマッチの数を指定してparam3に格納 param4 <- "kkk" #(multi-)FASTA形式のdescription部分(の一部)を指定してparam4に格納 param5 <- 23:30 #RNA配列長の範囲を指定してparam5に格納 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 colClasses <- c(rep(list(NULL), 4), "DNAString") #DNAStringSetというオブジェクト形式にするための情報を予め作成している。最初の4列には"NULL"を、最後の5列目には"DNAString"というベクトルを作成してcolClassesに格納している reads <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をreadsに格納 hoge <- reads[[1]]@ranges@width #以下のプログラムを見やすくするためにアダプター配列除去前のベクトル(reads[[1]]@ranges@width)をhogeに格納 if(length(hoge) != sum(hoge == mean(hoge))){ #以下の4行分のif文で、hogeの各要素についてhogeの平均値(この場合mean(hoge)=36に相当) cat("Error: Lengths of reads with adapter are different!\n") #に等しいものをカウントした結果(右辺に相当;この場合2220)が、元々のhogeの要素数 cat("You cannot use this program!\n") #(左辺のlength(hoge)に相当;この場合も2220)と等しくなければError以下の文を表示させている。 }else{ #もしこの文が表示されたら、同じ配列長でないものが含まれていることを意味するので、RNA配列長を指定することはあきらめてください hoge2 <- trimLRPatterns(Rpattern=param2, subject=reads[[1]], max.Rmismatch = rep(param3, nchar(param2)))#アダプターを含む配列の長さが全部同じだった場合のみ、アダプター配列除去を行い、結果をhoge2に格納 out <- hoge2[((hoge2@ranges@width >= min(param5)) & (hoge2@ranges@width <= max(param5))),]#hoge2の中からparam5で指定した配列長の条件を満たすもののみ抽出してoutに格納 count <- rowSums(alphabetFrequency(DNAStringSet(out))[,1:4]) #各readについてACGTの総数をカウントし、結果をcountに格納 out2 <- out[out@ranges@width == count] #各readの長さ(out@ranges@width)とcountの結果を比較して、同じ長さもののみout2に格納 out3 <- tables(out2, n=length(unique(out2))) #読まれた頻度順にshord readをソートして結果をout3に格納 out4 <- DNAStringSet(names(out3$top)) #short readsの配列情報(「names(out3$top)」)をDNAStringSetオブジェクトとしてout4に格納 names(out4) <- paste(param4, 1:length(out4), out3$top, sep="_")#(multi-)FASTA形式のdescription部分を作成している writeXStringSet(out4, file=out_f, format="fasta", width=80) #out4の中身をout_fで指定したファイル名で保存 } #以下は(こんなこともできますという)おまけ #out中の配列群について、配列長別に何readsあったかをカウントしてファイルに出力したい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 out2 <- NULL #最終的にout2という名前で結果を得るためのプレースホルダー(おまじない) hoge <- out@ranges@width #以下のプログラムを見やすくするために配列長のベクトル(out@ranges@width)をhogeに格納(hogeとして取り扱っているだけ) for(i in min(hoge):max(hoge)){ #配列長の最小値から最大値まで1刻みでループを回す out2 <- rbind(out2, c(i, sum(hoge == i))) #配列長iの数をカウントした結果をout2に格納している } #配列長の最小値から最大値まで1刻みでループを回す colnames(out2) <- c("length", "count") #得られたout2の1列目は配列長情報、2列目はその配列長だったread数に相当するので、列名をそのように与えている write.table(out2, out_f2, sep="\t", append=F, quote=F, row.names=F)#out2の中身をout_f2で指定したファイル名で保存。ShortRead:Morgan et al., Bioinformatics, 2009
param1 <- "s_._._.*_qseq.txt" #"s_._._.*_qseq.txt"という感じのファイル名のものを読み込みたい場合("."の有無に注意!!) param2 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam2に格納 param3 <- 2 #許容するミスマッチの数を指定してparam3に格納 param4 <- "kkk" #(multi-)FASTA形式のdescription部分(の一部)を指定してparam4に格納 param5 <- 23:30 #RNA配列長の範囲を指定してparam5に格納 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み files <- list.files(getwd(), pattern=param1) #param1で指定した正規表現にマッチする文字列を含むファイルのリストをfilesに格納 colClasses <- rep(list(NULL), 11) #DNAStringSetというオブジェクト形式にするための情報を予め作成している。初期値として全11列に"NULL"を与えている colClasses[9:10] <- c("DNAString", "BString") #DNAStringSetというオブジェクト形式にするための情報を予め作成している。9, 10列目がそれぞれ"DNAString", "BString"だという情報を与えている reads <- readXStringColumns(getwd(), param1, colClasses = colClasses)#colClassesで指定した列(この場合5列目)をreadXStringColumns関数を用いて読み込むことでXStringSetオブジェクト(この場合"X"は"DNA"に相当)にした結果をreadsに格納 hoge <- reads[[1]]@ranges@width #以下のプログラムを見やすくするためにアダプター配列除去前のベクトル(reads[[1]]@ranges@width)をhogeに格納 if(length(hoge) != sum(hoge == mean(hoge))){ #以下の4行分のif文で、hogeの各要素についてhogeの平均値(この場合mean(hoge)=36に相当) cat("Error: Lengths of reads with adapter are different!\n") #に等しいものをカウントした結果(右辺に相当;この場合2220)が、元々のhogeの要素数 cat("You cannot use this program!\n") #(左辺のlength(hoge)に相当;この場合も2220)と等しくなければError以下の文を表示させている。 }else{ #もしこの文が表示されたら、同じ配列長でないものが含まれていることを意味するので、RNA配列長を指定することはあきらめてください hoge2 <- trimLRPatterns(Rpattern=param2, subject=reads[[1]], max.Rmismatch = rep(param3, nchar(param2)))#アダプターを含む配列の長さが全部同じだった場合のみ、アダプター配列除去を行い、結果をhoge2に格納 out <- hoge2[((hoge2@ranges@width >= min(param5)) & (hoge2@ranges@width <= max(param5))),]#hoge2の中からparam5で指定した配列長の条件を満たすもののみ抽出してoutに格納 count <- rowSums(alphabetFrequency(DNAStringSet(out))[,1:4]) #各readについてACGTの総数をカウントし、結果をcountに格納 out2 <- out[out@ranges@width == count] #各readの長さ(out@ranges@width)とcountの結果を比較して、同じ長さもののみout2に格納 names(out2) <- paste(param4, 1:length(out2), sep="_") #(multi-)FASTA形式のdescription部分を作成している writeXStringSet(out2, file=out_f, format="fasta", width=80) #out2の中身をout_fで指定したファイル名で保存 } #以下は(こんなこともできますという)おまけ #out中の配列群について、配列長別に何readsあったかをカウントしてファイルに出力したい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 out2 <- NULL #最終的にout2という名前で結果を得るためのプレースホルダー(おまじない) hoge <- out@ranges@width #以下のプログラムを見やすくするために配列長のベクトル(out@ranges@width)をhogeに格納(hogeとして取り扱っているだけ) for(i in min(hoge):max(hoge)){ #配列長の最小値から最大値まで1刻みでループを回す out2 <- rbind(out2, c(i, sum(hoge == i))) #配列長iの数をカウントした結果をout2に格納している } #配列長の最小値から最大値まで1刻みでループを回す colnames(out2) <- c("length", "count") #得られたout2の1列目は配列長情報、2列目はその配列長だったread数に相当するので、列名をそのように与えている write.table(out2, out_f2, sep="\t", append=F, quote=F, row.names=F)#out2の中身をout_f2で指定したファイル名で保存。ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "SRR037439.fastq" #読み込みたいFASTQ形式のファイル名を指定してin_fに格納 out_f <- "hoge1.fastq" #アダプター配列除去後の出力ファイル名を指定してout_fに格納 param1 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam1に格納 #必要なパッケージをロード library(girafe) #パッケージの読み込み #FASTQ形式ファイルの読み込み readq <- readFastq(in_f) #in_fで指定したファイルの読み込み #本番 out <- trimAdapter(readq, param1) #trimAdapter関数を用いてアダプター配列除去した結果をoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存 head(sread(readq)) #アダプター配列除去前の塩基配列(の一部)を表示させてるだけ head(sread(out)) #アダプター配列除去後の塩基配列(の一部)を表示させてるだけ table(width(readq)) #アダプター配列除去前の塩基配列の配列長を示しているだけ(「35bpのものが500配列」という意味) table(width(out)) #アダプター配列除去後の塩基配列の配列長を示しているだけ(「35bpのものが464配列, 33bpのものが8配列, ...」という意味)2. paramで指定するアダプター配列と完全一致のみで且つ、最低2塩基以上一致しないとトリムしない場合:
in_f <- "SRR037439.fastq" #読み込みたいFASTQ形式のファイル名を指定してin_fに格納 out_f <- "hoge2.fastq" #アダプター配列除去後の出力ファイル名を指定してout_fに格納 param1 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam1に格納 param2 <- 2 #アダプター配列との最低一致塩基数をparam2に格納 mismatch <- nchar(param1) + 100 #不一致に対して大幅に減点するための値を「アダプター配列長 + 100」としている(100を余分に足しているのは念のためです) #必要なパッケージをロード library(girafe) #パッケージの読み込み #FASTQ形式ファイルの読み込み readq <- readFastq(in_f) #in_fで指定したファイルの読み込み #本番 out <- trimAdapter(readq, param1, mismatch.score = -mismatch, score.threshold = param2)#trimAdapter関数を用いてアダプター配列除去した結果をoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存 head(sread(readq)) #アダプター配列除去前の塩基配列(の一部)を表示させてるだけ head(sread(out)) #アダプター配列除去後の塩基配列(の一部)を表示させてるだけ table(width(readq)) #アダプター配列除去前の塩基配列の配列長を示しているだけ(「35bpのものが500配列」という意味) table(width(out)) #アダプター配列除去後の塩基配列の配列長を示しているだけ(「35bpのものが487配列, 33bpのものが10配列, ...」という意味)3. param1で指定するアダプター配列と完全一致のみで且つ、最低4塩基以上一致しないとトリムしない場合:
in_f <- "SRR037439.fastq" #読み込みたいFASTQ形式のファイル名を指定してin_fに格納 out_f <- "hoge3.fastq" #アダプター配列除去後の出力ファイル名を指定してout_fに格納 param1 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam1に格納 param2 <- 4 #アダプター配列との最低一致塩基数をparam2に格納 mismatch <- nchar(param1) + 100 #不一致に対して大幅に減点するための値を「アダプター配列長 + 100」としている(100を余分に足しているのは念のためです) #必要なパッケージをロード library(girafe) #パッケージの読み込み #FASTQ形式ファイルの読み込み readq <- readFastq(in_f) #in_fで指定したファイルの読み込み #本番 out <- trimAdapter(readq, param1, mismatch.score = -mismatch, score.threshold = param2)#trimAdapter関数を用いてアダプター配列除去した結果をoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存 head(sread(readq)) #アダプター配列除去前の塩基配列(の一部)を表示させてるだけ head(sread(out)) #アダプター配列除去後の塩基配列(の一部)を表示させてるだけ table(width(readq)) #アダプター配列除去前の塩基配列の配列長を示しているだけ(「35bpのものが500配列」という意味) table(width(out)) #アダプター配列除去後の塩基配列の配列長を示しているだけ(「35bpのものが498配列, 31bpのものが2配列」という意味)参考文献1(Toedling et al., Bioinformatics, 2010)
in_f <- "SRR037439.fastq" #読み込みたいFASTQ形式のファイル名を指定してin_fに格納 out_f <- "hoge1.fa" #アダプター配列除去後の出力ファイル名を指定してout_fに格納 param1 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam1に格納 param2 <- 2 #許容するミスマッチの数を指定してparam2に格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #FASTQ形式ファイルの読み込み readq <- readFastq(in_f) #in_fで指定したファイルの読み込み #本番(アダプター配列除去) out <- trimLRPatterns(Rpattern=param1, subject=sread(readq), max.Rmismatch=rep(param2, nchar(param1)))#アダプター配列除去を行った結果をoutに格納 names(out) <- id(readq) #description部分の記述をid(reads)で与えている #FASTA形式で出力 tmp <- out #outの中身をtmpにコピーしているだけ writeXStringSet(tmp, file=out_f, format="fasta", width=50) #tmpの中身をout_fで指定したファイル名で保存2. 上記1.のミスマッチ数指定に加え、アダプター配列除去後の配列長の範囲(23bp-30bp)を指定したい場合:
in_f <- "SRR037439.fastq" #読み込みたいFASTQ形式のファイル名を指定してin_fに格納 out_f <- "hoge2.fa" #アダプター配列除去後の出力ファイル名を指定してout_fに格納 param1 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam1に格納 param2 <- 2 #許容するミスマッチの数を指定してparam2に格納 param3 <- c(23, 30) #RNA配列長の最小と最大値を指定してparam3に格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #FASTQ形式ファイルの読み込み readq <- readFastq(in_f) #in_fで指定したファイルの読み込み #アダプター配列除去 out <- trimLRPatterns(Rpattern=param1, subject=sread(readq), max.Rmismatch=rep(param2, nchar(param1)))#アダプター配列除去を行った結果をoutに格納 names(out) <- id(readq) #description部分の記述をid(reads)で与えている #指定した配列長条件によるフィルタリング obj <- ((width(out) >= min(param3)) & (width(out) <= max(param3)))#条件を満たす配列長を持つ要素をTRUE、それ以外をFALSEとした論理値ベクトルobjを作成 out2 <- out[obj] #objがTRUEとなる要素のみ抽出した結果をout2に格納 #FASTA形式で出力 tmp <- out2 #out2の中身をtmpにコピーしているだけ writeXStringSet(tmp, file=out_f, format="fasta", width=50) #tmpの中身をout_fで指定したファイル名で保存3. 上記2.の「ミスマッチ数と配列長の範囲」指定に加え、ACGTのみからなる配列のみを抽出したい場合:
in_f <- "SRR037439.fastq" #読み込みたいFASTQ形式のファイル名を指定してin_fに格納 out_f <- "hoge3.fa" #アダプター配列除去後の出力ファイル名を指定してout_fに格納 param1 <- "CATCGATCCTGCAGGCTAGAGACAGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG"#アダプター配列情報を指定してparam1に格納 param2 <- 2 #許容するミスマッチの数を指定してparam2に格納 param3 <- c(23, 30) #RNA配列長の最小と最大値を指定してparam3に格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #FASTQ形式ファイルの読み込み readq <- readFastq(in_f) #in_fで指定したファイルの読み込み #本番(アダプター配列除去) out <- trimLRPatterns(Rpattern=param1, subject=sread(readq), max.Rmismatch=rep(param2, nchar(param1)))#アダプター配列除去を行った結果をoutに格納 names(out) <- id(readq) #description部分の記述をid(reads)で与えている #指定した配列長条件によるフィルタリング obj <- ((width(out) >= min(param3)) & (width(out) <= max(param3)))#条件を満たす配列長を持つ要素をTRUE、それ以外をFALSEとした論理値ベクトルobjを作成 out2 <- out[obj] #objがTRUEとなる要素のみ抽出した結果をout2に格納 #ACGTのみからなるもの(Nなどを含まない)をフィルタリング count <- rowSums(alphabetFrequency(DNAStringSet(out2))[,1:4]) #各readについてACGTの総数をカウントし、結果をcountに格納 out3 <- out2[width(out2) == count] #各readの長さwidth(out2)とcountの結果を比較して、同じ長さもののみout3に格納 #FASTA形式で出力 tmp <- out3 #out3の中身をtmpにコピーしているだけ writeXStringSet(tmp, file=out_f, format="fasta", width=50) #tmpの中身をout_fで指定したファイル名で保存ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "output.soap" #読み込みたいSOAP出力ファイル名を指定してin_fに格納 param1 <- "chr08" #染色体の条件 param2 <- "+" #strandの条件 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #第1段階:マップ後のファイルの読み込み output <- readAligned(in_f, type="SOAP") #in_fで指定したファイルの読み込み #第2段階:フィルタリング output <- output[output@chromosome == param1] #param1で指定した染色体の情報のみ抽出して、readsに格納 output <- output[output@strand == "+"] #param2で指定したstrandのもののみ抽出して、readsに格納 #以下は(こんなこともできますという)おまけ reads <- sread(output) #outputで得られたオブジェクトから塩基配列情報をDNAStringSetオブジェクトとして得たい場合2. 「8番染色体上の+鎖のみにマップされたもののみ」の場合のやり方2:
in_f <- "output.soap" #読み込みたいSOAP出力ファイル名を指定してin_fに格納 param1 <- "chr08" #染色体の条件 param2 <- "+" #strandの条件 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #第1段階:マップ後のファイルの読み込み output <- readAligned(in_f, type="SOAP") #in_fで指定したファイルの読み込み #第2段階:フィルタリング filter <- compose(chromosomeFilter(param1), strandFilter(param2))#param1 and param2で指定したフィルタリング条件をまとめてfilterに格納 output <- output[filter(output)] #フィルタリングを実行して、その結果をreadsに格納 #以下は(こんなこともできますという)おまけ reads <- sread(output) #outputで得られたオブジェクトから塩基配列情報をDNAStringSetオブジェクトとして得たい場合3. 「strandは気にせずに10番染色体上にマップされたもののみ」の場合:
in_f <- "output.soap" #読み込みたいSOAP出力ファイル名を指定してin_fに格納 param1 <- "chr10" #染色体の条件 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #第1段階:マップ後のファイルの読み込み output <- readAligned(in_f, type="SOAP") #in_fで指定したファイルの読み込み #第2段階:フィルタリング filter <- compose(chromosomeFilter(param1)) #param1で指定したフィルタリング条件をまとめてfilterに格納 output <- output[filter(output)] #フィルタリングを実行して、その結果をreadsに格納 #以下は(こんなこともできますという)おまけ reads <- sread(output) #outputで得られたオブジェクトから塩基配列情報をDNAStringSetオブジェクトとして得たい場合4. 「マップされた染色体全てについてマップされたリード数などの基礎情報を取得」の場合:
in_f <- "output.soap" #読み込みたいSOAP出力ファイル名を指定してin_fに格納 out_f <- "output.hoge" #出力ファイル名を指定 #第1段階:マップ後のファイルの読み込み library(ShortRead) #パッケージの読み込み output <- readAligned(in_f, type="SOAP") #in_fで指定したファイルの読み込み #第2段階:基礎情報取得 unique_chr <- sort(unique(output@chromosome)) #マップされた染色体情報を取得してunique_chrに格納 out <- NULL #おまじない for(j in 1:length(unique_chr)){ #unique_chr中の染色体数分だけループを回す output_sub <- output[output@chromosome == unique_chr[j]] #特定の染色体上にマップされたもののみ抽出してoutput_subに格納 out <- rbind(out, c(unique_chr[j], length(output_sub))) #染色体名(unique_chr[j])とその染色体上にマップされたリード数(length(output_sub))をまとめてoutに格納 } colnames(out) <- c("chromosome_name", "reads_mapped") #列名を左記のように与えている write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存。5. 「4. マップされた染色体全てについてマップされたリード数などの基礎情報を取得」の出力ファイル名の自動作成(拡張子.hoge)版: 割と便利なので備忘録的に掲載しておきます。
in_f <- "output.soap" #読み込みたいSOAP出力ファイル名を指定してin_fに格納 param <- "hoge" #出力ファイル名の拡張子を指定 out_f <- paste(unlist(strsplit(in_f, ".", fixed=TRUE))[1], param, sep=".") #出力ファイル名を作成してout_fに格納 #第1段階:マップ後のファイルの読み込み library(ShortRead) #パッケージの読み込み output <- readAligned(in_f, type="SOAP") #in_fで指定したファイルの読み込み #第2段階:基礎情報取得 unique_chr <- sort(unique(output@chromosome)) #マップされた染色体情報を取得してunique_chrに格納 out <- NULL #おまじない for(j in 1:length(unique_chr)){ #unique_chr中の染色体数分だけループを回す output_sub <- output[output@chromosome == unique_chr[j]] #特定の染色体上にマップされたもののみ抽出してoutput_subに格納 out <- rbind(out, c(unique_chr[j], length(output_sub))) #染色体名(unique_chr[j])とその染色体上にマップされたリード数(length(output_sub))をまとめてoutに格納 } colnames(out) <- c("chromosome_name", "reads_mapped") #列名を左記のように与えている write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存。6. 「5」を基本形として、さらにstrand(+ or -)別の情報を追加したもの: 割と便利なので備忘録的に掲載しておきます。
in_f <- "output.soap" #読み込みたいSOAP出力ファイル名を指定してin_fに格納 param <- "hoge" #出力ファイル名の拡張子を指定 out_f <- paste(unlist(strsplit(in_f, ".", fixed=TRUE))[1], param, sep=".") #出力ファイル名を作成してout_fに格納 #第1段階:マップ後のファイルの読み込み library(ShortRead) #パッケージの読み込み output <- readAligned(in_f, type="SOAP") #in_fで指定したファイルの読み込み #第2段階:基礎情報取得 unique_chr <- sort(unique(output@chromosome)) #マップされた染色体情報を取得してunique_chrに格納 out <- NULL #おまじない for(j in 1:length(unique_chr)){ #unique_chr中の染色体数分だけループを回す output_sub <- output[output@chromosome == unique_chr[j]] #特定の染色体上にマップされたもののみ抽出してoutput_subに格納 output_sub_f <- output_sub[output_sub@strand == "+"] #output_subの中で"+"鎖上にマップされたものをoutput_sub_fに格納 output_sub_r <- output_sub[output_sub@strand == "-"] #output_subの中で"-"鎖上にマップされたものをoutput_sub_rに格納 out <- rbind(out, c(unique_chr[j],length(output_sub),length(output_sub_f),length(output_sub_r)))#「染色体名(unique_chr[j])」、「その染色体上にマップされたリード数(length(output_sub))」、「+鎖上に...」、「-鎖上に...」をまとめてoutに格納 } colnames(out) <- c("chromosome_name", "reads_mapped", "reads_mapped(+)", "reads_mapped(-)") #列名を左記のように与えている write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存。
BioconductorのBiostringsのwebページ
参考文献1(Li et al., Bioinformatics., 2009)in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439.txt" #出力ファイル名を指定してout_fに格納 library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 out <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 qscore <- as(quality(out), "matrix") #ASCIIコードのquality scoreをPHRED scoreに変換し、データ構造をmatrixにした結果をqscoreに格納 dim(qscore) #qscoreの行数と列数を確認しているだけ rownames(qscore) <- serial #qscoreの行名をserialで与えている colnames(qscore) <- 1:ncol(qscore) #qscoreの列名を1:ncol(qscore)の数値ベクトルで与えている tmp <- cbind(serial, qscore) #qscore行列の左側にserialを結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。やり方2 (ASCIIコードからPHREDスコアに変換した結果の分布をboxplotで描きたい場合):
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 out <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 qscore <- as(quality(out), "matrix") #ASCIIコードのquality scoreをPHRED scoreに変換し、データ構造をmatrixにした結果をqscoreに格納 rownames(qscore) <- serial #qscoreの行名をserialで与えている colnames(qscore) <- 1:ncol(qscore) #qscoreの列名を1:ncol(qscore)の数値ベクトルで与えている boxplot(as.data.frame(qscore), outline=FALSE, xlab="cycle number", ylab="PHRED score")#qscoreをdata.frame形式にしてboxplotを描画(outline=FALSEの意味は、外れ値を描画しない、です。)やり方3 (ASCIIコードからPHREDスコアに変換した結果の分布をboxplotでpngファイルに保存したい場合):
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439.png" #出力ファイル名を指定してout_fに格納 param1 <- 600 #横幅(width; 単位はピクセル)を指定 param2 <- 400 #縦幅(height; 単位はピクセル)を指定 param3 <- 13 #文字の大きさ(単位はpoint)を指定 library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 out <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 qscore <- as(quality(out), "matrix") #ASCIIコードのquality scoreをPHRED scoreに変換し、データ構造をmatrixにした結果をqscoreに格納 rownames(qscore) <- serial #qscoreの行名をserialで与えている colnames(qscore) <- 1:ncol(qscore) #qscoreの列名を1:ncol(qscore)の数値ベクトルで与えている png(out_f, pointsize=param3, width=param1, height=param2) #出力ファイルの各種パラメータを指定 boxplot(as.data.frame(qscore), outline=FALSE, xlab="cycle number", ylab="PHRED score")#qscoreをdata.frame形式にしてboxplotを描画(outline=FALSEの意味は、外れ値を描画しない、です。) dev.off() #おまじないShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439_f.fastq" #出力ファイル名を指定してout_fに格納 param1 <- 20 #PHREDスコアの閾値を指定 param2 <- 0.1 #指定した閾値未満のものがリード長に占める割合を指定 library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 hoge2 <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをhoge2に格納 qscore <- as(quality(hoge2), "matrix") #ASCIIコードのquality scoreをPHRED scoreに変換し、データ構造をmatrixにした結果をqscoreに格納 obj <- (rowSums(qscore < param1) <= width(hoge2)*param2) #param1およびparam2で指定した条件を満たすリードをTRUE、そうでないものをFALSEとしたものをobjに格納 nrow(qscore) #qscoreの行数を表示させてもともとのリード数を表示させてるだけ sum(obj) #obj中のTRUEの要素数(除去されずに残ったリード数)を表示させてるだけ out <- hoge2[obj] #hoge2の中からobj中の要素がTRUEのもののみ抽出した結果をoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存2. 各リードに対するPHREDスコアが20以上の塩基数が0.9より多いリードのみ抽出したい場合: (1と同じことを別の言葉で表現しているだけです。)
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439_f.fastq" #出力ファイル名を指定してout_fに格納 param1 <- 20 #PHREDスコアの閾値を指定 param2 <- 0.9 #指定した閾値以上の塩基数の各リードに占める割合を指定 library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 hoge2 <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをhoge2に格納 qscore <- as(quality(hoge2), "matrix") #ASCIIコードのquality scoreをPHRED scoreに変換し、データ構造をmatrixにした結果をqscoreに格納 obj <- (rowSums(qscore >= param1) > width(hoge2)*param2) #param1およびparam2で指定した条件を満たすリードをTRUE、そうでないものをFALSEとしたものをobjに格納 nrow(qscore) #qscoreの行数を表示させてもともとのリード数を表示させてるだけ sum(obj) #obj中のTRUEの要素数(除去されずに残ったリード数)を表示させてるだけ out <- hoge2[obj] #hoge2の中からobj中の要素がTRUEのもののみ抽出した結果をoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存#3. 各リードに対するPHREDスコアが任意の閾値以上の塩基数をまずは自分で眺めたい場合:
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439_f.txt" #出力ファイル名を指定してout_fに格納 param1 <- 20 #PHREDスコアの閾値を指定 library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 hoge2 <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをhoge2に格納 qscore <- as(quality(hoge2), "matrix") #ASCIIコードのquality scoreをPHRED scoreに変換し、データ構造をmatrixにした結果をqscoreに格納 obj_num <- rowSums(qscore >= param1) #param1で指定した条件を満たすリードごとの塩基数をobj_numに格納 obj_percent <- 100*obj_num/width(hoge2) #obj_num中の塩基数をパーセンテージに変換したものをobj_percentに格納 tmp <- cbind(serial, width(hoge2), obj_num, obj_percent) #「リードのシリアル番号」、「リードの長さ」、「obj_num」、「obj_percent」を列方向に結合したものをtmpに格納 colnames(tmp) <- c("serial", "read_length", "nucleotide_number", "percentage")#tmpに対して任意の列名を与えている write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "SRR037439.fastq" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "SRR037439_f.fastq" #出力ファイル名を指定してout_fに格納 param1 <- 20 #PHREDスコアの閾値を指定 param2 <- "N" #置換後の文字を指定 library(Biostrings) #パッケージの読み込み library(ShortRead) #パッケージの読み込み reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge <- strsplit(as.character(id(reads)), " ", fixed=TRUE) #id(reads)中の文字列を" "で区切った結果をリスト形式でhogeに格納 serial <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してserialに格納 hoge2 <- ShortReadQ(sread(reads), quality(reads), BStringSet(serial))#ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをhoge2に格納 qscore <- as(quality(hoge2), "matrix") #ASCIIコードのquality scoreをPHRED scoreに変換し、データ構造をmatrixにした結果をqscoreに格納 at <- qscore < param1 #param1で指定した条件を満たす塩基をTRUE、そうでないものをFALSEとした結果をatに格納 hoge3 <- DNAString(paste(rep(param2, width(hoge2)[1]), collapse=""))#「リード長がwidth(hoge2)[1]」で「全ての塩基がparam2で指定した文字」からなるDNAStringオブジェクトを作成してhoge3に格納(この場合Nが35個からなる塩基配列に相当) letter <- as(Views(hoge3, start=1, end=rowSums(at)), "DNAStringSet")#rowSums(at)で各リードごとのPHREDスコアが閾値未満の塩基数がわかるので、その塩基数分からなるparam2の文字のDNAStringSetオブジェクトを作成してletterに格納 hoge4 <- replaceLetterAt(sread(hoge2), at, letter) #atやletterを作成したのは、ここで用いている目的のreplaceLetterAt関数がそれらの情報を用いて該当塩基部分の置換を行うからです out <- ShortReadQ(hoge4, quality(reads), BStringSet(serial)) #ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 sread(out) #sread(out)の中身を表示させてるだけ(Nが増えているのがわかる; hoge4でも同じ) writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存ShortRead:Morgan et al., Bioinformatics, 2009
in_f1 <- "read1.fq" #読み込みたいFASTQ形式のファイル名を指定してin_f1に格納 in_f2 <- "read2.fq" #読み込みたいFASTQ形式のファイル名を指定してin_f2に格納 out_f1 <- "read1_pf.fq" #出力ファイル名を指定してout_f1に格納 out_f2 <- "read2_pf.fq" #出力ファイル名を指定してout_f2に格納 library(ShortRead) #パッケージの読み込み #read1について基本情報取得 reads1 <- readFastq(in_f1) #in_f1で指定したファイルの読み込み hoge <- strsplit(as.character(id(reads1)), "/", fixed=TRUE) #id(reads1)中の文字列を"/"で区切った結果をリスト形式でhogeに格納 hoge2 <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してhoge2に格納 hoge3 <- strsplit(hoge2, ":", fixed=TRUE) #hoge2中の文字列を":"で区切った結果をリスト形式でhoge3に格納 pass_filter1 <- sapply(hoge3,"[[", length(hoge3[[1]])) #hoge3のリスト中の最後の要素のみ取り出してpass_filter1に格納 tmp_serial1 <- hoge2 #入力ファイルのIDの順番がファイル間で同じかどうかを確かめるためにhoge2情報をtmp_serial1に格納 #read2について基本情報取得 reads2 <- readFastq(in_f2) #in_f2で指定したファイルの読み込み hoge <- strsplit(as.character(id(reads2)), "/", fixed=TRUE) #id(reads2)中の文字列を"/"で区切った結果をリスト形式でhogeに格納 hoge2 <- sapply(hoge,"[[", 1) #hogeのリスト中の一番目の要素のみ取り出してhoge2に格納 hoge3 <- strsplit(hoge2, ":", fixed=TRUE) #hoge2中の文字列を":"で区切った結果をリスト形式でhoge3に格納 pass_filter2 <- sapply(hoge3,"[[", length(hoge3[[1]])) #hoge3のリスト中の最後の要素のみ取り出してpass_filter2に格納 tmp_serial2 <- hoge2 #入力ファイルのIDの順番がファイル間で同じかどうかを確かめるためにhoge2情報をtmp_serial2に格納 #入力ファイルの状態を念のため確認している #Step1:二つのファイル間でIDの総数が同じかどうかをチェック #Step2:二つのファイル間でID情報のpass filterの部分より左側のところのみが同じかどうかをチェック flag <- 0 if(length(tmp_serial1) == length(tmp_serial2)){ print("Step1:OK") flag <- 1 if(length(tmp_serial1) == sum(tmp_serial1 == tmp_serial2)){ print("Step2:OK") flag <- 2 }else{ print("Step2:IDs between two paired-end files are not ideltical!") } }else{ print("Step1:The two files are not paired-end!") } #本番:二つのファイル間でpass filteringフラグが1のもののみ抽出する if(flag == 2){ hoge_flag <- as.integer(pass_filter1) + as.integer(pass_filter2)#IDごとにpass filteringフラグの和を計算した結果をhoge_flagに格納(両方で1のものは2になる) length(hoge_flag) #フィルタリング前のリード数を表示 sum(hoge_flag == 2) #フィルタリング後のリード数を表示 writeFastq(reads1[hoge_flag == 2], out_f1) #reads1の中からhoge_flagの値が2となるもののみout_f1で指定したファイル名で保存 writeFastq(reads2[hoge_flag == 2], out_f2) #reads2の中からhoge_flagの値が2となるもののみout_f2で指定したファイル名で保存 }ShortRead:Morgan et al., Bioinformatics, 2009
in_f <- "" #読み込みたいファイル名を指定してin_fに格納 #必要なパッケージをロード library(htSeqTools) #パッケージの読み込み
BioconductorのhtSeqToolsのwebページ
参考文献1(Planet et al., Bioinformatics., 2012)in_f <- "hoge4.fa" #multi-fasta形式の入力ファイルを指定 out_f <- "hoge_out.fa" #出力ファイル名を指定 param1 <- 5 #3'末端のトリムしたい塩基数 param2 <- 20 #トリム後に出力する配列長の閾値(ここで指定した数値以上の長さのものが出力される) #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #塩基配列データファイルの読み込みとトリム reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み hoge <- DNAStringSet(reads, start=1, end=(width(reads)-param1)) #readsオブジェクトの中から(param1)塩基だけトリムした結果をDNAStringSet形式にしてhogeに格納 out <- hoge[width(hoge) >= param2] #(param2)で指定した配列長以上、という条件を満たすリードのみ抽出してoutに格納 writeXStringSet(out, file=out_f, format="fasta", width=60) #一行あたりの塩基数を60bpにして、out_fで指定したファイル名でoutというオブジェクトをFASTA形式で保存2. SRR037439.fastqファイルの場合(FASTQ形式):
in_f <- "SRR037439.fastq" #FASTQ形式の入力ファイルを指定 out_f <- "hoge_out2.fq" #出力ファイル名を指定 param1 <- 2 #3'末端のトリムしたい塩基数 param2 <- 30 #トリム後に出力する配列長の閾値(ここで指定した数値以上の長さのものが出力される) #必要なパッケージをロード library(Biostrings) #パッケージの読み込み library(ShortRead) #パッケージの読み込み #塩基配列データファイルの読み込みとトリム reads <- readFastq(in_f) #in_fで指定したファイルの読み込み hoge1 <- DNAStringSet(sread(reads), start=1, end=width(sread(reads))-param1)#sread(reads)オブジェクトの中から(param1)塩基だけトリムした結果をDNAStringSet形式にしてhoge1に格納 hoge2 <- BStringSet(quality(quality(reads)), start=1, end=width(quality(quality(reads)))-param1)#quality(reads)オブジェクトの中から(param1)塩基だけトリムした結果をDNAStringSet形式にしてhoge2に格納 #トリム後の配列長でフィルタリング hoge1.f <- hoge1[width(hoge1) >= param2] #(param2)で指定した配列長以上、という条件を満たすもののみ抽出してhoge1.fに格納 hoge2.f <- hoge2[width(hoge1) >= param2] #(param2)で指定した配列長以上、という条件を満たすもののみ抽出してhoge2.fに格納 hoge3.f <- BStringSet(as.character(id(reads)))[width(hoge1) >= param2]#(param2)で指定した配列長以上、という条件を満たすもののみ抽出してhoge3.fに格納 #FASTQ形式に再び戻してファイル出力 out <- ShortReadQ(hoge1.f, hoge2.f, hoge3.f) #ReadFastQ関数を用いてReadFastQというクラスオブジェクトを一から作成したものをoutに格納 writeFastq(out, out_f) #オブジェクトoutをFASTQ形式で保存
BioconductorのBiostringsのwebページ
ShortRead:Morgan et al., Bioinformatics, 2009in_f <- "Trinity.fasta" #読み込みたいファイル名を指定してin_fに格納 out_f <- "output.txt" #出力ファイル名を指定してout_fに格納 library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み hoge <- strsplit(names(reads), " ", fixed=TRUE) #names(reads)中の文字列をスペース(" ")で区切った結果をリスト形式でhogeに格納 contigID <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素(コンティグID部分に相当)のみ抽出してcontigIDに格納 hoge2 <- unlist(lapply(hoge, "[[", 3)) #hogeのリスト中の3番目の要素(FPKM部分に相当)のみ抽出してhoge2に格納 hoge3 <- strsplit(hoge2, "=", fixed=TRUE) #hoge2中の文字列を"="で区切った結果をリスト形式でhoge3に格納 FPKM <- unlist(lapply(hoge3, "[[", 2)) #hoge3のリスト中の2番目の要素(FPKMの実際の値部分に相当)のみ抽出してFPKMに格納 transcript_length <- width(reads) #配列長情報をtranscript_lengthに格納 tmp <- cbind(contigID, FPKM, transcript_length) #「コンティグID」、「FPKM値」、「配列長」を結合してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。Trinity:Grabherr et al., Nature Biotechnol, 2011
in_f1 <- "sample_1.bed" #読み込みたいBED形式ファイル名を指定してin_f1に格納 in_f2 <- "hoge4.fa" #マップに用いたリファレンス配列のファイル名を指定してin_f2に格納 out_f <- "output1.txt" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #入力ファイルの読み込みと必要な情報の抽出など reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルを読み込んでreadsに格納 data <- read.table(in_f1, header=TRUE, sep="\t") #in_f1で指定したファイルを読み込んでdataに格納 ID_list <- as.vector(data[,1]) #行列dataから1列目の情報のみ抽出してベクトル形式にした結果をID_listに格納 out <- rle(sort(ID_list)) #どのIDがいくつあったかをカウントした結果をoutに格納 #本番 rawcount <- rep(0, length(reads)) #最終的に欲しいrawcount値の初期値を0にしておく names(rawcount) <- names(reads) #names(reads)をnames(rawcount)に格納 hoge <- out$lengths #outオブジェクト中のカウント情報をhogeに格納 names(hoge) <- out$values #outオブジェクト中のID情報をnames(hoge)に格納 obj <- is.element(names(rawcount), names(hoge)) #names(rawcount)の並び順でnames(hoge)中のIDが存在する位置にTRUEを、そうでない位置にはFALSEを返した結果をobjに格納 common <- intersect(names(rawcount), names(hoge)) #names(rawcount)とnames(hoge)中の積集合をcommonに格納 rawcount[obj] <- hoge[common] #objがTRUEの位置に生リードカウントを代入 #ファイル出力 tmp <- cbind(names(reads), rawcount) #結果ファイルの1列目がID, 2列目がcount情報になるようにしたものをtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存2. マップされる側の配列(hoge4.fa)中のIDの並びでBED形式ファイル(sample_1.bed)中の出現回数をカウントする場合(1.と同じだが、若干異なる手順にしている):
in_f1 <- "sample_1.bed" #読み込みたいBED形式ファイル名を指定してin_f1に格納 in_f2 <- "hoge4.fa" #マップに用いたリファレンス配列のファイル名を指定してin_f2に格納 out_f <- "output2.txt" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #入力ファイルの読み込みと必要な情報の抽出など reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルを読み込んでreadsに格納 data <- read.table(in_f1, header=TRUE, sep="\t") #in_f1で指定したファイルを読み込んでdataに格納 ID_list <- as.vector(data[,1]) #行列dataから1列目の情報のみ抽出してベクトル形式にした結果をID_listに格納 out <- rle(sort(ID_list)) #どのIDがいくつあったかをカウントした結果をoutに格納 #本番 rawcount <- rep(0, length(reads)) #最終的に欲しいrawcount値の初期値を0にしておく names(rawcount) <- sort(names(reads)) #sort(names(reads))をnames(rawcount)に格納 hoge <- out$lengths #outオブジェクト中のカウント情報をhogeに格納 names(hoge) <- out$values #outオブジェクト中のID情報をnames(hoge)に格納 obj <- is.element(names(rawcount), names(hoge)) #names(rawcount)の並び順でnames(hoge)中のIDが存在する位置にTRUEを、そうでない位置にはFALSEを返した結果をobjに格納 rawcount[obj] <- hoge #objがTRUEの位置に生リードカウントを代入 #ファイル出力(この段階でin_f2で読み込んだファイルのIDの並びに変更している) tmp <- cbind(names(reads), rawcount[names(reads)]) #結果ファイルの1列目がID, 2列目がcount情報になるようにしたものをtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存3. マップされる側の配列(h_rna.fasta)中のIDの並びでBED形式ファイル(SRR002324_t.bed)中の出現回数をカウントする場合:
in_f1 <- "SRR002324_t.bed" #読み込みたいBED形式ファイル名を指定してin_f1に格納 in_f2 <- "h_rna.fasta" #マップに用いたリファレンス配列のファイル名を指定してin_f2に格納 out_f <- "output3.txt" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(ShortRead) #パッケージの読み込み #入力ファイルの読み込みと必要な情報の抽出など reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルを読み込んでreadsに格納 data <- read.table(in_f1, header=TRUE, sep="\t") #in_f1で指定したファイルを読み込んでdataに格納 ID_list <- as.vector(data[,1]) #行列dataから1列目の情報のみ抽出してベクトル形式にした結果をID_listに格納 out <- rle(sort(ID_list)) #どのIDがいくつあったかをカウントした結果をoutに格納 #本番 rawcount <- rep(0, length(reads)) #最終的に欲しいrawcount値の初期値を0にしておく names(rawcount) <- names(reads) #names(reads)をnames(rawcount)に格納 hoge <- out$lengths #outオブジェクト中のカウント情報をhogeに格納 names(hoge) <- out$values #outオブジェクト中のID情報をnames(hoge)に格納 obj <- is.element(names(rawcount), names(hoge)) #names(rawcount)の並び順でnames(hoge)中のIDが存在する位置にTRUEを、そうでない位置にはFALSEを返した結果をobjに格納 common <- intersect(names(rawcount), names(hoge)) #names(rawcount)とnames(hoge)中の積集合をcommonに格納 rawcount[obj] <- hoge[common] #objがTRUEの位置に生リードカウントを代入 #ファイル出力 tmp <- cbind(names(reads), rawcount) #結果ファイルの1列目がID, 2列目がcount情報になるようにしたものをtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存4. マップされる側の配列(h_rna.fasta)中のIDをソートした並びでBED形式ファイル(SRR002324_t.bed)中の出現回数をカウントする場合: 基本的に2.の記述と同じで、最後のファイル出力のところでalphabet順にソートしたままの状態で出力しているだけです。
in_f1 <- "SRR002324_t.bed" #読み込みたいBED形式ファイル名を指定してin_f1に格納 in_f2 <- "h_rna.fasta" #マップに用いたリファレンス配列のファイル名を指定してin_f2に格納 out_f <- "output4.txt" #出力ファイル名を指定してout_fに格納 #BEDファイル中に出現するIDのみ、アルファベット順にソートして生リード数をカウント data <- read.table(in_f1) #in_f1で指定したファイルを読み込んでdataに格納 ID_list <- as.vector(data[,1]) #行列dataから1列目の情報のみ抽出してベクトル形式にした結果をID_listに格納 out <- rle(sort(ID_list)) #どのIDがいくつあったかをカウントした結果をoutに格納 #マップされる側のファイルのID情報を抽出 library(ShortRead) #パッケージの読み込み reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルを読み込んでreadsに格納 #本番 rawcount <- rep(0, length(reads)) #最終的に欲しいrawcount値の初期値を0にしておく names(rawcount) <- sort(names(reads)) #sort(names(reads))をnames(rawcount)に格納 hoge <- out$lengths #outオブジェクト中のカウント情報をhogeに格納 names(hoge) <- out$values #outオブジェクト中のID情報をnames(hoge)に格納 obj <- is.element(names(rawcount), names(hoge)) #names(rawcount)の並び順でnames(hoge)中のIDが存在する位置にTRUEを、そうでない位置にはFALSEを返した結果をobjに格納 rawcount[obj] <- hoge #objがTRUEの位置に生リードカウントを代入 #ファイル出力 tmp <- cbind(names(rawcount), rawcount) #結果ファイルの1列目がID, 2列目がcount情報になるようにしたものをtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存5. BED形式ファイル(SRR002324_t.bed)中にあるIDのもののみ、アルファベット順にソートして出力する場合:
in_f <- "SRR002324_t.bed" #読み込みたいBED形式ファイル名を指定してin_fに格納 out_f <- "output5.txt" #出力ファイル名を指定してout_fに格納 data <- read.table(in_f) #in_fで指定したファイルの読み込んでdataに格納 ID_list <- as.vector(data[,1]) #行列dataから1列目の情報のみ抽出してベクトル形式にした結果をID_listに格納 out <- rle(sort(ID_list)) #どのIDがいくつあったかをカウントした結果をoutに格納 #ファイル出力 tmp <- cbind(out$values, out$lengths) #結果ファイルの1列目がID, 2列目がcount情報になるようにしたものをtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存Bowtie:Langmead et al., Genome Biol., 2009
edgeR:Robinson et al., Bioinformatics, 2010
TCC (≥ ver. 1.1.99):Sun et al., submittedShortRead:Morgan et al., Bioinformatics, 2009
Marioni et al., Genome Res., 2008in_f <- "ens_gene_46.txt" #アノテーション情報ファイルを指定してin_fに格納 out_f <- "ens_gene_46_length.txt" #出力ファイル名を指定してout_fに格納 param <- "median" #計算したい要約統計量を指定してparamに格納 tmp <- read.table(in_f, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み data <- na.omit(tmp) #行列tmpからNAを含む行を削除した結果をdataに格納 transcript_len <- data[,4] #Ensembl cDNA lengthに相当する列の情報をtranscript_lenに格納 ens_gene <- data[,1] #Ensembl Gene IDに相当する列の情報をens_geneに格納 tmpout <- tapply(transcript_len, ens_gene, param) #Ensembl Gene IDが同じものに対して、paramで指定した要約統計量を計算した結果をtmpoutに格納 out <- na.omit(as.data.frame(tmpout)) #tmpout中には新たに生成されたNAが含まれる。これは「length情報がない」ものに対して要約統計量を計算した結果に相当するものである。したがって、新たにtmpoutに対してNAを含むものを削除した結果をoutに格納している tmp <- cbind(rownames(out), out) #Ensembl Gene IDと中央値の二つのベクトルを結合した結果をtmpに格納 colnames(tmp) <- c("Ensembl Gene ID", "Length") #行列tmpに任意の列名を与えている write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Oshlack and Wakefield, Biology Direct, 2009)
in_f1 <- "SRR002324_t.bed" #読み込みたいBED形式ファイル名を指定してin_f1に格納 in_f2 <- "h_rna.fasta" #読み込みたいmulti-fastaファイル名を指定してin_f2に格納 out_f <- "output2.txt" #出力ファイル名を指定してout_fに格納 #0. 生リードカウントのところ data <- read.table(in_f1) #in_f1で指定したファイルの読み込んでdataに格納 ID_list <- as.vector(data[,1]) #行列dataから1列目の情報のみ抽出してベクトル形式にした結果をID_listに格納 hoge <- rle(sort(ID_list)) #どのIDがいくつあったかをカウントした結果をhogeに格納 rawcount <- hoge$lengths #count情報をrawcountに格納 names(rawcount) <- hoge$values #rawcountにnames属性を与えている(与えているのはID情報、つまりout$values) #1. 配列長情報取得のところ library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルをFASTA形式で読み込み trans_len <- width(reads) #配列長情報をtrans_lenに格納 names(trans_len) <- names(reads) #trans_lenにnames属性を与えている(与えているのはID情報、つまりnames(reads)) trans_len_s <- trans_len[order(names(trans_len))] #trans_lenをIDのアルファベット順に並び替えた結果をtrans_len_sに格納 #2. IDの対応づけ #背景:trans_len_sの要素数とrawcountの要素数は異なる。 #目的:trans_len_s中のIDの並びに対応した生リードカウントのベクトル情報、の取得 rawcount2 <- rep(0, length(trans_len_s)) #目的のベクトル情報rawcount2のplaceholderを作成(初期値は0) obj <- is.element(names(trans_len_s), names(rawcount)) #transl_len_sのIDの集合の中で、rawcount中のIDの集合に含まれるものはTRUEを、含まれないものはFALSEを返した結果をobjに格納 posi <- (1:length(obj))[obj] #objの中身はTRUE or FALSEでしかないので、TRUEに相当する行番号情報を取得してposiに格納 rawcount2[posi] <- rawcount #rawcount2ベクトル中のposiで与えた行番号の位置に、rawcountの値を順番に代入している out <- cbind(trans_len_s, rawcount2) #trans_len_sとrawcount2の二つの列ベクトルを結合した結果をoutに格納 rownames(out) <- names(trans_len_s) #行列outの行名をnames(trans_len_s)で与えている colnames(out) <- c("transcript_length", "raw_count") #行列outの列名を与えている tmp <- cbind(rownames(out), out) #rownames(out)の列ベクトルを行列outの左側に結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #3. 配列長と生のリードカウント数の箱ひげ図(boxplot)の作成 out_s <- out[order(out[,1]),] #行列outを1列目でソートした結果をout_sに格納 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定 f <- gl(param, floor(nrow(out_s)/param)+1, nrow(out_s)) #nrow(out_s)で表される要素数からなるベクトルをparam個の水準数に分割した因子オブジェクトfを作成 y <- out_s[,2] y[y < 0.1] <- 0.1 plot(f, log10(y)) #transcript_length順でparam個に分割したときのfの各水準に対する生リード数の箱ひげ図を描く参考文献1(Oshlack and Wakefield, Biology Direct, 2009)
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge1.txt" #出力ファイル名を指定 out_f2 <- "hoge1FDR.png" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている data <- as.matrix(data) #データの型をmatrixにしている tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d, prop.used=0.5, grid.length=500) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 fdr <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をfdrに格納 names(fdr) <- rownames(data) #FDR値とEnsembl Gene IDを対応づけている common <- intersect(names(gene_length), names(fdr)) #二つのベクトル(names(gene_length)とnames(fdr))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_fdr <- is.element(names(fdr), common) #commonで指定したEnsembl Gene IDsのnames(fdr)中における位置情報をobj_fdrに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 fdr_sub <- fdr[obj_fdr] #fdrベクトルの中から、obj_fdrがTRUEとなっているもののみ抽出してfdr_subに格納 tmp <- cbind(names(fdr_sub), data[obj_fdr,], gene_length_sub, fdr_sub)#配列長情報があるEnsembl Gene IDのみからなる入力データの右側に、「gene_length」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 lenfdr <- cbind(gene_length_sub, fdr_sub) #gene_length_subとfdr_subの二つのベクトルを列方向で結合した結果をlenfdrに格納。 lenfdr_s <- lenfdr[order(lenfdr[,1]),] #lenfdrを1列目のgene_lengthでソートした結果をlenfdr_sに格納。 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 f <- gl(param, floor(nrow(lenfdr_s)/param)+1, nrow(lenfdr_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenfdr_s[,2] #行列len_fdr_sの2列目の情報をyに格納 png(out_f2, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(f, y, xlab="gene length", ylab="FDR") #横軸がgene_length, 縦軸がFDRとしてプロット dev.off() #おまじない #参考文献2のFigure 1dのような縦軸にしたい場合 out_f3 <- "hoge1DE.png" #出力ファイル名を指定 param3 <- 0.1 #FDRの閾値を指定 hoge <- rep(1, nrow(lenfdr_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #FDR情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとのFDRが閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 png(out_f3, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット dev.off() #おまじない2. edgeRを用い、TMM正規化を行ったデータに対してDEGのランキングをする場合:
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge2.txt" #出力ファイル名を指定 out_f2 <- "hoge2FDR.png" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている data <- as.matrix(data) #データの型をmatrixにしている tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化係数を計算 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d, prop.used=0.5, grid.length=500) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 fdr <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をfdrに格納 names(fdr) <- rownames(data) #FDR値とEnsembl Gene IDを対応づけている common <- intersect(names(gene_length), names(fdr)) #二つのベクトル(names(gene_length)とnames(fdr))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_fdr <- is.element(names(fdr), common) #commonで指定したEnsembl Gene IDsのnames(fdr)中における位置情報をobj_fdrに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 fdr_sub <- fdr[obj_fdr] #fdrベクトルの中から、obj_fdrがTRUEとなっているもののみ抽出してfdr_subに格納 tmp <- cbind(names(fdr_sub), data[obj_fdr,], gene_length_sub, fdr_sub)#配列長情報があるEnsembl Gene IDのみからなる入力データの右側に、「gene_length」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 lenfdr <- cbind(gene_length_sub, fdr_sub) #gene_length_subとfdr_subの二つのベクトルを列方向で結合した結果をlenfdrに格納。 lenfdr_s <- lenfdr[order(lenfdr[,1]),] #lenfdrを1列目のgene_lengthでソートした結果をlenfdr_sに格納。 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 f <- gl(param, floor(nrow(lenfdr_s)/param)+1, nrow(lenfdr_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenfdr_s[,2] #行列len_fdr_sの2列目の情報をyに格納 png(out_f2, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(f, y, xlab="gene length", ylab="FDR") #横軸がgene_length, 縦軸がFDRとしてプロット dev.off() #おまじない #参考文献2のFigure 1dのような縦軸にしたい場合 out_f3 <- "hoge2DE.png" #出力ファイル名を指定 param3 <- 0.1 #FDRの閾値を指定 hoge <- rep(1, nrow(lenfdr_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #FDR情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとのFDRが閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 png(out_f3, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット dev.off() #おまじない3. baySeqを用い、生リードカウントデータを入力として長さ補正なしでDEGのランキングをする場合:
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge3.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #生データの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている data <- as.matrix(data) #データの型をmatrixにしている #配列長情報を得ている tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #baySeqを実行 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 libsizes <- rep(1000000, length(data.cl)) #すでにTMM正規化したデータを読み込ませるので、baySeq内部で正規化を行わないようにするためのおまじない groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=libsizes, groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=5000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 stat_out <- out@posteriors[,2] #事後確率(0に近いほど変動している; 0が最大値)をstat_outに格納 rank_out <- rank(-stat_out) #stat_outでランキングした結果をrank_outに格納 ratio_out <- out@estProps[2] #全遺伝子中に占めるDEGの割合をratio_outに格納 names(rank_out) <- rownames(data) #ランキング結果とEnsembl Gene IDを対応づけている #配列長情報がないEnsembl Gene IDのものもあるため、配列長情報があるもののみに限定 common <- intersect(names(gene_length), names(rank_out)) #二つのベクトル(names(gene_length)とnames(rank_out))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_rank_out <- is.element(names(rank_out), common) #commonで指定したEnsembl Gene IDsのnames(fdr)中における位置情報をobj_fdrに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 rank_out_sub <- rank_out[obj_rank_out] #fdrベクトルの中から、obj_rank_outがTRUEとなっているもののみ抽出してrank_out_subに格納 tmp <- cbind(names(rank_out_sub), data[obj_rank_out,], gene_length_sub, rank_out_sub)#配列長情報があるEnsembl Gene IDのみからなる入力データの右側に、「gene_length」、「順位情報」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 lenrank <- cbind(gene_length_sub, rank_out_sub) #gene_length_subとrank_out_subの二つのベクトルを列方向で結合した結果をlenrankに格納。 lenrank_s <- lenrank[order(lenrank[,1]),] #lenrankを1列目のgene_lengthでソートした結果をlenrank_sに格納。 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 f <- gl(param, floor(nrow(lenrank_s)/param)+1, nrow(lenrank_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenrank_s[,2] #行列len_rank_sの2列目の情報をyに格納 #参考文献2のFigure 1dのような縦軸にしたい場合 out_f3 <- "hoge3DE.png" #出力ファイル名を指定 param3 <- length(rank_out_sub)*ratio_out #「配列長をもつ全遺伝子数*DEGの割合」の順位までがDEGであるという情報をparam3に格納 hoge <- rep(1, nrow(lenrank_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #順位情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとの順位が閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 png(out_f3, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット dev.off() #おまじない4. baySeqを用い、TMM正規化を行ったデータに対して長さ補正なしでDEGのランキングをする場合:
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge4.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #生データの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている data <- as.matrix(data) #データの型をmatrixにしている #TMM正規化データの作成 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化係数を計算 norm_f <- 1000000/(colSums(data)*d$samples$norm.factors) #TMM正規化係数はRPM正規化とセットなので、最終的に各列に対して掛ける正規化係数はnorm_fで与えられる RPM_TMM <- sweep(data, 2, norm_f, "*") #TMM正規化後のデータをRPM_TMMとして格納 data <- round(RPM_TMM) #以下ではRPM_TMMをdataとして取り扱うが、baySeqは整数値のみしか取り扱わないのでRPM_TMM中の小数点以下の数値を丸めた結果をdataとしている #配列長情報を得ている tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #baySeqを実行 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 libsizes <- rep(1000000, length(data.cl)) #すでにTMM正規化したデータを読み込ませるので、baySeq内部で正規化を行わないようにするためのおまじない groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=libsizes, groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=5000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 stat_out <- out@posteriors[,2] #事後確率(0に近いほど変動している; 0が最大値)をstat_outに格納 rank_out <- rank(-stat_out) #stat_outでランキングした結果をrank_outに格納 ratio_out <- out@estProps[2] #全遺伝子中に占めるDEGの割合をratio_outに格納 names(rank_out) <- rownames(data) #ランキング結果とEnsembl Gene IDを対応づけている #配列長情報がないEnsembl Gene IDのものもあるため、配列長情報があるもののみに限定 common <- intersect(names(gene_length), names(rank_out)) #二つのベクトル(names(gene_length)とnames(rank_out))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_rank_out <- is.element(names(rank_out), common) #commonで指定したEnsembl Gene IDsのnames(fdr)中における位置情報をobj_fdrに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 rank_out_sub <- rank_out[obj_rank_out] #fdrベクトルの中から、obj_rank_outがTRUEとなっているもののみ抽出してrank_out_subに格納 tmp <- cbind(names(rank_out_sub), data[obj_rank_out,], gene_length_sub, rank_out_sub)#配列長情報があるEnsembl Gene IDのみからなる入力データの右側に、「gene_length」、「順位情報」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 lenrank <- cbind(gene_length_sub, rank_out_sub) #gene_length_subとrank_out_subの二つのベクトルを列方向で結合した結果をlenrankに格納。 lenrank_s <- lenrank[order(lenrank[,1]),] #lenrankを1列目のgene_lengthでソートした結果をlenrank_sに格納。 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 f <- gl(param, floor(nrow(lenrank_s)/param)+1, nrow(lenrank_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenrank_s[,2] #行列len_rank_sの2列目の情報をyに格納 #参考文献2のFigure 1dのような縦軸にしたい場合 out_f3 <- "hoge4DE.png" #出力ファイル名を指定 param3 <- length(rank_out_sub)*ratio_out #「配列長をもつ全遺伝子数*DEGの割合」の順位までがDEGであるという情報をparam3に格納 hoge <- rep(1, nrow(lenrank_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #順位情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとの順位が閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 png(out_f3, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット dev.off() #おまじない5. baySeqを用い、配列長情報があるもののみの生リードカウントデータを入力として長さ補正なしでDEGのランキングをする場合:
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge5.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #Ensembl Gene IDをアルファベット順に並び替えて発現データ(data)情報を取得 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている #Ensembl Gene IDをアルファベット順に並び替えてgene_length情報を取得 tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #gene_length情報があり、かつ発現データファイル中にもあるEnsembl Gene IDのもののみ取り扱うための処理 common <- intersect(names(gene_length), rownames(data)) #二つのベクトル(names(gene_length)とrownames(data))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_data <- is.element(rownames(data), common) #commonで指定したEnsembl Gene IDsのrownames(data)中における位置情報をobj_dataに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 data_sub <- data[obj_data,] #行列dataからobj_dataがTRUEとなっている行のみ抽出してdata_subに格納 #元々あった遺伝子数がどの程度の数になったかを表示 dim(data) #行列dataの行数と列数を表示 dim(data_sub) #行列data_subの行数と列数を表示 gene_length <- gene_length_sub #gene_lengthの中身をgene_length_subにしている data <- as.matrix(data_sub) #dataの中身をmatrix形式のdata_subにしている #baySeqを実行 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=data, replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=5000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_out <- out@posteriors[,2] #事後確率(0に近いほど変動している; 0が最大値)をstat_outに格納 rank_out <- rank(-stat_out) #stat_outでランキングした結果をrank_outに格納 ratio_out <- out@estProps[2] #全遺伝子中に占めるDEGの割合をratio_outに格納 names(rank_out) <- rownames(data) #ランキング結果とEnsembl Gene IDを対応づけている tmp <- cbind(names(rank_out), data, gene_length, rank_out) #配列長情報があるEnsembl Gene IDのみからなる入力データの右側に、「gene_length」、「順位情報」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #参考文献2のFigure 1dのような縦軸にしたい場合 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 out_f3 <- "hoge5DE.png" #出力ファイル名を指定 param3 <- length(rank_out)*ratio_out #「配列長をもつ全遺伝子数*DEGの割合」の順位までがDEGであるという情報をparam3に格納 lenrank <- cbind(gene_length, rank_out) #gene_lengthとrank_outの二つのベクトルを列方向で結合した結果をlenrankに格納。 lenrank_s <- lenrank[order(lenrank[,1]),] #lenrankを1列目のgene_lengthでソートした結果をlenrank_sに格納。 f <- gl(param, floor(nrow(lenrank_s)/param)+1, nrow(lenrank_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenrank_s[,2] #行列len_rank_sの2列目の情報をyに格納 hoge <- rep(1, nrow(lenrank_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #順位情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとの順位が閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 png(out_f3, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット dev.off() #おまじない6. baySeqを用い、配列長情報があるもののみの生リードカウントデータを入力として長さ補正ありでDEGのランキングをする場合:
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge6.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #Ensembl Gene IDをアルファベット順に並び替えて発現データ(data)情報を取得 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている #Ensembl Gene IDをアルファベット順に並び替えてgene_length情報を取得 tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #gene_length情報があり、かつ発現データファイル中にもあるEnsembl Gene IDのもののみ取り扱うための処理 common <- intersect(names(gene_length), rownames(data)) #二つのベクトル(names(gene_length)とrownames(data))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_data <- is.element(rownames(data), common) #commonで指定したEnsembl Gene IDsのrownames(data)中における位置情報をobj_dataに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 data_sub <- data[obj_data,] #行列dataからobj_dataがTRUEとなっている行のみ抽出してdata_subに格納 #元々あった遺伝子数がどの程度の数になったかを表示 dim(data) #行列dataの行数と列数を表示 dim(data_sub) #行列data_subの行数と列数を表示 gene_length <- gene_length_sub #gene_lengthの中身をgene_length_subにしている data <- as.matrix(data_sub) #dataの中身をmatrix形式のdata_subにしている #baySeqを実行 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=data, replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups, seglens=gene_length)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=5000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_out <- out@posteriors[,2] #事後確率(0に近いほど変動している; 0が最大値)をstat_outに格納 rank_out <- rank(-stat_out) #stat_outでランキングした結果をrank_outに格納 ratio_out <- out@estProps[2] #全遺伝子中に占めるDEGの割合をratio_outに格納 names(rank_out) <- rownames(data) #ランキング結果とEnsembl Gene IDを対応づけている tmp <- cbind(names(rank_out), data, gene_length, rank_out) #配列長情報があるEnsembl Gene IDのみからなる入力データの右側に、「gene_length」、「順位情報」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #参考文献2のFigure 1dのような縦軸にしたい場合 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 out_f3 <- "hoge6DE.png" #出力ファイル名を指定 param3 <- length(rank_out)*ratio_out #「配列長をもつ全遺伝子数*DEGの割合」の順位までがDEGであるという情報をparam3に格納 lenrank <- cbind(gene_length, rank_out) #gene_lengthとrank_outの二つのベクトルを列方向で結合した結果をlenrankに格納。 lenrank_s <- lenrank[order(lenrank[,1]),] #lenrankを1列目のgene_lengthでソートした結果をlenrank_sに格納。 f <- gl(param, floor(nrow(lenrank_s)/param)+1, nrow(lenrank_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenrank_s[,2] #行列len_rank_sの2列目の情報をyに格納 hoge <- rep(1, nrow(lenrank_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #順位情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとの順位が閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 png(out_f3, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット dev.off() #おまじない7. baySeqを用い、TMM正規化後の配列長情報があるもののみのデータを入力として長さ補正ありでDEGのランキングをする場合:
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge7.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #Ensembl Gene IDをアルファベット順に並び替えて発現データ(data)情報を取得 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている #TMM正規化データの作成 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化係数を計算 norm_f <- 1000000/(colSums(data)*d$samples$norm.factors) #TMM正規化係数はRPM正規化とセットなので、最終的に各列に対して掛ける正規化係数はnorm_fで与えられる RPM_TMM <- sweep(data, 2, norm_f, "*") #TMM正規化後のデータをRPM_TMMとして格納 data <- round(RPM_TMM) #以下ではRPM_TMMをdataとして取り扱うが、baySeqは整数値のみしか取り扱わないのでRPM_TMM中の小数点以下の数値を丸めた結果をdataとしている #Ensembl Gene IDをアルファベット順に並び替えてgene_length情報を取得 tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #gene_length情報があり、かつ発現データファイル中にもあるEnsembl Gene IDのもののみ取り扱うための処理 common <- intersect(names(gene_length), rownames(data)) #二つのベクトル(names(gene_length)とrownames(data))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_data <- is.element(rownames(data), common) #commonで指定したEnsembl Gene IDsのrownames(data)中における位置情報をobj_dataに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 data_sub <- data[obj_data,] #行列dataからobj_dataがTRUEとなっている行のみ抽出してdata_subに格納 #元々あった遺伝子数がどの程度の数になったかを表示 dim(data) #行列dataの行数と列数を表示 dim(data_sub) #行列data_subの行数と列数を表示 gene_length <- gene_length_sub #gene_lengthの中身をgene_length_subにしている data <- as.matrix(data_sub) #dataの中身をmatrix形式のdata_subにしている #baySeqを実行 groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=data, replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups, seglens=gene_length)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=5000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_out <- out@posteriors[,2] #事後確率(0に近いほど変動している; 0が最大値)をstat_outに格納 rank_out <- rank(-stat_out) #stat_outでランキングした結果をrank_outに格納 ratio_out <- out@estProps[2] #全遺伝子中に占めるDEGの割合をratio_outに格納 names(rank_out) <- rownames(data) #ランキング結果とEnsembl Gene IDを対応づけている tmp <- cbind(names(rank_out), data, gene_length, rank_out) #配列長情報があるEnsembl Gene IDのみからなる入力データの右側に、「gene_length」、「順位情報」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #参考文献2のFigure 1dのような縦軸にしたい場合 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 out_f3 <- "hoge7DE.png" #出力ファイル名を指定 param3 <- length(rank_out)*ratio_out #「配列長をもつ全遺伝子数*DEGの割合」の順位までがDEGであるという情報をparam3に格納 lenrank <- cbind(gene_length, rank_out) #gene_lengthとrank_outの二つのベクトルを列方向で結合した結果をlenrankに格納。 lenrank_s <- lenrank[order(lenrank[,1]),] #lenrankを1列目のgene_lengthでソートした結果をlenrank_sに格納。 f <- gl(param, floor(nrow(lenrank_s)/param)+1, nrow(lenrank_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenrank_s[,2] #行列len_rank_sの2列目の情報をyに格納 hoge <- rep(1, nrow(lenrank_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #順位情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとの順位が閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 png(out_f3, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット dev.off() #おまじない#3. RPKM正規化したデータを用いる場合:
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f1 <- "hoge3.txt" #出力ファイル名を指定 out_f2 <- "hoge3.png" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #まずはEnsembl Gene IDをアルファベット順に並び替えてRPM正規化 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている norm_factor1 <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_factor1に格納 RPM <- sweep(data, 2, norm_factor1, "*") #norm_factor1を各列に掛けた結果をRPMに格納 #Ensembl Gene IDをアルファベット順に並び替えてgene_length情報を取得 tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #RPKM正規化をするために、gene_length情報があるデータのみ抽出し、そのサブセットのみでRPKM正規化 common <- intersect(names(gene_length), rownames(RPM)) #二つのベクトル(names(gene_length)とrownames(RPM))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_RPM <- is.element(rownames(RPM), common) #commonで指定したEnsembl Gene IDsのrownames(RPM)中における位置情報をobj_RPMに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 RPM_sub <- RPM[obj_RPM,] #行列RPMからobj_RPMがTRUEとなっている行のみ抽出してRPM_subに格納 norm_factor2 <- 1000/gene_length_sub #各行に対して掛ける正規化係数を計算してnorm_factor2に格納 RPKM <- sweep(RPM_sub, 1, norm_factor2, "*") #norm_factor2を行列RPM_subの各行に掛けた結果をRPKMに格納 data <- as.matrix(RPKM) #データの型をmatrixにした結果をdataに格納 #発現変動の度合いを示すFDR値を各遺伝子について計算 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d, prop.used=0.5, grid.length=500) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 fdr <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をfdrに格納 tmp <- cbind(rownames(data), data, gene_length_sub, fdr) #入力データの右側に、「gene_length」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 lenfdr <- cbind(gene_length_sub, fdr) #gene_length_subとfdrの二つのベクトルを列方向で結合した結果をlenfdrに格納。 lenfdr_s <- lenfdr[order(lenfdr[,1]),] #lenfdrを1列目のgene_lengthでソートした結果をlenfdr_sに格納。 param <- 20 #boxplotを描くときの水準数(transcript_length順でソートした結果の分割数に相当)を指定。 f <- gl(param, floor(nrow(lenfdr_s)/param)+1, nrow(lenfdr_s)) #nrow(out_s)で表される要素数からなるベクトルを20個の水準数に分割した因子オブジェクトfを作成 y <- lenfdr_s[,2] #行列len_fdr_sの2列目の情報をyに格納 png(out_f2, width=600, height=300) #出力ファイルの各種パラメータを指定 plot(f, y, xlab="gene length", ylab="FDR") #横軸がgene_length, 縦軸がFDRとしてプロット dev.off() #おまじない #参考文献2のFigure 1dのような縦軸にしたい場合 param3 <- 0.1 #FDRの閾値を指定 hoge <- rep(1, nrow(lenfdr_s)) #のちに水準ごとの要素数をsum関数でカウントするために1からなるベクトルを作成している f_num <- tapply(hoge, f, sum) #水準ごとの要素数をカウントした結果をf_numに格納 hoge <- (y <= param3) #FDR情報を含むyに対して、param3で指定した閾値以下のものをTRUE, それ以外をFALSEとしたベクトルを作成してhogeに格納 y_num <- tapply(hoge, f, sum) #水準ごとのFDRが閾値を満たす要素数をカウントした結果をy_numに格納 ratio <- 100*y_num/f_num #水準ごとのDEGとされた割合(%)を計算した結果をratioに格納 plot(levels(f), ratio, xlab="gene length", ylab="%DE") #横軸がgene_length, 縦軸が%DEとしてプロット参考文献1(Marioni et al., Genome Res., 2008)
goseq:Young et al., Genome Biol., 2010
Bullard et al., BMC Bioinformatics, 2010DEXseq:Anders et al., Genome Res., 2012
Sun and Zhu, Bioinformatics, 2012param_A <- 2 #A群のサンプル数を指定 param_B <- 2 #B群のサンプル数を指定 param1 <- "full" #正規化法(full quantile正規化の場合は"full"のまま)を指定 #必要なパッケージをロード library(yeastRNASeq) #パッケージの読み込み library(EDASeq) #パッケージの読み込み #count dataやGC含量情報(SGD ver. r64)の読み込みとラベル情報の作成 data(geneLevelData) #yeastRNASeqパッケージ中で提供されているデータをロード data(yeastGC) #EDASeqパッケージ中で提供されているyeastのGC含量情報をロード dim(geneLevelData) #行数と列数を表示 head(geneLevelData) #最初の数行を表示 length(yeastGC) #要素数を表示 head(yeastGC) #最初の数個を表示 head(rownames(geneLevelData)) #geneLevelData行列の行名(rownames)情報の最初の数個を表示 head(names(yeastGC)) #yeastGCベクトルのnames属性情報の最初の数個を表示 data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #カウントデータ情報(geneLevelData)とGC含量情報(yeastGC)から共通して存在するサブセットを(同じ遺伝子名の並びで)取得 common <- intersect(rownames(geneLevelData), names(yeastGC)) #二つのベクトルから積集合(intersection)を抽出した結果をcommonに格納 length(common) #共通遺伝子数(正確にはcommonベクトルの要素数)を表示 data <- as.matrix(geneLevelData[common, ]) #6685個の共通遺伝子分のカウントデータ行列を行列形式でdataに格納 GC <- data.frame(GC = yeastGC[common]) #6685個の共通遺伝子分のGC含量ベクトルをデータフレーム形式でGCに格納 head(rownames(data)) #data行列の行名(rownames)情報の最初の数個を表示 head(rownames(GC)) #GC行列の行名(rownames)情報の最初の数個を表示 es <- newSeqExpressionSet(exprs = data, #SeqExpressionSetというクラスにデータを格納 featureData = GC, #SeqExpressionSetというクラスにデータを格納 phenoData = data.frame(conditions = data.cl, #SeqExpressionSetというクラスにデータを格納 row.names = colnames(data)))#SeqExpressionSetというクラスにデータを格納 es #esを表示 #横軸:GC含量、縦軸:log(count)のプロットを作成しbiasの有無をチェック #(GC含量依存性があることがわかる。ちなみにbiasがない場合には水平線になる) biasPlot(es, "GC", log = T, ylim = c(-1, 4)) #プロット。A群("mut_1" and "mut_2"に相当)のラベルが1, B群("wt_1" and "wt_2"に相当)のラベルが2としてプロットされている。 #本番(full quantile(FQ)正規化) out <- withinLaneNormalization(es, "GC", which = param1) #サンプル(列 or レーン)ごとに正規化を実行した結果をoutに格納 #横軸:GC含量、縦軸:log(count)のプロットを作成し正規化後の状態をチェック #(GC含量依存性が緩和されていることがわかる。full quantileなのになぜ水平にならないんだろう。。。) biasPlot(out, "GC", log = T, ylim = c(-1, 4)) #プロット。A群("mut_1" and "mut_2"に相当)のラベルが1, B群("wt_1" and "wt_2"に相当)のラベルが2としてプロットされている。 #GC bias補正前後のカウントデータとGC含量の情報をファイルに出力したい場合 out_f1 <- "data_yeastGCbias_common_before.txt" #出力ファイル名1(補正前のカウントデータ)を指定 out_f2 <- "data_yeastGCbias_common_after.txt" #出力ファイル名2(補正後のカウントデータ)を指定 out_f3 <- "data_yeastGCbias_common_GCcontent.txt" #出力ファイル名3(GC含量のデータ)を指定 tmp <- cbind(rownames(exprs(es)), exprs(es)) #補正前のカウント情報exprs(es)の左側にその行名(つまり遺伝子名)を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存 tmp <- cbind(rownames(exprs(out)), exprs(out)) #補正前のカウント情報exprs(es)の左側にその行名(つまり遺伝子名)を結合した結果をtmpに格納 write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f2で指定したファイル名で保存 tmp <- cbind(rownames(fData(es)), fData(es)) #GC含量情報fData(es)の左側にその行名(つまり遺伝子名)を結合した結果をtmpに格納 write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f3で指定したファイル名で保存 #GC bias補正前後のoffset(logスケールでの補正前後の差、正規化係数のlog、に相当)ファイルに出力したい場合 out_f4 <- "data_yeastGCbias_common_offset.txt" #出力ファイル名4(offset情報)を指定 out2 <- withinLaneNormalization(es, "GC", which = param1, offset = TRUE)#サンプル(列 or レーン)ごとに正規化を実行した結果をoutに格納 head(offst(out2)) #offset値(i.e., 正規化係数のlog)の最初の数行を表示 tmp <- cbind(rownames(offst(out2)), offst(out2)) #offset情報offst(out2)の左側にその行名(つまり遺伝子名)を結合した結果をtmpに格納 write.table(tmp, out_f4, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f4で指定したファイル名で保存 #offsetと正規化前後の数値の関係を簡単に説明 head(exprs(out)) #a. 正規化後のカウントデータの最初の数行を表示 head(exprs(es)) #b. 正規化前のカウントデータの最初の数行を表示 head(exp(offst(out2))) #c. (logスケールのなので)オリジナルスケール上でのoffset値にした状態で最初の数行を表示 normalized <- exprs(es) * exp(offst(out2)) #d. 「正規化前のカウントデータ」に「オリジナルスケールのoffset値」を掛けた結果をnormalizedに格納 head(normalized) #e. 掛け算(b * c)で得た正規化後のカウントデータnormalizedの最初の数行を表示(a.と微妙に異なっていることがわかる) head(round(normalized)) #f. 「a.の正規化後のデータ」は、e.のnormalizedの実数の数値をround関数で最も近い整数値に丸めたものです。2. 二つのタブ区切りテキストファイルの読み込みからやる場合: 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" #入力ファイル名(GC含量情報を含むファイル)を指定 param_A <- 2 #A群のサンプル数を指定 param_B <- 2 #B群のサンプル数を指定 param1 <- "full" #正規化法(full quantile正規化の場合は"full"のまま)を指定 #必要なパッケージをロード library(EDASeq) #パッケージの読み込み #count dataやGC含量情報の読み込みとラベル情報の作成 data.tmp <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#in_f1で指定したファイルを読み込んでdata.tmpに格納 gc.tmp <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")#in_f2で指定したファイルを読み込んでgc.tmpに格納 data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #カウントデータ情報(data.tmp)とGC含量情報(gc.tmp)から共通して存在するサブセットを(同じ遺伝子名の並びで)取得 common <- intersect(rownames(data.tmp), rownames(gc.tmp)) #二つのベクトルから積集合(intersection)を抽出した結果をcommonに格納 length(common) #共通遺伝子数(正確にはcommonベクトルの要素数)を表示 data <- as.matrix(data.tmp[common, ]) #6685個の共通遺伝子分のカウントデータ行列を行列形式でdataに格納 GC <- data.frame(GC = gc.tmp[common, ]) #6685個の共通遺伝子分のGC含量行列を行列形式でGCに格納 rownames(GC) <- common #行列GCにrownamesを代入している(消えてしまっているためです) es <- newSeqExpressionSet(exprs = data, #SeqExpressionSetというクラスにデータを格納 featureData = GC, #SeqExpressionSetというクラスにデータを格納 phenoData = data.frame(conditions = data.cl, #SeqExpressionSetというクラスにデータを格納 row.names = colnames(data)))#SeqExpressionSetというクラスにデータを格納 es #esを表示 #横軸:GC含量、縦軸:log(count)のプロットを作成しbiasの有無をチェック #(GC含量依存性があることがわかる。ちなみにbiasがない場合には水平線になる) biasPlot(es, "GC", log = T, ylim = c(-1, 4)) #プロット。A群("mut_1" and "mut_2"に相当)のラベルが1, B群("wt_1" and "wt_2"に相当)のラベルが2としてプロットされている。 #本番(full quantile(FQ)正規化) out <- withinLaneNormalization(es, "GC", which = param1) #サンプル(列 or レーン)ごとに正規化を実行した結果をoutに格納 #横軸:GC含量、縦軸:log(count)のプロットを作成し正規化後の状態をチェック #(GC含量依存性が緩和されていることがわかる。full quantileなのになぜ水平にならないんだろう。。。) biasPlot(out, "GC", log = T, ylim = c(-1, 4)) #プロット。A群("mut_1" and "mut_2"に相当)のラベルが1, B群("wt_1" and "wt_2"に相当)のラベルが2としてプロットされている。 #GC bias補正前後のカウントデータとGC含量の情報をファイルに出力したい場合 out_f1 <- "data_yeastGCbias_common_before.txt" #出力ファイル名1(補正前のカウントデータ)を指定 out_f2 <- "data_yeastGCbias_common_after.txt" #出力ファイル名2(補正後のカウントデータ)を指定 out_f3 <- "data_yeastGCbias_common_GCcontent.txt" #出力ファイル名3(GC含量のデータ)を指定 tmp <- cbind(rownames(exprs(es)), exprs(es)) #補正前のカウント情報exprs(es)の左側にその行名(つまり遺伝子名)を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存 tmp <- cbind(rownames(exprs(out)), exprs(out)) #補正前のカウント情報exprs(es)の左側にその行名(つまり遺伝子名)を結合した結果をtmpに格納 write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f2で指定したファイル名で保存 tmp <- cbind(rownames(fData(es)), fData(es)) #GC含量情報fData(es)の左側にその行名(つまり遺伝子名)を結合した結果をtmpに格納 write.table(tmp, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f3で指定したファイル名で保存
EDASeq:Risso et al., BMC Bioinformatics, 2011
yeastRNASeq:Lee et al., PLoS Genet., 2008RNASeqBias:Zheng et al., BMC Bioinformatics, 2011
in_f <- "data_hypodata_1vs1.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_1vs1_DEGESTbT.txt" #出力ファイル名を指定 param_A <- 1 #A群(G1群)のサンプル数を指定 param_B <- 1 #B群(G2群)のサンプル数を指定 param1 <- 1 #TMM-(baySeq-TMM)nパイプラインのnの値(iterationの回数)を指定(デフォルトは1) param2 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とかでやってみてください。) #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #iDEGES/DESeq正規化の実行 tcc <- calcNormFactors(tcc, norm.method = "tmm", test.method = "bayseq",#正規化を実行した結果をtccに格納 iteration=param1, samplesize=param2) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(17.19941 18.87876) #iDEGES/DESeq正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が8,049個、1 (G1で高発現のDEGに相当)が936個、2 (G2で高発現のDEGに相当)が1015個と判定されていたことがわかる。 #iDEGES/DESeq正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7786209 1.2213791) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.134), G1で高発現のDEG(青; -1.866), G2で高発現のDEG(赤; 2.187)
baySeq:Hardcastle and Kelly, BMC Bioinformatics, 2010
TCC (≥ ver. 1.1.99):Sun et al., submittedin_f <- "data_hypodata_1vs1.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_1vs1_iDEGESDESeq.txt" #出力ファイル名を指定 param_A <- 1 #A群(G1群)のサンプル数を指定 param_B <- 1 #B群(G2群)のサンプル数を指定 param1 <- 3 #DESeq-(DESeq-DESeq)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #iDEGES/DESeq正規化の実行 tcc <- calcNormFactors(tcc, iteration=param1) #正規化を実行した結果をtccに格納(iDEGES/edgeRのときと同じコマンドだが、内部的にカウント行列の列数で自動判定してiDEGES/DESeqを採用している) #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(17.33728 18.71540) #iDEGES/DESeq正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が9,500個、1 (G1で高発現のDEGに相当)が500個、2 (G2で高発現のDEGに相当)が0個と判定されていたことがわかるが、これはバグで実際にはG2で高発現のものもある。 #iDEGES/DESeq正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7707068 1.2292932) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.110), G1で高発現のDEG(青; -1.890), G2で高発現のDEG(赤; 2.163)
DESeq:Anders and Huber, Genome Biol, 2010
TCC (≥ ver. 1.1.99):Sun et al., submittedin_f <- "data_hypodata_1vs1.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_1vs1_TMM.txt" #出力ファイル名を指定 param_A <- 1 #A群(G1群)のサンプル数を指定 param_B <- 1 #B群(G2群)のサンプル数を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TMM正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(17.04961 19.06260) #TMM正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7874063 1.2125937) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.161), G1で高発現のDEG(青; -1.839), G2で高発現のDEG(赤; 2.213)TMM正規化法:Robinson and Oshlack, Genome Biol., 2010
edgeR:Robinson et al., Bioinformatics, 2010
TCC:Kadota et al., Algorithms Mol. Biol., 2012in_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_iDEGESedgeR.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 param1 <- 3 #TMM-(edgeR-TMM)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #iDEGES/edgeR正規化の実行 tcc <- calcNormFactors(tcc, iteration=param1) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(17.73976 17.92443 17.74807 18.17837 17.23521 17.16515) #iDEGES/edgeR正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が8,679個、1 (G1で高発現のDEGに相当)が1,109個、2 (G2で高発現のDEGに相当)が212個と判定されていたことがわかる #iDEGES/edgeR正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7469719 0.8344937 0.7237473 1.2551083 1.1897781 1.2499007) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.033), G1で高発現のDEG(青; -1.960), G2で高発現のDEG(赤; 2.043)2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_iDEGESedgeR.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param1 <- 3 #TMM-(edgeR-TMM)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #iDEGES/edgeR正規化の実行 tcc <- calcNormFactors(tcc, iteration=param1) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #iDEGES/edgeR正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が4,036個、1 (G1で高発現のDEGに相当)が1,284個、2 (G2で高発現のDEGに相当)が1,745個と判定されていたことがわかる。実に100*(1284+1745)/7065=42.873%がDEGと判定されていることになるがtechnical replicatesのデータなので妥当といえば妥当。 #iDEGES/edgeR正規化係数を表示 tcc$norm.factors #正規化係数を表示(1.1860633 1.1823388 0.8178319 0.8137659)3. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) このデータはどのサンプルでも発現していない(zero count; ゼロカウント)ものが多いので、 どこかのサンプルで0より大きいカウントのもののみからなるサブセットを抽出して2.と同様の計算を行っています。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_iDEGESedgeR2.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param1 <- 3 #TMM-(edgeR-TMM)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) param_lowcount <- 0 #低発現遺伝子のフィルタリングを行う際の閾値。遺伝子(行)ごとにカウントの総和を計算し、ここで指定した値よりも大きいものだけがその後の解析に用いられる #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 dim(tcc$count) #カウント行列の行数と列数を表示(7065行4列) #フィルタリングの実行(低発現のものを除去) tcc <- filterLowCountGenes(tcc, low.count = param_lowcount) #param_lowcountで指定した閾値より大きい総カウント数をもつ遺伝子のみを抽出している dim(tcc$count) #カウント行列の行数と列数を表示(6508行4列になっていることがわかる) #iDEGES/edgeR正規化の実行 tcc <- calcNormFactors(tcc, iteration=param1) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #iDEGES/edgeR正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が3,447個、1 (G1で高発現のDEGに相当)が1,311個、2 (G2で高発現のDEGに相当)が1,750個と判定されていたことがわかる #iDEGES/edgeR正規化係数を表示 tcc$norm.factors #正規化係数を表示(1.1849185 1.1802298 0.8192871 0.8155645)Robinson and Smyth, Biostatistics, 2008
edgeR:Robinson et al., Bioinformatics, 2010
baySeq:Hardcastle and Kelly, BMC Bioinformatics, 2010
TCC:Kadota et al., Algorithms Mol. Biol., 2012in_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_TbT.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 param_samplesize <- 10000 #TbT法のstep2中で行うブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TbT正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", #正規化を実行した結果をtccに格納 test.method="bayseq", samplesize=param_samplesize)#正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(17.70699, 17.78708, 17.60127, 18.20635, 17.41963, 17.27200) #TbT正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が8,494個、1 (G1で高発現のDEGに相当)が1,134個、2 (G2で高発現のDEGに相当)が372個と判定されていたことがわかる #TbT正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7494026 0.8421160 0.7308061 1.2549357 1.1788312 1.2439084) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.049), G1で高発現のDEG(青; -1.942), G2で高発現のDEG(赤; 2.061)2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_TbT.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param_samplesize <- 10000 #TbT法のstep2中で行うブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TbT正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", #正規化を実行した結果をtccに格納 test.method="bayseq", samplesize=param_samplesize)#正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #TbT正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が3,927個、1 (G1で高発現のDEGに相当)が1,604個、2 (G2で高発現のDEGに相当)が1,534個と判定されていたことがわかる。実に100*(1604+1534)/7065=44.416%がDEGと判定されていることになるがtechnical replicatesのデータなので妥当といえば妥当。 #TbT正規化係数を表示 tcc$norm.factors #正規化係数を表示(1.1456801 1.1463897 0.8556477 0.8522824)3. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) このデータはどのサンプルでも発現していない(zero count; ゼロカウント)ものが多いので、 どこかのサンプルで0より大きいカウントのもののみからなるサブセットを抽出して2.と同様の計算を行っています。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_TbT2.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param_samplesize <- 10000 #TbT法のstep2中で行うブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param_lowcount <- 0 #低発現遺伝子のフィルタリングを行う際の閾値。遺伝子(行)ごとにカウントの総和を計算し、ここで指定した値よりも大きいものだけがその後の解析に用いられる #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 dim(tcc$count) #カウント行列の行数と列数を表示(7065行4列) #フィルタリングの実行(低発現のものを除去) tcc <- filterLowCountGenes(tcc, low.count = param_lowcount) #param_lowcountで指定した閾値より大きい総カウント数をもつ遺伝子のみを抽出している dim(tcc$count) #カウント行列の行数と列数を表示(6508行4列になっていることがわかる) #TbT正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", #正規化を実行した結果をtccに格納 test.method="bayseq", samplesize=param_samplesize)#正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #TbT正規化のstep2で検出されたpotential DEGの結果(step3で使われないものたち)を表示 table(tcc$private$DEGES.potentialDEG) #0 (nonDEGに相当)が3,285個、1 (G1で高発現のDEGに相当)が1,656個、2 (G2で高発現のDEGに相当)が1,567個と判定されていたことがわかる #TbT正規化係数を表示 tcc$norm.factors #正規化係数を表示(1.1448574 1.1433478 0.8578253 0.8539695)Marioni et al., Genome Res., 2008
edgeR:Robinson et al., Bioinformatics, 2010
baySeq:Hardcastle and Kelly, BMC Bioinformatics, 2010
TCC (≥ ver. 1.1.99):Sun et al., submittedin_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_TMM.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TMM正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(17.06540 17.15646 17.07707 18.90293 18.04854 17.93468) #TMM正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7843388 0.8806613 0.7597886 1.2192004 1.1476476 1.2083632) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.152), G1で高発現のDEG(青; -1.840), G2で高発現のDEG(赤; 2.164)2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_TMM.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TMM正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #TMM正規化係数を表示 tcc$norm.factors #正規化係数を表示(1.1391738 1.1395812 0.8596891 0.8615559)3. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。 TCCを使わずにedgeRパッケージ内の関数を用いて2.と同じ結果を出すやり方です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_TMM2.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 #必要なパッケージをロード library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #TMM正規化本番 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #正規化係数を計算 d$samples$norm.factors #edgeRパッケージから得られる正規化係数そのものを表示(1.1504029 1.1508142 0.8681632 0.8700484) mean(d$samples$norm.factors) #正規化係数の平均が1でないことがわかる(1.009857) norm.factors <- d$samples$norm.factors/mean(d$samples$norm.factors)#正規化係数の平均が1になるように正規化したものがTCCパッケージで得られるものと同じです norm.factors #TCCパッケージから得られるTMM正規化係数と同じになっていることがわかる(1.1391738 1.1395812 0.8596891 0.8615559) #正規化後のデータをファイルに出力 ef.libsizes <- colSums(data)*norm.factors #effective library sizesというのはlibrary sizesに正規化係数を掛けたものなのでそれを計算した結果をef.libsizesに格納 normalized.count <- sweep(data, 2, mean(ef.libsizes)/ef.libsizes, "*")#正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存4. サンプルデータ14の10,000 genes×2 samplesの「複製なし」タグカウントデータ(data_hypodata_1vs1.txt) シミュレーションデータ(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" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_1vs1_TMM.txt" #出力ファイル名を指定 param_A <- 1 #A群(G1群)のサンプル数を指定 param_B <- 1 #B群(G2群)のサンプル数を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TMM正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", iteration=0) #正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(17.04961 19.06260) #TMM正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7874063 1.2125937) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.161), G1で高発現のDEG(青; -1.839), G2で高発現のDEG(赤; 2.213)5. サンプルデータ2の32,000 genes×10 samplesの「複製あり」タグカウントデータ(SupplementaryTable2_changed.txt) technical replicatesのデータ(Kidney群5サンプル vs. Liver群5サンプル)です。 ごく昔の記述です。参考まで。
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 out_f <- "SupplementaryTable2_changed_TMM2.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 1000000 #補正後の総リード数を指定(RPMデータと同程度の数値分布にしたい場合はここは変更しないで) #必要なパッケージをロード library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #TMM正規化本番 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化係数を計算 norm_f_TMM <- d$samples$norm.factors #TMM正規化係数の情報を抽出してnorm_f_TMMに格納 names(norm_f_TMM) <- colnames(data) #norm_f_TMMのnames属性をcolnames(data)で与えている effective_libsizes <- colSums(data) * norm_f_TMM #effective library sizesというのはlibrary sizesに(TMM)正規化係数を掛けたものなのでそれを計算した結果をeffective_libsizesに格納 RPM_TMM <- sweep(data, 2, param3/effective_libsizes, "*") #元のカウントデータをeffective_libsizesで割り(RPMデータと同程度の数値分布にしたいので)param3を掛けた正規化後のデータをRPM_TMMに格納 #正規化後のデータをファイルに出力 data <- RPM_TMM #RPM_TMMをdataに格納 tmp <- cbind(rownames(data), data) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #おまけとして、TMM正規化後のデータでM-A plotを描画 data <- RPM_TMM #RPM_TMMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示Marioni et al., Genome Res., 2008
edgeR:Robinson et al., Bioinformatics, 2010
TCC:Kadota et al., Algorithms Mol. Biol., 2012in_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_AH.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #Anders and Huberの(AH)正規化の実行 tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=FALSE)#正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(16.83471 17.03814 16.87943 19.26712 18.12903 18.16272) #正規化係数を表示 tcc$norm.factors #正規化係数を表示(0.7974195 0.8893788 0.7709404 1.1996644 1.1459043 1.1966927) #このデータは「答え」がわかっているものなので、答え(DEG or non-DEG)の情報込みで正規化後のデータのM-A plotを描画 tcc$private$simulation <- TRUE #おまじない tcc$simulation$trueDEG <- c(rep(1, 1800), rep(2, 200), rep(0, 8000))#真の情報からなるベクトルをtccクラスオブジェクトに格納 plot(tcc, median.lines=TRUE) #log-ratio(縦軸の値)のmedian値をそれぞれの色で表示:non-DEG(黒; 0.186), G1で高発現のDEG(青; -1.809), G2で高発現のDEG(赤; 2.196)2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_AH.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #Anders and Huberの(AH)正規化の実行 tcc <- calcNormFactors(tcc, norm.method="deseq", iteration=FALSE)#正規化を実行した結果をtccに格納 #正規化後のデータをファイルに出力 normalized.count <- getNormalizedData(tcc) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc) #M-A plotを描画 #正規化係数を表示 tcc$norm.factors #正規化係数を表示(1.1431946 1.1408795 0.8568723 0.8590536) #正規化後のデータの列ごとの各種要約統計量を表示 summary(normalized.count) #normalized.countの各列(つまりサンプル)の要約統計量を表示3. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。 TCCを使わずにDESeqパッケージ内の関数を用いて2.と同じ結果を出すやり方です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_AH2.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Anders and Huberの(AH)正規化本番 cds <- newCountDataSet(data, data.cl) #CountDataSetオブジェクトを作成してcdsに格納 cds <- estimateSizeFactors(cds) #size factorを計算し、結果をcdsに格納 sizeFactors(cds) #これがDESeqのsize factorsです(1.1365363 1.1272941 0.8835836 0.9287529) norm.factors <- sizeFactors(cds)/colSums(data) #DESeqのsize factorsから「DESeqの正規化係数(これの平均が1になるとは限らない)」をnorm.factorsに格納 norm.factors <- norm.factors/mean(norm.factors) #正規化係数の平均が1になるように正規化した「これ(norm.factors)」がTCCパッケージで得られる「DESeqの正規化係数」です norm.factors #norm.factorsの中身を表示(1.1431946 1.1408795 0.8568723 0.8590536)。TCCパッケージから得られる「DESeqの正規化係数」と同じになっていることがわかる。 #正規化後のデータをファイルに出力 sizeFactors(cds) <- sizeFactors(cds)/mean(sizeFactors(cds)) #正規化後のデータ取得自体は「DESeqの正規化係数」とは無関係に取得可能であるが、TCC経由で得られるものと同じにするためにsize factorsの平均が1になるように正規化している normalized.count <- counts(cds, normalized=TRUE) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータの列ごとの各種要約統計量を表示 summary(normalized.count) #normalized.countの各列(つまりサンプル)の要約統計量を表示4. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。 DESeqパッケージ内の関数を用いてDESeqパッケージ内のマニュアル通りにやった場合。 若干数値が違ってきます(ということを示したいだけです)が正規化後の値の要約統計量をどこに揃えるか程度の違いなので気にする必要はないです。 実際、ここで得られるsize factorsの平均は1.019042ですが、この定数値を正規化後のデータに掛けるとTCCで得られるデータと同じになります。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_AH3.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Anders and Huberの(AH)正規化本番 cds <- newCountDataSet(data, data.cl) #CountDataSetオブジェクトを作成してcdsに格納 cds <- estimateSizeFactors(cds) #size factorを計算し、結果をcdsに格納 #正規化後のデータをファイルに出力 normalized.count <- counts(cds, normalized=TRUE) #正規化後のデータを取り出してnormalized.countに格納 tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータの列ごとの各種要約統計量を表示 summary(normalized.count) #normalized.countの各列(つまりサンプル)の要約統計量を表示5. SupplementaryTable2_changed.txtの「5 samples vs. 5 samples」の比較の場合: 昔の記述です。参考まで。
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 out_f <- "SupplementaryTable2_changed_DESeq.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 1000000 #補正後の総リード数を指定(RPMデータと同程度の数値分布にしたい場合はここは変更しないで) #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #DESeq正規化本番 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) #data_DESeq <- sweep(data, 2, 1/sizeFactors(cds), "*") #生のリードカウントデータをDESeq正規化係数を含む補正後のライブラリサイズで割った正規化後のデータをdata_DESeqに格納 sizeFactors(cds) #計算された補正後のライブラリサイズを表示しているだけ norm_f_DESeq <- sizeFactors(cds) * mean(colSums(data)) / colSums(data)#DESeq正規化係数の情報を抽出してnorm_f_DESeqに格納 effective_libsizes <- colSums(data) * norm_f_DESeq #effective library sizesというのはlibrary sizesに正規化係数を掛けたものなのでそれを計算した結果をeffective_libsizesに格納 data_DESeq <- sweep(data, 2, mean(colSums(data))/effective_libsizes, "*")#生のリードカウントデータをDESeq正規化係数を含む補正後のライブラリサイズで割った正規化後のデータをdata_DESeqに格納 colSums(counts(cds, normalized=TRUE)) #正規化後のデータについて、列ごとのSumを表示 colSums(data_DESeq) #正規化後のデータについて、列ごとのSumを表示(上の結果と同じなので正しい正規化後のデータを得られていることが分かる) #正規化後のデータをファイルに出力 data <- data_DESeq #data_DESeqをdataに格納 tmp <- cbind(rownames(data), data) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #おまけとして、DESeq正規化後のデータでM-A plotを描画 data <- data_DESeq #data_DESeqをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示6. SupplementaryTable2_changed2.txtの「1 sample vs. 1 sample」の比較の場合: 昔の記述です。参考まで。
in_f <- "SupplementaryTable2_changed2.txt" #読み込みたい発現データファイルを指定してin_f1に格納 out_f <- "SupplementaryTable2_changed2_DESeq.txt" #出力ファイル名を指定 param_A <- 1 #A群のサンプル数を指定 param_B <- 1 #B群のサンプル数を指定 param3 <- 1000000 #補正後の総リード数を指定(RPMデータと同程度の数値分布にしたい場合はここは変更しないで) #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #DESeq正規化本番 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) #data_DESeq <- sweep(data, 2, 1/sizeFactors(cds), "*") #生のリードカウントデータをDESeq正規化係数を含む補正後のライブラリサイズで割った正規化後のデータをdata_DESeqに格納 sizeFactors(cds) #計算された補正後のライブラリサイズを表示しているだけ norm_f_DESeq <- sizeFactors(cds) * mean(colSums(data)) / colSums(data)#DESeq正規化係数の情報を抽出してnorm_f_DESeqに格納 effective_libsizes <- colSums(data) * norm_f_DESeq #effective library sizesというのはlibrary sizesに正規化係数を掛けたものなのでそれを計算した結果をeffective_libsizesに格納 data_DESeq <- sweep(data, 2, mean(colSums(data))/effective_libsizes, "*")#生のリードカウントデータをDESeq正規化係数を含む補正後のライブラリサイズで割った正規化後のデータをdata_DESeqに格納 colSums(counts(cds, normalized=TRUE)) #正規化後のデータについて、列ごとのSumを表示 colSums(data_DESeq) #正規化後のデータについて、列ごとのSumを表示(上の結果と同じなので正しい正規化後のデータを得られていることが分かる) #正規化後のデータをファイルに出力 data <- data_DESeq #data_DESeqをdataに格納 tmp <- cbind(rownames(data), data) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #おまけとして、DESeq正規化後のデータでM-A plotを描画 data <- data_DESeq #data_DESeqをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示
DESeq:Anders and Huber, Genome Biol, 2010
TCC:Kadota et al., Algorithms Mol. Biol., 2012in_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_UQ.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 param1 <- "upper" #upper-quartile正規化法("upper")を指定 #必要なパッケージをロード library(EDASeq) #パッケージの読み込み #発現データの読み込みとSeqExpressionSetオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 es <- newSeqExpressionSet(exprs = as.matrix(data), #SeqExpressionSetというクラスにデータを格納 phenoData = data.frame(conditions = data.cl, #SeqExpressionSetというクラスにデータを格納 row.names = colnames(data)))#SeqExpressionSetというクラスにデータを格納 es #esを表示 summary(exprs(es)) #発現データの要約統計量を表示(UQ値が揃っていないことがわかる; 3rd Qu.のところ) #UQ正規化の実行 hoge <- betweenLaneNormalization(es, which=param1) #正規化を実行した結果をhogeに格納 #正規化後のデータをファイルに出力 normalized.count <- exprs(hoge) #正規化後のデータを取り出してnormalized.countに格納 summary(normalized.count) #正規化後のデータの要約統計量を表示(UQ値が75に揃っていることがわかる; 3rd Qu.のところ) tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(16 16 16 20 19 19)2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_UQ.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param1 <- "upper" #upper-quartile正規化法("upper")を指定 #必要なパッケージをロード library(EDASeq) #パッケージの読み込み #発現データの読み込みとSeqExpressionSetオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 es <- newSeqExpressionSet(exprs = as.matrix(data), #SeqExpressionSetというクラスにデータを格納 phenoData = data.frame(conditions = data.cl, #SeqExpressionSetというクラスにデータを格納 row.names = colnames(data)))#SeqExpressionSetというクラスにデータを格納 es #esを表示 summary(exprs(es)) #発現データの要約統計量を表示(UQ値が揃っていないことがわかる; 3rd Qu.のところ; 51, 51, 42, 44) #UQ正規化の実行 hoge <- betweenLaneNormalization(es, which=param1) #正規化を実行した結果をhogeに格納 #正規化後のデータをファイルに出力 normalized.count <- exprs(hoge) #正規化後のデータを取り出してnormalized.countに格納 summary(normalized.count) #正規化後のデータの要約統計量を表示(UQ値が47に揃っていることがわかる; 3rd Qu.のところ) tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存Bullard et al., BMC Bioinformatics, 2010
in_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_Qu.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 param1 <- "full" #Quantile正規化法("full")を指定 #必要なパッケージをロード library(EDASeq) #パッケージの読み込み #発現データの読み込みとSeqExpressionSetオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 es <- newSeqExpressionSet(exprs = as.matrix(data), #SeqExpressionSetというクラスにデータを格納 phenoData = data.frame(conditions = data.cl, #SeqExpressionSetというクラスにデータを格納 row.names = colnames(data)))#SeqExpressionSetというクラスにデータを格納 es #esを表示 summary(exprs(es)) #発現データの要約統計量を表示(分布が揃っていないことがわかる) #UQ正規化の実行 hoge <- betweenLaneNormalization(es, which=param1) #正規化を実行した結果をhogeに格納 #正規化後のデータをファイルに出力 normalized.count <- exprs(hoge) #正規化後のデータを取り出してnormalized.countに格納 summary(normalized.count) #正規化後のデータの要約統計量を表示(分布が完全に揃っていることがわかる) tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみを用いて(logスケールで)boxplot nonDEG <- 2001:10000 #non-DEGの位置情報をnonDEGに格納 boxplot(log(normalized.count[nonDEG, ])) #boxplot (non-DEGなので分布が揃っているほどよい正規化法であることを意味する。一部0のlogをとろうとしているので警告が出る、、、が気にしない) #正規化後のデータでnon-DEGsに相当する2001-10000行目のデータのみについて要約統計量を表示(サンプル間の数値が揃っているほどよい) summary(normalized.count[nonDEG, ]) #各列(つまりサンプル)の要約統計量を表示 apply(normalized.count[nonDEG, ], 2, median) #各列(つまりサンプル)のmedian(中央値)を表示(16 16 16 20 19 19)2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_Qu.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param1 <- "full" #Quantile正規化法("full")を指定 #必要なパッケージをロード library(EDASeq) #パッケージの読み込み #発現データの読み込みとSeqExpressionSetオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 es <- newSeqExpressionSet(exprs = as.matrix(data), #SeqExpressionSetというクラスにデータを格納 phenoData = data.frame(conditions = data.cl, #SeqExpressionSetというクラスにデータを格納 row.names = colnames(data)))#SeqExpressionSetというクラスにデータを格納 es #esを表示 summary(exprs(es)) #発現データの要約統計量を表示(分布が揃っていないことがわかる) #UQ正規化の実行 hoge <- betweenLaneNormalization(es, which=param1) #正規化を実行した結果をhogeに格納 #正規化後のデータをファイルに出力 normalized.count <- exprs(hoge) #正規化後のデータを取り出してnormalized.countに格納 summary(normalized.count) #正規化後のデータの要約統計量を表示(分布が完全に揃っていることがわかる) tmp <- cbind(rownames(normalized.count), normalized.count) #「rownames情報」と「正規化後のデータ」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存Bullard et al., BMC Bioinformatics, 2010
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "SupplementaryTable2_changed_RPM.txt" #出力ファイル名を指定 param1 <- 1000000 #補正後の総リード数を指定(RPMにしたい場合はここの数値はそのまま) data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み #RPM正規化 norm_f_RPM <- param1/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 #正規化後のデータをファイルに出力 data <- RPM #RPMをdataに格納 tmp <- cbind(rownames(data), data) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #おまけとして、RPM正規化後のデータでM-A plotを描画 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示2.edgeRパッケージ中のcpm関数を用いるやり方の場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "SupplementaryTable2_changed_RPM.txt" #出力ファイル名を指定 #必要なパッケージをロード library(edgeR) #パッケージの読み込み #発現データの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み #CPM正規化の実行 RPM <- cpm(data) #CPM正規化を実行した結果をRPMに格納 #正規化後のデータをファイルに出力 data <- RPM #RPMをdataに格納 tmp <- cbind(rownames(data), data) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #おまけとして、RPM正規化後のデータでM-A plotを描画 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示参考文献1(Mortazavi et al., Nat Methods, 2008)
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f <- "SupplementaryTable2_changed_RPKM.txt" #出力ファイル名を指定 param1 <- 1000000 #補正後の総リード数(per million mapped readsにするところ)を指定(RPKMにしたい場合はここの数値はそのまま) param2 <- 1000 #補正後の配列長(per kilobase of exonにするところ)を指定(RPKMにしたい場合はここの数値はそのまま) #まずはEnsembl Gene IDをアルファベット順に並び替えてRPM正規化 library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている norm_f_RPM <- param1/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 #Ensembl Gene IDをアルファベット順に並び替えてgene_length情報を取得 tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #RPKM正規化をするために、gene_length情報があるデータのみ抽出し、そのサブセットのみでRPKM正規化 common <- intersect(names(gene_length), rownames(RPM)) #二つのベクトル(names(gene_length)とrownames(RPM))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_RPM <- is.element(rownames(RPM), common) #commonで指定したEnsembl Gene IDsのrownames(RPM)中における位置情報をobj_RPMに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 RPM_sub <- RPM[obj_RPM,] #行列RPMからobj_RPMがTRUEとなっている行のみ抽出してRPM_subに格納 norm_factor2 <- param2/gene_length_sub #各行に対して掛ける正規化係数を計算してnorm_factor2に格納 RPKM <- sweep(RPM_sub, 1, norm_factor2, "*") #norm_factor2を行列RPM_subの各行に掛けた結果をRPKMに格納 tmp <- cbind(rownames(RPM_sub), gene_length_sub, RPKM) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Mortazavi et al., Nat Methods, 2008)
in_f1 <- "SRR002323.bowtiebed" #BED formatファイルを指定してin_f1に格納 in_f2 <- "refFlat.txt" #refFlat formatファイルを指定してin_f2に格納 out_f <- "SRR002323.bowtieexp" #出力ファイル名を指定してout_fに格納 library(DEGseq) #パッケージの読み込み out <- getGeneExp(in_f1, refFlat=in_f2, output=out_f) #発現レベルを計算(一応結果をoutに格納しているが、出力ファイルの内容と同じです) #以下は(こんなこともできますという)おまけ out[,3] #3列目のRPKMの情報のみ抽出したいときBioconductorのDEGseqのwebページ
in_f1 <- "seq2.fasta" #読み込みたいファイル名を指定してin_f1に格納 in_f2 <- "seq3.fasta" #読み込みたいファイル名を指定してin_f2に格納 param1 <- "local" #アラインメントのタイプ(local, global, overlap, global-local, local-globalのいずれか)を指定 param2 <- -10 #gap opening panalty(ギャップ開始ペナルティ)を指定(-10がデフォルト) param3 <- -0.5 #gap extension penalty(ギャップ伸長ペナルティ)を指定(-4がデフォルト) file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4" #置換行列ファイル(EDNAFULLのものはNUC.4.4に相当)のURLをfileに格納 submat <- as.matrix(read.table(file, check.names=FALSE)) #fileを読み込んでsubmatに格納 library(Biostrings) #パッケージの読み込み read1 <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルの読み込み read2 <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルの読み込み out <- pairwiseAlignment(pattern=read1,subject=read2,type=param1,#アラインメントを実行し、結果をoutに格納 gapOpening=param2,gapExtension=param3,substitutionMatrix=submat)#アラインメントを実行し、結果をoutに格納 #以下は(こんなこともできますという)おまけ #out中の情報抽出あれこれ: out@pattern #in_f1で指定した配列中のアラインメントされた領域を表示 out@subject #in_f2で指定した配列中のアラインメントされた領域を表示 out@score #アラインメントスコアを表示 #二つの配列のIDとアラインメントスコアをファイルに出力: out_f <- "hoge.txt" #出力ファイル名を指定 tmp <- cbind(names(read1), names(read2), out@score) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. multi-fastaファイル中の「seq3 vs. seq1」のglobal alignmentの場合:
in_f <- "test2.fasta" #読み込みたいmulti-fasta形式のファイル名を指定してin_fに格納 param1 <- "global" #アラインメントのタイプ(local, global, overlap, global-local, local-globalのいずれか)を指定 param2 <- 3 #multi-fasta入力ファイルの何番目の配列かを指定 param3 <- 1 #multi-fasta入力ファイルの何番目の配列かを指定 param4 <- -10 #gap opening panalty(ギャップ開始ペナルティ)を指定(-10がデフォルト) param5 <- -0.5 #gap extension penalty(ギャップ伸長ペナルティ)を指定(-4がデフォルト) file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4" #置換行列ファイル(EDNAFULLのものはNUC.4.4に相当)のURLをfileに格納 submat <- as.matrix(read.table(file, check.names=FALSE)) #fileを読み込んでsubmatに格納 library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み out <- pairwiseAlignment(pattern=reads[param2],subject=reads[param3],type=param1,#アラインメントを実行し、結果をoutに格納 gapOpening=param4,gapExtension=param5,substitutionMatrix=submat)#アラインメントを実行し、結果をoutに格納 #以下は(こんなこともできますという)おまけ #二つの配列のID,アラインメントスコア,%identidyをファイルに出力: out_f <- "hoge.txt" #出力ファイル名を指定 tmp <- cbind(names(reads[param2]), names(reads[param3]), score(out), pid(out))#ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存。
#まずはアラインメント結果outの取得 in_f1 <- "seq2.fasta" #読み込みたいファイル名を指定してin_f1に格納 in_f2 <- "seq3.fasta" #読み込みたいファイル名を指定してin_f2に格納 param1 <- "local" #アラインメントのタイプ(local, global, overlap, global-local, local-globalのいずれか)を指定 param2 <- -10 #gap opening panalty(ギャップ開始ペナルティ)を指定(-10がデフォルト) param3 <- -0.5 #gap extension penalty(ギャップ伸長ペナルティ)を指定(-4がデフォルト) file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4" #置換行列ファイル(EDNAFULLのものはNUC.4.4に相当)のURLをfileに格納 submat <- as.matrix(read.table(file, check.names=FALSE)) #fileを読み込んでsubmatに格納 library(Biostrings) #パッケージの読み込み read1 <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルの読み込み read2 <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルの読み込み out <- pairwiseAlignment(pattern=read1,subject=read2,type=param1,#アラインメントを実行し、結果をoutに格納 gapOpening=param2,gapExtension=param3,substitutionMatrix=submat)#アラインメントを実行し、結果をoutに格納 #ここからがいろいろな情報を取得するやり方 out #まずはデフォルトのoutの中身を表示 score(out) #アラインメントスコアを表示 pattern(out) #左側の配列(この場合seq2に相当;pattern)のアラインメントされた領域を表示 subject(out) #右側の配列(この場合seq2に相当;subject)のアラインメントされた領域を表示 nchar(out) #アラインメントされた領域(gapを含む)の長さを表示 nmatch(out) #アラインメントされた領域の一致塩基数を表示 nmismatch(out) #アラインメントされた領域の不一致塩基数を表示 nedit(out) #アラインメントされた領域のレーベンシュタイン距離(Levenshtein distance)を表示(nedit(out) + nmatch(out) = nchar(out)です) pid(out) #アラインメントされた領域の配列一致度(percent identity)を表示
in_f <- "test2.fasta" #読み込みたいmulti-fasta形式のファイル名を指定してin_fに格納 param1 <- "local" #アラインメントのタイプ(local, global, overlap, global-local, local-globalのいずれか)を指定 param2 <- 1 #multi-fasta入力ファイルの何番目の配列かを指定 param3 <- -10 #gap opening panalty(ギャップ開始ペナルティ)を指定(-10がデフォルト) param4 <- -0.5 #gap extension penalty(ギャップ伸長ペナルティ)を指定(-4がデフォルト) file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4" #置換行列ファイル(EDNAFULLのものはNUC.4.4に相当)のURLをfileに格納 submat <- as.matrix(read.table(file, check.names=FALSE)) #fileを読み込んでsubmatに格納 library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み out <- pairwiseAlignment(pattern=reads[-param2],subject=reads[param2],type=param1,#アラインメントを実行し、結果をoutに格納 gapOpening=param3,gapExtension=param4,substitutionMatrix=submat)#アラインメントを実行し、結果をoutに格納 #以下は(こんなこともできますという)おまけ #比較している配列の組み合わせ数などの情報を得たい: names(reads[param2]) #param2で指定した特定の配列のIDを表示("subject"に相当) names(reads[-param2]) #param2で指定した特定の配列"以外"のID(s)を表示("pattern"に相当) length(reads[-param2]) #ペアワイスアラインメント(pairwise alignment)をいくつやっているのか表示 #out中の情報抽出あれこれ: out[1] #1つ目のペアワイズアラインメント結果を表示 out[1]@score #1つ目のペアワイズアラインメント結果のスコアを表示 score(out[1]) #1つ目のペアワイズアラインメント結果のスコアを表示 out[2] #2つ目のペアワイズアラインメント結果を表示 out[2]@score #2つ目のペアワイズアラインメント結果のスコアを表示 score(out[2]) #2つ目のペアワイズアラインメント結果のスコアを表示 score(out) #ペアワイズアラインメント結果のスコアを全て表示 #比較した二配列のIDとアラインメントスコアをファイルに出力: 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))#ファイルに出力したい情報を連結してtmpに格納 } write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 特定の配列が入力multi-fastaファイルの3番目にある場合:
in_f <- "test2.fasta" #読み込みたいmulti-fasta形式のファイル名を指定してin_fに格納 param1 <- "local" #アラインメントのタイプ(local, global, overlap, global-local, local-globalのいずれか)を指定 param2 <- 3 #multi-fasta入力ファイルの何番目の配列かを指定 param3 <- -10 #gap opening panalty(ギャップ開始ペナルティ)を指定(-10がデフォルト) param4 <- -0.5 #gap extension penalty(ギャップ伸長ペナルティ)を指定(-4がデフォルト) file <- "ftp://ftp.ncbi.nih.gov/blast/matrices/NUC.4.4" #置換行列ファイル(EDNAFULLのものはNUC.4.4に相当)のURLをfileに格納 submat <- as.matrix(read.table(file, check.names=FALSE)) #fileを読み込んでsubmatに格納 library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み out <- pairwiseAlignment(pattern=reads[-param2],subject=reads[param2],type=param1,#アラインメントを実行し、結果をoutに格納 gapOpening=param3,gapExtension=param4,substitutionMatrix=submat)#アラインメントを実行し、結果をoutに格納 #以下は(こんなこともできますという)おまけ #比較している配列の組み合わせ数などの情報を得たい: names(reads[param2]) #param2で指定した特定の配列のIDを表示("subject"に相当) names(reads[-param2]) #param2で指定した特定の配列"以外"のID(s)を表示("pattern"に相当) length(reads[-param2]) #ペアワイスアラインメント(pairwise alignment)をいくつやっているのか表示 #out中の情報抽出あれこれ: out[1] #1つ目のペアワイズアラインメント結果を表示 out[1]@score #1つ目のペアワイズアラインメント結果のスコアを表示 score(out[1]) #1つ目のペアワイズアラインメント結果のスコアを表示 out[2] #2つ目のペアワイズアラインメント結果を表示 out[2]@score #2つ目のペアワイズアラインメント結果のスコアを表示 score(out[2]) #2つ目のペアワイズアラインメント結果のスコアを表示 score(out) #ペアワイズアラインメント結果のスコアを全て表示 #比較した二配列のIDとアラインメントスコアをファイルに出力: 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))#ファイルに出力したい情報を連結してtmpに格納 } write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "DHFR.fasta" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 param <- "AATGCTCAGGTA" #調べたい配列パターンを指定してparamに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #本番 out <- vmatchPattern(pattern=param, subject=seq) #paramで指定した配列と100%マッチの領域を探索して結果をoutに格納 out[[1]] #outの中身を表示(入力ファイル中には一致領域がないことを示している)2. DHFR.fastaを入力として、"CCTACTATGT"でキーワード探索を行う場合(存在することが分かっている断片配列):
in_f <- "DHFR.fasta" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 param <- "CCTACTATGT" #調べたい配列パターンを指定してparamに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #本番 out <- vmatchPattern(pattern=param, subject=seq) #paramで指定した配列と100%マッチの領域を探索して結果をoutに格納 out[[1]] #outの中身を表示(入力ファイルの(13,22)の位置に一致領域があることを示している) unlist(out) #outの中身を表示(入力ファイルの(13,22)の位置に一致領域があることを示している) start(unlist(out)) #一致領域のstart位置情報の抽出3. DHFR.fastaを入力として、"CCTACTATGT"でキーワード探索を行った結果をファイルに保存する場合:
in_f <- "DHFR.fasta" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定してout_fに格納 param <- "CCTACTATGT" #調べたい配列パターンを指定してparamに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #本番 out <- vmatchPattern(pattern=param, subject=seq) #paramで指定した配列と100%マッチの領域を探索して結果をoutに格納 tmp <- cbind(start(unlist(out)), end(unlist(out))) #一致領域の(start, end)の位置情報をtmpに格納 colnames(tmp) <- c("start", "end") #行列tmpの列名を追加 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。4. multi-fastaファイルhoge4.faを入力として、"AGG"でキーワード探索を行う場合:
in_f <- "hoge4.fa" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定してout_fに格納 param <- "AGG" #調べたい配列パターンを指定してparamに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #本番 out <- vmatchPattern(pattern=param, subject=seq) #paramで指定した配列と100%マッチの領域を探索して結果をoutに格納 hoge <- cbind(start(unlist(out)), end(unlist(out))) #一致領域の(start, end)の位置情報をhogeに格納 colnames(hoge) <- c("start", "end") #行列hogeに列名を付加 rownames(hoge) <- names(unlist(out)) #行列hogeに行名を付加 tmp <- cbind(rownames(hoge), hoge) #ファイルに出力したい情報を連結してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。5. multi-fastaファイルhoge4.faをリファレンス配列(マップされる側)として、10リードからなるdata_seqlogo1.txtでマッピングを行う場合:
in_f1 <- "hoge4.fa" #読み込みたいFASTA形式ファイルを指定してin_f1に格納 in_f2 <- "data_seqlogo1.txt" #読み込みたいFASTA形式ファイルを指定してin_f2に格納 out_f <- "hoge3.txt" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルの読み込み reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルの読み込み #本番 out <- c("in_f2", "in_f1", "start", "end") #最終的に得る出力ファイルのヘッダー情報を指定してoutに格納(4列のデータを得る) for(i in 1:length(reads)){ #リード数分だけループを回す tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)#オブジェクトreads中の各塩基配列と100%マッチの領域を探索して結果をtmpに格納 hoge1 <- cbind(start(unlist(tmp)), end(unlist(tmp))) #一致領域の(start, end)の位置情報をhoge1に格納 hoge2 <- names(unlist(tmp)) #ヒットしたリファレンス配列中のIDをhoge2に格納 hoge3 <- rep(as.character(reads[i]), length(hoge2)) #hoge2の要素数分だけ、マップする側の配列(in_f2で指定するものに相当)のIDをhoge3に格納 out <- rbind(out, cbind(hoge3, hoge2, hoge1)) #cbind(hoge3, hoge2, hoge1)で表される欲しい情報をどんどんオブジェクトoutの下に追加している(ループが回るたびにどんどん行数が増えていっているイメージ) } write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#resultの中身をout_fで指定したファイル名で保存。6. multi-fastaファイルhoge4.faをリファレンス配列(マップされる側)として、4リードからなるdata_reads.txtでマッピングを行う場合:
in_f1 <- "hoge4.fa" #読み込みたいFASTA形式ファイルを指定してin_f1に格納 in_f2 <- "data_reads.txt" #読み込みたいFASTA形式ファイルを指定してin_f2に格納 out_f <- "hoge4.txt" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルの読み込み reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルの読み込み #本番 out <- c("in_f2", "in_f1", "start", "end") #最終的に得る出力ファイルのヘッダー情報を指定してoutに格納(4列のデータを得る) for(i in 1:length(reads)){ #リード数分だけループを回す tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)#オブジェクトreads中の各塩基配列と100%マッチの領域を探索して結果をtmpに格納 hoge1 <- cbind(start(unlist(tmp)), end(unlist(tmp))) #一致領域の(start, end)の位置情報をhoge1に格納 hoge2 <- names(unlist(tmp)) #ヒットしたリファレンス配列中のIDをhoge2に格納 hoge3 <- rep(as.character(reads[i]), length(hoge2)) #hoge2の要素数分だけ、マップする側の配列(in_f2で指定するものに相当)のIDをhoge3に格納 out <- rbind(out, cbind(hoge3, hoge2, hoge1)) #cbind(hoge3, hoge2, hoge1)で表される欲しい情報をどんどんオブジェクトoutの下に追加している(ループが回るたびにどんどん行数が増えていっているイメージ) } write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#resultの中身をout_fで指定したファイル名で保存。7. multi-fastaファイルhoge4.faをリファレンス配列(マップされる側)として、4リードからなるdata_reads.txtでマッピングを行う場合(hoge1オブジェクトの作成のところの記述の仕方が若干異なる):
in_f1 <- "hoge4.fa" #読み込みたいFASTA形式ファイルを指定してin_f1に格納 in_f2 <- "data_reads.txt" #読み込みたいFASTA形式ファイルを指定してin_f2に格納 out_f <- "hoge5.txt" #出力ファイル名を指定してout_fに格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルの読み込み reads <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルの読み込み #本番 out <- c("in_f2", "in_f1", "start", "end") #最終的に得る出力ファイルのヘッダー情報を指定してoutに格納(4列のデータを得る) for(i in 1:length(seq)){ #リファレンス配列数分だけループを回す tmp <- matchPDict(PDict(reads), seq[[i]]) #リファレンス配列中のi番目の配列に対してオブジェクトreads中の全配列をmatchPDict関数を用いてマッピングした結果をtmpに格納 hoge1 <- cbind(start(unlist(tmp)), end(unlist(tmp))) #一致領域の(start, end)の位置情報をhoge1に格納 hoge2 <- names(unlist(tmp)) #ヒットしたリードのIDをhoge2に格納 hoge3 <- rep(names(seq[i]), length(hoge2)) #hoge2の要素数分だけ、マップされる側のリファレンス配列(in_f1で指定するものに相当)のIDをhoge3に格納 out <- rbind(out, cbind(hoge3, hoge2, hoge1)) #cbind(hoge3, hoge2, hoge1)で表される欲しい情報をどんどんオブジェクトoutの下に追加している(ループが回るたびにどんどん行数が増えていっているイメージ) #as.integer(coverage(tmp, 1, width(seq[i]))) } write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=F)#resultの中身をout_fで指定したファイル名で保存。
BioconductorのBiostringsのwebページ
参考文献1(Santiago et al., PNAS, 2008)in_f <- "hoge4.fa" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "hoge1.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #GC含量(GC content)計算のところ count <- alphabetFrequency(reads) #A,C,G,T,..の数を各配列ごとにカウントした結果をcountに格納 CG <- rowSums(count[,2:3]) #C,Gの総数を計算してCGに格納 ACGT <- rowSums(count[,1:4]) #A,C,G,Tの総数を計算してACGTに格納 out <- CG/ACGT*100 #%GC含量を計算してoutに格納 #出力用に結果をまとめている tmp <- cbind(names(reads), CG, ACGT, width(reads), out) #ファイルに出力したい情報を連結してtmpに格納 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)#tmpの中身をout_fで指定したファイル名で保存。2. test1.fastaファイルの場合:
in_f <- "test1.fasta" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #GC含量(GC content)計算のところ count <- alphabetFrequency(reads) #A,C,G,T,..の数を各配列ごとにカウントした結果をcountに格納 CG <- rowSums(count[,2:3]) #C,Gの総数を計算してCGに格納 ACGT <- rowSums(count[,1:4]) #A,C,G,Tの総数を計算してACGTに格納 out <- CG/ACGT*100 #%GC含量を計算してoutに格納 #出力用に結果をまとめている tmp <- cbind(names(reads), CG, ACGT, width(reads), out) #ファイルに出力したい情報を連結してtmpに格納 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)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "test1.fasta" #読み込みたいファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み library(seqLogo) #パッケージの読み込み #入力ファイルの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #本番 hoge <- consensusMatrix(reads, as.prob=T, baseOnly=T) #各ポジションの塩基組成(probability)を計算してhogeに格納。as.prob=Fにすることで塩基の出現割合ではなく出現頻度にすることもできる out <- makePWM(hoge[1:4,]) #hogeはACGT以外の塩基(例えばN)のprobabilityもotherという5番目の行に出力するが、makePWM関数はACGTの最初の4行分の行列データのみ許容して受け付け、情報量(information content; ic)などを計算してくれる seqLogo(out) #塩基組成やicの情報を含むoutを入力としてsequence logoを描画。単に「plot(out)」でも同じ結果が得られる。2. 入力ファイルがmulti-fasta形式のファイル(data_seqlogo1.txt)の場合:
in_f <- "data_seqlogo1.txt" #読み込みたいファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み library(seqLogo) #パッケージの読み込み #入力ファイルの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #本番 hoge <- consensusMatrix(reads, as.prob=T, baseOnly=T) #各ポジションの塩基組成(probability)を計算してhogeに格納。as.prob=Fにすることで塩基の出現割合ではなく出現頻度にすることもできる out <- makePWM(hoge[1:4,]) #hogeはACGT以外の塩基(例えばN)のprobabilityもotherという5番目の行に出力するが、makePWM関数はACGTの最初の4行分の行列データのみ許容して受け付け、情報量(information content; ic)などを計算してくれる seqLogo(out) #塩基組成やicの情報を含むoutを入力としてsequence logoを描画。単に「plot(out)」でも同じ結果が得られる。3. 入力ファイルがmulti-fasta形式のファイル(data_seqlogo1.txt)で得られた図をファイルに保存したい場合:
in_f <- "data_seqlogo1.txt" #読み込みたいファイル名を指定 out_f <- "test3.png" #出力ファイル名を指定 param <- c(600, 400) #ファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード library(Biostrings) #パッケージの読み込み library(seqLogo) #パッケージの読み込み #入力ファイルの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み #本番 hoge <- consensusMatrix(reads, as.prob=T, baseOnly=T) #各ポジションの塩基組成(probability)を計算してhogeに格納。as.prob=Fにすることで塩基の出現割合ではなく出現頻度にすることもできる out <- makePWM(hoge[1:4,]) #hogeはACGT以外の塩基(例えばN)のprobabilityもotherという5番目の行に出力するが、makePWM関数はACGTの最初の4行分の行列データのみ許容して受け付け、情報量(information content; ic)などを計算してくれる png(out_f, width=param[1], height=param[2]) #出力ファイルの各種パラメータを指定 seqLogo(out) #塩基組成やicの情報を含むoutを入力としてsequence logoを描画。単に「plot(out)」でも同じ結果が得られる。 dev.off() #おまじない4. 入力ファイルがmulti-fasta形式のファイル(TAIR10_upstream_1000_20101104.fasta)で、1000bpと長いため、930-1000bpの範囲のみについて解析し得られた図をファイルに保存したい場合:
in_f <- "TAIR10_upstream_1000_20101104.fasta" #読み込みたいファイル名を指定 out_f <- "test4.png" #出力ファイル名を指定 param1 <- c(930, 1000) #抽出したい範囲の始点と終点を指定 param2 <- c(1300, 400) #ファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード library(Biostrings) #パッケージの読み込み library(seqLogo) #パッケージの読み込み #入力ファイルの読み込み reads_org <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み reads_org <- reads_org[width(reads_org) == 1000] #配列長が1000bpでないもの(がたまに含まれるので)を除去している reads <- subseq(reads_org, param1[1], param1[2]) #param1で指定した始点と終点の範囲の配列を抽出してreadsに格納 #本番 hoge <- consensusMatrix(reads, as.prob=T, baseOnly=T) #各ポジションの塩基組成(probability)を計算してhogeに格納。as.prob=Fにすることで塩基の出現割合ではなく出現頻度にすることもできる out <- makePWM(hoge[1:4,]) #hogeはACGT以外の塩基(例えばN)のprobabilityもotherという5番目の行に出力するが、makePWM関数はACGTの最初の4行分の行列データのみ許容して受け付け、情報量(information content; ic)などを計算してくれる png(out_f, width=param2[1], height=param2[2]) #出力ファイルの各種パラメータを指定 seqLogo(out) #塩基組成やicの情報を含むoutを入力としてsequence logoを描画。単に「plot(out)」でも同じ結果が得られる。 dev.off() #おまじない5. 入力ファイルが塩基組成のファイル(data_seqlogo2.txt)の場合:
in_f <- "data_seqlogo2.txt" #読み込みたいファイル名を指定 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み library(seqLogo) #パッケージの読み込み #入力ファイルの読み込み hoge <- read.table(in_f) #in_fで指定したファイルの読み込み #本番 out <- makePWM(hoge) #情報量(information content; ic)を計算している seqLogo(out) #塩基組成やicの情報を含むoutを入力としてsequence logoを描画。単に「plot(out)」でも同じ結果が得られる。参考文献1(Schneider and Stephens, NAR, 1990)
in_f <- "TAIR10_upstream_1000_20101104.fasta" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定してout_fに格納 param1 <- 5 #調べたい連続塩基数(hexamerの場合は6, octamerの場合は8など)を指定してparam1に格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込みとフィルタリング seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み seq #seqの中身をざっとみてるだけ(33602個あることがわかる) seq <- seq[width(seq) == median(width(seq))] #配列長はほとんどが一定長(この場合1000bp)だがときどき存在する異なるものを除去している seq #seqの中身をざっとみてるだけ(33600個となり、1000bpでなかったものが2個含まれていたことがわかる) #(param1)-merの可能な全ての塩基配列を作成 reads <- mkAllStrings(c("A", "C", "G", "T"), param1) #(param1)連続塩基の全ての可能な配列情報をreadsに格納 #4^(param1)通りの塩基配列一つ一つについて上流配列セットseqに対するパターンマッチングを行う out <- NULL for(i in 1:length(reads)){ #readsの要素数分だけループを回す tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)#オブジェクトreads中の各塩基配列と100%マッチの領域を探索し、結果をtmpに格納 s_posi_freq <- rle(sort(start(unlist(tmp)))) #一致領域のstart positionごとの頻度情報を計算してs_posi_freqに格納 hoge <- rep(0, (width(seq[1]) - param1 + 1)) #1000bp長の配列から5連続塩基で一致領域を探索しそのstart positionのみ調査する場合には、可能なstart positionは1塩基目から(1000-5+1)塩基目までしかないため、取りうる範囲を限定してpositionごとの頻度の初期値を0として作成している hoge2 <- replace(hoge, s_posi_freq$values, s_posi_freq$lengths)#s_posi_freqベクトルはfrequencyの値が0のポジションの情報がないため、0個のfrequencyのポジションを確実に作成して要素数を揃えている out <- rbind(out, hoge2) #全部で(width(seq[1]) - param1 + 1)個分の要素(この場合は1000-5+1=996個の要素)からなるstart positionごとの頻度情報ベクトルhoge2を調べたい連続塩基ごとに作成した結果を行方向でどんどん結合している if(i%%10 == 0) cat(i, "/", length(reads), "finished\n") #進行状況を表示させてるだけ } rownames(out) <- reads #行列outのどの行がどの連続塩基由来のものかを割り当てている #有意な(param1)-merを探索 threshold <- apply(out,1,median) + 5*apply(out,1,mad) #出現頻度の(median+5*MAD)の値を計算してthresholdに格納 obj <- apply(out,1,max) > threshold #条件を満たすかどうかをチェック:出現頻度の最大値がthresholdより大きいものをTRUE baseline <- apply(out,1,median) #baselineを出現頻度の中央値として与えている baseline[baseline < 1] <- 1 #baselineが1未満のものを1に置換している RPH <- apply(out,1,max) / baseline #出現頻度の最大値をbaselineで割ったものをRPHと定義している RPA <- apply((out - baseline),1,sum) / apply(out,1,sum) #「(出現頻度 - baseline)の和 / 出現頻度の和」をRPAと定義している #ファイルに出力 tmp <- cbind(rownames(out), RPH, RPA, obj) #ファイルに出力したい情報を連結してtmpに格納 colnames(tmp) <- c("(param1)-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)#tmpの中身をout_fで指定したファイル名で保存。 #既知のコアプロモーター領域の分布をチェック plot(out["TATAA",]) #TATA-boxのプロット plot(out["GCCCA",]) #PPDB(参考文献4)中でGCCCA, PLACE(参考文献5)中でGGGCCというモチーフのやつ。転写開始点(右側)近傍にブロードにGCCCAという配列が濃縮して存在していることがわかる。2. 上記を基本としつつ組合せ数分だけ原著論文(参考文献1)Fig.1と同じような図をpngファイルで生成したい場合: (以下をコピペすると作業ディレクトリ上に1024個のpngファイルが生成されますので注意!!)
in_f <- "TAIR10_upstream_1000_20101104.fasta" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定してout_fに格納 param1 <- 5 #調べたい連続塩基数(hexamerの場合は6, octamerの場合は8など)を指定してparam1に格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込みとフィルタリング seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み seq #seqの中身をざっとみてるだけ(33602個あることがわかる) seq <- seq[width(seq) == median(width(seq))] #配列長はほとんどが一定長(この場合1000bp)だがときどき存在する異なるものを除去している seq #seqの中身をざっとみてるだけ(33600個となり、1000bpでなかったものが2個含まれていたことがわかる) #(param1)-merの可能な全ての塩基配列を作成 reads <- mkAllStrings(c("A", "C", "G", "T"), param1) #(param1)連続塩基の全ての可能な配列情報をreadsに格納 #4^(param1)通りの塩基配列一つ一つについて上流配列セットseqに対するパターンマッチングを行う out <- NULL for(i in 1:length(reads)){ #readsの要素数分だけループを回す tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)#オブジェクトreads中の各塩基配列と100%マッチの領域を探索し、結果をtmpに格納 s_posi_freq <- rle(sort(start(unlist(tmp)))) #一致領域のstart positionごとの頻度情報を計算してs_posi_freqに格納 hoge <- rep(0, (width(seq[1]) - param1 + 1)) #1000bp長の配列から5連続塩基で一致領域を探索しそのstart positionのみ調査する場合には、可能なstart positionは1塩基目から(1000-5+1)塩基目までしかないため、取りうる範囲を限定してpositionごとの頻度の初期値を0として作成している hoge2 <- replace(hoge, s_posi_freq$values, s_posi_freq$lengths)#s_posi_freqベクトルはfrequencyの値が0のポジションの情報がないため、0個のfrequencyのポジションを確実に作成して要素数を揃えている out <- rbind(out, hoge2) #全部で(width(seq[1]) - param1 + 1)個分の要素(この場合は1000-5+1=996個の要素)からなるstart positionごとの頻度情報ベクトルhoge2を調べたい連続塩基ごとに作成した結果を行方向でどんどん結合している if(i%%10 == 0) cat(i, "/", length(reads), "finished\n") #進行状況を表示させてるだけ } rownames(out) <- reads #行列outのどの行がどの連続塩基由来のものかを割り当てている #有意な(param1)-merを探索 threshold <- apply(out,1,median) + 5*apply(out,1,mad) #出現頻度の(median+5*MAD)の値を計算してthresholdに格納 obj <- apply(out,1,max) > threshold #条件を満たすかどうかをチェック:出現頻度の最大値がthresholdより大きいものをTRUE baseline <- apply(out,1,median) #baselineを出現頻度の中央値として与えている baseline[baseline < 1] <- 1 #baselineが1未満のものを1に置換している PH <- apply(out,1,max) #出現頻度の最大値をPHに格納 RPH <- PH / baseline #出現頻度の最大値をbaselineで割ったものをRPHと定義している RPA <- apply((out - baseline),1,sum) / apply(out,1,sum) #「(出現頻度 - baseline)の和 / 出現頻度の和」をRPAと定義している #ファイルに出力 tmp <- cbind(rownames(out), RPH, RPA, obj) #ファイルに出力したい情報を連結してtmpに格納 colnames(tmp) <- c("(param1)-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)#tmpの中身をout_fで指定したファイル名で保存。 #pngファイルを一気に生成 for(i in 1:length(reads)){ out_f <- paste("result_", rownames(out)[i], ".png", sep="") #ファイル名を作成している png(out_f, width=1000, height=500) #横幅1000ピクセル、縦幅500ピクセルの描画領域を生成 plot(out[i,], ylim=c(0, max(c(PH[i], threshold[i]))), #行列outのi番目の行の数値をプロットしている ylab="Occurence", xlab="Position", type="p", pch=20, cex=0.8)#行列outのi番目の行の数値をプロットしている abline(h=baseline[i], col="red") #baseline (出現頻度の中央値)を赤線で追加している text(0, baseline[i], "baseline", col="red", adj=c(0,0)) #baselineを引いたところに"baseline"という文字を追加している abline(h=threshold[i], col="red") #有意かどうかを判定するために採用した閾値(threshold = baseline+5*MAD)の値も赤線で追加している text(0, threshold[i], "threshold(= baseline + 5*MAD)", col="red", adj=c(0,0))#閾値を引いたところに"threshold"という文字を追加している dev.off() }3. 2と同じだが入力ファイルがラット上流配列セット(ファイル名:"rat_upstream_1000.fa")の場合:
in_f <- "rat_upstream_1000.fa" #読み込みたいFASTA形式のファイル名を指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定してout_fに格納 param1 <- 5 #調べたい連続塩基数(hexamerの場合は6, octamerの場合は8など)を指定してparam1に格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込みとフィルタリング seq <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルの読み込み seq #seqの中身をざっとみてるだけ(33602個あることがわかる) seq <- seq[width(seq) == median(width(seq))] #配列長はほとんどが一定長(この場合1000bp)だがときどき存在する異なるものを除去している seq #seqの中身をざっとみてるだけ(33600個となり、1000bpでなかったものが2個含まれていたことがわかる) #(param1)-merの可能な全ての塩基配列を作成 reads <- mkAllStrings(c("A", "C", "G", "T"), param1) #(param1)連続塩基の全ての可能な配列情報をreadsに格納 #4^(param1)通りの塩基配列一つ一つについて上流配列セットseqに対するパターンマッチングを行う out <- NULL for(i in 1:length(reads)){ #readsの要素数分だけループを回す tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq)#オブジェクトreads中の各塩基配列と100%マッチの領域を探索し、結果をtmpに格納 s_posi_freq <- rle(sort(start(unlist(tmp)))) #一致領域のstart positionごとの頻度情報を計算してs_posi_freqに格納 hoge <- rep(0, (width(seq[1]) - param1 + 1)) #1000bp長の配列から5連続塩基で一致領域を探索しそのstart positionのみ調査する場合には、可能なstart positionは1塩基目から(1000-5+1)塩基目までしかないため、取りうる範囲を限定してpositionごとの頻度の初期値を0として作成している hoge2 <- replace(hoge, s_posi_freq$values, s_posi_freq$lengths)#s_posi_freqベクトルはfrequencyの値が0のポジションの情報がないため、0個のfrequencyのポジションを確実に作成して要素数を揃えている out <- rbind(out, hoge2) #全部で(width(seq[1]) - param1 + 1)個分の要素(この場合は1000-5+1=996個の要素)からなるstart positionごとの頻度情報ベクトルhoge2を調べたい連続塩基ごとに作成した結果を行方向でどんどん結合している if(i%%10 == 0) cat(i, "/", length(reads), "finished\n") #進行状況を表示させてるだけ } rownames(out) <- reads #行列outのどの行がどの連続塩基由来のものかを割り当てている #有意な(param1)-merを探索 threshold <- apply(out,1,median) + 5*apply(out,1,mad) #出現頻度の(median+5*MAD)の値を計算してthresholdに格納 obj <- apply(out,1,max) > threshold #条件を満たすかどうかをチェック:出現頻度の最大値がthresholdより大きいものをTRUE baseline <- apply(out,1,median) #baselineを出現頻度の中央値として与えている baseline[baseline < 1] <- 1 #baselineが1未満のものを1に置換している PH <- apply(out,1,max) #出現頻度の最大値をPHに格納 RPH <- PH / baseline #出現頻度の最大値をbaselineで割ったものをRPHと定義している RPA <- apply((out - baseline),1,sum) / apply(out,1,sum) #「(出現頻度 - baseline)の和 / 出現頻度の和」をRPAと定義している #ファイルに出力 tmp <- cbind(rownames(out), RPH, RPA, obj) #ファイルに出力したい情報を連結してtmpに格納 colnames(tmp) <- c("(param1)-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)#tmpの中身をout_fで指定したファイル名で保存。 #pngファイルを一気に生成 for(i in 1:length(reads)){ out_f <- paste("result_", rownames(out)[i], ".png", sep="") #ファイル名を作成している png(out_f, width=1000, height=500) #横幅1000ピクセル、縦幅500ピクセルの描画領域を生成 plot(out[i,], ylim=c(0, max(c(PH[i], threshold[i]))), #行列outのi番目の行の数値をプロットしている ylab="Occurence", xlab="Position", type="p", pch=20, cex=0.8)#行列outのi番目の行の数値をプロットしている abline(h=baseline[i], col="red") #baseline (出現頻度の中央値)を赤線で追加している text(0, baseline[i], "baseline", col="red", adj=c(0,0)) #baselineを引いたところに"baseline"という文字を追加している abline(h=threshold[i], col="red") #有意かどうかを判定するために採用した閾値(threshold = baseline+5*MAD)の値も赤線で追加している text(0, threshold[i], "threshold(= baseline + 5*MAD)", col="red", adj=c(0,0))#閾値を引いたところに"threshold"という文字を追加している dev.off() }参考文献1(LDSS; Yamamoto et al., BMC Genomics, 2007)
in_f1 <- "seq_BAT_DEG.fa" #読み込みたいFASTA形式のDEGのファイル名を指定してin_f1に格納 in_f2 <- "seq_BAT_nonDEG.fa" #読み込みたいFASTA形式のnonDEGのファイル名を指定してin_f2に格納 out_f <- "hoge.txt" #出力ファイル名を指定してout_fに格納 param1 <- 5 #調べたい連続塩基数(hexamerの場合は6, octamerの場合は8など)を指定してparam1に格納 #必要なパッケージをロード library(Biostrings) #パッケージの読み込み #入力ファイルの読み込み seq_DEG <- readDNAStringSet(in_f1, format="fasta") #in_f1で指定したファイルの読み込み seq_DEG #オブジェクトの中身をざっとみてるだけ(563 sequencesであることがわかる) seq_nonDEG <- readDNAStringSet(in_f2, format="fasta") #in_f2で指定したファイルの読み込み seq_nonDEG #オブジェクトの中身をざっとみてるだけ(8898 sequencesであることがわかる) #(param1)-merの可能な全ての塩基配列を作成 reads <- mkAllStrings(c("A", "C", "G", "T"), param1) #(param1)連続塩基の全ての可能な配列情報をreadsに格納 #4^(param1)通りの塩基配列一つ一つについて上流配列セットに対するパターンマッチングを行う out <- NULL for(i in 1:length(reads)){ #readsの要素数分だけループを回す tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq_DEG)#オブジェクトreads中の各塩基配列と100%マッチの領域を探索し、結果をtmpに格納 out_DEG <- length(start(unlist(tmp))) #一致領域のstart positionの情報を抽出してout_DEGに格納 tmp <- vmatchPattern(pattern=as.character(reads[i]), subject=seq_nonDEG)#オブジェクトreads中の各塩基配列と100%マッチの領域を探索し、結果をtmpに格納 out_nonDEG <- length(start(unlist(tmp))) #一致領域のstart positionの情報を抽出してout_nonDEGに格納 x <- c(out_nonDEG, length(seq_nonDEG), out_DEG, length(seq_DEG))#Fisher's Exact Testを行うための2×2分割表の基礎情報を作成してxに格納 data <- matrix(x, ncol=2, byrow=T) #ベクトルxを行列形式に変換した結果をdataに格納 pvalue <- fisher.test(data)$p.value #Fisher's Exact Testを行って得られたp値をpvalueに格納 out <- rbind(out, c(x, pvalue)) #必要な情報を行方向で結合することでまとめている if(i%%10 == 0) cat(i, "/", length(reads), "finished\n") #進行状況を表示させてるだけ } rownames(out) <- reads #行列outのどの行がどの連続塩基由来のものかを割り当てている(行名を与えている) FDR <- p.adjust(out[,ncol(out)], method="BH") #Benjamini and Hochberg (1995)の方法でFDRを計算した結果をFDRに格納 #ファイルに出力 tmp <- cbind(rownames(out), out, FDR) #ファイルに出力したい情報を連結してtmpに格納 colnames(tmp) <- c("k-mer", "Occurence in nonDEG", "# of nonDEG sequences", "Occurence in DEG", "# of DEG sequences", "p-value", "FDR")#列名を与えている write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(RAR; Yamamoto et al., BMC Plant Biol., 2011)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み RPM <- sweep(data, 2, 1000000/colSums(data), "*") #サンプル(列)ごとの総リード数をそろえるべくRPMデータにしておく RPM_k <- RPM[,1:5] #最初の5列分のデータがkidneyのデータなのでそれだけを抽出した結果をRPM_kに格納 RPM_k <- RPM_k[rowSums(RPM_k) > 0,] #全部が0だと分散を計算できないので、行の和が0より大きいもののみ抽出している MEAN <- apply(RPM_k, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(RPM_k, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #以下では回帰分析を行うことを通じて、統計的な検証を行っている hoge <- as.data.frame(cbind(MEAN, VARIANCE)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がVARIANCEならなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(VARIANCE~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をVARIANCEとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加(この結果から傾きがおおむね1であることがわかり、確かにポアソン分布に従っていることがわかる) out #outの簡単な中身を表示(切片(Intercept)が-0.3470, 傾き(MEAN)が0.9927であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.897と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) #一応y=xの直線を青で引いておく(y=a+bxのa=0, b=1) abline(a=0, b=1, col="blue") #y=xの直線を追加2. ファイルに保存したい場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.png" #出力ファイル名を指定してout_fに格納 param1 <- 400 #横軸の大きさ(単位はピクセル)を指定 param2 <- 400 #縦軸の大きさ(単位はピクセル)を指定 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み RPM <- sweep(data, 2, 1000000/colSums(data), "*") #サンプル(列)ごとの総リード数をそろえるべくRPMデータにしておく RPM_k <- RPM[,1:5] #最初の5列分のデータがkidneyのデータなのでそれだけを抽出した結果をRPM_kに格納 RPM_k <- RPM_k[rowSums(RPM_k) > 0,] #全部が0だと分散を計算できないので、行の和が0より大きいもののみ抽出している MEAN <- apply(RPM_k, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(RPM_k, 1, var) #各行の分散を計算した結果をVARIANCEに格納 #描画 png(out_f, width=param1, height=param2) #出力ファイルの各種パラメータを指定 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 hoge <- as.data.frame(cbind(MEAN, VARIANCE)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がVARIANCEならなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(VARIANCE~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をVARIANCEとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加(この結果から傾きがおおむね1であることがわかり、確かにポアソン分布に従っていることがわかる) out #outの簡単な中身を表示(切片(Intercept)が-0.3470, 傾き(MEAN)が0.9927であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.897と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) abline(a=0, b=1, col="blue") #y=xの直線を青色で追加 dev.off() #おまじない3. ファイルに保存したい場合でさらに軸の値の範囲も指定したい場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge_RPM.png" #出力ファイル名を指定してout_fに格納 param1 <- 400 #横軸の大きさ(単位はピクセル)を指定 param2 <- 400 #縦軸の大きさ(単位はピクセル)を指定 param3 <- c(1e-03, 1e+05) #x軸の値の範囲を指定 param4 <- c(1e-03, 1e+05) #y軸の値の範囲を指定 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み RPM <- sweep(data, 2, 1000000/colSums(data), "*") #サンプル(列)ごとの総リード数をそろえるべくRPMデータにしておく RPM_k <- RPM[,1:5] #最初の5列分のデータがkidneyのデータなのでそれだけを抽出した結果をRPM_kに格納 RPM_k <- RPM_k[rowSums(RPM_k) > 0,] #全部が0だと分散を計算できないので、行の和が0より大きいもののみ抽出している MEAN <- apply(RPM_k, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(RPM_k, 1, var) #各行の分散を計算した結果をVARIANCEに格納 #描画 png(out_f, width=param1, height=param2) #出力ファイルの各種パラメータを指定 plot(MEAN, VARIANCE, log="xy", xlim=param3, ylim=param4) #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 hoge <- as.data.frame(cbind(MEAN, VARIANCE)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がVARIANCEならなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(VARIANCE~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をVARIANCEとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加(この結果から傾きがおおむね1であることがわかり、確かにポアソン分布に従っていることがわかる) out #outの簡単な中身を表示(切片(Intercept)が-0.3470, 傾き(MEAN)が0.9927であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.897と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) abline(a=0, b=1, col="blue") #y=xの直線を青色で追加 dev.off() #おまじない参考文献1(Marioni et al., Genome Res., 2008)
#任意のλ(> 0)を与え、任意の数の乱数を発生させ、その分散がλに近い値になっているかどうか調べる param1 <- 8 #λの値を指定 param2 <- 100 #発生させる乱数の数を指定 out <- rpois(param2, lambda=param1) #ポアソン分布に従う乱数を発生させた結果をoutに格納 out #outの中身を表示 var(out) #outの分散を計算している1-2. ポアソン分布の感覚をつかむ(中級):
#λを1から100までにし、各λの値について発生させる乱数の数を増やし、λの値ごとの平均と分散を計算した結果をプロット out <- NULL #最終的に平均と分散の計算結果を格納するためのプレースホルダを作成している for(i in 1:100){ #100回ループを回す x <- rpois(n=2000, lambda=i) #λがiのときのポアソン分布に従う乱数を2000個発生させた結果をxに格納 out <- rbind(out, c(mean(x), var(x))) #xの平均と分散を計算した結果をどんどんoutの下の行に追加 } #ここまできたら、次のiの値でループの最初からやり直し colnames(out) <- c("MEAN", "VARIANCE") #最終的に得られるoutは100行2列のデータ。この列名を指定している plot(out) #平均と分散の関係をプロット(傾きが1の直線っぽくなっていることが分かる。つまり平均=分散ってこと) #λを5, 60, 200の三つの要素からなるベクトルとして与えて各々1000個分の乱数を発生させる param1 <- c(5, 60, 200) #λの値を指定 param2 <- 10000 #各λの値ごとの発生させる乱数の数を指定 out <- rpois(param2*length(param1), lambda=param1) #ポアソン分布に従う乱数を発生させた結果をoutに格納 hist(out) #ヒストグラムを描画2. シミュレーションデータの作成本番(7サンプル分の行列データとして作成):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 7 #サンプル数を指定 #データファイルの読み込みとλベクトルの作成(kidneyのfive technical replicatesのデータを用いる) tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tmp <- rowSums(tmp[,1:5]) #kidneyの5 replicatesのデータの各行の和を計算している RPM <- tmp*1000000/sum(tmp) #リード数の総和を100万にしている LAMBDA <- RPM[RPM > 0] #λが0だと意味がないのでそういうものを除いている #ポアソン分布に従う乱数を生成してシミュレーションデータを得る out <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param1){ #param1回ループを回す out <- cbind(out, rpois(n=length(LAMBDA), lambda=LAMBDA)) #length(LAMBDA)個の乱数を発生させている(λベクトルはLAMBDAで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #得られた20921行×param1列からなる行列outがポアソン分布に従っているかを確認 obj <- rowSums(out) > 0 #全部が0だと分散を計算できないので、行の和が0より大きいもののみTRUE、それ以外をFALSEとしたベクトルobjを作成している out2 <- out[obj,] #objがTRUEのもののみ抽出してout2に格納 MEAN <- apply(out2, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(out2, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #行列outの中から分散が計算できたもののみ、検証用情報(LAMDA, MEAN, VARIANCE)とともにファイルに出力 tmp <- cbind(out2, LAMBDA[obj], MEAN, VARIANCE) #行列out2の右側に、「λ」、「(発生させた乱数の)平均」、「(発生させた乱数の)分散」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存3. シミュレーションデータの作成本番(遺伝子数(行数)を任意に与える場合):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 7 #サンプル数を指定 param2 <- 5000 #遺伝子数を指定 #データファイルの読み込みとλベクトルの作成(kidneyのfive technical replicatesのデータを用いる) tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tmp <- rowSums(tmp[,1:5]) #kidneyの5 replicatesのデータの各行の和を計算している LAMBDA <- tmp[tmp > 0] #λが0だと意味がないのでそういうものを除いている LAMBDA <- sample(LAMBDA, param2, replace=TRUE) #param2で指定した数だけサンプリングした結果をLAMBDAに格納 LAMBDA <- LAMBDA*1000000/sum(LAMBDA) #リード数の総和を100万にしている #ポアソン分布に従う乱数を生成してシミュレーションデータを得る out <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param1){ #param1回ループを回す out <- cbind(out, rpois(n=length(LAMBDA), lambda=LAMBDA)) #length(LAMBDA)個の乱数を発生させている(λベクトルはLAMBDAで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #得られたparam2行×param1列からなる行列outがポアソン分布に従っているかを確認 obj <- apply(out, 1, var) > 0 #行列outの各行の分散が0より大きいものをTRUE、それ以外をFALSEとしたベクトルobjを作成している out2 <- out[obj,] #objがTRUEのもののみ抽出してout2に格納 MEAN <- apply(out2, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(out2, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #行列outをファイルに出力 tmp <- cbind(LAMBDA, out) #LAMBDAの数値情報の右側に行列outを列方向で結合した結果をtmpに格納 colnames(tmp) <- c("LAMBDA", paste("replicate",1:param1,sep="")) #tmpの列名を与えている write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存4. シミュレーションデータの作成本番(A群3サンプル vs. B群3サンプルのデータで、全遺伝子の10%がA群で2倍高発現というデータにしたい場合):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 10000 #遺伝子数を指定 param4 <- 0.1 #発現変動遺伝子の割合を指定 param5 <- 2 #発現変動の度合い(fold-change)を指定 #データファイルの読み込みとλベクトルの作成(kidneyのfive technical replicatesのデータを用いる) tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tmp <- rowSums(tmp[,1:5]) #kidneyの5 replicatesのデータの各行の和を計算している LAMBDA <- tmp[tmp > 0] #λが0だと意味がないのでそういうものを除いている LAMBDA <- sample(LAMBDA, param3, replace=TRUE) #param3で指定した数だけサンプリングした結果をLAMBDAに格納 LAMBDA <- LAMBDA*1000000/sum(LAMBDA) #リード数の総和を100万にしている #発現変動遺伝子(DEG)に相当する位置情報の特定、およびA群用にその部分のみ(param5)倍高発現となるようなλに変更 DEG_degree <- rep(1, param3) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree[1:(param3*param4)] <- param5 #param3個の遺伝子ベクトル中最初の(param3*param4)個の発現変動の度合いをparam5としている DEG_posi <- DEG_degree == param5 #DEGの位置情報を取得している LAMBDA_A <- LAMBDA*DEG_degree #A群用のλ(つまりLAMBDA*DEG_degree)をLAMBDA_Aに格納 LAMBDA_B <- LAMBDA #B群用のλ(つまりLAMBDA)をLAMBDA_Bに格納 #ポアソン分布に従う乱数を生成してシミュレーションデータを得る(A群用) outA <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param1){ #param1回ループを回す(つまりA群のサンプル数分だけループを回している) outA <- cbind(outA, rpois(n=length(LAMBDA_A), lambda=LAMBDA_A))#length(LAMBDA_A)個の乱数を発生させている(λベクトルはLAMBDA_Aで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #ポアソン分布に従う乱数を生成してシミュレーションデータを得る(B群用) outB <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #param2回ループを回す(つまりB群のサンプル数分だけループを回している) outB <- cbind(outB, rpois(n=length(LAMBDA_B), lambda=LAMBDA_B))#length(LAMBDA_B)個の乱数を発生させている(λベクトルはLAMBDA_Bで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #行列outをファイルに出力 out <- cbind(outA, outB) #A群のデータとB群のデータを列方向で結合した結果をoutに格納 colnames(out) <- c(paste("A",1:param1,sep=""),paste("B",1:param2,sep=""))#outの列名を与えている write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- out #シミュレーションデータをdataとして取り扱う data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をマゼンタにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)#legendを表示5. シミュレーションデータの作成本番(A群3サンプル vs. B群3サンプルのデータで、全遺伝子の10%がDEG。DEGのうちの80%がA群で高発現、残りの20%がB群で高発現というデータにしたい場合):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 10000 #遺伝子数を指定 param4 <- 0.1 #発現変動遺伝子の割合(PDEG)を指定 param5 <- 2 #発現変動の度合い(fold-change)を指定 param6 <- 0.8 #DEGのうちA群で高発現なものの割合(PA)を指定 #データファイルの読み込みとλベクトルの作成(kidneyのfive technical replicatesのデータを用いる) tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tmp <- rowSums(tmp[,1:5]) #kidneyの5 replicatesのデータの各行の和を計算している LAMBDA <- tmp[tmp > 0] #λが0だと意味がないのでそういうものを除いている LAMBDA <- sample(LAMBDA, param3, replace=TRUE) #param3で指定した数だけサンプリングした結果をLAMBDAに格納 LAMBDA <- LAMBDA*1000000/sum(LAMBDA) #リード数の総和を100万にしている #発現変動遺伝子(DEG)に相当する位置情報の特定、およびその部分のみ(param5)倍高発現となるようなλに変更 DEG_degree_A <- rep(1, param3) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_A[1:(param3*param4*param6)] <- param5 #param3個の遺伝子ベクトル中最初の(param3*param4*param6)個の発現変動の度合いをparam5としている LAMBDA_A <- LAMBDA*DEG_degree_A #A群用のλ(つまりLAMBDA*DEG_degree_A)をLAMBDA_Aに格納 DEG_degree_B <- rep(1, param3) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_B[(param3*param4*param6+1):(param3*param4)] <- param5 #param3個の遺伝子ベクトル中「(param3*param4*param6+1):(param3*param4)」に相当する位置のの発現変動の度合いをparam5としている LAMBDA_B <- LAMBDA*DEG_degree_B #B群用のλ(つまりLAMBDA*DEG_degree_B)をLAMBDA_Bに格納 DEG_posi <- (DEG_degree_A*DEG_degree_B) > 1 #DEGの位置情報を取得している #ポアソン分布に従う乱数を生成してシミュレーションデータを得る(A群用) outA <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param1){ #param1回ループを回す(つまりA群のサンプル数分だけループを回している) outA <- cbind(outA, rpois(n=length(LAMBDA_A), lambda=LAMBDA_A))#length(LAMBDA_A)個の乱数を発生させている(λベクトルはLAMBDA_Aで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #ポアソン分布に従う乱数を生成してシミュレーションデータを得る(B群用) outB <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #param2回ループを回す(つまりB群のサンプル数分だけループを回している) outB <- cbind(outB, rpois(n=length(LAMBDA_B), lambda=LAMBDA_B))#length(LAMBDA_B)個の乱数を発生させている(λベクトルはLAMBDA_Bで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #行列outをファイルに出力 out <- cbind(outA, outB) #A群のデータとB群のデータを列方向で結合した結果をoutに格納 colnames(out) <- c(paste("A",1:param1,sep=""),paste("B",1:param2,sep=""))#outの列名を与えている write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- out #シミュレーションデータをdataとして取り扱う data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をマゼンタにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)#legendを表示6. シミュレーションデータの作成本番(参考文献2のFig. 2のデータとほとんど同じものを作りたい場合。違いはA群およびB群でuniqueに発現しているものを入れてないだけ。各群1サンプルしかないのでapply関数のところがなくなっていることにご注意ください):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 1 #A群のサンプル数を指定 param2 <- 1 #B群のサンプル数を指定 param3 <- 20000 #遺伝子数を指定 param4 <- 0.1 #発現変動遺伝子の割合(PDEG)を指定 param5 <- 2 #発現変動の度合い(fold-change)を指定 param6 <- 0.8 #DEGのうちA群で高発現なものの割合(PA)を指定 #データファイルの読み込みとλベクトルの作成(kidneyのfive technical replicatesのデータを用いる) tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tmp <- rowSums(tmp[,1:5]) #kidneyの5 replicatesのデータの各行の和を計算している LAMBDA <- tmp[tmp > 0] #λが0だと意味がないのでそういうものを除いている LAMBDA <- sample(LAMBDA, param3, replace=TRUE) #param3で指定した数だけサンプリングした結果をLAMBDAに格納 LAMBDA <- LAMBDA*1000000/sum(LAMBDA) #リード数の総和を100万にしている #発現変動遺伝子(DEG)に相当する位置情報の特定、およびその部分のみ(param5)倍高発現となるようなλに変更 DEG_degree_A <- rep(1, param3) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_A[1:(param3*param4*param6)] <- param5 #param3個の遺伝子ベクトル中最初の(param3*param4*param6)個の発現変動の度合いをparam5としている LAMBDA_A <- LAMBDA*DEG_degree_A #A群用のλ(つまりLAMBDA*DEG_degree_A)をLAMBDA_Aに格納 DEG_degree_B <- rep(1, param3) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_B[(param3*param4*param6+1):(param3*param4)] <- param5 #param3個の遺伝子ベクトル中「(param3*param4*param6+1):(param3*param4)」に相当する位置のの発現変動の度合いをparam5としている LAMBDA_B <- LAMBDA*DEG_degree_B #B群用のλ(つまりLAMBDA*DEG_degree_B)をLAMBDA_Bに格納 DEG_posi <- (DEG_degree_A*DEG_degree_B) > 1 #DEGの位置情報を取得している #ポアソン分布に従う乱数を生成してシミュレーションデータを得る(A群用) outA <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param1){ #param1回ループを回す(つまりA群のサンプル数分だけループを回している) outA <- cbind(outA, rpois(n=length(LAMBDA_A), lambda=LAMBDA_A))#length(LAMBDA_A)個の乱数を発生させている(λベクトルはLAMBDA_Aで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #ポアソン分布に従う乱数を生成してシミュレーションデータを得る(B群用) outB <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #param2回ループを回す(つまりB群のサンプル数分だけループを回している) outB <- cbind(outB, rpois(n=length(LAMBDA_B), lambda=LAMBDA_B))#length(LAMBDA_B)個の乱数を発生させている(λベクトルはLAMBDA_Bで与えている) } #ここまできたら、次のiの値でループの最初からやり直し #行列outをファイルに出力 out <- cbind(outA, outB) #A群のデータとB群のデータを列方向で結合した結果をoutに格納 colnames(out) <- c(paste("A",1:param1,sep=""),paste("B",1:param2,sep=""))#outの列名を与えている write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- out #シミュレーションデータをdataとして取り扱う data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をマゼンタにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)#legendを表示参考文献1(Marioni et al., Genome Res., 2008)
param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #(パッケージ中に存在する)発現データのロードとラベル情報の作成 data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする dim(data) #行数と列数を表示 head(data) #最初の数行分を表示(最初の3列がMockサンプルであることが分かる) data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #RPM正規化とサブセットの抽出 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #サンプル(列)ごとの総リード数をそろえるべくRPMデータにしておく RPM_k <- RPM[,data.cl == 1] #A群(つまりMockサンプル)に相当するデータだけを抽出した結果をRPM_kに格納 RPM_k <- RPM_k[apply(RPM_k, 1, var) > 0,] #(後にlogスケールで描画するため)各行の分散が0より大きいもののみ抽出している(24,027行のデータになっているはず) #Mean-Variance plotの作成 MEAN <- apply(RPM_k, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(RPM_k, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #以下では回帰分析を行うことを通じて、統計的な検証を行っている hoge <- as.data.frame(cbind(MEAN, VARIANCE)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がVARIANCEならなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(VARIANCE~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をVARIANCEとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加 out #outの簡単な中身を表示(切片(Intercept)が-0.001173, 傾き(MEAN)が1.349519であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.8149と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) #一応y=xの直線を青で引いておく(y=a+bxのa=0, b=1) abline(a=0, b=1, col="blue") #y=xの直線を追加(この結果から赤色の直線の傾きが1よりも明らかに大きく、ポアソン分布の「分散=平均」ではなく「分散 > 平均」となっていることがわかる) #変動係数周辺 STDEV <- apply(RPM_k, 1, sd) #各行の標準偏差を計算した結果をSTDEVに格納 hoge <- as.data.frame(cbind(MEAN, STDEV)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がSTDEVからなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(STDEV~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をSTDEVとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加 out #outの簡単な中身を表示(切片(Intercept)が-0.001173, 傾き(MEAN)が1.349519であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.8149と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) out$coefficients[2]2. treatedサンプルの3 biological replicatesのデータの場合1:
param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #(パッケージ中に存在する)発現データのロードとラベル情報の作成 data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする dim(data) #行数と列数を表示 head(data) #最初の数行分を表示(最初の3列がMockサンプルであることが分かる) data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #RPM正規化とサブセットの抽出 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #サンプル(列)ごとの総リード数をそろえるべくRPMデータにしておく RPM_k <- RPM[,data.cl == 2] #B群(つまりhrccサンプル)に相当するデータだけを抽出した結果をRPM_kに格納 RPM_k <- RPM_k[apply(RPM_k, 1, var) > 0,] #(後にlogスケールで描画するため)各行の分散が0より大きいもののみ抽出している(24,027行のデータになっているはず) #Mean-Variance plotの作成 MEAN <- apply(RPM_k, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(RPM_k, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #以下では回帰分析を行うことを通じて、統計的な検証を行っている hoge <- as.data.frame(cbind(MEAN, VARIANCE)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がVARIANCEならなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(VARIANCE~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をVARIANCEとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加 out #outの簡単な中身を表示(切片(Intercept)が-0.001173, 傾き(MEAN)が1.349519であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.8149と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) #一応y=xの直線を青で引いておく(y=a+bxのa=0, b=1) abline(a=0, b=1, col="blue") #y=xの直線を追加(この結果から赤色の直線の傾きが1よりも明らかに大きく、ポアソン分布の「分散=平均」ではなく「分散 > 平均」となっていることがわかる)3. treatedサンプルの3 biological replicatesのデータの場合2:
in_f <- "data_arab.txt" #読み込みたい発現データファイルを指定してin_fに格納 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み dim(data) #行数と列数を表示 head(data) #最初の数行分を表示(最初の3列がMockサンプルであることが分かる) data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #RPM正規化とサブセットの抽出 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #サンプル(列)ごとの総リード数をそろえるべくRPMデータにしておく RPM_k <- RPM[,data.cl == 2] #B群(つまりhrccサンプル)に相当するデータだけを抽出した結果をRPM_kに格納 RPM_k <- RPM_k[apply(RPM_k, 1, var) > 0,] #(後にlogスケールで描画するため)各行の分散が0より大きいもののみ抽出している(24,027行のデータになっているはず) #Mean-Variance plotの作成 MEAN <- apply(RPM_k, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(RPM_k, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #以下では回帰分析を行うことを通じて、統計的な検証を行っている hoge <- as.data.frame(cbind(MEAN, VARIANCE)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がVARIANCEならなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(VARIANCE~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をVARIANCEとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加 out #outの簡単な中身を表示(切片(Intercept)が-0.001173, 傾き(MEAN)が1.349519であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.8149と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) #一応y=xの直線を青で引いておく(y=a+bxのa=0, b=1) abline(a=0, b=1, col="blue") #y=xの直線を追加(この結果から赤色の直線の傾きが1よりも明らかに大きく、ポアソン分布の「分散=平均」ではなく「分散 > 平均」となっていることがわかる)4. 3.を基本として、軸の値の範囲を指定してMean-Variance plotをファイルに保存したい場合:
in_f <- "data_arab.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.png" #出力ファイル名を指定してout_fに格納 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 param1 <- 500 #横軸の大きさ(単位はピクセル)を指定 param2 <- 500 #縦軸の大きさ(単位はピクセル)を指定 param3 <- c(1e-03, 1e+08) #x軸の値の範囲を指定 param4 <- c(1e-03, 1e+08) #y軸の値の範囲を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み dim(data) #行数と列数を表示 head(data) #最初の数行分を表示(最初の3列がMockサンプルであることが分かる) data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #RPM正規化とサブセットの抽出 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #サンプル(列)ごとの総リード数をそろえるべくRPMデータにしておく RPM_k <- RPM[,data.cl == 2] #B群(つまりhrccサンプル)に相当するデータだけを抽出した結果をRPM_kに格納 RPM_k <- RPM_k[apply(RPM_k, 1, var) > 0,] #(後にlogスケールで描画するため)各行の分散が0より大きいもののみ抽出している(24,027行のデータになっているはず) #Mean-Variance plotの作成 MEAN <- apply(RPM_k, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(RPM_k, 1, var) #各行の分散を計算した結果をVARIANCEに格納 png(out_f, width=param1, height=param2) #出力ファイルの各種パラメータを指定 plot(MEAN, VARIANCE, log="xy", xlim=param3, ylim=param4) #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #以下では回帰分析を行うことを通じて、統計的な検証を行っている hoge <- as.data.frame(cbind(MEAN, VARIANCE)) #回帰分析(regression analysis)を行うためののおまじない(1列目がMEAN, 2列目がVARIANCEならなる行列を作成したあとデータフレーム形式にした結果をhogeに格納) out <- lm(VARIANCE~MEAN, data=log10(hoge)) #独立変数(説明変数)をMEAN, 従属変数(目的変数)をVARIANCEとしてlog10変換したデータの線形回帰を行った結果をoutに格納 abline(out, col="red") #回帰直線を追加 out #outの簡単な中身を表示(切片(Intercept)が-0.001173, 傾き(MEAN)が1.349519であることがわかる。つまり、y=a+bxのaが切片、bが傾きに相当する) summary(out) #回帰分析結果outのもう少し詳細な結果を表示している(Multiple R-squared(決定係数)の値が0.8149と1に相当近い値が得られていることから線形回帰で十分よいfittingが得られていると判断できる。また、一番下のp-valueが限りなく0に近いことは、MEANという従属変数が不要であるという帰無仮説を棄却するに値する、つまり従属変数が独立変数によって説明可能であることを意味する) #一応y=xの直線を青で引いておく(y=a+bxのa=0, b=1) abline(a=0, b=1, col="blue") #y=xの直線を追加(この結果から赤色の直線の傾きが1よりも明らかに大きく、ポアソン分布の「分散=平均」ではなく「分散 > 平均」となっていることがわかる) dev.off() #おまじない参考文献1(Di et al., SAGMB, 2011)
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 10 #dispersion parameter (shape parameter of the gamma mixing distribution)を指定 param2 <- 4 #サンプル数を指定 library(NBPSeq) #パッケージの読み込み data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする tmp <- rowSums(data[,1:3]) #A群のみのデータの各行の和を計算した結果をtmpに格納 RPM <- tmp*1000000/sum(tmp) #リード数の総和を100万にしている mu <- RPM[RPM > 0] #リード数が0のものはシミュレーションデータを作成できないので除いている #param1で指定したshapeパラメタを用いて(param2)サンプル分のシミュレーションデータを得る out <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す out <- cbind(out, rnbinom(n=length(mu), mu=mu, size=param1)) #length(mu)個の乱数を発生させている(VARIANCEはmu + mu^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #得られた行列outの分布を一応チェック obj <- apply(out, 1, var) > 0 #行列outの各行の分散が0より大きいものをTRUE、それ以外をFALSEとしたベクトルobjを作成している out2 <- out[obj,] #objがTRUEのもののみ抽出してout2に格納 MEAN <- apply(out2, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(out2, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #行列outの中から分散が計算できたもののみ、検証用情報(MEAN, VARIANCE)とともにファイルに出力 tmp <- cbind(out2, MEAN, VARIANCE) #行列out2の右側に、「(発生させた乱数の)平均」、「(発生させた乱数の)分散」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存2. 4サンプル分のシミュレーションデータで、任意の遺伝子数(行数)をしたい場合:
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 10 #dispersion parameter (shape parameter of the gamma mixing distribution)を指定 param2 <- 4 #サンプル数を指定 param3 <- 5000 #遺伝子数を指定 #データファイルの読み込みとempirical distribution of read countsに相当するmuを得る library(NBPSeq) #パッケージの読み込み data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする tmp <- rowSums(data[,1:3]) #A群のみのデータの各行の和を計算した結果をtmpに格納 tmp <- tmp[tmp > 0] #リード数が0のものはシミュレーションデータを作成できないので除いている hoge <- sample(tmp, param3, replace=TRUE) #param3で指定した数だけサンプリングした結果をhogeに格納 mu <- hoge*1000000/sum(hoge) #リード数の総和を100万にしている #負の二項分布に従う乱数を生成してシミュレーションデータを得る out <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す out <- cbind(out, rnbinom(n=length(mu), mu=mu, size=param1)) #length(mu)個の乱数を発生させている(VARIANCEはmu + mu^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #得られた行列outの分布を一応チェック obj <- apply(out, 1, var) > 0 #行列outの各行の分散が0より大きいものをTRUE、それ以外をFALSEとしたベクトルobjを作成している out2 <- out[obj,] #objがTRUEのもののみ抽出してout2に格納 MEAN <- apply(out2, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(out2, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #行列outをファイルに出力 tmp <- cbind(mu, out) #muの数値情報の右側に行列outを列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存3. A群3サンプル vs. B群3サンプルのデータで、全遺伝子の15%がDEG。DEGのうちの20%がA群で4倍高発現、残りの80%がB群で4倍高発現というデータにしたい場合:
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 10 #dispersion parameter (shape parameter of the gamma mixing distribution)を指定 param2 <- 3 #A群のサンプル数を指定 param3 <- 3 #B群のサンプル数を指定 param4 <- 20000 #全遺伝子数を指定 param5 <- 0.15 #発現変動遺伝子の割合(PDEG)を指定 param6 <- 4 #発現変動の度合い(fold-change)を指定 param7 <- 0.2 #DEGのうちA群で高発現なものの割合(PA)を指定 #データファイルの読み込みとempirical distribution of read countsに相当するmuを得る library(NBPSeq) #パッケージの読み込み data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする tmp <- rowSums(data[,1:3]) #A群のみのデータの各行の和を計算した結果をtmpに格納 tmp <- tmp[tmp > 0] #リード数が0のものはシミュレーションデータを作成できないので除いている hoge <- sample(tmp, param4, replace=TRUE) #param4で指定した数だけサンプリングした結果をhogeに格納 mu <- hoge*1000000/sum(hoge) #リード数の総和を100万にしている #発現変動遺伝子(DEG)に相当する位置情報の特定、およびその部分のみ(param6)倍高発現となるようなmuに変更 DEG_degree_A <- rep(1, param4) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_A[1:(param4*param5*param7)] <- param6 #param4個の要素からなる遺伝子ベクトル中最初の(param4*param5*param7)個の発現変動の度合いをparam6としている mu_A <- mu*DEG_degree_A #A群用のmu(つまりmu*DEG_degree_A)をmu_Aに格納 DEG_degree_B <- rep(1, param4) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_B[(param4*param5*param7+1):(param4*param5)] <- param6 #param4個の要素からなる遺伝子ベクトル中「(param4*param5*param7+1):(param4*param5)」に相当する位置の発現変動の度合いをparam6としている mu_B <- mu*DEG_degree_B #B群用のmu(つまりmu*DEG_degree_B)をmu_Bに格納 DEG_posi <- (DEG_degree_A*DEG_degree_B) > 1 #DEGの位置情報を取得している #負の二項分布に従う乱数を生成してシミュレーションデータを得る(A群用) outA <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す outA <- cbind(outA, rnbinom(n=length(mu_A), mu=mu_A, size=param1)) #length(mu_A)個の乱数を発生させている(VARIANCEはmu_A + mu_A^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #負の二項分布に従う乱数を生成してシミュレーションデータを得る(B群用) outB <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す outB <- cbind(outB, rnbinom(n=length(mu_B), mu=mu_B, size=param1)) #length(mu_B)個の乱数を発生させている(VARIANCEはmu_B + mu_B^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #行列outをファイルに出力 out <- cbind(outA, outB) #A群のデータとB群のデータを列方向で結合した結果をoutに格納 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- out #シミュレーションデータをdataとして取り扱う data.cl <- c(rep(1, param2), rep(2, param3)) #A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をマゼンタにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)#legendを表示参考文献1(Di et al., SAGMB, 2011)
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- c(0.85, 0.5) #shape parameterとscale parameterを指定 param2 <- 4 #サンプル数を指定 library(NBPSeq) #パッケージの読み込み data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする tmp <- rowSums(data[,1:3]) #A群のみのデータの各行の和を計算した結果をtmpに格納 RPM <- tmp*1000000/sum(tmp) #リード数の総和を100万にしている mu <- RPM[RPM > 0] #リード数が0のものはシミュレーションデータを作成できないので除いている #param1で指定したshapeパラメタを用いて(param2)サンプル分のシミュレーションデータを得る out <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す dispersion_parameter <- rgamma(length(mu), shape=param1[1], scale=param1[2])#ガンマ分布からparam1で指定したパラメータを用いて以下のrnbinom関数中で用いるsizeのところに与えるrandom dispersion parameterベクトルを作成した結果をdispersion_parameterに格納 out <- cbind(out, rnbinom(n=length(mu), mu=mu, size=1/dispersion_parameter))#length(mu)個の乱数を発生させている(VARIANCEはmu + mu^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #得られた行列outの分布を一応チェック obj <- apply(out, 1, var) > 0 #行列outの各行の分散が0より大きいものをTRUE、それ以外をFALSEとしたベクトルobjを作成している out2 <- out[obj,] #objがTRUEのもののみ抽出してout2に格納 MEAN <- apply(out2, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(out2, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #行列outの中から分散が計算できたもののみ、検証用情報(MEAN, VARIANCE)とともにファイルに出力 tmp <- cbind(out2, MEAN, VARIANCE) #行列out2の右側に、「(発生させた乱数の)平均」、「(発生させた乱数の)分散」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存2. 4サンプル分のシミュレーションデータで、任意の遺伝子数(行数)をしたい場合:
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- c(0.85, 0.5) #shape parameterとscale parameterを指定 param2 <- 4 #サンプル数を指定 param3 <- 5000 #遺伝子数を指定 #データファイルの読み込みとempirical distribution of read countsに相当するmuを得る library(NBPSeq) #パッケージの読み込み data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする tmp <- rowSums(data[,1:3]) #A群のみのデータの各行の和を計算した結果をtmpに格納 tmp <- tmp[tmp > 0] #リード数が0のものはシミュレーションデータを作成できないので除いている hoge <- sample(tmp, param3, replace=TRUE) #param3で指定した数だけサンプリングした結果をhogeに格納 mu <- hoge*1000000/sum(hoge) #リード数の総和を100万にしている #負の二項分布に従う乱数を生成してシミュレーションデータを得る out <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す dispersion_parameter <- rgamma(length(mu), shape=param1[1], scale=param1[2])#ガンマ分布からparam1で指定したパラメータを用いて以下のrnbinom関数中で用いるsizeのところに与えるrandom dispersion parameterベクトルを作成した結果をdispersion_parameterに格納 out <- cbind(out, rnbinom(n=length(mu), mu=mu, size=1/dispersion_parameter))#length(mu)個の乱数を発生させている(VARIANCEはmu + mu^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #得られた行列outの分布を一応チェック obj <- apply(out, 1, var) > 0 #行列outの各行の分散が0より大きいものをTRUE、それ以外をFALSEとしたベクトルobjを作成している out2 <- out[obj,] #objがTRUEのもののみ抽出してout2に格納 MEAN <- apply(out2, 1, mean) #各行の平均を計算した結果をMEANに格納 VARIANCE <- apply(out2, 1, var) #各行の分散を計算した結果をVARIANCEに格納 plot(MEAN, VARIANCE, log="xy") #両対数(底は10)プロット grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 #行列outをファイルに出力 tmp <- cbind(mu, out) #muの数値情報の右側に行列outを列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存3. A群3サンプル vs. B群3サンプルのデータで、全遺伝子の15%がDEG。DEGのうちの20%がA群で4倍高発現、残りの80%がB群で4倍高発現というデータにしたい場合:
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- c(0.85, 0.5) #shape parameterとscale parameterを指定 param2 <- 3 #A群のサンプル数を指定 param3 <- 3 #B群のサンプル数を指定 param4 <- 20000 #全遺伝子数を指定 param5 <- 0.15 #発現変動遺伝子の割合(PDEG)を指定 param6 <- 4 #発現変動の度合い(fold-change)を指定 param7 <- 0.2 #DEGのうちA群で高発現なものの割合(PA)を指定 #データファイルの読み込みとempirical distribution of read countsに相当するmuを得る library(NBPSeq) #パッケージの読み込み data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする tmp <- rowSums(data[,1:3]) #A群のみのデータの各行の和を計算した結果をtmpに格納 tmp <- tmp[tmp > 0] #リード数が0のものはシミュレーションデータを作成できないので除いている hoge <- sample(tmp, param4, replace=TRUE) #param4で指定した数だけサンプリングした結果をhogeに格納 mu <- hoge*1000000/sum(hoge) #リード数の総和を100万にしている #発現変動遺伝子(DEG)に相当する位置情報の特定、およびその部分のみ(param6)倍高発現となるようなmuに変更 DEG_degree_A <- rep(1, param4) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_A[1:(param4*param5*param7)] <- param6 #param4個の要素からなる遺伝子ベクトル中最初の(param4*param5*param7)個の発現変動の度合いをparam6としている mu_A <- mu*DEG_degree_A #A群用のmu(つまりmu*DEG_degree_A)をmu_Aに格納 DEG_degree_B <- rep(1, param4) #DEGの発現変動の度合い情報を格納するプレースホルダを作成している DEG_degree_B[(param4*param5*param7+1):(param4*param5)] <- param6 #param4個の要素からなる遺伝子ベクトル中「(param4*param5*param7+1):(param4*param5)」に相当する位置の発現変動の度合いをparam6としている mu_B <- mu*DEG_degree_B #B群用のmu(つまりmu*DEG_degree_B)をmu_Bに格納 DEG_posi <- (DEG_degree_A*DEG_degree_B) > 1 #DEGの位置情報を取得している #負の二項分布に従う乱数を生成してシミュレーションデータを得る(A群用) outA <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す dispersion_parameter <- rgamma(length(mu_A), shape=param1[1], scale=param1[2])#ガンマ分布からparam1で指定したパラメータを用いて以下のrnbinom関数中で用いるsizeのところに与えるrandom dispersion parameterベクトルを作成した結果をdispersion_parameterに格納 outA <- cbind(outA, rnbinom(n=length(mu_A), mu=mu_A, size=1/dispersion_parameter)) #length(mu_A)個の乱数を発生させている(VARIANCEはmu_A + mu_A^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #負の二項分布に従う乱数を生成してシミュレーションデータを得る(B群用) outB <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す dispersion_parameter <- rgamma(length(mu_B), shape=param1[1], scale=param1[2])#ガンマ分布からparam1で指定したパラメータを用いて以下のrnbinom関数中で用いるsizeのところに与えるrandom dispersion parameterベクトルを作成した結果をdispersion_parameterに格納 outB <- cbind(outB, rnbinom(n=length(mu_B), mu=mu_B, size=1/dispersion_parameter)) #length(mu_B)個の乱数を発生させている(VARIANCEはmu_B + mu_B^2/size) } #ここまできたら、次のiの値でループの最初からやり直し #行列outをファイルに出力 out <- cbind(outA, outB) #A群のデータとB群のデータを列方向で結合した結果をoutに格納 write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#outの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- out #シミュレーションデータをdataとして取り扱う data.cl <- c(rep(1, param2), rep(2, param3)) #A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をマゼンタにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)#legendを表示参考文献1(Di et al., SAGMB, 2011)
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 20000 #遺伝子数を指定 param2 <- 4 #サンプル数を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする data.cl <- c(rep(1, 3), rep(2, 3)) #A群を1、B群を2としたベクトルdata.clを作成 #RPM正規化して群ごとのMEANとφの経験分布情報を取得 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #RPM正規化した結果をRPMに格納 RPM_A <- RPM[,data.cl == 1] #A群のデータのみ抽出してRPM_Aに格納 RPM_B <- RPM[,data.cl == 2] #B群のデータのみ抽出してRPM_Bに格納 RPM_A <- RPM_A[apply(RPM_A, 1, var) > 0,] #分散が0より大きいもののみ抽出 RPM_B <- RPM_B[apply(RPM_B, 1, var) > 0,] #分散が0より大きいもののみ抽出 MEAN <- c(apply(RPM_A, 1, mean), apply(RPM_B, 1, mean)) #read countsの遺伝子ごとの平均値を計算した結果をMEANに格納 VARIANCE <- c(apply(RPM_A, 1, var), apply(RPM_B, 1, var)) #read countsの遺伝子ごとの分散を計算した結果をVARIANCEに格納 DISPERSION <- (VARIANCE - MEAN)/(MEAN*MEAN) #read countsの遺伝子ごとのφを計算した結果をDISPERSIONに格納 mean_disp_tmp <- cbind(MEAN, DISPERSION) #MEANとDISPERSIONを列方向に結合した結果をmean_disp_tmpに格納 mean_disp_tmp <- mean_disp_tmp[mean_disp_tmp[,2] > 0,] #mean_disp_tmp行列中の二列目(DISPERSION部分)が0より大きいもののみ抽出 hoge <- sample(1:nrow(mean_disp_tmp), param1, replace=TRUE) #最終的にparam1で指定した行数分のデータにしたいので、mean_disp_tmp行列の行数から(復元抽出で)ランダムサンプリングするための数値ベクトル情報をhogeに格納 mean_disp <- mean_disp_tmp[hoge,] #mean_disp_tmp行列からhogeで指定した行を抽出した結果をmean_dispに格納 #負の二項分布に従う乱数を生成してシミュレーションデータを得る out <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param2){ #(param2)回ループを回す out <- cbind(out, rnbinom(n=nrow(mean_disp), mu=mean_disp[,1], size=1/mean_disp[,2]))#nrow(mean_disp)個の乱数を発生させている(rnbinom関数はVARIANCE=mu + mu^2/sizeとして定義しているので左記のような指定方法でよい) } #ここまできたら、次のiの値でループの最初からやり直し #行列outをファイルに出力 tmp <- cbind(mean_disp[,1], out) #muの数値情報の右側に行列outを列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #MEAN vs. DISPERSIONの両対数プロットを描画(参考文献1のFigure1と本質的に同じものです) #png(file="hoge_real.png", height=600, width=600) #pngファイルにx軸:mean, y軸:dispersionのプロット図を保存 plot(log(MEAN, base=10), log(DISPERSION, base=10), panel.first=grid())#プロット図を作成 #dev.off() #おまじない2. A群2サンプル vs. B群2サンプルのデータで、全遺伝子の15%がDEG。DEGのうちの20%がA群で4倍高発現、残りの80%がB群で4倍高発現というデータにしたい場合:
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 4 #発現変動の度合い(fold-change)を指定 param_A <- 2 #A群のサンプル数を指定 param_B <- 2 #B群のサンプル数を指定 param4 <- 20000 #全遺伝子数を指定 param_PDEG <- 0.15 #発現変動遺伝子の割合(PDEG)を指定 param_PA <- 0.2 #DEGのうちA群で高発現なものの割合(PA)を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする data.cl <- c(rep(1, 3), rep(2, 3)) #A群を1、B群を2としたベクトルdata.clを作成(ここのラベル情報は経験分布作成用のデータが3群 vs. 3群のデータだと分かっているため) #RPM正規化して群ごとのMEANとφの経験分布情報を取得 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #RPM正規化した結果をRPMに格納 RPM_A <- RPM[,data.cl == 1] #A群のデータのみ抽出してRPM_Aに格納 RPM_B <- RPM[,data.cl == 2] #B群のデータのみ抽出してRPM_Bに格納 RPM_A <- RPM_A[apply(RPM_A, 1, var) > 0,] #分散が0より大きいもののみ抽出 RPM_B <- RPM_B[apply(RPM_B, 1, var) > 0,] #分散が0より大きいもののみ抽出 MEAN <- c(apply(RPM_A, 1, mean), apply(RPM_B, 1, mean)) #RPM補正後のread countsの遺伝子ごとの平均値を計算した結果をMEANに格納 VARIANCE <- c(apply(RPM_A, 1, var), apply(RPM_B, 1, var)) #RPM補正後のread countsの遺伝子ごとの分散を計算した結果をVARIANCEに格納 DISPERSION <- (VARIANCE - MEAN)/(MEAN*MEAN) #RPM補正後のread countsの遺伝子ごとのφを計算した結果をDISPERSIONに格納 mean_disp_tmp <- cbind(MEAN, DISPERSION) #MEANとDISPERSIONを列方向に結合した結果をmean_disp_tmpに格納 mean_disp_tmp <- mean_disp_tmp[mean_disp_tmp[,2] > 0,] #mean_disp_tmp行列中の二列目(DISPERSION部分)が0より大きいもののみ抽出(理由は後に使うrnbinom関数が負のdispersion parameterの値を許容しないからです) hoge <- sample(1:nrow(mean_disp_tmp), param4, replace=TRUE) #最終的にparam4で指定した行数分のデータにしたいので、mean_disp_tmp行列の行数から(復元抽出で)ランダムサンプリングするための数値ベクトル情報をhogeに格納 mean_disp <- mean_disp_tmp[hoge,] #mean_disp_tmp行列からhogeで指定した行を抽出した結果をmean_dispに格納 #指定したDEGの条件にすべく、meanに相当するところの値を群ごとに変更する。また、このときにDEGの位置情報も取得している mu <- mean_disp[,1] #経験分布の平均値に相当する情報をmuに格納(単に文字数を減らして見やすくしたいだけです) DEG_degree_A <- rep(1, param4) #(param4)で指定した遺伝子数分だけ倍率変化の初期値を1倍としたものをDEG_degree_Aに格納 DEG_degree_A[1:(param4*param_PDEG*param_PA)] <- param1 #DEG_degree_Aのベクトルに対して、最初の行から(param4*param_PDEG*param_PA)で表現されるA群で高発現にする遺伝子数分に相当する位置を(param1)倍するという情報に置換する mu_A <- mu*DEG_degree_A #A群で高発現とする位置のmuの値を(param1)倍した結果をmu_Aに格納 DEG_degree_B <- rep(1, param4) #(param4)で指定した遺伝子数分だけ倍率変化の初期値を1倍としたものをDEG_degree_Bに格納 DEG_degree_B[(param4*param_PDEG*param_PA+1):(param4*param_PDEG)] <- param1#DEG_degree_Bのベクトルに対して、A群で高発現とした位置情報の次の行(param4*param_PDEG*param_PA+1)からB群で高発現にする遺伝子数分に相当する位置を(param1)倍するという情報に置換する mu_B <- mu*DEG_degree_B #B群で高発現とする位置のmuの値を(param1)倍した結果をmu_Bに格納 DEG_posi_org <- (DEG_degree_A*DEG_degree_B) > 1 #DEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posi_orgに格納 nonDEG_posi_org <- (DEG_degree_A*DEG_degree_B) == 1 #non-DEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをnon-DEG_posi_orgに格納 #負の二項分布に従う乱数を生成して群ごとのシミュレーションデータを得る outA <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param_A){ #(param_A)回ループを回す outA <- cbind(outA, rnbinom(n=length(mu_A), mu=mu_A, size=1/mean_disp[,2]))#length(mu_A)個の乱数を発生させている(rnbinom関数はVARIANCE=mu + mu^2/sizeとして定義しているので左記のような指定方法でよい) } #ここまできたら、次のiの値でループの最初からやり直し outB <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param_B){ #(param_B)回ループを回す outB <- cbind(outB, rnbinom(n=length(mu_B), mu=mu_B, size=1/mean_disp[,2]))#length(mu_B)個の乱数を発生させている(rnbinom関数はVARIANCE=mu + mu^2/sizeとして定義しているので左記のような指定方法でよい) } #ここまできたら、次のiの値でループの最初からやり直し #(param4)行(param_A+param_B)列のカウント情報からなる行列outから全ての列でゼロカウントの行を削除した行列RAWを作成し、ファイルに出力 out <- cbind(outA, outB) #A群のデータとB群のデータを列方向で結合した結果をoutに格納 obj <- rowSums(out) > 0 #行の和が0より大きいものをTRUE、それ以外をFALSEとした情報をobjに格納 RAW <- out[obj,] #行列outの中からobjベクトルの値がTRUEとなる行のみを抽出してRAWに格納 DEG_posi <- DEG_posi_org[obj] #DEG_posi_orgベクトルに対して、objベクトルの値がTRUEとなる要素のみを抽出してDEG_posiに格納 nonDEG_posi <- nonDEG_posi_org[obj] #nonDEG_posi_orgベクトルに対して、objベクトルの値がTRUEとなる要素のみを抽出してnonDEG_posiに格納 tmp <- cbind(RAW, DEG_posi) #行列RAWの右側にDEGかどうかのフラグ情報を追加したものをtmpとして格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- RAW #シミュレーションデータRAWをdataとして取り扱う data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 #param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 #plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 plot(x_axis, y_axis, pch=20, cex=0.1, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をマゼンタにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)#legendを表示3. A群1サンプル vs. B群1サンプルのデータで、全遺伝子の15%がDEG。DEGのうちの20%がA群で4倍高発現、残りの80%がB群で4倍高発現というデータにしたい場合:
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 4 #発現変動の度合い(fold-change)を指定 param_A <- 1 #A群のサンプル数を指定 param_B <- 1 #B群のサンプル数を指定 param4 <- 20000 #全遺伝子数を指定 param_PDEG <- 0.15 #発現変動遺伝子の割合(PDEG)を指定 param_PA <- 0.2 #DEGのうちA群で高発現なものの割合(PA)を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data(arab) #このパッケージ中にあるarabというオブジェクト名のデータを取り出している data <- arab #データはarabというオブジェクト名で取り扱えるが、dataという名前で取り扱うことにする data.cl <- c(rep(1, 3), rep(2, 3)) #A群を1、B群を2としたベクトルdata.clを作成 #RPM正規化して群ごとのMEANとφの経験分布情報を取得 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #RPM正規化した結果をRPMに格納 RPM_A <- RPM[,data.cl == 1] #A群のデータのみ抽出してRPM_Aに格納 RPM_B <- RPM[,data.cl == 2] #B群のデータのみ抽出してRPM_Bに格納 RPM_A <- RPM_A[apply(RPM_A, 1, var) > 0,] #分散が0より大きいもののみ抽出 RPM_B <- RPM_B[apply(RPM_B, 1, var) > 0,] #分散が0より大きいもののみ抽出 MEAN <- c(apply(RPM_A, 1, mean), apply(RPM_B, 1, mean)) #RPM補正後のread countsの遺伝子ごとの平均値を計算した結果をMEANに格納 VARIANCE <- c(apply(RPM_A, 1, var), apply(RPM_B, 1, var)) #RPM補正後のread countsの遺伝子ごとの分散を計算した結果をVARIANCEに格納 DISPERSION <- (VARIANCE - MEAN)/(MEAN*MEAN) #RPM補正後のread countsの遺伝子ごとのφを計算した結果をDISPERSIONに格納 mean_disp_tmp <- cbind(MEAN, DISPERSION) #MEANとDISPERSIONを列方向に結合した結果をmean_disp_tmpに格納 mean_disp_tmp <- mean_disp_tmp[mean_disp_tmp[,2] > 0,] #mean_disp_tmp行列中の二列目(DISPERSION部分)が0より大きいもののみ抽出(理由は後に使うrnbinom関数が負のdispersion parameterの値を許容しないからです) hoge <- sample(1:nrow(mean_disp_tmp), param4, replace=TRUE) #最終的にparam4で指定した行数分のデータにしたいので、mean_disp_tmp行列の行数から(復元抽出で)ランダムサンプリングするための数値ベクトル情報をhogeに格納 mean_disp <- mean_disp_tmp[hoge,] #mean_disp_tmp行列からhogeで指定した行を抽出した結果をmean_dispに格納 #指定したDEGの条件にすべく、meanに相当するところの値を群ごとに変更する。また、このときにDEGの位置情報も取得している mu <- mean_disp[,1] #経験分布の平均値に相当する情報をmuに格納(単に文字数を減らして見やすくしたいだけです) DEG_degree_A <- rep(1, param4) #(param4)で指定した遺伝子数分だけ倍率変化の初期値を1倍としたものをDEG_degree_Aに格納 DEG_degree_A[1:(param4*param_PDEG*param_PA)] <- param1 #DEG_degree_Aのベクトルに対して、最初の行から(param4*param_PDEG*param_PA)で表現されるA群で高発現にする遺伝子数分に相当する位置を(param1)倍するという情報に置換する mu_A <- mu*DEG_degree_A #A群で高発現とする位置のmuの値を(param1)倍した結果をmu_Aに格納 DEG_degree_B <- rep(1, param4) #(param4)で指定した遺伝子数分だけ倍率変化の初期値を1倍としたものをDEG_degree_Bに格納 DEG_degree_B[(param4*param_PDEG*param_PA+1):(param4*param_PDEG)] <- param1#DEG_degree_Bのベクトルに対して、A群で高発現とした位置情報の次の行(param4*param_PDEG*param_PA+1)からB群で高発現にする遺伝子数分に相当する位置を(param1)倍するという情報に置換する mu_B <- mu*DEG_degree_B #B群で高発現とする位置のmuの値を(param1)倍した結果をmu_Bに格納 DEG_posi_org <- (DEG_degree_A*DEG_degree_B) > 1 #DEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posi_orgに格納 nonDEG_posi_org <- (DEG_degree_A*DEG_degree_B) == 1 #non-DEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posi_orgに格納 #負の二項分布に従う乱数を生成して群ごとのシミュレーションデータを得る outA <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param_A){ #(param_A)回ループを回す outA <- cbind(outA, rnbinom(n=length(mu_A), mu=mu_A, size=1/mean_disp[,2]))#length(mu_A)個の乱数を発生させている(rnbinom関数はVARIANCE=mu + mu^2/sizeとして定義しているので左記のような指定方法でよい) } #ここまできたら、次のiの値でループの最初からやり直し outB <- NULL #最終的に結果を格納するためのプレースホルダを作成している for(i in 1:param_B){ #(param_B)回ループを回す outB <- cbind(outB, rnbinom(n=length(mu_B), mu=mu_B, size=1/mean_disp[,2]))#length(mu_B)個の乱数を発生させている(rnbinom関数はVARIANCE=mu + mu^2/sizeとして定義しているので左記のような指定方法でよい) } #ここまできたら、次のiの値でループの最初からやり直し #(param4)行(param_A+param_B)列のカウント情報からなる行列outから全ての列でゼロカウントの行を削除した行列RAWを作成し、ファイルに出力 out <- cbind(outA, outB) #A群のデータとB群のデータを列方向で結合した結果をoutに格納 obj <- rowSums(out) > 0 #行の和が0より大きいものをTRUE、それ以外をFALSEとした情報をobjに格納 RAW <- out[obj,] #行列outの中からobjベクトルの値がTRUEとなる行のみを抽出してRAWに格納 DEG_posi <- DEG_posi_org[obj] #DEG_posi_orgベクトルに対して、objベクトルの値がTRUEとなる要素のみを抽出してDEG_posiに格納 nonDEG_posi <- nonDEG_posi_org[obj] #nonDEG_posi_orgベクトルに対して、objベクトルの値がTRUEとなる要素のみを抽出してnonDEG_posiに格納 tmp <- cbind(RAW, DEG_posi) #行列RAWの右側にDEGかどうかのフラグ情報を追加したものをtmpとして格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- RAW #シミュレーションデータRAWをdataとして取り扱う data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 #param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 #plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 plot(x_axis, y_axis, pch=20, cex=0.1, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi], y_axis[DEG_posi], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をマゼンタにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG", "non-DEG"), col=c("magenta", "black"), pch=19)#legendを表示4. A群3サンプル vs. B群3サンプルのデータで、全遺伝子の20%がDEG。DEGのうちの90%がA群で4倍高発現、残りの80%がB群で4倍高発現というデータにしたい場合: (2.と基本的には同じですがTCCパッケージ(ver. 0.3)中の関数を使って短いコードで実装しています)
out_f <- "simdata_3vs3.txt" #出力ファイル名を指定 param1 <- 4 #発現変動の度合い(fold-change)を指定 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 param4 <- 20000 #全遺伝子数を指定 param_PDEG <- 0.20 #発現変動遺伝子の割合(PDEG)を指定 param_PA <- 0.9 #DEGのうちA群で高発現なものの割合(PA)を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #シミュレーションデータの作成本番 hoge <- NBsample(DEG_foldchange=param1, repA=param_A, repB=param_B, Ngene=param4, PDEG=param_PDEG, PA=param_PA)#シミュレーションデータの作成を行うNBsample関数を実行した結果をhogeに格納 RAW <- hoge$data #作成した数値データ部分を抽出してRAWに格納 rownames(RAW) <- paste("gene", 1:nrow(RAW), sep="_") #"gene_1", "gene_2"などの遺伝子名を付加している DEG_posi <- hoge$DEG_posi #導入したDEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posiに格納 nonDEG_posi <- hoge$nonDEG_posi #導入したnon-DEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posiに格納 #得られた結果をファイルに出力 tmp <- cbind(rownames(RAW), RAW, DEG_posi, nonDEG_posi) #行列RAWの右側にDEGかどうかのフラグ情報を追加したものをtmpとして格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存5. A群3サンプル vs. B群3サンプルのデータで、全遺伝子の20%がDEG。DEGのうちの90%がA群で4倍高発現、残りの80%がB群で4倍高発現というデータにしたい場合: (4.と基本的には同じですが3群間比較などの多群間比較用のシミュレーションデータ作成に対応したやり方です)
out_f <- "simdata_multi.txt" #出力ファイル名を指定 param_DEG.foldchange <- c(4, 10) #群ごとの発現変動の度合い(fold-change)を指定。ここでは「A群のDEGは4倍高発現、B群のDEGは10倍高発現」と指定している。 param_group <- c(5, 3) #群ごとのサンプル数を指定。ここでは「A群が5サンプル、B群が3サンプル」と指定している。 param_DEG.assign <- c(0.9, 0.1) #DEGのうち各群で高発現なものの割合を指定。ここでは「DEGのうち、A群で高発現なものが90%, B群で高発現なものが10%」と指定している。 param_Ngene <- 20000 #全遺伝子数を指定 param_PDEG <- 0.20 #全遺伝子に占める発現変動遺伝子の割合(PDEG)を指定。ここでは20000個中(20000*0.2)個をDEGと指定している。 #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #シミュレーションデータの作成を行うNBsample_multi関数をロード library(TCC) #パッケージの読み込み #シミュレーションデータの作成本番 hoge <- NBsample_multi(DEG.foldchange=param_DEG.foldchange, group=param_group, Ngene=param_Ngene, PDEG=param_PDEG, DEG.assign=param_DEG.assign)#シミュレーションデータの作成を行うNBsample_multi関数を実行した結果をhogeに格納 RAW <- hoge$data #作成した数値データ部分を抽出してRAWに格納 rownames(RAW) <- paste("gene", 1:nrow(RAW), sep="_") #"gene_1", "gene_2"などの遺伝子名を付加している DEG_posi <- hoge$DEG_posi #導入したDEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posiに格納 nonDEG_posi <- hoge$nonDEG_posi #導入したnon-DEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posiに格納 #得られた結果をファイルに出力 tmp <- cbind(rownames(RAW), RAW, DEG_posi, nonDEG_posi) #行列RAWの右側にDEGかどうかのフラグ情報を追加したものをtmpとして格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #A vs. BのM-A plotを描画して確認 data <- RAW #シミュレーションデータをdataとして取り扱う data.cl <- c(rep(1, param_samplenum[1]), rep(2, param_samplenum[2]))#A群を1、B群を2としたベクトルdata.clを作成 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #M-A plotの横軸に相当する情報(Average)を計算した結果をx_axisに格納 y_axis <- meanB - meanA #M-A plotの縦軸に相当する情報(Minus)を計算した結果をy_axisに格納 param_xrange <- c(0.5, 10000) #横軸の描画範囲を指定したものをparam_xrangeに格納 plot(x_axis, y_axis, pch=20, cex=0.1, xlim=log2(param_xrange), xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)")#M-A plotを描画 points(x_axis[DEG_posi == "A"], y_axis[DEG_posi == "A"], col="magenta", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をmagentaにしている points(x_axis[DEG_posi == "B"], y_axis[DEG_posi == "B"], col="cyan", pch=20, cex=0.1)#DEGに相当するもの(つまりDEG_posiがTRUEの部分)の色をcyanにしている grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 legend("topright", c("DEG(up_in_A)", "DEG(up_in_B)", "non-DEG"), col=c("magenta", "cyan", "black"), pch=19)#legendを表示6. 全部で5群のデータにしたい場合: (5.と基本的には同じ枠組みですが多群間のシミュレーションデータ作成例です)
out_f <- "simdata_multi.txt" #出力ファイル名を指定 param_DEG.foldchange <- c(4, 10, 0, 5, 7) #群ごとの発現変動の度合い(fold-change)を指定。ここでは「A群のDEGは4倍高発現, B群のDEGは10倍高発現, C群のDEGは0倍高発現, D群のDEGは5倍高発現, E群のDEGは7倍高発現」と指定している。 param_group <- c(5, 3, 1, 2, 2) #群ごとのサンプル数を指定。ここでは「A群が5サンプル, B群が3サンプル, C群が1サンプル, D群が2サンプル, E群が2サンプル」と指定している。 param_DEG.assign <- c(0, 0.2, 0, 0.5, 0.3) #DEGのうち各群で高発現なものの割合を指定。ここでは「DEGのうち、A群で高発現なものが0%, B群で高発現なものが20%, C群で高発現なものが0%, D群で高発現なものが50%, E群で高発現なものが30%」と指定している。 param_Ngene <- 20000 #全遺伝子数を指定 param_PDEG <- 0.20 #全遺伝子に占める発現変動遺伝子の割合(PDEG)を指定。ここでは20000個中(20000*0.2)個をDEGと指定している。 #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #シミュレーションデータの作成を行うNBsample_multi関数をロード library(TCC) #パッケージの読み込み #シミュレーションデータの作成本番 hoge <- NBsample_multi(DEG.foldchange=param_DEG.foldchange, group=param_group, Ngene=param_Ngene, PDEG=param_PDEG, DEG.assign=param_DEG.assign)#シミュレーションデータの作成を行うNBsample_multi関数を実行した結果をhogeに格納 RAW <- hoge$data #作成した数値データ部分を抽出してRAWに格納 rownames(RAW) <- paste("gene", 1:nrow(RAW), sep="_") #"gene_1", "gene_2"などの遺伝子名を付加している DEG_posi <- hoge$DEG_posi #導入したDEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posiに格納 nonDEG_posi <- hoge$nonDEG_posi #導入したnon-DEGに相当する位置をTRUE、それ以外をFALSEとしたベクトルをDEG_posiに格納 #得られた結果をファイルに出力 tmp <- cbind(rownames(RAW), RAW, DEG_posi, nonDEG_posi) #行列RAWの右側にDEGかどうかのフラグ情報を追加したものをtmpとして格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存参考文献1(Di et al., SAGMB, 2011)
in_f <- "data_hypodata_1vs1.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_1vs1_iDEGESDESeq_DE.txt" #出力ファイル名を指定 param_A <- 1 #A群(G1群)のサンプル数を指定 param_B <- 1 #B群(G2群)のサンプル数を指定 param1 <- 3 #DESeq-(DESeq-DESeq)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) param_DEmethod <- "deseq" #(正規化後に実行する)DEG検出法を指定 param_FDR <- 0.05 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 tcc <- new("TCC", data, data.cl) #TCCクラスオブジェクトtccを作成 #iDEGES/DESeq正規化の実行 tcc <- calcNormFactors(tcc, norm.method="deseq", test.method="deseq",#正規化を実行した結果をtccに格納 iteration=param1, FDR=0.1, floorPDEG=0.05)#正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, test.method=param_DEmethod, FDR=param_FDR)#DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画
DESeq:Anders and Huber, Genome Biol, 2010
TCC (≥ ver. 1.1.99):Sun et al., submittedin_f <- "data_hypodata_1vs1.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_1vs1_DESeq_DE.txt" #出力ファイル名を指定 param_A <- 1 #A群(G1群)のサンプル数を指定 param_B <- 1 #B群(G2群)のサンプル数を指定 param_fitType <- "parametric" #DESeqパッケージ内のestimateDispersions関数内のパラメータ("parametric" or "local")を指定 #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Anders and Huberの(AH)正規化本番 cds <- newCountDataSet(data, data.cl) #CountDataSetオブジェクトを作成してcdsに格納 cds <- estimateSizeFactors(cds) #size factorを計算し、結果をcdsに格納 sizeFactors(cds) #これがDESeqのsize factorsです(1.1365363 1.1272941 0.8835836 0.9287529) #DEG検出の実行と結果の抽出 cds <- estimateDispersions(cds, method="blind", sharingMode="fit-only", fitType=param_fitType)#モデル構築 out <- nbinomTest(cds, 1, 2) #発現変動の各種統計量を計算し、結果をoutに格納 p.value <- out$pval #p-valueをp.valueに格納 p.value <- ifelse(is.na(p.value), 1, p.value) #NAを1に置換している q.value <- out$padj #adjusted p-valueをq.valueに格納 q.value <- ifelse(is.na(q.value), 1, q.value) #NAを1に置換している rank_DESeq <- rank(p.value) #p.valueでランキングした結果をrank_DESeqに格納 logratio <- out$log2FoldChange #log2(B/A)統計量をlogratioに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(data), data, p.value, q.value, rank_DESeq, logratio)#入力データの右側に、「p.value」、「q.value」、「rank_DESeq」、「log(B/A)」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plotMA(out) #FDR < 0.1 を満たすDEGを赤としてM-A plotを描画2. サンプルデータ14の10,000 genes×2 samplesの「複製なし」タグカウントデータ(data_hypodata_1vs1.txt) TCCパッケージを用いて同様の解析を行うやり方です。出力ファイルのa.value列がlogratioに相当し、q.value列上でFDR閾値を決めます。
in_f <- "data_hypodata_1vs1.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_1vs1_TCC_DE.txt" #出力ファイル名を指定 param_A <- 1 #A群(G1群)のサンプル数を指定 param_B <- 1 #B群(G2群)のサンプル数を指定 param_FDR <- 0.10 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #Anders and Huberの(AH)正規化の実行 tcc <- calcNormFactors(tcc, iteration=FALSE) #正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, FDR=param_FDR) #DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画
DESeq:Anders and Huber, Genome Biol, 2010
TCC (≥ ver. 1.1.99):Sun et al., submittedin_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_iDEGESedgeR_DE.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 param1 <- 3 #正規化におけるTMM-(edgeR-TMM)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) param_DEmethod <- "edger" #(正規化後に実行する)DEG検出法を指定 param_FDR <- 0.05 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 tcc <- new("TCC", data, data.cl) #TCCクラスオブジェクトtccを作成 #iDEGES/edgeR正規化の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", test.method="edger",#正規化を実行した結果をtccに格納 iteration=param1, FDR=0.1, floorPDEG=0.05)#正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, test.method=param_DEmethod, FDR=param_FDR)#DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_iDEGESedgeR_DE.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param1 <- 3 #TMM-(edgeR-TMM)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) param_DEmethod <- "edger" #DEG検出法を指定 param_FDR <- 0.05 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #iDEGES/edgeR正規化の実行 tcc <- calcNormFactors(tcc, iteration=param1) #正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, test.method=param_DEmethod, FDR=param_FDR)#DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画3. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) このデータはどのサンプルでも発現していない(zero count; ゼロカウント)ものが多いので、 どこかのサンプルで0より大きいカウントのもののみからなるサブセットを抽出して2.と同様の計算を行っています。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_iDEGESedgeR_DE2.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param1 <- 3 #TMM-(edgeR-TMM)nパイプラインのnの値(iterationの回数)を指定(デフォルトは3) param_lowcount <- 0 #低発現遺伝子のフィルタリングを行う際の閾値。遺伝子(行)ごとにカウントの総和を計算し、ここで指定した値よりも大きいものだけがその後の解析に用いられる param_DEmethod <- "edger" #DEG検出法を指定 param_FDR <- 0.05 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 dim(tcc$count) #カウント行列の行数と列数を表示(7065行4列) #フィルタリングの実行(低発現のものを除去) tcc <- filterLowCountGenes(tcc, low.count = param_lowcount) #param_lowcountで指定した閾値より大きい総カウント数をもつ遺伝子のみを抽出している dim(tcc$count) #カウント行列の行数と列数を表示(6508行4列になっていることがわかる) #iDEGES/edgeR正規化の実行 tcc <- calcNormFactors(tcc, iteration=param1) #正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, test.method=param_DEmethod, FDR=param_FDR)#DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画TCC (≥ ver. 1.1.99):Sun et al., submitted
edgeR:Robinson et al., Bioinformatics, 2010
TMM正規化法:Robinson and Oshlack, Genome Biol., 2010in_f <- "data_hypodata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_hypodata_3vs3_DEGESTbT_DE.txt" #出力ファイル名を指定 param_A <- 3 #A群(G1群)のサンプル数を指定 param_B <- 3 #B群(G2群)のサンプル数を指定 param_samplesize <- 500 #TbT法のstep2中で行うブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param_DEmethod <- "edger" #DEG検出法を指定 param_FDR <- 0.05 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TbT正規化(TCC論文中のDEGES/TbTと同じ)の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", #正規化を実行した結果をtccに格納 test.method="bayseq", samplesize=param_samplesize)#正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, test.method=param_DEmethod, FDR=param_FDR)#DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画2. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) technical replicatesのデータ(mut群2サンプル vs. wt群2サンプル)です。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_DEGESTbT_DE.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param_samplesize <- 500 #TbT法のstep2中で行うブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param_DEmethod <- "edger" #DEG検出法を指定 param_FDR <- 0.05 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 #TbT正規化(TCC論文中のDEGES/TbTと同じ)の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", #正規化を実行した結果をtccに格納 test.method="bayseq", samplesize=param_samplesize)#正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, test.method=param_DEmethod, FDR=param_FDR)#DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画3. サンプルデータ10の7,065 genes×4 samplesの「複製あり」タグカウントデータ(data_yeast_7065.txt) このデータはどのサンプルでも発現していない(zero count; ゼロカウント)ものが多いので、 どこかのサンプルで0より大きいカウントのもののみからなるサブセットを抽出して2.と同様の計算を行っています。
in_f <- "data_yeast_7065.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "data_yeast_7065_DEGESTbT_DE2.txt" #出力ファイル名を指定 param_A <- 2 #A群(mut群)のサンプル数を指定 param_B <- 2 #B群(wt群)のサンプル数を指定 param_samplesize <- 500 #TbT法のstep2中で行うブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param_lowcount <- 0 #低発現遺伝子のフィルタリングを行う際の閾値。遺伝子(行)ごとにカウントの総和を計算し、ここで指定した値よりも大きいものだけがその後の解析に用いられる param_DEmethod <- "edger" #DEG検出法を指定 param_FDR <- 0.05 #DEG検出時のfalse discovery rate (FDR)閾値を指定 #必要なパッケージをロード library(TCC) #パッケージの読み込み #発現データの読み込みとTCCクラスオブジェクトの作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み tcc <- new("TCC", as.matrix(data), c(param_A, param_B)) #TCCクラスオブジェクトtccを作成 dim(tcc$count) #カウント行列の行数と列数を表示(7065行4列) #フィルタリングの実行(低発現のものを除去) tcc <- filterLowCountGenes(tcc, low.count = param_lowcount) #param_lowcountで指定した閾値より大きい総カウント数をもつ遺伝子のみを抽出している dim(tcc$count) #カウント行列の行数と列数を表示(6508行4列になっていることがわかる) #TbT正規化(TCC論文中のDEGES/TbTと同じ)の実行 tcc <- calcNormFactors(tcc, norm.method="tmm", #正規化を実行した結果をtccに格納 test.method="bayseq", samplesize=param_samplesize)#正規化を実行した結果をtccに格納 #DEG検出の実行と結果の抽出 tcc <- estimateDE(tcc, test.method=param_DEmethod, FDR=param_FDR)#DEG検出を実行した結果をtccに格納 result <- getResult(tcc, sort=FALSE) #p値などの結果を抽出してをresultに格納 #結果をまとめたものをファイルに出力 tmp <- cbind(rownames(tcc$count), tcc$count, result) #「rownames情報」、「カウントデータ」、「DEG検出結果」を列方向で結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #以下は(こんなこともできますという)おまけ #正規化後のデータでM-A plotを描画 plot(tcc, FDR=param_FDR) #param_FDRで指定した閾値を満たすDEGをマゼンタ色にしてM-A plotを描画TCC (≥ ver. 1.1.99):Sun et al., submitted
edgeR:Robinson et al., Bioinformatics, 2010
TMM正規化法:Robinson and Oshlack, Genome Biol., 2010baySeq:Hardcastle and Kelly, BMC Bioinformatics, 2010
TbT正規化法:Kadota et al., Algorithms Mol. Biol., 2012in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge2.txt" #出力ファイル名を指定 out_f2 <- "hoge2.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param4 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param5 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #門田のタグカウントデータ正規化法(TbT法)を利用するための関数をロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #TbT正規化係数を計算 TbTout <- do_TbT(data, data.cl, sample_num=param3) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 #TbT正規化係数を組合せたedgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d$samples$norm.factors <- norm_f_TbT #TbT正規化係数を代入 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d, prop.used=0.5, grid.length=500) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 rank_edgeR <- rank(stat_edgeR) #FDR値でランキングした結果をrank_edgeRに格納 hoge <- cbind(rownames(data), data, out$table, stat_edgeR, rank_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」、「順位」を結合した結果をhogeに格納 tmp <- hoge[order(rank_edgeR),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_edgeR < param4) #param4で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param5[1], height=param5[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示2. Biological replicatesデータ(A群3サンプル vs. B群3サンプルdata_arab.txt)の場合:
in_f <- "data_arab.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge4.txt" #出力ファイル名を指定 out_f2 <- "hoge4.png" #出力ファイル名を指定 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param4 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param5 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #門田のタグカウントデータ正規化法(TbT法)を利用するための関数をロード library(NBPSeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #TbT正規化係数を計算 TbTout <- do_TbT(data, data.cl, sample_num=param3) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 #TbT正規化係数を組合せたedgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d$samples$norm.factors <- norm_f_TbT #TbT正規化係数を代入 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d, prop.used=0.5, grid.length=500) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 rank_edgeR <- rank(stat_edgeR) #FDR値でランキングした結果をrank_edgeRに格納 hoge <- cbind(rownames(data), data, out$table, stat_edgeR, rank_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」、「順位」を結合した結果をhogeに格納 tmp <- hoge[order(rank_edgeR),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_edgeR < param4) #param4で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param5[1], height=param5[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示参考文献1(Kadota et al., AMB, 2012)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge1.txt" #出力ファイル名を指定 out_f2 <- "hoge1.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param4 <- 0.01 #MA-plot描画時のp値の閾値を指定 param5 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード #source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #門田のタグカウントデータ正規化法(TbT法)を利用するための関数をロード library(NBPSeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(TCC) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データをmatrix型に変換している data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #TbT正規化係数を計算 TbTout <- do_TbT(data, data.cl, sample_num=param3) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 #TbT正規化係数を組合せたNBPSeqを用いてDEGの検出を実行 out <- nbp.test(data, data.cl, 1, 2, norm.factors=norm_f_TbT) #TbT正規化係数を組み合わせて計算を実行 stat_NBPSeq <- out$p.values #p-valueをstat_NBPSeqに格納 stat_NBPSeq <- ifelse(is.na(stat_NBPSeq), 1, stat_NBPSeq) #NAを1に置換している rank_NBPSeq <- rank(stat_NBPSeq) #stat_NBPSeqでランキングした結果をrank_NBPSeqに格納 hoge <- cbind(rownames(data), data, stat_NBPSeq, rank_NBPSeq) #入力データの右側に、「stat_NBPSeq」と「rank_NBPSeq」を結合した結果をtmpに格納 tmp <- hoge[order(rank_NBPSeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NBPSeq < param4) #param4で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param5[1], height=param5[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示2. Biological replicatesデータ(A群3サンプル vs. B群3サンプル)の場合:
in_f <- "data_arab.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge2.txt" #出力ファイル名を指定 out_f2 <- "hoge2.png" #出力ファイル名を指定 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param4 <- 0.01 #MA-plot描画時のp値の閾値を指定 param5 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード #source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #門田のタグカウントデータ正規化法(TbT法)を利用するための関数をロード library(NBPSeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(TCC) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データをmatrix型に変換している data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #TbT正規化係数を計算 TbTout <- do_TbT(data, data.cl, sample_num=param3) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 #TbT正規化係数を組合せたNBPSeqを用いてDEGの検出を実行 out <- nbp.test(data, data.cl, 1, 2, norm.factors=norm_f_TbT) #TbT正規化係数を組み合わせて計算を実行 stat_NBPSeq <- out$p.values #p-valueをstat_NBPSeqに格納 stat_NBPSeq <- ifelse(is.na(stat_NBPSeq), 1, stat_NBPSeq) #NAを1に置換している rank_NBPSeq <- rank(stat_NBPSeq) #stat_NBPSeqでランキングした結果をrank_NBPSeqに格納 hoge <- cbind(rownames(data), data, stat_NBPSeq, rank_NBPSeq) #入力データの右側に、「stat_NBPSeq」と「rank_NBPSeq」を結合した結果をtmpに格納 tmp <- hoge[order(rank_NBPSeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NBPSeq < param4) #param4で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param5[1], height=param5[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示参考文献1(Kadota et al., AMB, 2012)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge1.txt" #出力ファイル名を指定 out_f2 <- "hoge1.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param4 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param5 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード #source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #門田のタグカウントデータ正規化法(TbT法)を利用するための関数をロード library(DESeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(TCC) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データをmatrix型に変換している data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #TbT正規化係数を計算 TbTout <- do_TbT(data, data.cl, sample_num=param3) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 #TbT正規化係数を組合せたDESeqを用いてDEGの検出を実行 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) sizeFactors(cds) <- colSums(data)*norm_f_TbT #TbT正規化係数を掛けたeffective library sizeの値を代入している cds <- estimateDispersions(cds, method="per-condition", sharingMode="maximum", fitType="local")#DESeq本番 out <- nbinomTest(cds, 1, 2) #DESeq本番 stat_DESeq <- out$padj #p-valueをstat_DESeqに格納 stat_DESeq <- ifelse(is.na(stat_DESeq), 1, stat_DESeq) #NAを1に置換している rank_DESeq <- rank(stat_DESeq) #stat_DESeqでランキングした結果をrank_DESeqに格納 hoge <- cbind(rownames(data), data, stat_DESeq, rank_DESeq) #入力データの右側に、「stat_DESeq」と「rank_DESeq」を結合した結果をhogeに格納 tmp <- hoge[order(rank_DESeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_DESeq < param4) #param4で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param5[1], height=param5[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示2. Biological replicatesデータ(A群3サンプル vs. B群3サンプル: data_arab.txt)の場合:
in_f <- "data_arab.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge2.txt" #出力ファイル名を指定 out_f2 <- "hoge2.png" #出力ファイル名を指定 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param4 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param5 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード #source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #門田のタグカウントデータ正規化法(TbT法)を利用するための関数をロード library(DESeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(TCC) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データをmatrix型に変換している data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #TbT正規化係数を計算 TbTout <- do_TbT(data, data.cl, sample_num=param3) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 #TbT正規化係数を組合せたDESeqを用いてDEGの検出を実行 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) sizeFactors(cds) <- colSums(data)*norm_f_TbT #TbT正規化係数を掛けたeffective library sizeの値を代入している cds <- estimateDispersions(cds, method="per-condition", sharingMode="maximum", fitType="local")#DESeq本番 out <- nbinomTest(cds, 1, 2) #DESeq本番 stat_DESeq <- out$padj #p-valueをstat_DESeqに格納 stat_DESeq <- ifelse(is.na(stat_DESeq), 1, stat_DESeq) #NAを1に置換している rank_DESeq <- rank(stat_DESeq) #stat_DESeqでランキングした結果をrank_DESeqに格納 hoge <- cbind(rownames(data), data, stat_DESeq, rank_DESeq) #入力データの右側に、「stat_DESeq」と「rank_DESeq」を結合した結果をhogeに格納 tmp <- hoge[order(rank_DESeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_DESeq < param4) #param4で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param5[1], height=param5[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示3. Biological replicatesのシミュレーションデータデータ(A群3サンプル vs. B群3サンプル、simdata_3vs3.txt)の場合:
in_f <- "data_arab.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge2.txt" #出力ファイル名を指定 out_f2 <- "hoge2.png" #出力ファイル名を指定 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は500とか1000とかでやってみてください。) param4 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param5 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード #source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #門田のタグカウントデータ正規化法(TbT法)を利用するための関数をロード library(DESeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み library(DEGseq) #パッケージの読み込み library(baySeq) #パッケージの読み込み library(TCC) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data.tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データをmatrix型に変換している data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 data <- data.tmp[,1:(param_A+param_B)] #発現データ部分のみ抽出してdataに格納 RAW <- data #dataをRAWに格納 #TbT正規化係数を計算 TbTout <- do_TbT(data, data.cl, sample_num=param3) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 #TbT正規化係数を組合せたDESeqを用いてDEGの検出を実行 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) sizeFactors(cds) <- colSums(data)*norm_f_TbT #TbT正規化係数を掛けたeffective library sizeの値を代入している cds <- estimateDispersions(cds, method="per-condition", sharingMode="maximum", fitType="local")#DESeq本番 out <- nbinomTest(cds, 1, 2) #DESeq本番 stat_DESeq <- out$padj #p-valueをstat_DESeqに格納 stat_DESeq <- ifelse(is.na(stat_DESeq), 1, stat_DESeq) #NAを1に置換している rank_DESeq <- rank(stat_DESeq) #stat_DESeqでランキングした結果をrank_DESeqに格納 hoge <- cbind(rownames(data), data, stat_DESeq, rank_DESeq) #入力データの右側に、「stat_DESeq」と「rank_DESeq」を結合した結果をhogeに格納 tmp <- hoge[order(rank_DESeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_DESeq < param4) #param4で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param5[1], height=param5[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示参考文献1(Kadota et al., AMB, 2012)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge.txt" #出力ファイル名を指定 out_f2 <- "hoge.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は1000とかでやってみてください。) param4 <- c(600, 400) #MA-plotのファイル出力時の横幅(単位はピクセル)と縦幅を指定 library(baySeq) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=colSums(data), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=param3, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) rank_bayseq <- rank(-out@posteriors[,2]) #DEのposterior likelihoodでランキングした結果をrank_bayseqに格納 hoge <- cbind(rownames(data), data, rank_bayseq) #入力データの右側に、「rank_bayseq」を結合した結果をhogeに格納 hoge_s <- hoge[order(rank_bayseq),] #発現変動の度合いでソートした結果をhoge_sに格納 hoge2 <- topCounts(out, group=2, number=length(rank_bayseq)) #LikelihoodやFDRを計算するtopCounts関数を適用した結果をhoge2に格納 tmp <- cbind(hoge_s, hoge2$Likelihood, hoge2$FDR) #hoge_sの右側に「Likelihood」, 「FDR値」を追加してtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存 #MA-plotを描画(するための基礎情報取得) RPM <- sweep(data, 2, 1000000/colSums(data), "*") #RPM正規化した結果をRPMに格納 data <- RPM #オブジェクトRPMをdataに代入 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEGnum <- length(rank_bayseq)*out@estProps[2] #発現変動遺伝子数をDEGnumに格納 obj <- rownames(data)[rank_bayseq < DEGnum] #DEGに相当する遺伝子名情報をobjに格納 DEG_posi <- is.element(rownames(data), obj) #rownames(data)中の並びでのDEGの位置情報を取得してDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="solid") #grid線を追加 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ DEGnum #発現変動遺伝子数を表示 out@estProps[2] #発現変動遺伝子の全遺伝子数に占める割合を表示2. 配列長の情報なし(FDRカットオフ)の場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge.txt" #出力ファイル名を指定 out_f2 <- "hoge.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は1000とかでやってみてください。) param4 <- c(600, 400) #MA-plotのファイル出力時の横幅(単位はピクセル)と縦幅を指定 param5 <- 0.05 #MA-plot描画時のFDRの閾値を指定 library(baySeq) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=colSums(data), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=param3, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) rank_bayseq <- rank(-out@posteriors[,2]) #DEのposterior likelihoodでランキングした結果をrank_bayseqに格納 hoge <- cbind(rownames(data), data, rank_bayseq) #入力データの右側に、「rank_bayseq」を結合した結果をhogeに格納 hoge_s <- hoge[order(rank_bayseq),] #発現変動の度合いでソートした結果をhoge_sに格納 hoge2 <- topCounts(out, group=2, number=length(rank_bayseq)) #LikelihoodやFDRを計算するtopCounts関数を適用した結果をhoge2に格納 tmp <- cbind(hoge_s, hoge2$Likelihood, hoge2$FDR) #hoge_sの右側に「Likelihood」, 「FDR値」を追加してtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存 #MA-plotを描画(するための基礎情報取得) RPM <- sweep(data, 2, 1000000/colSums(data), "*") #RPM正規化した結果をRPMに格納 data <- RPM #オブジェクトRPMをdataに代入 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEGnum <- sum(hoge2$FDR < param5) #param5で指定したFDRの閾値を満たす発現変動遺伝子数をDEGnumに格納 obj <- rownames(tmp)[hoge2$FDR < param5] #param5で指定したFDRの閾値を満たす遺伝子名情報をobjに格納 DEG_posi <- is.element(rownames(data), obj) #rownames(data)中の並びでのDEGの位置情報を取得してDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="solid") #grid線を追加 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ DEGnum #発現変動遺伝子数を表示 DEGnum/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示3. 配列長の情報あり(前処理 | Ensembl Geneの長さを計算するを行って得られたens_gene_46_length.txtから情報取得):
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_46_length.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f <- "hoge.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 10000 #ブートストラップリサンプリング回数(10000が推奨。すごく時間がかかります。とりあえず、という人は1000とかでやってみてください。) #Ensembl Gene IDをアルファベット順に並び替えて発現データ(data)情報を取得 library(baySeq) #パッケージの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- data[order(rownames(data)),] #Ensembl Gene IDのアルファベット順に行列dataの行を並び替えている #Ensembl Gene IDをアルファベット順に並び替えてgene_length情報を取得 tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gene_length <- tmp[,2] #配列長をgene_lengthに格納 names(gene_length) <- tmp[,1] #gene_length中の値とEnsembl Gene IDを対応づけている gene_length <- gene_length[order(names(gene_length))] #Ensembl Gene IDのアルファベット順にgene_length中の要素を並び替えている #gene_length情報があり、かつ発現データファイル中にもあるEnsembl Gene IDのもののみ取り扱うための処理 common <- intersect(names(gene_length), rownames(data)) #二つのベクトル(names(gene_length)とrownames(data))の積集合(intersection)をcommonに格納 obj_gene_length <- is.element(names(gene_length), common) #commonで指定したEnsembl Gene IDsのnames(gene_length)中における位置情報をobj_gene_lengthに格納 obj_data <- is.element(rownames(data), common) #commonで指定したEnsembl Gene IDsのrownames(data)中における位置情報をobj_dataに格納 gene_length_sub <- gene_length[obj_gene_length] #gene_lengthベクトルの中から、obj_gene_lengthがTRUEとなっているもののみ抽出してgene_length_subに格納 data_sub <- data[obj_data,] #行列dataからobj_dataがTRUEとなっている行のみ抽出してdata_subに格納 #元々あった遺伝子数がどの程度の数になったかを表示 dim(data) #行列dataの行数と列数を表示 dim(data_sub) #行列data_subの行数と列数を表示 gene_length <- gene_length_sub #gene_lengthの中身をgene_length_subにしている data <- as.matrix(data_sub) #dataの中身をmatrix形式のdata_subにしている #baySeq本番 data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 groups <- list(NDE=rep(1, (param1+param2)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=data, replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups, seglens=gene_length)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=param3, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_bayseq <- out@posteriors[,2] #DEのposterior likelihoodをstat_bayseqに格納 rank_bayseq <- rank(-stat_bayseq, ties.method="min") #stat_bayseqでランキングした結果をrank_bayseqに格納 tmp <- cbind(rownames(data), data, stat_bayseq, rank_bayseq) #入力データの右側に、「stat_bayseq」と「rank_bayseq」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存参考文献1(Hardcastle and Kelly, BMC Bioinformatics, 2010)
#必要なパッケージをロード library(BitSeq) #パッケージの読み込みBitSeq:Glaus et al., Bioinformatics, 2012
#必要なパッケージをロード library(DSS) #パッケージの読み込み
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge1.txt" #出力ファイル名を指定 out_f2 <- "hoge1.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- "tech" #replicatesのタイプを指定。入力データがtechnical replicatesの場合は"tech"を、biological replicatesの場合は"bio"を指定 param4 <- "tmm" #データ正規化手段を指定。Upper Quartile値を揃える場合は"uqua"を、TMM正規化法を採用する場合には"tmm"を、(転写物の長さ情報がある場合には1000bpに揃えて)総リード数が100万になるようにしたい場合には"rpkm"を、データ正規化を行わない場合には"n"を指定 param5 <- 0.8 #DEGとみなすProbability(1に近いほどより厳しい閾値に相当)を指定 param6 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")#NOISeqを利用するための関数をロード #発現データの読み込みとラベル情報の作成 data <- readData(file=in_f, header=TRUE, cond1=c(2:(param1+1)), cond2=c((param1+2):(param1+1+param2)))#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- cbind(data[[1]], data[[2]]) #結果の出力時にA群B群の別々に分かれた状態になっているのをまとめたものをRAWに格納(出力時により簡便に取り扱うためのおまじない) rownames(RAW) <- rownames(data[[1]]) #RAWの行名を読み込んだ発現データファイルの一列目の情報で与えている #NOISeq本番 out <- noiseq(data[[1]], data[[2]], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)#NOISeqを実行した結果をoutに格納 #得られた統計量や順位情報などを抽出してファイル出力 stat_NOISeq <- out$probab #DEGとみなす確率(1に近いほど発現変動の度合いが大きくて0に近いほどnon-DEG。ここではq=0.8と指定しているので、Probabilityが0.8以上のものがDEGとされていることになる)をstat_NOISeqに格納 stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq) #NAを0に置換している(全部の数値が0で計算できないようなものがNAとなり、これらはDEGとは言えないのでProbabilityの値を0にしたいという思想です) rank_NOISeq <- rank(-stat_NOISeq) #stat_NOISeqでランキングした結果をrank_NOISeqに格納 hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq) #入力データの右側に、「stat_NOISeq」と「rank_NOISeq」を結合した結果をtmpに格納 tmp <- hoge[order(rank_NOISeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NOISeq > param5) #param5で指定した閾値以上のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param6[1], height=param6[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示2. Biological replicatesデータ(A群3サンプル vs. B群3サンプル)の場合:
in_f <- "data_arab.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge2.txt" #出力ファイル名を指定 out_f2 <- "hoge2.png" #出力ファイル名を指定 param_A <- 3 #A群のサンプル数を指定 param_B <- 3 #B群のサンプル数を指定 param3 <- "bio" #replicatesのタイプを指定。入力データがtechnical replicatesの場合は"tech"を、biological replicatesの場合は"bio"を指定 param4 <- "tmm" #データ正規化手段を指定。Upper Quartile値を揃える場合は"uqua"を、TMM正規化法を採用する場合には"tmm"を、(転写物の長さ情報がある場合には1000bpに揃えて)総リード数が100万になるようにしたい場合には"rpkm"を、データ正規化を行わない場合には"n"を指定 param5 <- 0.8 #DEGとみなすProbability(1に近いほどより厳しい閾値に相当)を指定 param6 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")#NOISeqを利用するための関数をロード #発現データの読み込みとラベル情報の作成 data <- readData(file=in_f, header=TRUE, cond1=c(2:(param1+1)), cond2=c((param1+2):(param1+1+param2)))#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- cbind(data[[1]], data[[2]]) #結果の出力時にA群B群の別々に分かれた状態になっているのをまとめたものをRAWに格納(出力時により簡便に取り扱うためのおまじない) rownames(RAW) <- rownames(data[[1]]) #RAWの行名を読み込んだ発現データファイルの一列目の情報で与えている #NOISeq本番 out <- noiseq(data[[1]], data[[2]], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)#NOISeqを実行した結果をoutに格納 #得られた統計量や順位情報などを抽出してファイル出力 stat_NOISeq <- out$probab #DEGとみなす確率(1に近いほど発現変動の度合いが大きくて0に近いほどnon-DEG。ここではq=0.8と指定しているので、Probabilityが0.8以上のものがDEGとされていることになる)をstat_NOISeqに格納 stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq) #NAを0に置換している(全部の数値が0で計算できないようなものがNAとなり、これらはDEGとは言えないのでProbabilityの値を0にしたいという思想です) rank_NOISeq <- rank(-stat_NOISeq) #stat_NOISeqでランキングした結果をrank_NOISeqに格納 hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq) #入力データの右側に、「stat_NOISeq」と「rank_NOISeq」を結合した結果をtmpに格納 tmp <- hoge[order(rank_NOISeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NOISeq > param5) #param5で指定した閾値以上のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param6[1], height=param6[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示3. Biological replicatesのシミュレーションデータデータ(A群3サンプル vs. B群3サンプル、simdata_3vs3.txt)の場合:
in_f <- "simdata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge3.txt" #出力ファイル名を指定 out_f2 <- "hoge3.png" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- "bio" #replicatesのタイプを指定。入力データがtechnical replicatesの場合は"tech"を、biological replicatesの場合は"bio"を指定 param4 <- "tmm" #データ正規化手段を指定。Upper Quartile値を揃える場合は"uqua"を、TMM正規化法を採用する場合には"tmm"を、(転写物の長さ情報がある場合には1000bpに揃えて)総リード数が100万になるようにしたい場合には"rpkm"を、データ正規化を行わない場合には"n"を指定 param5 <- 0.8 #DEGとみなすProbability(1に近いほどより厳しい閾値に相当)を指定 param6 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")#NOISeqを利用するための関数をロード #発現データの読み込みとラベル情報の作成 data <- readData(file=in_f, header=TRUE, cond1=c(2:(param1+1)), cond2=c((param1+2):(param1+1+param2)))#発現データファイルの読み込み data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- cbind(data[[1]], data[[2]]) #結果の出力時にA群B群の別々に分かれた状態になっているのをまとめたものをRAWに格納(出力時により簡便に取り扱うためのおまじない) rownames(RAW) <- rownames(data[[1]]) #RAWの行名を読み込んだ発現データファイルの一列目の情報で与えている #NOISeq本番 out <- noiseq(data[[1]], data[[2]], repl=param3, norm=param4, long=1000, q=param5, nss=0, lc=1, k=0.5)#NOISeqを実行した結果をoutに格納 #得られた統計量や順位情報などを抽出してファイル出力 stat_NOISeq <- out$probab #DEGとみなす確率(1に近いほど発現変動の度合いが大きくて0に近いほどnon-DEG。ここではq=0.8と指定しているので、Probabilityが0.8以上のものがDEGとされていることになる)をstat_NOISeqに格納 stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq) #NAを0に置換している(全部の数値が0で計算できないようなものがNAとなり、これらはDEGとは言えないのでProbabilityの値を0にしたいという思想です) rank_NOISeq <- rank(-stat_NOISeq) #stat_NOISeqでランキングした結果をrank_NOISeqに格納 hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq) #入力データの右側に、「stat_NOISeq」と「rank_NOISeq」を結合した結果をtmpに格納 tmp <- hoge[order(rank_NOISeq),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NOISeq > param5) #param5で指定した閾値以上のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param6[1], height=param6[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示4. Biological replicatesのシミュレーションデータデータ(A群3サンプル vs. B群3サンプル、simdata_3vs3.txt)の場合 どこがDEGがわかっているのでAUC値を計算するところまでやる:
in_f <- "simdata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge4.txt" #出力ファイル名を指定 out_f2 <- "hoge4.png" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- "bio" #replicatesのタイプを指定。入力データがtechnical replicatesの場合は"tech"を、biological replicatesの場合は"bio"を指定 param4 <- "tmm" #データ正規化手段を指定。Upper Quartile値を揃える場合は"uqua"を、TMM正規化法を採用する場合には"tmm"を、(転写物の長さ情報がある場合には1000bpに揃えて)総リード数が100万になるようにしたい場合には"rpkm"を、データ正規化を行わない場合には"n"を指定 param5 <- 0.8 #DEGとみなすProbability(1に近いほどより厳しい閾値に相当)を指定 param6 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")#NOISeqを利用するための関数をロード library(ROC) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data.tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 DEG_posi <- data.tmp$DEG_posi #DEGの位置情報を取得 nonDEG_posi <- data.tmp$nonDEG_posi #nonDEGの位置情報を取得 data <- data.tmp[,1:(param1+param2)] #発現データ部分のみ抽出してdataに格納 RAW <- data #dataの内容をRAWにコピーしてるだけー #NOISeq本番 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)#NOISeqを実行した結果をoutに格納 #得られた統計量や順位情報などを抽出してファイル出力 stat_NOISeq <- out$probab #DEGとみなす確率(1に近いほど発現変動の度合いが大きくて0に近いほどnon-DEG。ここではq=0.8と指定しているので、Probabilityが0.8以上のものがDEGとされていることになる)をstat_NOISeqに格納 stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq) #NAを0に置換している(全部の数値が0で計算できないようなものがNAとなり、これらはDEGとは言えないのでProbabilityの値を0にしたいという思想です) rank_NOISeq <- rank(-stat_NOISeq) #stat_NOISeqでランキングした結果をrank_NOISeqに格納 hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq, DEG_posi)#入力データの右側に、「stat_NOISeq」、「rank_NOISeq」、「DEG_posi」を結合した結果をtmpに格納 write.table(hoge, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #AUC値を計算 AUC(rocdemo.sca(truth=DEG_posi, data=-rank_NOISeq)) #AUC値を計算する関数AUCを実行(結果はそのまま表示されている。1に近いほど感度・特異度が高いことを示す) #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NOISeq > param5) #param5で指定した閾値以上のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param6[1], height=param6[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示5. Biological replicatesのシミュレーションデータデータ(A群3サンプル vs. B群3サンプル、simdata_3vs3.txt)の場合 どこがDEGがわかっているのでAUC値を計算するところまでやり、予めTMM正規化したデータをNOISeqで解析する:
in_f <- "simdata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge5.txt" #出力ファイル名を指定 out_f2 <- "hoge5.png" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- "bio" #replicatesのタイプを指定。入力データがtechnical replicatesの場合は"tech"を、biological replicatesの場合は"bio"を指定 param4 <- "n" #データ正規化手段を指定。ここでは自分でTMM正規化後のデータを作成したものを読み込ませるので、オプションとしては「データの正規化を行わない"n"」を与えている param5 <- 0.8 #DEGとみなすProbability(1に近いほどより厳しい閾値に相当)を指定 param6 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")#NOISeqを利用するための関数をロード library(edgeR) #パッケージの読み込み library(ROC) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data.tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 DEG_posi <- data.tmp$DEG_posi #DEGの位置情報を取得 nonDEG_posi <- data.tmp$nonDEG_posi #nonDEGの位置情報を取得 data <- data.tmp[,1:(param1+param2)] #発現データ部分のみ抽出してdataに格納 RAW <- data #dataの内容をRAWにコピーしてるだけ #TMM正規化後のデータを作成 data <- RAW #RAWの内容をdataにコピーしてるだけ d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化係数を計算 norm_f_TMM <- d$samples$norm.factors #TMM正規化係数の情報を抽出してnorm_f_TMMに格納 effective_libsizes <- colSums(data) * norm_f_TMM #effective library sizesというのはlibrary sizesに(TMM)正規化係数を掛けたものなのでそれを計算した結果をeffective_libsizesに格納 RPM_TMM <- sweep(data, 2, 1000000/effective_libsizes, "*") #元のカウントデータをeffective_libsizesで割り(RPMデータと同程度の数値分布にしたいので)one million (=1000000)を掛けた正規化後のデータをRPM_TMMに格納 #NOISeq本番 data <- RPM_TMM #RPM_TMMの内容を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)#NOISeqを実行した結果をoutに格納 #得られた統計量や順位情報などを抽出してファイル出力 stat_NOISeq <- out$probab #DEGとみなす確率(1に近いほど発現変動の度合いが大きくて0に近いほどnon-DEG。ここではq=0.8と指定しているので、Probabilityが0.8以上のものがDEGとされていることになる)をstat_NOISeqに格納 stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq) #NAを0に置換している(全部の数値が0で計算できないようなものがNAとなり、これらはDEGとは言えないのでProbabilityの値を0にしたいという思想です) rank_NOISeq <- rank(-stat_NOISeq) #stat_NOISeqでランキングした結果をrank_NOISeqに格納 hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq, DEG_posi)#入力データの右側に、「stat_NOISeq」、「rank_NOISeq」、「DEG_posi」を結合した結果をtmpに格納 write.table(hoge, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #AUC値を計算 AUC(rocdemo.sca(truth=DEG_posi, data=-rank_NOISeq)) #AUC値を計算する関数AUCを実行(結果はそのまま表示されている。1に近いほど感度・特異度が高いことを示す) #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NOISeq > param5) #param5で指定した閾値以上のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param6[1], height=param6[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示6. Biological replicatesのシミュレーションデータデータ(A群3サンプル vs. B群3サンプル、simdata_3vs3.txt)の場合 どこがDEGがわかっているのでAUC値を計算するところまでやり、予めTbT正規化したデータをNOISeqで解析する:
in_f <- "simdata_3vs3.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge6.txt" #出力ファイル名を指定 out_f2 <- "hoge6.png" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- "bio" #replicatesのタイプを指定。入力データがtechnical replicatesの場合は"tech"を、biological replicatesの場合は"bio"を指定 param4 <- "n" #データ正規化手段を指定。ここでは自分でTMM正規化後のデータを作成したものを読み込ませるので、オプションとしては「データの正規化を行わない"n"」を与えている param5 <- 0.8 #DEGとみなすProbability(1に近いほどより厳しい閾値に相当)を指定 param6 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード source("http://bioinfo.cipf.es/noiseq/lib/exe/fetch.php?media=noiseq.r")#NOISeqを利用するための関数をロード 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, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 DEG_posi <- data.tmp$DEG_posi #DEGの位置情報を取得 nonDEG_posi <- data.tmp$nonDEG_posi #nonDEGの位置情報を取得 data <- data.tmp[,1:(param1+param2)] #発現データ部分のみ抽出してdataに格納 RAW <- data #dataの内容をRAWにコピーしてるだけ #TbT正規化後のデータを作成 data <- RAW #RAWの内容をdataにコピーしてるだけ TbTout <- do_TbT(data, data.cl, sample_num=10000) #TbT正規化法を実行する関数do_TbTを実行した結果をTbToutに格納 norm_f_TbT <- TbTout$norm_f_TbT #TbT正規化係数の情報を抽出してnorm_f_TbTに格納 effective_libsizes <- colSums(data) * norm_f_TbT #effective library sizesというのはlibrary sizesに(TbT)正規化係数を掛けたものなのでそれを計算した結果をeffective_libsizesに格納 RPM_TbT <- sweep(data, 2, 1000000/effective_libsizes, "*") #元のカウントデータをeffective_libsizesで割り(RPMデータと同程度の数値分布にしたいので)one million (=1000000)を掛けた正規化後のデータをRPM_TbTに格納 #NOISeq本番 data <- RPM_TbT #RPM_TMMの内容を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)#NOISeqを実行した結果をoutに格納 #得られた統計量や順位情報などを抽出してファイル出力 stat_NOISeq <- out$probab #DEGとみなす確率(1に近いほど発現変動の度合いが大きくて0に近いほどnon-DEG。ここではq=0.8と指定しているので、Probabilityが0.8以上のものがDEGとされていることになる)をstat_NOISeqに格納 stat_NOISeq <- ifelse(is.na(stat_NOISeq), 0, stat_NOISeq) #NAを0に置換している(全部の数値が0で計算できないようなものがNAとなり、これらはDEGとは言えないのでProbabilityの値を0にしたいという思想です) rank_NOISeq <- rank(-stat_NOISeq) #stat_NOISeqでランキングした結果をrank_NOISeqに格納 hoge <- cbind(rownames(RAW), RAW, stat_NOISeq, rank_NOISeq, DEG_posi)#入力データの右側に、「stat_NOISeq」、「rank_NOISeq」、「DEG_posi」を結合した結果をtmpに格納 write.table(hoge, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #AUC値を計算 AUC(rocdemo.sca(truth=DEG_posi, data=-rank_NOISeq)) #AUC値を計算する関数AUCを実行(結果はそのまま表示されている。1に近いほど感度・特異度が高いことを示す) #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NOISeq > param5) #param5で指定した閾値以上のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param6[1], height=param6[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示NOISeqのwebページ
#必要なパッケージをロード library(GPseq) #パッケージの読み込みCRANのGPseqのwebページ
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 param3 <- 0.01 #MA-plot描画時のp-valueの閾値を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データをmatrix型に変換している data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #NBPSeqを用いてDEGの検出を実行 out <- nbp.test(data, data.cl, 1, 2) #計算を実行 stat_NBPSeq <- out$p.values #p-valueをstat_NBPSeqに格納 rank_NBPSeq <- rank(stat_NBPSeq) #stat_NBPSeqでランキングした結果をrank_NBPSeqに格納 tmp <- cbind(rownames(data), data, stat_NBPSeq, rank_NBPSeq) #入力データの右側に、「stat_NBPSeq」と「rank_NBPSeq」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NBPSeq < param3) #param3で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている2. TMM正規化法を組み合わせた場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 param3 <- 0.01 #MA-plot描画時のp-valueの閾値を指定 #必要なパッケージをロード library(NBPSeq) #パッケージの読み込み library(edgeR) #パッケージの読み込み library(DEGseq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データをmatrix型に変換している data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #TMM正規化係数を得る d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献2)を実行 norm_f_TMM <- d$samples$norm.factors #TMM正規化係数の部分のみ取り出してnorm_f_TMMに格納 #TMM正規化係数とNBPSeqを組合せてDEGの検出を実行 out <- nbp.test(data, data.cl, 1, 2, norm.factors=norm_f_TMM) #TMM正規化係数を組み合わせて計算を実行 stat_NBPSeq <- out$p.values #p-valueをstat_NBPSeqに格納 rank_NBPSeq <- rank(stat_NBPSeq) #stat_NBPSeqでランキングした結果をrank_NBPSeqに格納 tmp <- cbind(rownames(data), data, stat_NBPSeq, rank_NBPSeq) #入力データの右側に、「stat_NBPSeq」と「rank_NBPSeq」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_NBPSeq < param3) #param3で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしているCRANのNBPSeqのwebページ
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge1.txt" #出力ファイル名を指定 out_f2 <- "hoge1.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 0.01 #FDRの閾値を指定 param4 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #DESeqを用いてDEGの検出を実行 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) sizeFactors(cds) #計算された正規化係数を表示しているだけ cds <- estimateDispersions(cds, method="per-condition", sharingMode="maximum", fitType="local")#DESeq本番 out <- nbinomTest(cds, 1, 2) #発現変動の各種統計量を計算し、結果をoutに格納 stat_DESeq <- out$padj #p-valueをstat_DESeqに格納 stat_DESeq <- ifelse(is.na(stat_DESeq), 1, stat_DESeq) #NAを1に置換している rank_DESeq <- rank(stat_DESeq) #stat_DESeqでランキングした結果をrank_DESeqに格納 logratio <- out$log2FoldChange #log2(B/A)統計量をlogratioに格納 tmp <- cbind(rownames(data), data, stat_DESeq, rank_DESeq, logratio)#入力データの右側に、「stat_DESeq」、「rank_DESeq」、「log(B/A)」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_DESeq < param3) #param3で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示2. SupplementaryTable2_changed2.txtの「1 sample vs. 1 sample」の比較:
in_f <- "SupplementaryTable2_changed2.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge2.txt" #出力ファイル名を指定 out_f2 <- "hoge2.png" #出力ファイル名を指定 param_A <- 1 #A群のサンプル数を指定 param_B <- 1 #B群のサンプル数を指定 param3 <- 0.01 #FDRの閾値を指定 param4 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #DESeqを用いてDEGの検出を実行 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) sizeFactors(cds) #計算された正規化係数を表示しているだけ cds <- estimateDispersions(cds, method="blind", sharingMode="fit-only", fitType="local")#DESeq本番 out <- nbinomTest(cds, 1, 2) #発現変動の各種統計量を計算し、結果をoutに格納 stat_DESeq <- out$padj #p-valueをstat_DESeqに格納 stat_DESeq <- ifelse(is.na(stat_DESeq), 1, stat_DESeq) #NAを1に置換している rank_DESeq <- rank(stat_DESeq) #stat_DESeqでランキングした結果をrank_DESeqに格納 logratio <- out$log2FoldChange #log2(B/A)統計量をlogratioに格納 tmp <- cbind(rownames(data), data, stat_DESeq, rank_DESeq, logratio)#入力データの右側に、「stat_DESeq」、「rank_DESeq」、「log(B/A)」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_DESeq < param3) #param3で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示3. SupplementaryTable2_changed2.txtの「1 sample vs. 1 sample」の比較 片方の群の数値が0になっている場合にlogratioの値がInf or -Infになるのを防ぐため正規化後のデータで1未満の数値をを1にしてlogratioを再計算している:
in_f <- "SupplementaryTable2_changed2.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge3.txt" #出力ファイル名を指定 out_f2 <- "hoge3.png" #出力ファイル名を指定 param_A <- 1 #A群のサンプル数を指定 param_B <- 1 #B群のサンプル数を指定 param3 <- 0.01 #FDRの閾値を指定 param4 <- c(600, 400) #MA-plotのファイル出力時の横幅と縦幅を指定(単位はピクセル) #必要なパッケージをロード library(DESeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #DESeqを用いてDEGの検出を実行 cds <- newCountDataSet(data, data.cl) #おまじない(CountDataSetというクラスを作成している) cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) sizeFactors(cds) #計算された正規化係数を表示しているだけ norm_f_DESeq <- sizeFactors(cds) #DESeq正規化係数の情報を抽出してnorm_f_DESeqに格納 cds <- estimateDispersions(cds, method="blind", sharingMode="fit-only", fitType="local")#DESeq本番 out <- nbinomTest(cds, 1, 2) #発現変動の各種統計量を計算し、結果をoutに格納 stat_DESeq <- out$padj #p-valueをstat_DESeqに格納 stat_DESeq <- ifelse(is.na(stat_DESeq), 1, stat_DESeq) #NAを1に置換している rank_DESeq <- rank(stat_DESeq) #stat_DESeqでランキングした結果をrank_DESeqに格納 logratio1 <- out$log2FoldChange #log2(B/A)統計量をlogratio1に格納 #DESeq正規化後のデータを作成し、1未満の数値を1にしてlogratioを計算した結果をlogratio2に格納 data <- RAW #RAWをdataに格納 data_DESeq <- sweep(data, 2, 1/norm_f_DESeq, "*") #生のリードカウントデータをDESeq正規化係数で割った正規化後のデータをdata_DESeqに格納 data <- data_DESeq #data_DESeqをdataに格納 data[data < 1] <- 1 #1未満の数値を1にしている logratio2 <- log2(data[,data.cl==2]) - log2(data[,data.cl==1]) #log2(B/A)を計算した結果をlogratio2に格納 #ファイル出力 data <- RAW #RAWをdataに格納 tmp <- cbind(rownames(data), data, stat_DESeq, rank_DESeq, logratio1, logratio2)#入力データの右側に、「stat_DESeq」、「rank_DESeq」、「logratio1」、「logratio2」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_DESeq < param3) #param3で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示参考文献1(Anders and Huber, Genome Biol, 2010)
in_f <- "SupplementaryTable2.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- c(7, 9, 12, 15, 18) #A群のサンプルが何列目にあるかを指定 param2 <- c(8, 10, 11, 13, 16) #B群のサンプルが何列目にあるかを指定 param3 <- 1 #in_f中の何列目に遺伝子名に相当する情報があるかを指定 param4 <- "FET" #方法を指定 library(DEGseq) #パッケージの読み込み data_A <- readGeneExp(file = in_f, geneCol=param3, valCol=param1)#A群の発現データのみ抽出してdata_Aに格納している data_B <- readGeneExp(file = in_f, geneCol=param3, valCol=param2)#B群の発現データのみ抽出してdata_Bに格納している DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:length(param1)+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:length(param2)+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_p <- rank(out[,5]) #p値でランキングした結果をrank_pに格納 out <- cbind(out, rank_p) #rank_pの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "p-value", "FDR(BH)", "FDR(Storey)", "rank(p-value)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。2. サンプルデータ2のSupplementaryTable2_changed.txtを用いる場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 param4 <- "FET" #方法を指定 library(DEGseq) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data_A <- cbind(rownames(data), data[,1:param1]) #A群の発現データを抽出してdata_Aに格納している data_B <- cbind(rownames(data), data[,(param1+1):(param1+param2)])#B群の発現データを抽出してdata_Bに格納している data_A <- as.matrix(data_A) #データの型をmatrixとしている data_B <- as.matrix(data_B) #データの型をmatrixとしている DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:param1+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:param2+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_p <- rank(out[,5]) #p値でランキングした結果をrank_pに格納 out <- cbind(out, rank_p) #rank_pの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "p-value", "FDR(BH)", "FDR(Storey)", "rank(p-value)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Bloom et al., BMC Genomics, 2009)
in_f <- "SupplementaryTable2.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- c(7, 9, 12, 15, 18) #A群のサンプルが何列目にあるかを指定 param2 <- c(8, 10, 11, 13, 16) #B群のサンプルが何列目にあるかを指定 param3 <- 1 #in_f中の何列目に遺伝子名に相当する情報があるかを指定 param4 <- "LRT" #方法を指定 library(DEGseq) #パッケージの読み込み data_A <- readGeneExp(file = in_f, geneCol=param3, valCol=param1)#A群の発現データのみ抽出してdata_Aに格納している data_B <- readGeneExp(file = in_f, geneCol=param3, valCol=param2)#B群の発現データのみ抽出してdata_Bに格納している DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:length(param1)+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:length(param2)+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_p <- rank(out[,5]) #p値でランキングした結果をrank_pに格納 out <- cbind(out, rank_p) #rank_pの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "p-value", "FDR(BH)", "FDR(Storey)", "rank(p-value)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。2. サンプルデータ2のSupplementaryTable2_changed.txtを用いる場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 param4 <- "LRT" #方法を指定 library(DEGseq) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data_A <- cbind(rownames(data), data[,1:param1]) #A群の発現データを抽出してdata_Aに格納している data_B <- cbind(rownames(data), data[,(param1+1):(param1+param2)])#B群の発現データを抽出してdata_Bに格納している data_A <- as.matrix(data_A) #データの型をmatrixとしている data_B <- as.matrix(data_B) #データの型をmatrixとしている DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:param1+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:param2+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_p <- rank(out[,5]) #p値でランキングした結果をrank_pに格納 out <- cbind(out, rank_p) #rank_pの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "p-value", "FDR(BH)", "FDR(Storey)", "rank(p-value)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Marioni et al., Genome Res., 2008)
in_f <- "SupplementaryTable2.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- c(7, 9, 12, 15, 18) #A群のサンプルが何列目にあるかを指定 param2 <- c(8, 10, 11, 13, 16) #B群のサンプルが何列目にあるかを指定 param3 <- 1 #in_f中の何列目に遺伝子名に相当する情報があるかを指定 param4 <- "FC" #方法を指定 library(DEGseq) #パッケージの読み込み data_A <- readGeneExp(file = in_f, geneCol=param3, valCol=param1)#A群の発現データのみ抽出してdata_Aに格納している data_B <- readGeneExp(file = in_f, geneCol=param3, valCol=param2)#B群の発現データのみ抽出してdata_Bに格納している DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:length(param1)+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:length(param2)+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_FC <- rank(-abs(out[,4])) #「正規化後のlog(FC)」の絶対値でランキングした結果をrank_FCに格納 out <- cbind(out, rank_FC) #rank_FCの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "rank(log2(A/B)_normalized)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。2. サンプルデータ2のSupplementaryTable2_changed.txtを用いる場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 param4 <- "FC" #方法を指定 library(DEGseq) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data_A <- cbind(rownames(data), data[,1:param1]) #A群の発現データを抽出してdata_Aに格納している data_B <- cbind(rownames(data), data[,(param1+1):(param1+param2)])#B群の発現データを抽出してdata_Bに格納している data_A <- as.matrix(data_A) #データの型をmatrixとしている data_B <- as.matrix(data_B) #データの型をmatrixとしている DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:param1+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:param2+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_FC <- rank(-abs(out[,4])) #「正規化後のlog(FC)」の絶対値でランキングした結果をrank_FCに格納 out <- cbind(out, rank_FC) #rank_FCの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "rank(log2(A/B)_normalized)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。参考文献2(Marioni et al., Genome Res., 2008)
in_f <- "SupplementaryTable2.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- c(7, 9, 12, 15, 18) #A群のサンプルが何列目にあるかを指定 param2 <- c(8, 10, 11, 13, 16) #B群のサンプルが何列目にあるかを指定 param3 <- 1 #in_f中の何列目に遺伝子名に相当する情報があるかを指定 param4 <- "MARS" #方法を指定 library(DEGseq) #パッケージの読み込み data_A <- readGeneExp(file = in_f, geneCol=param3, valCol=param1)#A群の発現データのみ抽出してdata_Aに格納している data_B <- readGeneExp(file = in_f, geneCol=param3, valCol=param2)#B群の発現データのみ抽出してdata_Bに格納している DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:length(param1)+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:length(param2)+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_Z <- rank(-abs(out[,5])) #Zスコアの絶対値でランキングした結果をrank_Zに格納 out <- cbind(out, rank_Z) #rank_Zの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "z-score", "p-value", "FDR(BH)", "FDR(Storey)", "rank(z-score)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。2. サンプルデータ2のSupplementaryTable2_changed.txtを用いる場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定 param1 <- 5 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 param4 <- "MARS" #方法を指定 library(DEGseq) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data_A <- cbind(rownames(data), data[,1:param1]) #A群の発現データを抽出してdata_Aに格納している data_B <- cbind(rownames(data), data[,(param1+1):(param1+param2)])#B群の発現データを抽出してdata_Bに格納している data_A <- as.matrix(data_A) #データの型をmatrixとしている data_B <- as.matrix(data_B) #データの型をmatrixとしている DEGexp(geneExpMatrix1=data_A, geneCol1=1, expCol1=2:param1+1, groupLabel1="A",#以下の3行でMARSを実行している geneExpMatrix2=data_B, geneCol2=1, expCol2=2:param2+1, groupLabel2="B", #groupLabelのところでは"A"とか"B"とか書いているが特に気にしなくてよい。 method=param4, outputDir=getwd()) #このDEGexp()関数はデフォルトで「"output"というディレクトリ、"output_score.txt"、"output.html"」を出力する tmp <- read.table("output_score.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記までの手続きでoutput_score.txtというファイルが自動生成されるので、不必要な部分を削除すべくそれを読み込んでいる out <- tmp[,1:(ncol(tmp)-1)] #output_score.txt中の最終列以外の情報を抽出して、outに格納 out <- out[data_A[,1],] #「out中の行の並び」を「in_fで指定した入力ファイル中の行の並び」に変更 rank_Z <- rank(-abs(out[,5])) #Zスコアの絶対値でランキングした結果をrank_Zに格納 out <- cbind(out, rank_Z) #rank_Zの情報もoutの右側に追加 colnames(out) <- c("sum(A)", "sum(B)", "log2(A/B)", "log2(A/B)_normalized", "z-score", "p-value", "FDR(BH)", "FDR(Storey)", "rank(z-score)")#列名情報を与えている tmp2 <- cbind(rownames(out), out) #おまじない write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Wang et al., Bioinformatics, 2010)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge1.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 tmp <- cbind(rownames(data), data, out$table, stat_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. MA-plotも描く場合
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge2.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 tmp <- cbind(rownames(data), data, out$table, stat_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #MA-plotを描画 plotSmear(d) #MA-plotの基本形(縦軸(M):log-ratio, 横軸(A):全体的な発現レベル)3. MA-plotも描く場合(FDR < 0.05を満たすものを赤色で示す)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge3.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 0.05 #MA-plot描画時のFDRの閾値を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 tmp <- cbind(rownames(data), data, out$table, stat_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #MA-plotを描画 obj <- rownames(data)[stat_edgeR < param3] #param3で指定したFDRの閾値を満たす遺伝子名情報をobjに格納 plotSmear(d, de.tags=obj) #MA-plotの基本形に加え、発現変動遺伝子に相当する length(obj) #発現変動遺伝子数を表示 length(obj)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示4. MA-plotも描く場合(FDR値で発現変動順に並べた上位300個を赤色で示す)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge4.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 300 #MA-plot描画時の赤色で示す上位遺伝子数の閾値を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 tmp <- cbind(rownames(data), data, out$table, stat_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #MA-plotを描画 obj <- rownames(data)[rank(stat_edgeR) <= param3] #param3で指定した個数の上位遺伝子の遺伝子名情報をobjに格納 plotSmear(d, de.tags=obj) #MA-plotの基本形に加え、発現変動遺伝子に相当する length(obj) #発現変動遺伝子数を表示 length(obj)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示5. MA-plotも描く場合(2倍以上発現変化しているものを赤色で示す)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge5.txt" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 2 #MA-plot描画時の倍率変化の閾値を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 tmp <- cbind(rownames(data), data, out$table, stat_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #MA-plotを描画 obj <- rownames(data)[abs(out$table$logFC) >= log2(param3)] #param3で指定した倍率変化の閾値を満たす遺伝子名情報をobjに格納 plotSmear(d, de.tags=obj) #MA-plotの基本形に加え、発現変動遺伝子に相当する length(obj) #発現変動遺伝子数を表示 length(obj)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示6. MA-plotも描く場合(5.のMA-plotで大きさを指定してpng形式ファイルに保存したいとき)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge6.txt" #出力ファイル名を指定 out_f2 <- "hoge6.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 2 #MA-plot描画時の倍率変化の閾値を指定 param4 <- c(600, 400) #MA-plotのファイル出力時の横幅(単位はピクセル)と縦幅を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 tmp <- cbind(rownames(data), data, out$table, stat_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」を結合した結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #MA-plotを描画 png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 obj <- rownames(data)[abs(out$table$logFC) >= log2(param3)] #param3で指定した倍率変化の閾値を満たす遺伝子名情報をobjに格納 plotSmear(d, de.tags=obj) #MA-plotの基本形に加え、発現変動遺伝子に相当する dev.off() #おまじない length(obj) #発現変動遺伝子数を表示 length(obj)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示7. MA-plotも描く場合(FDR < 0.01を満たすものを赤色で示したMA-plotをファイルに保存)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge7.txt" #出力ファイル名を指定 out_f2 <- "hoge7.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param4 <- c(600, 400) #MA-plotのファイル出力時の横幅(単位はピクセル)と縦幅を指定 #必要なパッケージをロード library(DEGseq) #パッケージの読み込み library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 rank_edgeR <- rank(stat_edgeR) #FDR値でランキングした結果をrank_edgeRに格納 hoge <- cbind(rownames(data), data, out$table, stat_edgeR, rank_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」、「順位」を結合した結果をhogeに格納 tmp <- hoge[order(rank_edgeR),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #MA-plotを描画 png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 obj <- rownames(data)[stat_edgeR < param3] #param3で指定したFDRの閾値を満たす遺伝子名情報をobjに格納 plotSmear(d, de.tags=obj) #MA-plotの基本形に加え、発現変動遺伝子に相当する dev.off() #おまじない #おまけ length(obj) #発現変動遺伝子数を表示 length(obj)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示8. MA-plotも描く場合(基本は7と同じで、MA-plotの描画をplotSmear関数を用いないで行うやり方)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge8.txt" #出力ファイル名を指定 out_f2 <- "hoge8.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param4 <- c(600, 400) #MA-plotのファイル出力時の横幅(単位はピクセル)と縦幅を指定 #必要なパッケージをロード library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 rank_edgeR <- rank(stat_edgeR) #FDR値でランキングした結果をrank_edgeRに格納 hoge <- cbind(rownames(data), data, out$table, stat_edgeR, rank_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」、「順位」を結合した結果をhogeに格納 tmp <- hoge[order(rank_edgeR),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 norm_f_RPM <- 1000000/colSums(data) #各列に対して掛ける正規化係数を計算してnorm_f_RPMに格納 RPM <- sweep(data, 2, norm_f_RPM, "*") #norm_f_RPMを各列に掛けた結果をRPMに格納 data <- RPM #RPMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_edgeR < param3) #param3で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示9. MA-plotも描く場合(基本は8と同じで、MA-plotの描画をRPMではなくTMM正規化後のデータで行うやり方)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f1 <- "hoge9.txt" #出力ファイル名を指定 out_f2 <- "hoge9.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 0.01 #MA-plot描画時のFDRの閾値を指定 param4 <- c(600, 400) #MA-plotのファイル出力時の横幅(単位はピクセル)と縦幅を指定 #必要なパッケージをロード library(edgeR) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data <- as.matrix(data) #データの型をmatrixにしている data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 RAW <- data #dataをRAWに格納 #edgeRを用いてDEGの検出を実行 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化(参考文献5)を実行 d <- estimateCommonDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でcommon dispersionを計算している d <- estimateTagwiseDisp(d) #the quantile-adjusted conditional maximum likelihood (qCML)法でmoderated tagwise dispersionを計算している out <- exactTest(d) #exact test (正確確率検定)で発現変動遺伝子を計算した結果をoutに格納 stat_edgeR <- p.adjust(out$table$PValue, method="BH") #False Discovery Rate (FDR)を計算し、結果をstat_edgeRに格納 rank_edgeR <- rank(stat_edgeR) #FDR値でランキングした結果をrank_edgeRに格納 hoge <- cbind(rownames(data), data, out$table, stat_edgeR, rank_edgeR) #入力データの右側に、「logConc (M-A plotのAに相当するもの;全体的な発現レベルに相当)」、「logFC (M-A plotのMに相当するもの;いわゆるlog ratioと同じもの)」、「p値」、「(Benjamini and Hochbergの方法で計算した)FDR値」、「順位」を結合した結果をhogeに格納 tmp <- hoge[order(rank_edgeR),] #発現変動の度合いでソートした結果をtmpに格納 write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f1で指定したファイル名で保存。 #RPM正規化後のデータでM-A plotを描画(するための基礎情報取得) data <- RAW #RAWをdataに格納 d <- DGEList(counts=data, group=data.cl) #DGEListオブジェクトを作成してdに格納 d <- calcNormFactors(d) #TMM正規化係数を計算 norm_f_TMM <- d$samples$norm.factors #TMM正規化係数の情報を抽出してnorm_f_TMMに格納 names(norm_f_TMM) <- colnames(data) #norm_f_TMMのnames属性をcolnames(data)で与えている effective_libsizes <- colSums(data) * norm_f_TMM #effective library sizesというのはlibrary sizesに(TMM)正規化係数を掛けたものなのでそれを計算した結果をeffective_libsizesに格納 RPM_TMM <- sweep(data, 2, 1000000/effective_libsizes, "*") #元のカウントデータをeffective_libsizesで割り(RPMデータと同程度の数値分布にしたいので)1000000を掛けた正規化後のデータをRPM_TMMに格納 data <- RPM_TMM #RPM_TMMをdataに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) DEG_posi <- (stat_edgeR < param3) #param3で指定した閾値未満のものの位置情報をDEG_posiに格納 #MA-plotを描画(本番) png(out_f2, width=param4[1], height=param4[2]) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 points(x_axis[DEG_posi], y_axis[DEG_posi], col="red", pch=20, cex=0.1)#DEGを赤色にしている dev.off() #おまじない #おまけ sum(DEG_posi) #発現変動遺伝子数を表示 sum(DEG_posi)/nrow(data) #発現変動遺伝子の全遺伝子数に占める割合を表示参考文献1(Robinson et al., Bioinformatics, 2010)
Rコードのあるウェブサイト
Rスクリプトのwebページ
Young et al., Genome Biol., 2010
library(DiffBind) #パッケージの読み込み
library(ChIPseqR) #パッケージの読み込み
library(chipseq) #パッケージの読み込み
library(PICS) #パッケージの読み込み
参考文献1(Zhang et al., Biometrics, 2011)
library(ChIPpeakAnno) #パッケージの読み込み
BioconductorのChIPpeakAnnoのwebページ
参考文献1(Zhu et al., BMC Bioinformatics, 2010)
library(rMAT) #パッケージの読み込み
参考文献1(Droit et al., Bioinformatics, 2010)
library(CSAR) #パッケージの読み込み
参考文献1(Kaufmann et al., PLoS Biol., 2009)
library(ChIPsim) #パッケージの読み込み
参考文献1(Zhang et al., PLoS Comput. Biol., 2008)
library(rGADEM) #パッケージの読み込み
参考文献1(Li L, J. Comput. Biol., 2009)
library(r3Cseq) #パッケージの読み込み
library(REDseq) #パッケージの読み込み
参考文献1(Zhu et al., 準備中だそうで)
library(segmentSeq) #パッケージの読み込み
BioconductorのsegmentSeqのwebページ
参考文献1(Hardcastle et al., Bioinformatics, Dec. 6, 2011 accepted)
library(ggplot2) #パッケージの読み込み
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #M-A plot本番 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 #以下は(こんなこともできますという)おまけ #縦軸の任意の位置に赤で水平線を引きたい param3 <- 1 #縦軸の任意の値(つまりこの場合は2倍の発現量の差に相当)をparam3に格納 abline(h=param3, col="red", lwd=1) #param3で指定したy軸上の値で横線を引く(lwdの値を大きくするほど線が太くなる;横線を引きたいときはh=param3で、縦線を引きたいときはv=param3にするとよい)2. raw countのデータ(サイズを指定してpng形式で保存したいとき):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge2.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 600 #横幅(単位はピクセル)を指定 param4 <- 400 #縦幅(単位はピクセル)を指定 #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #M-A plot本番 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) png(out_f, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid() #grid線を追加している dev.off() #おまじない3. raw countのデータ(2を基本としてy軸の範囲をparam5で指定したいとき):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge3.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 600 #横幅(単位はピクセル)を指定 param4 <- 400 #縦幅(単位はピクセル)を指定 param5 <- c(-5, 5) #y軸の任意の範囲を指定 #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #M-A plot本番 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) png(out_f, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1, ylim=param5)#MA-plotを描画 dev.off() #おまじない4. raw countのデータ(3を基本としてグリッドをparam6で指定した色およびparam7で指定した線のタイプで表示させたいとき):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge4.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 600 #横幅(単位はピクセル)を指定 param4 <- 400 #縦幅(単位はピクセル)を指定 param5 <- c(-5, 5) #y軸の任意の範囲を指定 param6 <- "gray" #グリッドの色(red, black, blue, and so on)を指定 param7 <- "solid" #グリッド線のタイプ("dotted", "solid", ...)を指定 #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #M-A plot本番 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) png(out_f, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1, ylim=param5)#MA-plotを描画 grid(col=param6, lty=param7) #param6, 7で指定したパラメータでグリッドを表示 dev.off() #おまじない5. raw countのデータ(4を基本としてparam8で指定した任意のIDがどのあたりにあるかをparam9で指定した色で表示):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge5.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 600 #横幅(単位はピクセル)を指定 param4 <- 400 #縦幅(単位はピクセル)を指定 param5 <- c(-8, 8) #y軸の任意の範囲を指定 param6 <- "gray" #グリッドの色(red, black, blue, and so on)を指定 param7 <- "dotted" #グリッド線のタイプ("dotted", "solid", ...)を指定 param8 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")#任意のIDを指定 param9 <- "red" #色を指定 #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #M-A plot本番 obj <- is.element(rownames(data), param8) #param8で指定したIDの位置情報をobjに格納 meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) png(out_f, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1, ylim=param5)#MA-plotを描画 grid(col=param6, lty=param7) #param6, 7で指定したパラメータでグリッドを表示 points(x_axis[obj], y_axis[obj], col=param9) #param8で指定したGene symbolsに相当する点をparam9で指定した色で表示 dev.off() #おまじない #以下は(こんなこともできますという)おまけ data[obj,] #param8で指定したIDの発現データを表示6. raw countのデータ(4を基本としてparam8で指定した原著論文中でRT-PCRで発現変動が確認された7遺伝子のGene symbolsがどのあたりにあるかをparam9で指定した色で表示): 一見ややこしくて回りくどい感じですが、以下のような事柄に対処するために、ここで記述しているような集合演算テクニック(intersect, is.element (or %in%))を駆使することは非常に大事です: a) 一つのgene symbolが複数のEnsembl Gene IDsに対応することがよくある。 b) BioMartなどから取得したIDの対応関係情報を含むアノテーションファイル(ens_gene_48.txt)中に、原著論文で言及されparam8で指定したgene symbolsが存在しない。 c) 読み込んだ発現データファイル中にはあるがアノテーションファイル中には存在しないIDがある。
in_f1 <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_f1に格納 in_f2 <- "ens_gene_48.txt" #アノテーション情報ファイルを指定してin_f2に格納 out_f <- "hoge6.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 600 #横幅(単位はピクセル)を指定 param4 <- 400 #縦幅(単位はピクセル)を指定 param5 <- c(-8, 8) #y軸の任意の範囲を指定 param6 <- "gray" #グリッドの色(red, black, blue, and so on)を指定 param7 <- "dotted" #グリッド線のタイプ("dotted", "solid", ...)を指定 param8 <- c("MMP25","SLC5A1","MDK","GPR64","CD38","GLOD5","FBXL6")#RT-PCRで発現変動が確認されたGene symbolsを指定 param9 <- "red" #色を指定 #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 tmp <- read.table(in_f2, header=TRUE, sep="\t", quote="") #アノテーション情報ファイルの読み込み gs_annot <- tmp[,5] #5列目(HGNC symbol)の情報をgs_annotに格納 names(gs_annot) <- tmp[,1] #gs_annotとIDを対応づけている gs_annot_sub <- intersect(gs_annot, param8) #param8で指定したgene symbolsとアノテーションファイル中のgene symbolsの積集合をgs_annot_subに格納(結果としてparam8と同じ情報になるが、アノテーションファイル中にないものをparam8で指定する可能性もあるためです) obj_annot <- is.element(gs_annot, gs_annot_sub) #gs_annot_subで指定したgene symbolsのアノテーションファイル中における位置情報をobj_annotに格納(「obj_annot <- gs_annot %in% gs_annot_sub」と同じ意味) ensembl_annot_gs <- unique(names(gs_annot)[obj_annot]) #アノテーションファイル中のobj_annotに対応する位置にあるEnsembl IDsをensembl_annot_gsに格納 ensembl_data_gs <- intersect(rownames(data), ensembl_annot_gs) #ensembl_annot_gsで指定したEnsembl IDsと発現データファイル中のEnsembl IDsの積集合をensembl_data_gs obj <- is.element(rownames(data), ensembl_data_gs) #発現データファイル中のensembl_data_gsに対応する位置にあるEnsembl IDsをobjに格納 (「obj <- rownames(data) %in% ensembl_data_gs」と同じ意味) meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) png(out_f, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1, ylim=param5)#MA-plotを描画 grid(col=param6, lty=param7) #param6, 7で指定したパラメータでグリッドを表示 points(x_axis[obj], y_axis[obj], col=param9) #param8で指定したGene symbolsに相当する点をparam9で指定した色で表示 dev.off() #おまじない #以下は(こんなこともできますという)おまけ ensembl_data_gs #param8で指定したGene symbolsに対応するEnsembl Gene IDを表示 data[obj,] #param8で指定したGene symbolsの発現データを表示7. RPMデータ(library size normalizationを行ったデータでMA-plot)の場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 out_f <- "hoge7.png" #出力ファイル名を指定 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- 600 #横幅(単位はピクセル)を指定 param4 <- 400 #縦幅(単位はピクセル)を指定 #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #RPM補正とM-A plot本番 RPM <- sweep(data, 2, 1000000/colSums(data), "*") #RPM補正した結果をRPMに格納 data <- RPM #オブジェクトRPMの情報をdataに代入している meanA <- log2(apply(as.matrix(data[,data.cl==1]), 1, mean)) #遺伝子ごとにA群の平均の対数を計算した結果をmeanAに格納 meanB <- log2(apply(as.matrix(data[,data.cl==2]), 1, mean)) #遺伝子ごとにB群の平均の対数を計算した結果をmeanBに格納 x_axis <- (meanA + meanB)/2 #「A群の平均値」と「B群の平均値」の平均をとったものがM-A plotのA(x軸の値)に相当するものなのでx_axisに格納) y_axis <- meanB - meanA #いわゆるlog比(logの世界での引き算)がM-A plotのM(y軸の値)に相当するものなのでy_axisに格納) png(out_f, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(x_axis, y_axis, xlab="A = (log2(B)+log2(A))/2", ylab="M = log2(B)-log2(A)", pch=20, cex=.1)#MA-plotを描画 grid() #grid線を追加している dev.off() #おまじない参考文献1(Marioni et al., Genome Res., 2008)
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")#任意のIDを指定 param4 <- "False Positive Rate (FPR)" #ROC曲線の図のx軸ラベルを指定 param5 <- "True Positive Rate (TPR)" #ROC曲線の図のy軸ラベルを指定 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_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Step1: 任意のランキング法を用いて順位情報を取得 groups <- list(NDE=rep(1, (param_A+param_B)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_bayseq <- out@posteriors[,2] #DEのposterior likelihoodをstat_bayseqに格納 rank_bayseq <- rank(-stat_bayseq, ties.method="min") #stat_bayseqでランキングした結果をrank_bayseqに格納 #Step2: 「真の発現変動遺伝子」に相当する行に1を、それ以外を0としたベクトルを作成 obj <- is.element(rownames(data), param3) #param3で指定したIDの位置情報をobjに格納 obj[obj == "TRUE"] <- 1 #TRUE or FALSEの情報から1 or 0の情報に変換 #Step3: ROC曲線描画 out <- rocdemo.sca(truth = obj, data =-rank_bayseq) #ROC曲線描画用の形式にしてoutに格納 plot(out, xlab=param4, ylab=param5, main=param6) #描画 #以下は(こんなこともできますという)おまけ AUC(out) #AUC値を計算2. 「1.を基本としつつ、さらにもう一つのランキング法を実行して、二つのROC曲線を重ね書きしたい」場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")#任意のIDを指定 param4 <- "False Positive Rate (FPR)" #ROC曲線の図のx軸ラベルを指定 param5 <- "True Positive Rate (TPR)" #ROC曲線の図のy軸ラベルを指定 param6 <- "ROC curves for raw count data" #図のタイトルを指定 #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #おまじない(関数ADの呼び出しのため) library(ROC) #パッケージの読み込み library(baySeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Step1-1: 任意のランキング法1(baySeq)を用いて順位情報を取得 groups <- list(NDE=rep(1, (param_A+param_B)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_bayseq <- out@posteriors[,2] #DEのposterior likelihoodをstat_bayseqに格納 rank_bayseq <- rank(-stat_bayseq, ties.method="min") #stat_bayseqでランキングした結果をrank_bayseqに格納 #Step1-2: 任意のランキング法2(AD; logratio)を用いて順位情報を取得 datalog <- log2(data + 1) #生データに1足してlogをとったものをdatalogに格納 stat_AD <- AD(data=datalog, data.cl=data.cl) #AD統計量(ただのlogの世界でのAverage Difference)を計算して結果をstat_ADに格納 rank_AD <- rank(-abs(stat_AD), ties.method="min") #stat_ADでランキングした結果をrank_ADに格納 #Step2: 「真の発現変動遺伝子」に相当する行に1を、それ以外を0としたベクトルを作成 obj <- is.element(rownames(data), param3) #param3で指定したIDの位置情報をobjに格納 obj[obj == "TRUE"] <- 1 #TRUE or FALSEの情報から1 or 0の情報に変換 #Step3: ROC曲線描画 out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq) #ランキング法1の結果をROC曲線描画用の形式にしてout1に格納 plot(out1, axes=F, ann=F) #軸の数値情報およびラベル情報を描画しない(axes=Fとann=F)設定にして描画 par(new=T) #上書きします、という宣言 out2 <- rocdemo.sca(truth = obj, data =-rank_AD) #ランキング法2の結果をROC曲線描画用の形式にしてout2に格納 plot(out2, xlab=param4, ylab=param5, main=param6) #描画 #以下は(こんなこともできますという)おまけ AUC(out) #AUC値を計算3. 「2.を基本としつつ、ランキング法ごとに指定した色にしたい」場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")#任意のIDを指定 param4 <- "False Positive Rate (FPR)" #ROC曲線の図のx軸ラベルを指定 param5 <- "True Positive Rate (TPR)" #ROC曲線の図のy軸ラベルを指定 param6 <- "ROC curves for raw count data" #図のタイトルを指定 param7 <- c( 0, 0, 0) #ランキング法1の色をRGBで指定 param8 <- c(255, 0, 0) #ランキング法2の色をRGBで指定 #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #おまじない(関数ADの呼び出しのため) library(ROC) #パッケージの読み込み library(baySeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Step1-1: 任意のランキング法1(baySeq)を用いて順位情報を取得 groups <- list(NDE=rep(1, (param_A+param_B)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_bayseq <- out@posteriors[,2] #DEのposterior likelihoodをstat_bayseqに格納 rank_bayseq <- rank(-stat_bayseq, ties.method="min") #stat_bayseqでランキングした結果をrank_bayseqに格納 #Step1-2: 任意のランキング法2(AD; logratio)を用いて順位情報を取得 datalog <- log2(data + 1) #生データに1足してlogをとったものをdatalogに格納 stat_AD <- AD(data=datalog, data.cl=data.cl) #AD統計量(ただのlogの世界でのAverage Difference)を計算して結果をstat_ADに格納 rank_AD <- rank(-abs(stat_AD), ties.method="min") #stat_ADでランキングした結果をrank_ADに格納 #Step2: 「真の発現変動遺伝子」に相当する行に1を、それ以外を0としたベクトルを作成 obj <- is.element(rownames(data), param3) #param3で指定したIDの位置情報をobjに格納 obj[obj == "TRUE"] <- 1 #TRUE or FALSEの情報から1 or 0の情報に変換 #Step3: ROC曲線描画 out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq) #ランキング法1の結果をROC曲線描画用の形式にしてout1に格納 plot(out1, axes=F, ann=F, col=rgb(param7[1], param7[2], param7[3], max=255))#軸の数値情報およびラベル情報を描画しない(axes=Fとann=F)設定にして描画 par(new=T) #上書きします、という宣言 out2 <- rocdemo.sca(truth = obj, data =-rank_AD) #ランキング法2の結果をROC曲線描画用の形式にしてout2に格納 plot(out2, xlab=param4, ylab=param5, main=param6, col=rgb(param8[1], param8[2], param8[3], max=255))#描画 #以下は(こんなこともできますという)おまけ AUC(out1) #ランキング法1のAUC値を計算 AUC(out2) #ランキング法2のAUC値を計算4. 「3.を基本としつつ、legendも追加したい(ここではとりあえず「lwd=1」としてますが線分の形式をいろいろ変えることができます(詳細はこちら))」場合:
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")#任意のIDを指定 param4 <- "False Positive Rate (FPR)" #ROC曲線の図のx軸ラベルを指定 param5 <- "True Positive Rate (TPR)" #ROC曲線の図のy軸ラベルを指定 param6 <- "ROC curves for raw count data" #図のタイトルを指定 param7 <- c( 0, 0, 0) #ランキング法1の色をRGBで指定 param8 <- c(255, 0, 0) #ランキング法2の色をRGBで指定 param9 <- "baySeq" #legend用のランキング法1の名前を指定 param10 <- "AD" #legend用のランキング法2の名前を指定 #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #おまじない(関数ADの呼び出しのため) library(ROC) #パッケージの読み込み library(baySeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Step1-1: 任意のランキング法1(baySeq)を用いて順位情報を取得 groups <- list(NDE=rep(1, (param_A+param_B)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_bayseq <- out@posteriors[,2] #DEのposterior likelihoodをstat_bayseqに格納 rank_bayseq <- rank(-stat_bayseq, ties.method="min") #stat_bayseqでランキングした結果をrank_bayseqに格納 #Step1-2: 任意のランキング法2(AD; logratio)を用いて順位情報を取得 datalog <- log2(data + 1) #生データに1足してlogをとったものをdatalogに格納 stat_AD <- AD(data=datalog, data.cl=data.cl) #AD統計量(ただのlogの世界でのAverage Difference)を計算して結果をstat_ADに格納 rank_AD <- rank(-abs(stat_AD), ties.method="min") #stat_ADでランキングした結果をrank_ADに格納 #Step2: 「真の発現変動遺伝子」に相当する行に1を、それ以外を0としたベクトルを作成 obj <- is.element(rownames(data), param3) #param3で指定したIDの位置情報をobjに格納 obj[obj == "TRUE"] <- 1 #TRUE or FALSEの情報から1 or 0の情報に変換 #Step3: ROC曲線描画 out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq) #ランキング法1の結果をROC曲線描画用の形式にしてout1に格納 plot(out1, axes=F, ann=F, col=rgb(param7[1], param7[2], param7[3], max=255))#軸の数値情報およびラベル情報を描画しない(axes=Fとann=F)設定にして描画 par(new=T) #上書きします、という宣言 out2 <- rocdemo.sca(truth = obj, data =-rank_AD) #ランキング法2の結果をROC曲線描画用の形式にしてout2に格納 plot(out2, xlab=param4, ylab=param5, main=param6, col=rgb(param8[1], param8[2], param8[3], max=255))#描画 legend(0.6, 0.3, #legendの左上の開始点がx軸0.6y軸0.3の座標となるようにしてlegendを描画 c(param9, param10), #param9, 10で指定した方法名を描画 col=c(rgb(param7[1], param7[2], param7[3], max=255), #param7指定した方法の色を描画 rgb(param8[1], param8[2], param8[3], max=255) #param8指定した方法の色を描画 ), #色指定のところは終了 lwd=1, #線の幅を指定(大きな値-->太い線) merge=TRUE #TRUEにすると図の右端の線にかぶらない ) #legendの各種パラメータ指定終了 #以下は(こんなこともできますという)おまけ AUC(out1) #ランキング法1のAUC値を計算 AUC(out2) #ランキング法2のAUC値を計算5. 「4」と同じ結果だがパラメータの指定法が違う場合(多数の方法を一度に描画するときに便利です):
in_f <- "SupplementaryTable2_changed.txt" #読み込みたい発現データファイルを指定してin_fに格納 param_A <- 5 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 param3 <- c("ENSG00000004468","ENSG00000182325","ENSG00000110492","ENSG00000008516","ENSG00000100170","ENSG00000173698","ENSG00000171433")#任意のIDを指定 param4 <- "False Positive Rate (FPR)" #ROC曲線の図のx軸ラベルを指定 param5 <- "True Positive Rate (TPR)" #ROC曲線の図のy軸ラベルを指定 param6 <- "ROC curves for raw count data" #図のタイトルを指定 param7 <- list("baySeq", c( 0, 0, 0)) #ランキング法1の「方法名」と「色をRGB」で指定 param8 <- list("AD", c(255, 0, 0)) #ランキング法2の「方法名」と「色をRGB」で指定 #必要なパッケージをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #おまじない(関数ADの呼び出しのため) library(ROC) #パッケージの読み込み library(baySeq) #パッケージの読み込み #発現データの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データファイルの読み込み data.cl <- c(rep(1, param_A), rep(2, param_B)) #A群を1、B群を2としたベクトルdata.clを作成 #Step1-1: 任意のランキング法1(baySeq)を用いて順位情報を取得 groups <- list(NDE=rep(1, (param_A+param_B)), DE=data.cl) #このデータセット中には発現変動遺伝子群(DE)とそうでないもの(NDE)が含まれているという情報をgroupsオブジェクトに格納 data1 <- new("countData", data=as.matrix(data), replicates=data.cl, libsizes=as.integer(colSums(data)), groups=groups)#countDataオブジェクト形式にしてdata1に格納 data1P.NB <- getPriors.NB(data1, samplesize=1000, estimation="QL", cl=NULL)#事前パラメータの推定 out <- getLikelihoods.NB(data1P.NB, pET="BIC", cl=NULL) #事後確率を計算 out@estProps #発現変動(DE)遺伝子がデータの中にどの程度含まれていたかを表示(右側の数値;ちなみに左側の数値はNDEの割合を示す) stat_bayseq <- out@posteriors[,2] #DEのposterior likelihoodをstat_bayseqに格納 rank_bayseq <- rank(-stat_bayseq, ties.method="min") #stat_bayseqでランキングした結果をrank_bayseqに格納 #Step1-2: 任意のランキング法2(AD; logratio)を用いて順位情報を取得 datalog <- log2(data + 1) #生データに1足してlogをとったものをdatalogに格納 stat_AD <- AD(data=datalog, data.cl=data.cl) #AD統計量(ただのlogの世界でのAverage Difference)を計算して結果をstat_ADに格納 rank_AD <- rank(-abs(stat_AD), ties.method="min") #stat_ADでランキングした結果をrank_ADに格納 #Step2: 「真の発現変動遺伝子」に相当する行に1を、それ以外を0としたベクトルを作成 obj <- is.element(rownames(data), param3) #param3で指定したIDの位置情報をobjに格納 obj[obj == "TRUE"] <- 1 #TRUE or FALSEの情報から1 or 0の情報に変換 #Step3: ROC曲線描画 out1 <- rocdemo.sca(truth = obj, data =-rank_bayseq) #ランキング法1の結果をROC曲線描画用の形式にしてout1に格納 plot(out1, axes=F, ann=F, col=rgb(param7[[2]][1], param7[[2]][2], param7[[2]][3], max=255))#軸の数値情報およびラベル情報を描画しない(axes=Fとann=F)設定にして描画 par(new=T) #上書きします、という宣言 out2 <- rocdemo.sca(truth = obj, data =-rank_AD) #ランキング法2の結果をROC曲線描画用の形式にしてout2に格納 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, #legendの左上の開始点がx軸0.6y軸0.3の座標となるようにしてlegendを描画 c(param7[[1]], param8[[1]]), #param9, 10で指定した方法名を描画 col=c(rgb(param7[[2]][1], param7[[2]][2], param7[[2]][3], max=255),#param7指定した方法の色を描画 rgb(param8[[2]][1], param8[[2]][2], param8[[2]][3], max=255) #param8指定した方法の色を描画 ), #色指定のところは終了 lwd=1, #線の幅を指定(大きな値-->太い線) merge=TRUE #TRUEにすると図の右端の線にかぶらない ) #legendの各種パラメータして終了 #以下は(こんなこともできますという)おまけ AUC(out1) #ランキング法1のAUC値を計算 AUC(out2) #ランキング法2のAUC値を計算参考文献1(Kadota et al., AMB, 2008)
############################ ### 1. Illuminaのqseq形式のファイルを含むフォルダを指定してfastq形式ファイルで保存 ############################ qseq2fastq.pl sampleA sampleA.fq qseq2fastq.pl sampleB sampleB.fq ############################ ### 2. おまじない(マップするゲノム配列の前処理) ############################ bowtie-build -f ref_genome.fa ref_genome ############################ ### 3. ゲノムにマッピング(mismatchを許容しないで、複数個所にマップされず一か所にのみマップされるものを採用) ############################ ( bowtie --offrate 3 -p 8 -a --best --strata -v 0 -m 1 -t --sam ref_genome -q sampleA.fq > sampleA.sam ) >& sampleA.samlog ( bowtie --offrate 3 -p 8 -a --best --strata -v 0 -m 1 -t --sam ref_genome -q sampleB.fq > sampleB.sam ) >& sampleB.samlog ############################ ### 4. ファイル形式の変換 ############################ sam2bed.pl sampleA.sam sampleA.bed sam2bed.pl sampleB.sam sampleB.bed ############################ ### 5. マップされた領域の和集合領域を「発現している領域(エクソン領域のようなイメージ)」としている ############################ cat sampleA.bed sampleB.bed | mergeBed -i stdin > data_merge.bed ############################ ### 6. 各「発現している領域」中に何リードマップされたかカウントしている ############################ intersectBed -a data_merge.bed -b sampleA.bed -c > sampleA.count intersectBed -a data_merge.bed -b sampleB.bed -c > sampleB.count ############################ ### 7. Linux上でRを実行して6のところで作成した*.countファイルを一つずつ読み込んでRPKM値を計算し、結果を*.rpkmというファイル名で保存 ############################ R #Rの起動 in_f <- list.files(pattern=".count") #"*.count"という名前をファイルをin_fに格納(「ls -1 *.count > in_f」みたいなイメージ) for(i in 1:length(in_f)){ #in_fの要素数(*.countのファイル数)分だけループを回す out_f <- paste(unlist(strsplit(in_f[i], ".", fixed=TRUE))[1], "rpkm", sep=".")#出力ファイルを"*.rpkm"に変えてout_fに格納 data <- read.table(in_f[i], header=FALSE, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 raw_counts <- data[,4] #dataの4列目の情報をraw_countsに格納 all_reads <- as.numeric(sum(data[,4])) #dataの4列目の数値の和を実数(as.numeric)としてall_readsに格納 gene_length <- data[,3] - data[,2] #dataの(3列目 - 2列目)の結果ををgene_lengthに格納(BED形式なのでこの計算式でよい) RPKM <- raw_counts*1000000000/(gene_length*all_reads) #RPKM値を計算してRPKMに格納 gene_name <- paste(data[,1], data[,2]+1, data[,3], sep="_") #ゲノム(or コンティグ)上の座標情報をgene_nameとして格納 tmp <- cbind(gene_name, raw_counts, gene_length, all_reads, RPKM)#「gene_name, raw_counts, gene_length, all_reads, RPKM」の順番で、計5列を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 } #一連の作業をin_fの要素数(*.countのファイル数)分だけループを回す q() #Rの終了コマンド n #保存しないで終了 ############################ ### 8. 発現変動遺伝子のランキング (RのDESeqパッケージとWAD法のランキング結果を出力) ### DESeqは内部的に独自の正規化を行っており、配列長由来の偏りに関する補正は行っていない。 ### WADはRPKMのデータを用いてランキングを行っているが、MA-plotで表示させているのは ### DESeq内部補正後のデータなので若干異なった結果となっている。 ############################ R #Rの起動 out_f1 <- "result_DEG.txt" #出力ファイル名を指定 param1 <- 1 #A群のサンプル数を指定 param2 <- 1 #B群のサンプル数を指定 library(DESeq) #パッケージの読み込み data_raw <- NULL #(DESeqはraw countsデータを入力とするので)raw countsデータ格納用プレースホルダ data_rpkm <- NULL #(WADやADはRPKMデータを入力とするので)RPKMデータ格納用プレースホルダ in_f <- list.files(pattern=".rpkm") #"*.rpkm"という名前をファイルをin_fに格納 for(i in 1:length(in_f)){ #in_fの要素数(*.rpkmのファイル数)分だけループを回す data <- read.table(in_f[i], header=TRUE, row.names=1, sep="\t", quote="") #入力ファイルを読み込んでdataに格納 data_raw <- cbind(data_raw, data[,1]) #raw_countsに相当する列の情報をdata_rawの右側の列に追加 data_rpkm <- cbind(data_rpkm, data[,4]) #RPKM値に相当する列の情報をdata_rpkmの右側の列に追加 } #一連の作業をin_fの要素数(*.rpkmのファイル数)分だけループを回す data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 ### 8-1. DESeqのランキング結果を取得 ### cds <- newCountDataSet(data_raw, data.cl) #おまじない(CountDataSetというクラスを作成している cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) cds <- estimateVarianceFunctions(cds, method="blind") #おまじない(ばらつきを計算している) out <- nbinomTest(cds, 1, 2) #発現変動の各種統計量を計算し、結果をoutに格納 logratio <- out$log2FoldChange #log2(B/A)統計量をlogratioに格納 FDR <- out$padj #p値をBenjamini-Hochberg procedureで補正したFDR値をFDRに格納 rank_DESeq <- rank(FDR) #FDR値でランキングした結果をrank_DESeqに格納 ### 8-2. WADのランキング結果を取得 ### datalog <- log2(data_rpkm + 1) #data_rpkmに1足して対数をとったものをdatalogに格納 aveA <- datalog[,data.cl==1] #datalogの行列からdata.clが1に相当する列をaveAに格納 aveB <- datalog[,data.cl==2] #datalogの行列からdata.clが2に相当する列をaveBに格納 average <- (aveA + aveB)/2 #logスケールでの遺伝子(行)ごとの平均発現レベルを計算しaverageに格納 weight <- (average - min(average))/(max(average) - min(average)) #遺伝子(行)ごとの相対発現レベルをweightに格納 stat_WAD <- (aveB - aveA)*weight #WAD統計量を計算してstat_WADに格納 rank_WAD <- rank(-abs(stat_WAD)) #WAD統計量をの順位を計算してrank_WADに格納 tmp <- cbind(rownames(data), data_raw, logratio, FDR, rank_DESeq, stat_WAD, rank_WAD)#raw countsデータの右側に、「lograio」、「DESeqで計算したFDR」、「その順位」、「WAD統計量」、「その順位」を結合した結果をtmpに格納 colnames(tmp) <- c("expressed_resion_ID", "raw_count(sampleA)", "raw_count(sampleB)", "log2(B/A)", "FDR(DESeq)", "rank(DESeq)", "WAD_statistics", "rank(WAD)") write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存 ### 8-3. FDRの任意の閾値を満たす遺伝子(行)数を調べたりMA-plotを描画したり... ### param3 <- 0.01 #FDRの閾値を指定 param4 <- 600 #図のx軸の長さを指定 param5 <- 400 #図のy軸の長さを指定 out_f2 <- "result_DEG.png" #MA-plot用出力ファイル名を指定 png(out_f2, width=param4, height=param5*2) #出力ファイルの各種パラメータを指定 par(mfcol= c(2,1)) #二分割して2行1列でMA-plotを描画 plot(out$baseMean, logratio, log="x", pch=20, cex=.1, col=ifelse(FDR < param3, "red", "black"), xlab="Average expression level", main="DESeq_result")#DESeqの結果を表示 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 DEG_num <- sum(FDR < param3, na.rm=TRUE) #"NA"のものを無視して条件を満たす要素数をDEG_numに格納 legend("topleft", "DEG", col="red", pch=20) #左上のlegendを描画している legend("bottomright", paste("FDR < ", param3, ":", DEG_num)) #右下のlegendを描画している plot(out$baseMean, logratio, log="x", pch=20, cex=.1, col=ifelse(rank_WAD < DEG_num, "red", "black"), xlab="Average expression level", main="WAD_result")#WADの結果を表示 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 dev.off() #おまじない(作図終了宣言) q() #Rの終了コマンド n #保存しないで終了qseq2fastq.pl
############################ ### 1. Illuminaのqseq形式のファイルを含むフォルダを指定してfastq形式ファイルで保存 ############################ qseq2fastq.pl sampleA sampleA.fq qseq2fastq.pl sampleB sampleB.fq ############################ ### 2. おまじない(マップするゲノム配列の前処理) ############################ bowtie-build -f ref_genome.fa ref_genome ############################ ### 3. ゲノムにマッピング(mismatchを許容しないで、複数個所にマップされず一か所にのみマップされるものを採用) ############################ ( bowtie --offrate 3 -p 8 -a --best --strata -v 0 -m 1 -t --sam ref_genome -q sampleA.fq > sampleA.sam ) >& sampleA.samlog ( bowtie --offrate 3 -p 8 -a --best --strata -v 0 -m 1 -t --sam ref_genome -q sampleB.fq > sampleB.sam ) >& sampleB.samlog ############################ ### 4. ファイル形式の変換 ############################ sam2bed.pl sampleA.sam sampleA.bed sam2bed.pl sampleB.sam sampleB.bed ############################ ### 5. マップされた領域の和集合領域を「発現している領域(エクソン領域のようなイメージ)」としている ### "-s"というオプションを加えることで、同じ座標上にマップされたものでも ### +鎖にマップされたものと-鎖にマップされたものを区別することができる ############################ cat sampleA.bed sampleB.bed | mergeBed -i stdin -s > data_merge.bed ############################ ### 6. 各「発現している領域」中に何リードマップされたかカウントしている ### step5のところでstrandの向きを考慮した結果ファイルは、BED形式でなくなっている。 ### そのため、以下は若干ややこしくなっている ############################ grep "+" data_merge.bed > hoge_m grep "+" sampleA.bed > hoge_A intersectBed -a hoge_m -b hoge_A -c > sampleA.count grep "-" data_merge.bed > hoge_m grep "-" sampleA.bed > hoge_A intersectBed -a hoge_m -b hoge_A -c >> sampleA.count grep "+" data_merge.bed > hoge_m grep "+" sampleB.bed > hoge_B intersectBed -a hoge_m -b hoge_B -c > sampleB.count grep "-" data_merge.bed > hoge_m grep "-" sampleB.bed > hoge_B intersectBed -a hoge_m -b hoge_B -c >> sampleB.count ############################ ### 7. Linux上でRを実行して6のところで作成した*.countファイルを一つずつ読み込んでRPKM値を計算し、結果を*.rpkmというファイル名で保存 ############################ R #Rの起動 in_f <- list.files(pattern=".count") #"*.count"という名前をファイルをin_fに格納(「ls -1 *.count > in_f」みたいなイメージ) for(i in 1:length(in_f)){ #in_fの要素数(*.countのファイル数)分だけループを回す out_f <- paste(unlist(strsplit(in_f[i], ".", fixed=TRUE))[1], "rpkm", sep=".")#出力ファイルを"*.rpkm"に変えてout_fに格納 data <- read.table(in_f[i], header=FALSE, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 raw_counts <- data[,4] #dataの4列目の情報をraw_countsに格納 all_reads <- as.numeric(sum(data[,4])) #dataの4列目の数値の和を実数(as.numeric)としてall_readsに格納 gene_length <- data[,3] - data[,2] #dataの(3列目 - 2列目)の結果ををgene_lengthに格納(BED形式なのでこの計算式でよい) RPKM <- raw_counts*1000000000/(gene_length*all_reads) #RPKM値を計算してRPKMに格納 gene_name <- paste(data[,1], data[,2]+1, data[,3], sep="_") #ゲノム(or コンティグ)上の座標情報をgene_nameとして格納 tmp <- cbind(gene_name, raw_counts, gene_length, all_reads, RPKM)#「gene_name, raw_counts, gene_length, all_reads, RPKM」の順番で、計5列を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 } #一連の作業をin_fの要素数(*.countのファイル数)分だけループを回す q() #Rの終了コマンド n #保存しないで終了 ############################ ### 8. 発現変動遺伝子のランキング (RのDESeqパッケージとWAD法のランキング結果を出力) ### DESeqは内部的に独自の正規化を行っており、配列長由来の偏りに関する補正は行っていない。 ### WADはRPKMのデータを用いてランキングを行っているが、MA-plotで表示させているのは ### DESeq内部補正後のデータなので若干異なった結果となっている。 ############################ R #Rの起動 out_f1 <- "result_DEG.txt" #出力ファイル名を指定 param1 <- 1 #A群のサンプル数を指定 param2 <- 1 #B群のサンプル数を指定 library(DESeq) #パッケージの読み込み data_raw <- NULL #(DESeqはraw countsデータを入力とするので)raw countsデータ格納用プレースホルダ data_rpkm <- NULL #(WADやADはRPKMデータを入力とするので)RPKMデータ格納用プレースホルダ in_f <- list.files(pattern=".rpkm") #"*.rpkm"という名前をファイルをin_fに格納 for(i in 1:length(in_f)){ #in_fの要素数(*.rpkmのファイル数)分だけループを回す data <- read.table(in_f[i], header=TRUE, row.names=1, sep="\t", quote="") #入力ファイルを読み込んでdataに格納 data_raw <- cbind(data_raw, data[,1]) #raw_countsに相当する列の情報をdata_rawの右側の列に追加 data_rpkm <- cbind(data_rpkm, data[,4]) #RPKM値に相当する列の情報をdata_rpkmの右側の列に追加 } #一連の作業をin_fの要素数(*.rpkmのファイル数)分だけループを回す data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 ### 8-1. DESeqのランキング結果を取得 ### cds <- newCountDataSet(data_raw, data.cl) #おまじない(CountDataSetというクラスを作成している cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) cds <- estimateVarianceFunctions(cds, method="blind") #おまじない(ばらつきを計算している) out <- nbinomTest(cds, 1, 2) #発現変動の各種統計量を計算し、結果をoutに格納 logratio <- out$log2FoldChange #log2(B/A)統計量をlogratioに格納 FDR <- out$padj #p値をBenjamini-Hochberg procedureで補正したFDR値をFDRに格納 rank_DESeq <- rank(FDR) #FDR値でランキングした結果をrank_DESeqに格納 ### 8-2. WADのランキング結果を取得 ### datalog <- log2(data_rpkm + 1) #data_rpkmに1足して対数をとったものをdatalogに格納 aveA <- datalog[,data.cl==1] #datalogの行列からdata.clが1に相当する列をaveAに格納 aveB <- datalog[,data.cl==2] #datalogの行列からdata.clが2に相当する列をaveBに格納 average <- (aveA + aveB)/2 #logスケールでの遺伝子(行)ごとの平均発現レベルを計算しaverageに格納 weight <- (average - min(average))/(max(average) - min(average)) #遺伝子(行)ごとの相対発現レベルをweightに格納 stat_WAD <- (aveB - aveA)*weight #WAD統計量を計算してstat_WADに格納 rank_WAD <- rank(-abs(stat_WAD)) #WAD統計量をの順位を計算してrank_WADに格納 tmp <- cbind(rownames(data), data_raw, logratio, FDR, rank_DESeq, stat_WAD, rank_WAD)#raw countsデータの右側に、「lograio」、「DESeqで計算したFDR」、「その順位」、「WAD統計量」、「その順位」を結合した結果をtmpに格納 colnames(tmp) <- c("expressed_resion_ID", "raw_count(sampleA)", "raw_count(sampleB)", "log2(B/A)", "FDR(DESeq)", "rank(DESeq)", "WAD_statistics", "rank(WAD)") write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存 ### 8-3. FDRの任意の閾値を満たす遺伝子(行)数を調べたりMA-plotを描画したり... ### param3 <- 0.01 #FDRの閾値を指定 param4 <- 600 #図のx軸の長さを指定 param5 <- 400 #図のy軸の長さを指定 out_f2 <- "result_DEG.png" #MA-plot用出力ファイル名を指定 png(out_f2, width=param4, height=param5*2) #出力ファイルの各種パラメータを指定 par(mfcol= c(2,1)) #二分割して2行1列でMA-plotを描画 plot(out$baseMean, logratio, log="x", pch=20, cex=.1, col=ifelse(FDR < param3, "red", "black"), xlab="Average expression level", main="DESeq_result")#DESeqの結果を表示 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 DEG_num <- sum(FDR < param3, na.rm=TRUE) #"NA"のものを無視して条件を満たす要素数をDEG_numに格納 legend("topleft", "DEG", col="red", pch=20) #左上のlegendを描画している legend("bottomright", paste("FDR < ", param3, ":", DEG_num)) #右下のlegendを描画している plot(out$baseMean, logratio, log="x", pch=20, cex=.1, col=ifelse(rank_WAD < DEG_num, "red", "black"), xlab="Average expression level", main="WAD_result")#WADの結果を表示 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 dev.off() #おまじない(作図終了宣言) q() #Rの終了コマンド n #保存しないで終了qseq2fastq.pl
############################ ### 1. おまじない(マップするゲノム配列の前処理) ############################ bowtie-build -f ref_genome.fa ref_genome ############################ ### 2. Bowtieでマッピング ############################ ( bowtie --offrate 3 -p 8 -a -t -S ref_genome sample_read1.fq,sample_read2.fq -q > sample.sam ) >& sample.samlog
############################ ### 0. トランスクリプトーム配列ファイルhuman.rna.fnaの前処理を行って、description部分を必要最小限に変更したref_transcriptome.faというファイルの作成、 ### およびその後の解析で必要となる情報も別ファイル(ref_transcriptome.bed)として保存しておく ############################ in_f <- "human.rna.fna" #解凍後のmulti-fastaファイルのファイル名human.rna.fnaを指定 out_f1 <- "ref_transcriptome.fa" #出力ファイル名を指定 out_f2 <- "ref_transcriptome.bed" #出力ファイル名を指定 library(Biostrings) #パッケージの読み込み reads <- readDNAStringSet(in_f, format="fasta") #in_fで指定したファイルをFASTA形式で読み込み hoge <- strsplit(names(reads), "|", fixed=TRUE) #names(reads)中の文字列を"|"で区切った結果をリスト形式でhogeに格納 refseq_with_v <- sapply(hoge, "[[", 4) #hogeのリスト中の4番目の要素(RefSeq accession number部分に相当)のみ抽出してrefseq_with_vに格納 hoge2 <- strsplit(refseq_with_v, ".", fixed=TRUE) #refseq_with_v中の文字列を"."で区切った結果をリスト形式でhoge2に格納 refseq_without_v <- sapply(hoge2, "[[", 1) #hoge2のリスト中の1番目の要素(RefSeq accession numberのバージョン番号でない部分に相当)のみ抽出してrefseq_without_vに格納 reads #今現在のreadsオブジェクトを眺めているだけ(namesという列の部分がオリジナルのdescriptionのままになっていることがわかる) names(reads) <- refseq_with_v #names(reads)の中身をrefseq_with_vで置換(バージョン番号なしにしたければrefseq_without_vにすればいい) reads #今現在のreadsオブジェクトを眺めているだけ(namesという列の部分がrefseq_with_vでちゃんと置換されていることがわかる) writeXStringSet(reads, file=out_f1, format="fasta", width=60) #一行あたりの塩基数を60にして、out_f1で指定したファイル名でreadsというオブジェクトをfasta形式で保存 tmp <- cbind(refseq_with_v, 0, width(reads)) #5.で使うためのファイルを作成している。「バージョン情報なしのRefSeq accession number (refseq_without_v)」、0、「配列長情報(width(reads))」を結合してtmpに格納 write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f2で指定したファイル名で保存。 ############################ ### 1. Illuminaのqseq形式のファイルを含むフォルダを指定してfastq形式ファイルで保存 ############################ qseq2fastq.pl sampleA sampleA.fq qseq2fastq.pl sampleB sampleB.fq ############################ ### 2. おまじない(マップするトランスクリプトーム配列の前処理) ############################ bowtie-build -f ref_transcriptome.fa ref_transcriptome ############################ ### 3. ゲノムにマッピング(mismatchを許容しないで、複数個所にマップされず一か所にのみマップされるものを採用) ############################ ( bowtie --offrate 3 -p 8 -a --best --strata -v 0 -m 1 -t --sam ref_transcriptome -q sampleA.fq > sampleA.sam ) >& sampleA.samlog ( bowtie --offrate 3 -p 8 -a --best --strata -v 0 -m 1 -t --sam ref_transcriptome -q sampleB.fq > sampleB.sam ) >& sampleB.samlog ############################ ### 4. ファイル形式の変換 ############################ sam2bed.pl sampleA.sam sampleA.bed sam2bed.pl sampleB.sam sampleB.bed ############################ ### 5. 各転写物配列中に何リードマップされたかカウントしている ############################ intersectBed -a ref_transcriptome.bed -b sampleA.bed -c > ref_transcriptome_A.count intersectBed -a ref_transcriptome.bed -b sampleB.bed -c > ref_transcriptome_B.count ############################ ### 6. Linux上でRを実行して6のところで作成した*.countファイルを一つずつ読み込んでRPKM値を計算し、結果を*.rpkmというファイル名で保存 ############################ R #Rの起動 in_f <- list.files(pattern=".count") #"*.count"という名前をファイルをin_fに格納(「ls -1 *.count > in_f」みたいなイメージ) for(i in 1:length(in_f)){ #in_fの要素数(*.countのファイル数)分だけループを回す out_f <- paste(unlist(strsplit(in_f[i], ".", fixed=TRUE))[1], "rpkm", sep=".")#出力ファイルを"*.rpkm"に変えてout_fに格納 data <- read.table(in_f[i], header=FALSE, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 raw_counts <- data[,4] #dataの4列目の情報をraw_countsに格納 all_reads <- as.numeric(sum(data[,4])) #dataの4列目の数値の和を実数(as.numeric)としてall_readsに格納 gene_length <- data[,3] - data[,2] #dataの(3列目 - 2列目)の結果ををgene_lengthに格納(BED形式なのでこの計算式でよい) RPKM <- raw_counts*1000000000/(gene_length*all_reads) #RPKM値を計算してRPKMに格納 gene_name <- paste(data[,1], data[,2]+1, data[,3], sep="_") #ゲノム(or コンティグ)上の座標情報をgene_nameとして格納 tmp <- cbind(gene_name, raw_counts, gene_length, all_reads, RPKM)#「gene_name, raw_counts, gene_length, all_reads, RPKM」の順番で、計5列を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存 } #一連の作業をin_fの要素数(*.countのファイル数)分だけループを回す q() #Rの終了コマンド n #保存しないで終了 ############################ ### 7. 発現変動遺伝子のランキング (RのDESeqパッケージとWAD法のランキング結果を出力) ### DESeqは内部的に独自の正規化を行っており、配列長由来の偏りに関する補正は行っていない。 ### WADはRPKMのデータを用いてランキングを行っているが、MA-plotで表示させているのは ### DESeq内部補正後のデータなので若干異なった結果となっている。 ############################ R #Rの起動 out_f1 <- "result_DEG.txt" #出力ファイル名を指定 param1 <- 1 #A群のサンプル数を指定 param2 <- 1 #B群のサンプル数を指定 library(DESeq) #パッケージの読み込み data_raw <- NULL #(DESeqはraw countsデータを入力とするので)raw countsデータ格納用プレースホルダ data_rpkm <- NULL #(WADやADはRPKMデータを入力とするので)RPKMデータ格納用プレースホルダ in_f <- list.files(pattern=".rpkm") #"*.rpkm"という名前をファイルをin_fに格納 for(i in 1:length(in_f)){ #in_fの要素数(*.rpkmのファイル数)分だけループを回す data <- read.table(in_f[i], header=TRUE, row.names=1, sep="\t", quote="") #入力ファイルを読み込んでdataに格納 data_raw <- cbind(data_raw, data[,1]) #raw_countsに相当する列の情報をdata_rawの右側の列に追加 data_rpkm <- cbind(data_rpkm, data[,4]) #RPKM値に相当する列の情報をdata_rpkmの右側の列に追加 } #一連の作業をin_fの要素数(*.rpkmのファイル数)分だけループを回す data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 ### 8-1. DESeqのランキング結果を取得 ### cds <- newCountDataSet(data_raw, data.cl) #おまじない(CountDataSetというクラスを作成している cds <- estimateSizeFactors(cds) #おまじない(サンプル間でマップされたread数が異なるのを補正するための正規化係数を計算している;いわゆるRPMの計算をしているような認識で差し支えない) cds <- estimateVarianceFunctions(cds, method="blind") #おまじない(ばらつきを計算している) out <- nbinomTest(cds, 1, 2) #発現変動の各種統計量を計算し、結果をoutに格納 logratio <- out$log2FoldChange #log2(B/A)統計量をlogratioに格納 FDR <- out$padj #p値をBenjamini-Hochberg procedureで補正したFDR値をFDRに格納 rank_DESeq <- rank(FDR) #FDR値でランキングした結果をrank_DESeqに格納 ### 8-2. WADのランキング結果を取得 ### datalog <- log2(data_rpkm + 1) #data_rpkmに1足して対数をとったものをdatalogに格納 aveA <- datalog[,data.cl==1] #datalogの行列からdata.clが1に相当する列をaveAに格納 aveB <- datalog[,data.cl==2] #datalogの行列からdata.clが2に相当する列をaveBに格納 average <- (aveA + aveB)/2 #logスケールでの遺伝子(行)ごとの平均発現レベルを計算しaverageに格納 weight <- (average - min(average))/(max(average) - min(average)) #遺伝子(行)ごとの相対発現レベルをweightに格納 stat_WAD <- (aveB - aveA)*weight #WAD統計量を計算してstat_WADに格納 rank_WAD <- rank(-abs(stat_WAD)) #WAD統計量をの順位を計算してrank_WADに格納 tmp <- cbind(rownames(data), data_raw, logratio, FDR, rank_DESeq, stat_WAD, rank_WAD)#raw countsデータの右側に、「lograio」、「DESeqで計算したFDR」、「その順位」、「WAD統計量」、「その順位」を結合した結果をtmpに格納 colnames(tmp) <- c("expressed_resion_ID", "raw_count(sampleA)", "raw_count(sampleB)", "log2(B/A)", "FDR(DESeq)", "rank(DESeq)", "WAD_statistics", "rank(WAD)") write.table(tmp, out_f1, sep="\t", append=F, quote=F, row.names=F, col.names=T)#tmpの中身をout_fで指定したファイル名で保存 ### 8-3. FDRの任意の閾値を満たす遺伝子(行)数を調べたりMA-plotを描画したり... ### param3 <- 0.01 #FDRの閾値を指定 param4 <- 600 #図のx軸の長さを指定 param5 <- 400 #図のy軸の長さを指定 out_f2 <- "result_DEG.png" #MA-plot用出力ファイル名を指定 png(out_f2, width=param4, height=param5*2) #出力ファイルの各種パラメータを指定 par(mfcol= c(2,1)) #二分割して2行1列でMA-plotを描画 plot(out$baseMean, logratio, log="x", pch=20, cex=.1, col=ifelse(FDR < param3, "red", "black"), xlab="Average expression level", main="DESeq_result")#DESeqの結果を表示 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 DEG_num <- sum(FDR < param3, na.rm=TRUE) #"NA"のものを無視して条件を満たす要素数をDEG_numに格納 legend("topleft", "DEG", col="red", pch=20) #左上のlegendを描画している legend("bottomright", paste("FDR < ", param3, ":", DEG_num)) #右下のlegendを描画している plot(out$baseMean, logratio, log="x", pch=20, cex=.1, col=ifelse(rank_WAD < DEG_num, "red", "black"), xlab="Average expression level", main="WAD_result")#WADの結果を表示 grid(col="gray", lty="dotted") #指定したパラメータでグリッドを表示 dev.off() #おまじない(作図終了宣言) q() #Rの終了コマンド n #保存しないで終了qseq2fastq.pl
library(cosmo) #パッケージの読み込み
参考文献1(Bembom et al., SAGMB, 2007)