What's new?
source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #おまじない 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.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #おまじない install.packages("ADaCGH") #ADaCGHパッケージのインストール install.packages("agilp") #agilpパッケージのインストール install.packages("cclust") #cclustパッケージのインストール install.packages("celsius") #celsiusパッケージのインストール install.packages("corpcor") #corpcorパッケージのインストール install.packages("e1071") #e1071パッケージのインストール install.packages("eqtl") #eqtlパッケージのインストール install.packages("GeneCycle") #GeneCycleパッケージのインストール install.packages("geometry") #geometryパッケージのインストール install.packages("gRapHD") #gRapHDパッケージのインストール install.packages("GSA") #GSAパッケージのインストール install.packages("locfdr") #locfdrパッケージのインストール install.packages("longitudinal") #longitudinalパッケージのインストール install.packages("permtest") #permtestパッケージのインストール install.packages("pvclust") #pvclustパッケージのインストール install.packages("qvalue") #qvalueパッケージのインストール install.packages("samr") #samrパッケージのインストール install.packages("som") #somパッケージのインストール install.packages("st") #stパッケージのインストール install.packages("varSelRF") #varSelRFパッケージのインストール #install.packages("VR") #VRパッケージのインストール source("http://bioconductor.org/biocLite.R") #おまじない biocLite() #おまじない biocLite("affypdnn") #affypdnnパッケージのインストール biocLite("annotate") #annotateパッケージのインストール biocLite("ArrayExpress") #ArrayExpressパッケージのインストール biocLite("clusterStab") #clusterStabパッケージのインストール biocLite("DNAcopy") #DNAcopyパッケージのインストール biocLite("gcrma") #gcrmaパッケージのインストール biocLite("genefilter") #genefilterパッケージのインストール biocLite("GEOquery") #GEOqueryパッケージのインストール biocLite("GLAD") #GLADパッケージのインストール biocLite("GSEABase") #GSEABaseパッケージのインストール biocLite("KEGG.db") #KEGG.dbパッケージのインストール biocLite("limma") #limmaパッケージのインストール biocLite("marray") #marrayパッケージのインストール biocLite("maSigPro") #maSigProパッケージのインストール biocLite("org.Hs.eg.db") #org.Hs.eg.dbパッケージのインストール biocLite("OCplus") #OCplusパッケージのインストール biocLite("PGSEA") #PGSEAパッケージのインストール biocLite("plier") #plierパッケージのインストール biocLite("puma") #pumaパッケージのインストール biocLite("RankProd") #RankProdパッケージのインストール biocLite("RefPlus") #RefPlusパッケージのインストール biocLite("ROC") #ROCパッケージのインストール biocLite("SAGx") #SAGxパッケージのインストール biocLite("vsn") #vsnパッケージのインストール biocLite("xtable") #xtableパッケージのインストール
source("http://bioconductor.org/biocLite.R") #おまじない biocLite("affy") #おまじない
1+2 #1+2を計算 hoge <- 4 #hogeに4を代入 hoge #hogeの中身を表示 sqrt(hoge) #4のルートを計算 sqrt(4) #4のルートを計算(当然同じ意味) #の後の文章はコメントなので何を書いてもいいですよ。
sink("out.txt")#出力ファイル名をout.txtとする 1+2 #1+2を計算 hoge <- 4 #hogeに4を代入 hoge #hogeの中身を表示 sqrt(hoge) #4のルートを計算 sqrt(4) #4のルートを計算(当然同じ意味) #の後の文章はコメントなので何を書いてもいいですよ。コマンドライン上に結果が表示されず、out.txtに結果が以下のように表示されていることと思います:
library(multtest)
data(golub)
dim(golub)
で得られるサンプルデータと本質的に同じ。library(golubEsets) library(help=golubEsets) #golubEsetsライブラリ中にどのような情報が含まれているか調べる data(Golub_Merge) dim(Golub_Merge)で得られるサンプルデータと本質的に同じ。尚、どのサンプルがALLまたはAMLかを知りたいときは以下のようにして情報を得る。
Golub_Merge #Golub_Merge中にどのような情報が含まれているか調べる varLabels(Golub_Merge) #Golub_Merge$ALL.AMLと打ち込めば、どのサンプルがALL or AMLかが分かりそうだと判明する Golub_Merge$ALL.AML tmp <- rbind(Golub_Merge$ALL.AML, exprs(Golub_Merge)) write.table(tmp, "data_Golub_Merge.txt", sep = "\t", append=F, quote=F, col.names=F)参考文献:Golub et al., Science, 286, 531-537, 1999
library(maSigPro) data(data.abiotic) data(edesign.abiotic) write.table(data.abiotic, "sample10.txt", sep = "\t", append=F, quote=F, col.names=T) write.table(edesign.abiotic, "sample10_cl.txt", sep = "\t", append=F, quote=F, col.names=T)として得られる1,000(ProbeSets)×36(samples)の遺伝子発現データ(sample10.txt)とその実験デザイン情報(sample10_cl.txt)を加工したもの。
in_f <- "sample13.txt" #入力ファイル名を指定 out_f <- "sample13_7vs7.txt" #出力ファイル名を指定 #発現データの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.tmp <- data[,c(3:6,9,13:21)] #行列dataの中から3-6, 9, 13-21列のデータのみ抽出してdata.tmpに格納 tmp <- cbind(rownames(data), data.tmp) #遺伝子名の右側にdata.tmpを追加して、tmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
library(celsius) #パッケージの読み込み
CRANのcelsiusのwebページparam <- "GDS1096" #入手したいGEO IDを指定 out_f <- "data_hoge1.txt" #出力ファイル名を指定 #必要なパッケージをロード library(GEOquery) #パッケージの読み込み data <- getGEO(param) #指定したGEO IDをダウンロードし、dataに格納 eset_data <- GDS2eSet(data) #正規化|Affymetrix GeneChip|MAS,MBEI,RMAなどで行った結果得られるExpressionSetというフォーマットと同じ形式に変換し、結果をeset_dataに格納 write.exprs(eset_data, file=out_f) #eset_dataの中身を指定したファイル名で保存。1-2. 参考文献2のAffymetrixデータ(GDS1096)を入手したい場合2: (上記と出力ファイル形式が微妙に異なります...)
param <- "GDS1096" #入手したいGEO IDを指定 out_f <- "data_hoge2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(GEOquery) #パッケージの読み込み data <- getGEO(param) #指定したGEO IDをダウンロードし、dataに格納 write.table(Table(data), out_f,sep="\t",row.names=F,col.names=T,quote=FALSE)#dataの中身を指定したファイル名で保存。2. 参考文献2のAffymetrixデータ(GSE2361)を入手したい場合:
param <- "GSE2361" #入手したいGEO IDを指定 out_f <- "data_hoge3.txt" #出力ファイル名を指定 #必要なパッケージをロード library(GEOquery) #パッケージの読み込み data <- getGEO(param) #指定したGEO IDをダウンロードし、dataに格納 write.table(exprs(data[[1]]), out_f,sep="\t",col.names=NA,quote=FALSE)#dataの中身を指定したファイル名で保存。3. 参考文献2のAffymetrixデータ(GSE2361)そのものではなく、他の様々な情報を得たい場合:
param <- "GSE2361" #入手したいGEO IDを指定 out_f <- "data_hoge4.txt" #出力ファイル名を指定 #必要なパッケージをロード library(GEOquery) #パッケージの読み込み data <- getGEO(param) #指定したGEO IDをダウンロードし、dataに格納 data #dataの中には「exprs(data[[1]])」で取り出せる遺伝子発現行列以外にも様々な情報が取り出せそうな気がします varLabels(data[[1]]) #title, geo_accessionなど様々な情報を取り出せることが分かる(おそらく、GSEXXXXのXXXX部分の違いによってここで得られる情報や順番は異なるので注意!) pData(data[[1]])[1] #title情報を取り出したい場合1 pData(data[[1]])$title #title情報を取り出したい場合2 write.table(pData(data[[1]]),out_f,sep="\t",col.names=NA,quote=FALSE)#pData(data[[1]])から取り出せる全てを指定したファイル名で保存。4. 参考文献3のtwo-color Agilentデータ(GSE1322)を入手したい場合: 詳細はGEOのGSE1322でわかりますが、ここで入手している発現データ (全部糖尿病患者のperipheral bloodサンプル)はいわゆるlog ratioです。具体的にはlog2(Cy5/Cy3)で、 GSM21742: (面白い話を聞いた患者ID1)log2(After/Before) GSM21743: (面白い話を聞いた患者ID2)log2(After/Before) GSM21744: (面白い話を聞いた患者ID3)log2(After/Before) GSM21745: (面白い話を聞いた患者ID5)log2(After/Before) GSM21746: (面白い話を聞いた患者ID6)log2(After/Before) GSM21747: (面白い話を聞いた患者ID7)log2(After/Before) GSM21748: (面白い話を聞いた患者ID8)log2(After/Before) GSM21749: (面白い話を聞いた患者ID9)log2(After/Before) GSM21750: (面白い話を聞いた患者ID10)log2(After/Before) GSM21751: (面白い話を聞いた患者ID11)log2(After/Before) GSM21752: (面白い話を聞いた患者ID13)log2(After/Before) GSM21753: (面白い話を聞いた患者ID14)log2(After/Before) GSM21758: (面白い話を聞いた患者ID16)log2(After/Before) GSM21759: (面白い話を聞いた患者ID17)log2(After/Before) GSM21761: (退屈な講義を聞いた患者ID3)log2(After/Before) GSM21763: (退屈な講義を聞いた患者ID5)log2(After/Before) GSM21765: (退屈な講義を聞いた患者ID6)log2(After/Before) GSM21767: (退屈な講義を聞いた患者ID7)log2(After/Before) GSM21769: (退屈な講義を聞いた患者ID10)log2(After/Before) GSM21771: (退屈な講義を聞いた患者ID16)log2(After/Before) GSM21772: (退屈な講義を聞いた患者ID17)log2(After/Before) のデータです(私の理解が間違ってなければ...)。
param <- "GSE1322" #入手したいGEO IDを指定 out_f <- "sample13.txt" #出力ファイル名を指定 library(GEOquery) #パッケージの読み込み data <- getGEO(param) #指定したGEO IDをダウンロードし、dataに格納 data #dataの中には「exprs(data[[1]])」で取り出せる遺伝子発現行列以外にも様々な情報が取り出せそうな気がします varLabels(data[[1]]) #title, geo_accessionなど様々な情報を取り出せることが分かる(おそらく、GSEXXXXのXXXX部分の違いによってここで得られる情報や順番は異なるので注意!) pData(data[[1]])[1] #title情報を取り出したい場合1 pData(data[[1]])$title #title情報を取り出したい場合2 write.table(exprs(data[[1]]),out_f,sep="\t",col.names=NA,quote=FALSE)#dataの中身を指定したファイル名で保存。参考文献1(GEOQuery: Davis and Meltzer, Bioinformatics, 2007)
param1 <- "leukemia" #キーワードを指定 param2 <- "homo+sapiens" #生物種を指定 #必要なパッケージをロード library(ArrayExpress) #パッケージの読み込み sets <- queryAE(keywords = param1, species = param2) #param1, param2で指定した条件で検索を実行2. すでにArrayExpress IDがE-MEXP-1422だと分かっている場合: 以下のコマンドを実行すると、(8つの)ファイルが得られるので、 「ファイル」−「ディレクトリの変更」でファイルを保存したいディレクトリに移動し、以下をコピペ。
param <- "E-MEXP-1422" #IDを指定 #必要なパッケージをロード library(ArrayExpress) #パッケージの読み込み rawset <- ArrayExpress(param) #paramで指定したIDのデータをダウンロードBioconductorのArrayExpressのwebページ
#必要なパッケージをロード library(rat2302.db) #パッケージの読み込み library(help=rat2302.db) #rat2302.db中にどんな情報が含まれているか見る ls("package:rat2302.db") #rat2302.db中にどんな情報が含まれているか見る(上とほぼ同じ情報が得られる) #ここまでの作業で例えばrat2302ACCNUM中にGenBank accession numberとManufacturer identifiersの対応関係についての情報が入っていることなどが分かる #例えば、"mappedkeys(rat2302ACCNUM)"でGenBank accession numberとの対応があるManufacturer identifiersを表示したり、 #"length(mappedkeys(rat2302ACCNUM))"でGenBank accession numberとの対応があるManufacturer identifiersの数を表示したり、 #"summary(rat2302ACCNUM)"で対応関係のsummaryを表示したりすることができます #以下は(こんなこともできますという)おまけ #全遺伝子のidentifierとgene symbolの情報をファイルに保存したい場合 out_f <- "hoge.txt" #出力ファイル名を指定 param <- rat2302SYMBOL #欲しい対応関係情報を指定(e.g., rat2302ENSEMBLやrat2302GENENAMEなど) out <- unlist(as.list(param)) #paramから得られるidentifierとの対応関係情報をoutに格納 tmp <- cbind(names(out), out) #identifierとoutの情報を結合してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存Bioconductorのrat2302.dbのwebページ 2. 「Illumina Mousev2」の場合:
#必要なパッケージをロード library(illuminaMousev2.db) #パッケージの読み込み library(help=illuminaMousev2.db) #illuminaMousev2.db中にどんな情報が含まれているか見る #ここまでの作業で例えばilluminaMousev2ENTREZID中にEntrez GeneとManufacturer identifiersの対応関係についての情報が入っていることなどが分かる #以下は(こんなこともできますという)おまけ #全遺伝子のidentifierとgene symbolの情報をファイルに保存したい場合 out_f <- "hoge.txt" #出力ファイル名を指定 param <- illuminaMousev2SYMBOL #欲しい対応関係情報を指定(e.g., illuminaMousev2UNIGENEやilluminaMousev2PFAMなど) out <- unlist(as.list(param)) #paramから得られるidentifierとの対応関係情報をoutに格納 tmp <- cbind(names(out), out) #identifierとoutの情報を結合してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存BioconductorのilluminaMousev2.dbのwebページ 3. 「Agilent Human 1A (V2)」の場合:
#必要なパッケージをロード library(hgug4110b.db) #パッケージの読み込み library(help=hgug4110b.db) #hgug4110b.db中にどんな情報が含まれているか見る #ここまでの作業で例えばhgug4110bSYMBOL中にGene symbolとManufacturer identifiersの対応関係についての情報が入っていることなどが分かる #以下は(こんなこともできますという)おまけ #全遺伝子のidentifierとgene symbolの情報をファイルに保存したい場合 out_f <- "hoge.txt" #出力ファイル名を指定 param <- hgug4110bSYMBOL #欲しい対応関係情報を指定(e.g., hgug4110bUNIPROTやhgug4110bGOなど) out <- unlist(as.list(param)) #paramから得られるidentifierとの対応関係情報をoutに格納 tmp <- cbind(names(out), out) #identifierとoutの情報を結合してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存Bioconductorのhgug4110b.dbのwebページ
BioconductorのChipManufacturerのwebページ
参考文献1(Nakai et al., BBB, 2008)library(limma) #パッケージの読み込み limmaUsersGuide() #詳しい説明(PDFファイルが開く)Bioconductorのlimmaのwebページ
library(marray) #パッケージの読み込み
Bioconductorのmarrayのwebページparam1 <- 10 #ここで指定した回数分だけRMA+を行う(数が大きいほど時間はかかるがより精度が増す; 1の場合はRefRMAなどと同じ意味) param2 <- 3 #一種類につき、いくつサンプリングするかを指定(数が大きいほどメモリを食うのでout of memoryにならないできるだけ大きい数を指定する; この場合の最大値は30だが、30で正常に動くのなら、RMA+をやる必要がそもそもない) param3 <- 5 #ここで指定した数のサンプル数づつ外挿を行う(1以上の数値) library(RefPlus) #パッケージの読み込み list_files <- list.files() #「MAQC_AFX_123456_120CELs」ディレクトリ中のファイル名のリストをゲットしてlist_filesに格納 list_files #list_filesの中身を表示(最初の20個がSite1, 次の20個がSite2などということが分かる) #RMA+を"param1"回実行。 #一回のRMA+で(外挿作業を"param3"サンプルずつの24分割しているので)24個のファイルができるので、計24×"param1" = 240個のファイルがここの作業で作成される #1回目のRMA+で作成されるファイル名:data_RMA_5_1.txt, data_RMA_10_1.txt, ...data_RMA_120_1.txt #2回目のRMA+で作成されるファイル名:data_RMA_5_2.txt, data_RMA_10_2.txt, ...data_RMA_120_2.txt #... #"param1"回目のRMA+で作成されるファイル名:data_RMA_5_10.txt, data_RMA_10_10.txt, ...data_RMA_120_10.txt for(i in 1:param1){ #param1回ループを回す #A-Dそれぞれのサンプルから、ランダムに"param2"個ずつ取り出す vector_A <- c(1:5, 21:25, 41:45, 61:65, 81:85, 101:105) #サンプルAの位置情報 vector_B <- vector_A + 5 #サンプルBの位置情報 vector_C <- vector_B + 5 #サンプルCの位置情報 vector_D <- vector_C + 5 #サンプルDの位置情報 sample_A <- sample(vector_A, param2, replace=FALSE) #vector_Aからランダムに"param2"個取り出す sample_B <- sample(vector_B, param2, replace=FALSE) #vector_Bからランダムに"param2"個取り出す sample_C <- sample(vector_C, param2, replace=FALSE) #vector_Cからランダムに"param2"個取り出す sample_D <- sample(vector_D, param2, replace=FALSE) #vector_Dからランダムに"param2"個取り出す ref_vector <- c(sample_A, sample_B, sample_C, sample_D) #sample_Aからsample_Dまでのベクトルを結合 list_files[ref_vector] #確かに全種類のサンプルが"param2"個ずつ含まれていることを確認 #reference datasetに対してRMAを適用し、外挿用のパラメータを得る data = ReadAffy(filenames = list_files[ref_vector]) #計12個のCELファイル(reference dataset)を読み込んでdataに格納 Para <- rma.para(data, bg = TRUE, exp = TRUE) #dataに対してRMAを実行し、正規化に用いた外挿用のパラメータParaを得る #reference datasetから得られた外挿用パラメータParaを用いて、全サンプルについてRMAを実行 #メモリの関係で、全120サンプルを"param3"サンプルづつの、計24分割して独立に行う。 sub_vector <- c(1:param3) #「MAQC_AFX_123456_120CELs」ディレクトリ中の最初の"param3"個の位置情報を格納 while(sub_vector[param3] <= length(list_files)){ #sub_vector中の"param3"番目の要素の値がlength(list_files)の値以下になるまで繰り返す cat(sub_vector, "\n") #今どのサンプルを外挿しているのか表示 data = ReadAffy(filenames = list_files[sub_vector]) #"param3"個の CEL filesを読み込んでdataに格納 quantified_data <- rmaplus(data, rmapara = Para, bg = TRUE)#dataに対して外挿用パラメータParaを用いてRMAを実行し、結果をquantified_dataに保存 write_filename <- paste("data_RMA_", sub_vector[param3], "_", i, ".txt", sep="")#出力用ファイル名(最初のループではdata_RMA_5_1.txt、次はdata_RMA_10_1.txtなど)を作成 write.table(quantified_data, write_filename, sep="\t",col.names=NA,quote=FALSE) #結果をwrite_filenameで定義したファイル名で保存 sub_vector <- sub_vector + param3 #次の"param3" サンプルという情報に変更し、次のループへ } #sub_vector中の"param3"番目の要素の値がlength(list_files)の値以下になるまで繰り返す if(i == 1){ #最初のループで得られたref_vectorをref_vector_saveに格納 ref_vector_save <- ref_vector #最初のループで得られたref_vectorをref_vector_saveに格納 }else{ #2回目以降で得られたref_vectorはref_vector_saveの下の行にどんどん追加していく ref_vector_save <- rbind(ref_vector_save, ref_vector) #2回目以降で得られたref_vectorはref_vector_saveの下の行にどんどん追加していく } #2回目以降で得られたref_vectorはref_vector_saveの下の行にどんどん追加していく data <- NULL #次のループ用に初期化 quantified_data <- NULL #次のループ用に初期化 Para <- NULL #次のループ用に初期化 } #param1回ループを回す write.table(ref_vector_save, "ref_vector_save.txt", sep="\t",col.names=NA,quote=FALSE)#"param1"回のRMA+で使われたreference datasetの情報を"ref_vector_save.txt"に保存 #data_RMA_5_1.txt, data_RMA_5_2.txt, ..., data_RMA_5_10.txtの"param1"個のファイルを読み込み、"param1"回の平均値のデータをdata_RMA_5_ave.txtとして保存 #data_RMA_10_1.txt, data_RMA_10_2.txt, ..., data_RMA_10_10.txtの"param1"個のファイルを読み込み、"param1"回の平均値のデータをdata_RMA_10_ave.txtとして保存 #... #data_RMA_120_1.txt, data_RMA_120_2.txt, ..., data_RMA_120_10.txtの"param1"個のファイルを読み込み、"param1"回の平均値のデータをdata_RMA_120_ave.txtとして保存 sub_vector <- c(1:param3) while(sub_vector[param3] <= length(list_files)){ tmp <- paste("^data_RMA_", sub_vector[param3], "_", sep="")#最初のループでは"data_RMA_5_"、次のループでは"data_RMA_10_"からはじまる全てのファイルを抽出できるようその情報をtmpに格納 filenames <- list.files(pattern = tmp) #「MAQC_AFX_123456_120CELs」ディレクトリ中の「tmpのパターン」からはじまる全てのファイルをfilenamesに格納 for(i in 1:length(filenames)){ if(i == 1){ data.tmp <- read.table(filenames[i], header=TRUE, row.names=1, sep="\t") } else{ data.tmp <- data.tmp + read.table(filenames[i], header=TRUE, row.names=1, sep="\t") } } data <- data.tmp/length(filenames) write_filename <- paste("data_RMA_", sub_vector[param3], "_ave.txt", sep="") write.table(data, write_filename, sep="\t",col.names=NA,quote=FALSE) sub_vector <- sub_vector + param3 }RMA++の参考文献(Harbron et al., Bioinformatics, 2007)
param2 <- 3 #一種類につき、いくつサンプリングするかを指定(数が大きいほどメモリを食うのでout of memoryにならないできるだけ大きい数を指定する; この場合の最大値は30だが、30で正常に動くのなら、RMA+をやる必要がそもそもない) param3 <- 5 #ここで指定した数のサンプル数づつ外挿を行う(1以上の数値) library(RefPlus) #パッケージの読み込み list_files <- list.files() #「MAQC_AFX_123456_120CELs」ディレクトリ中のファイル名のリストをゲットしてlist_filesに格納 list_files #list_filesの中身を表示(最初の20個がSite1, 次の20個がSite2などということが分かる) #A-Dそれぞれのサンプルから、ランダムに"param2"個ずつ取り出す vector_A <- c(1:5, 21:25, 41:45, 61:65, 81:85, 101:105) #サンプルAの位置情報 vector_B <- vector_A + 5 #サンプルBの位置情報 vector_C <- vector_B + 5 #サンプルCの位置情報 vector_D <- vector_C + 5 #サンプルDの位置情報 sample_A <- sample(vector_A, param2, replace=FALSE) #vector_Aからランダムに"param2"個取り出す sample_B <- sample(vector_B, param2, replace=FALSE) #vector_Bからランダムに"param2"個取り出す sample_C <- sample(vector_C, param2, replace=FALSE) #vector_Cからランダムに"param2"個取り出す sample_D <- sample(vector_D, param2, replace=FALSE) #vector_Dからランダムに"param2"個取り出す ref_vector <- c(sample_A, sample_B, sample_C, sample_D) #sample_Aからsample_Dまでのベクトルを結合 list_files[ref_vector] #確かに全種類のサンプルが"param2"個ずつ含まれていることを確認 #reference datasetに対してRMAを適用し、外挿用のパラメータを得る data = ReadAffy(filenames = list_files[ref_vector]) #計12("param2"*4種類のサンプルだから)個のCELファイル(reference dataset)を読み込んでdataに格納 Para <- rma.para(data, bg = TRUE, exp = TRUE) #dataに対してRMAを実行し、正規化に用いた外挿用のパラメータParaを得る #「(120 - 12)サンプルからなるfuture dataset」と「12サンプルからなるreference dataset」に対して、 #reference datasetから得られた外挿用パラメータParaを用いてRMAを実行 #メモリの関係で、全120サンプルを"param3"サンプルづつの、計24分割して独立に行う。 sub_vector <- c(1:param3) #「MAQC_AFX_123456_120CELs」ディレクトリ中の最初の"param3"個の位置情報を格納 while(sub_vector[param3] <= length(list_files)){ #sub_vector中の"param3"番目の要素の値がlength(list_files)の値と同じになるまで繰り返す cat(sub_vector, "\n") #今どのサンプルを外挿しているのか表示 data = ReadAffy(filenames = list_files[sub_vector]) #"param3"個のCEL filesを読み込んでdataに格納 quantified_data <- rmaplus(data, rmapara = Para, bg = TRUE) #dataに対して外挿用パラメータParaを用いてRMAを実行し、結果をquantified_dataに保存 write_filename <- paste("data_RMA_", sub_vector[param3], ".txt", sep="")#出力用ファイル名(最初のループではdata_RMA_5.txt、次はdata_RMA_10.txtなど)を作成 write.table(quantified_data, write_filename, sep="\t",col.names=NA,quote=FALSE)#結果をwrite_filenameで定義したファイル名で保存 sub_vector <- sub_vector + param3 #次の"param3"サンプルという情報に変更し、次のループへ } #sub_vector中の"param3"番目の要素の値がlength(list_files)の値と同じになるまで繰り返す data <- NULL #dataを初期化 quantified_data <- NULL #quantified_dataを初期化 Para <- NULL #Paraを初期化4. 無事計算が終了すると、data_RMA_5.txt, ..., data_RMA_120.txtまでの24個のファイルが出来上がります。 これが5サンプルごとに分割して出力させたRMA-quantified dataということになります。 全部を一緒にしたファイル(data_RMAall.txt)を作成したいときには例えば以下のようにします(もちろんExcelでもできます):
out_f <- "data_RMAall.txt" #出力ファイル名を指定 #マージしたいファイルのみ抽出し、ソートした情報を得る filenames <- list.files(pattern = "^data_RMA_") #「MAQC_AFX_123456_120CELs」ディレクトリ中の"data_RMA_"からはじまる全てのファイルをfilenamesに格納 tmp <- filenames #filenamesと同じものをtmpに格納 tmp #4で作成した順のファイル名になっていないのでうれしくないことが分かる tmp <- sub("data_RMA_", "", tmp) #ファイル名から、まず"data_RMA_"という文字を削除した情報を得る tmp #ちゃんと削除されていることが分かる tmp <- sub(".txt", "", tmp) #次に、".txt"という文字を削除した情報を得る filenames_sorted <- filenames[order(as.numeric(tmp))] #tmp情報を用いてファイル名を作成された順にソートした結果をfilenames_sortedに格納 filenames_sorted #ちゃんとソートされていることを確認 #"filenames_sorted"中のファイルを読み込んで、結合していく for(i in 1:length(filenames_sorted)){ #ファイルの数分だけループを回す cat(filenames_sorted[i], "\n") #ループを回すごとにファイル名を表示させている if(i == 1){ #最初のファイルを読み込んだ結果をdataに格納 data <- read.table(filenames_sorted[i], header=TRUE, row.names=1, sep="\t")#最初のファイルを読み込んだ結果をdataに格納 } else{ #二番目以降のファイルを読み込んだ結果は順次右側の列に格納していく data <- cbind(data, read.table(filenames_sorted[i], header=TRUE, row.names=1, sep="\t"))#二番目以降のファイルを読み込んだ結果は順次右側の列に格納していく } #ファイルの数分だけループを回す } #ファイルの数分だけループを回す write.table(data, out_f, sep="\t",col.names=NA, quote=FALSE) #120サンプル分の結合後のデータをout_fで指定した名前で保存参考文献(RMA+: Harbron et al., Bioinformatics, 2007)
out_f <- "data_dfw.txt" #出力ファイル名を指定 source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/dfw.R") #DFWを実行する関数を含むファイルをあらかじめ読み込む library(affy) #パッケージの読み込み data <- ReadAffy() #CELファイルの読み込み eset <- expresso(data, bgcorrect.method="none", normalize.method="quantiles", pmcorrect.method="pmonly", summary.method="dfw")#DFW法を実行し、結果をesetに保存。 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。参考文献(Chen et al., Bioinformatics, 2007)
install.packages("farms_1.4.1.zip", repos=NULL)「ファイル」−「ディレクトリの変更」で解析したいファイル(*.CELファイル)を置いてあるディレクトリに移動。 1. q.farms(quantile normalization; デフォルト)の場合:
out_f <- "data_qfarms.txt" #出力ファイル名を指定 library(affy) #パッケージの読み込み library(farms) #パッケージの読み込み library(help=farms) #パッケージの説明 data <- ReadAffy() #*.CELファイルの読み込み eset <- q.farms(data) #qFARMSを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。2. l.farms(loess normalization)の場合:
out_f <- "data_lfarms.txt" #出力ファイル名を指定 library(affy) #パッケージの読み込み library(farms) #パッケージの読み込み library(help=farms) #パッケージの説明 data <- ReadAffy() #*.CELファイルの読み込み eset <- l.farms(data) #lFARMSを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。参考URL
out_f <- "data_mmgmos.txt" #出力ファイル名を指定 library(puma) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset <- mmgmos(data) #multi-mgMOSを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。
Bioconductorの(multi-mgMOSを含むパッケージ)pumaのwebページ
参考文献1(Liu et al., Bioinformatics, 2005)out_f <- "data_gcrma.txt" #出力ファイル名を指定 library(gcrma) #パッケージの読み込み library(help=gcrma) #パッケージの説明 data <- ReadAffy() #*.CELファイルの読み込み eset <- gcrma(data) #GCRMAを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。参考文献(Wu et al., J. Am. Stat. Assoc., 2004)
out_f <- "data_plier.txt" #出力ファイル名を指定 library(plier) #パッケージの読み込み library(help=plier) #パッケージの説明 data <- ReadAffy() #*.CELファイルの読み込み eset <- justPlier(data) #PLIERを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。2. 「quantile normalizationしてからPLIER」の場合:
out_f <- "data_plier.txt" #出力ファイル名を指定 library(plier) #パッケージの読み込み library(help=plier) #パッケージの説明 data <- ReadAffy() #*.CELファイルの読み込み eset <- justPlier(data, normalize=TRUE) #quantile normalizationつきのPLIERを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。PDFマニュアル
out_f <- "data_pdnn.txt" #出力ファイル名を指定 library(affypdnn) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み energy.file <- system.file("exampleData", "pdnn-energy-parameter_hg-u133a.txt", package = "affypdnn")#チップの型に対応した専用のパラメータファイルの読み込み params.chiptype <- pdnn.params.chiptype(energy.file, probes.pack = "hgu133aprobe")#チップの型に対応した専用のパラメータファイルの読み込み参考文献1(手法の原著論文PDF; Zhang et al., Nat. Biotechnol., 2003)
out_f <- "data_vsn.txt" #出力ファイル名を指定 library(vsn) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset <- vsnrma(data) #VSNを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。vsn:Huber et al., Bioinformatics, 2002
out_f <- "data_mas.txt" #出力ファイル名を指定 library(affy) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset <- mas5(data) #MASを実行し、結果をesetに保存 summary(exprs(eset)) #得られたesetの遺伝子発現行列のシグナル強度分布を表示(20090709追加) exprs(eset)[exprs(eset) < 1] <- 1 #対数変換(log2)できるようにシグナル強度が1未満のものを1にしておく(20090709追加) summary(exprs(eset)) #上記処理後のシグナル強度分布を再び表示させて確認(20090709追加) exprs(eset) <- log(exprs(eset), 2) #底を2として対数変換(20090709追加) write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。参考文献(Hubbell et al., Bioinformatics, 2002) 2. RMAアルゴリズムの場合:
out_f <- "data_rma.txt" #出力ファイル名を指定 library(affy) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset <- rma(data) #RMAを実行し、結果をesetに保存 write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。参考文献(Irizarry et al., Biostatistics, 2003) 3. MBEIアルゴリズム(PM onlyモデル)の場合:
out_f <- "data_mbei_pmonly.txt" #出力ファイル名を指定 library(affy) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset <- expresso(data, normalize.method="invariantset", bg.correct=FALSE, pmcorrect.method="pmonly", summary.method="liwong")#dChip(PM onlyモデル)を実行し、結果をesetに保存 summary(exprs(eset)) #得られたesetの遺伝子発現行列のシグナル強度分布を表示(20090709追加) exprs(eset)[exprs(eset) < 1] <- 1 #対数変換(log2)できるようにシグナル強度が1未満のものを1にしておく(20090709追加) summary(exprs(eset)) #上記処理後のシグナル強度分布を再び表示させて確認(20090709追加) exprs(eset) <- log(exprs(eset), 2) #底を2として対数変換(20090709追加) write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。参考文献(Li and Wong, PNAS, 2001) 4. MBEIアルゴリズム(PM-MMモデル)の場合:
out_f <- "data_mbei.txt" #出力ファイル名を指定 library(affy) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset <- expresso(data, normalize.method="invariantset", bg.correct=FALSE, pmcorrect.method="subtractmm", summary.method="liwong")#dChip(PM-MMモデル)を実行し、結果をesetに保存 summary(exprs(eset)) #得られたesetの遺伝子発現行列のシグナル強度分布を表示(20090709追加) exprs(eset)[exprs(eset) < 1] <- 1 #対数変換(log2)できるようにシグナル強度が1未満のものを1にしておく(20090709追加) summary(exprs(eset)) #上記処理後のシグナル強度分布を再び表示させて確認(20090709追加) exprs(eset) <- log(exprs(eset), 2) #底を2として対数変換(20090709追加) write.exprs(eset, file=out_f) #結果をout_fで指定したファイル名で保存。参考文献(Li and Wong, PNAS, 2001) Bioconductorのaffyのwebページ
in_f1 <- "genelist_A.txt" #入力ファイル名を指定 in_f2 <- "genelist_B.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #入力ファイルの読み込み data1 <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#ファイルの読み込み data2 <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")#ファイルの読み込み #本番 common <- intersect(rownames(data1), rownames(data2)) #二つの遺伝子名のベクトル同士の積集合(intersection)をcommonに格納 obj <- is.element(rownames(data1), common) #rownames(data1)で表されるin_f1で読み込んだファイル中の遺伝子名のベクトル中の各要素がベクトルcommon中に含まれるか含まれないか(TRUE or FALSE)の情報をobjに格納(別にdata1でなくてdata2のほうでやってもよい) out <- data1[obj,] #行列data1からobjがTRUEとなる行のみを抽出した結果をoutに格納 names(out) <- rownames(data1)[obj] #ファイルに出力 tmp <- cbind(names(out), out) #行の名前、outを列ベクトル単位で結合し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample19.txt" #入力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#ファイルの読み込み #本番 dist(t(data), method="euclidean") #ユークリッド距離 dist(t(data), method="manhattan") #マンハッタン距離 dist(t(data), method="maximum") #最大距離 dist(t(data), method="canberra") #キャンベラ距離 1 - cor(data, method="pearson") #1 - Pearson相関係数 dist(t(data), method="binary") #Binary距離 dist(t(data), method="minkowski") #minkowski距離 1 - cor(data, method="spearman") #1 - Spearman相関係数
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み out <- apply(data, 1, mean) #各行の平均値(mean)をoutに格納 tmp <- cbind(rownames(data), data, out) #行の名前、data、outを列ベクトル単位で結合し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 中央値(median)を調べたい場合:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み out <- apply(data, 1, median) #各行の中央値(median)をoutに格納 tmp <- cbind(rownames(data), data, out) #行の名前、data、outを列ベクトル単位で結合し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. 重みつき平均(Tukey biweighted mean)を調べたい場合:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(affy) #tukey.biweight関数が含まれているaffyパッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み out <- apply(data, 1, tukey.biweight) #各行のtukey.biweight値をoutに格納 tmp <- cbind(rownames(data), data, out) #行の名前、data、outを列ベクトル単位で結合し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み out <- colnames(data)[max.col(data)] #最大発現量を示す組織名outに格納 tmp <- cbind(rownames(data), data, out) #入力データの右側にoutの情報を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #最大発現量を示す組織順にソートしてファイルに保存したい場合: out_f2 <- "hoge2.txt" #出力ファイル名2を指定 tmp2 <- tmp[order(max.col(data)),] #最大発現量を示す組織のシリアル番号順にソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
in_f <- "sample19.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param <- 10 #各サンプルの正規化後の平均値を指定 #データファイルの読み込み data_tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み tmp_mean <- apply(data_tmp, 2, mean, na.rm=TRUE) #各サンプル(列)の平均シグナル強度を計算した結果をtmp_meanに格納 data <- sweep(data_tmp, 2, param/tmp_mean, "*") #各列中の全てのシグナル値にparam/tmp_meanを掛け、その結果をdataに格納 data #結果を表示 apply(data, 2, mean) #各列のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data), data) #遺伝子IDの列を行列dataの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 6 genes ×11 samplesのデータファイル(sample2.txt)の場合:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param <- 100 #各サンプルの正規化後の平均値を指定 #データファイルの読み込み data_tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み tmp_mean <- apply(data_tmp, 2, mean, na.rm=TRUE) #各サンプル(列)の平均シグナル強度を計算した結果をtmp_meanに格納 data <- sweep(data_tmp, 2, param/tmp_mean, "*") #各列中の全てのシグナル値にparam/tmp_meanを掛け、その結果をdataに格納 data #結果を表示 apply(data, 2, mean) #各列のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data), data) #遺伝子IDの列を行列dataの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param <- 50 #各サンプルの正規化後の中央値を指定 #データファイルの読み込み data_tmp <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み tmp_median <- apply(data_tmp, 2, median, na.rm=TRUE) #各サンプル(列)のシグナル強度のmedianを計算した結果をtmp_medianに格納 data <- sweep(data_tmp, 2, param/tmp_median, "*") #各列中の全てのシグナル値にparam/tmp_medianを掛け、その結果をdataに格納 data #結果を表示 apply(data, 2, median) #各列のmedianを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data), data) #遺伝子IDの列を行列dataの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(som) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み data.z <- normalize(data, byrow=FALSE) #列方向に正規化した結果をdata.zに格納 data.z #結果を表示 apply(data.z, 2, mean) #各列のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.z), data.z) #遺伝子IDの列を行列data.zの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. やり方2:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み data.z <- genescale(data, axis=2, method="Z") #列方向に正規化した結果をdata.zに格納 data.z #結果を表示 apply(data.z, 2, mean) #各列のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.z), data.z) #遺伝子IDの列を行列data.zの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. やり方3:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み data.z <- scale(data) #列方向に正規化した結果をdata.zに格納 data.z #結果を表示 apply(data.z, 2, mean) #各列のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.z), data.z) #遺伝子IDの列を行列data.zの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。CRANのsomのwebページ
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(som) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み data.z <- normalize(data, byrow=TRUE) #行方向に正規化した結果をdata.zに格納 data.z #結果を表示 apply(data.z, 1, mean) #各行のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.z), data.z) #遺伝子IDの列を行列data.zの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. やり方2:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み data.z <- genescale(data, axis=1, method="Z") #行方向に正規化した結果をdata.zに格納 data.z #結果を表示 apply(data.z, 1, mean) #各行のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.z), data.z) #遺伝子IDの列を行列data.zの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. やり方3:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #ファイルの読み込み tmp <- scale(t(data)) #scale関数は列方向のscalingしかしてくれないので、t関数を使って転置行列に対してscale関数を実行し、結果をtmpに格納 data.z <- t(tmp) #前の行で行列を転置させていたので、もう一度転置しなおした結果をdata.zに格納 data.z #結果を表示 apply(data.z, 1, mean) #各行のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.z), data.z) #遺伝子IDの列を行列data.zの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。CRANのsomのwebページ
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.t <- t(data) #行列の転置(この後に使うscale関数が列ごとの操作を行うため、scale関数をそのまま使えるように予め行列を入れ替えておく必要があるため) data.t.mean.mad <- scale(data.t, apply(data.t,2,mean), apply(data.t,2,mad,constant=1))#各列のmean=0, MAD=1になるようにスケーリングし、結果をdata.t.mean.madに格納 data.mean.mad <- t(data.t.mean.mad) #scale関数の適用が終わったので、もう一度行列の転置を行って元に戻し、結果をdata.mean.madに格納 apply(data.mean.mad, 1, mean) #各行のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.mean.mad), data.mean.mad) #遺伝子IDの列を行列data.mean.madの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. サンプル(列)方向にスケーリングしたい場合:
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.mean.mad <- scale(data, apply(data,2,mean), apply(data,2,mad,constant=1))#各列のmean=0, MAD=1になるようにスケーリングし、結果をdata.mean.madに格納 apply(data.mean.mad, 2, mean) #各列のmeanを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.mean.mad), data.mean.mad) #遺伝子IDの列を行列data.mean.madの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.t <- t(data) #行列の転置(この後に使うscale関数が列ごとの操作を行うため、scale関数をそのまま使えるように予め行列を入れ替えておく必要があるため) data.t.m.sd <- scale(data.t, apply(data.t,2,median), apply(data.t,2,sd))#各列のmedian=0, SD=1になるようにスケーリングし、結果をdata.t.m.sdに格納 data.m.sd <- t(data.t.m.sd) #scale関数の適用が終わったので、もう一度行列の転置を行って元に戻し、結果をdata.m.sdに格納 apply(data.m.sd, 1, median) #各行のmedianを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.m.sd), data.m.sd) #遺伝子IDの列を行列data.m.sdの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. サンプル(列)方向にスケーリングしたい場合:
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.m.sd <- scale(data, apply(data,2,median), apply(data,2,sd)) #各列のmedian=0, SD=1になるようにスケーリングし、結果をdata.m.sdに格納 apply(data.m.sd, 2, median) #各列のmedianを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.m.sd), data.m.sd) #遺伝子IDの列を行列data.m.sdの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.t <- t(data) #行列の転置(この後に使うscale関数が列ごとの操作を行うため、scale関数をそのまま使えるように予め行列を入れ替えておく必要があるため) data.t.m.mad <- scale(data.t, apply(data.t,2,median), apply(data.t,2,mad,constant=1))#各列のmedian=0, MAD=1になるようにスケーリングし、結果をdata.t.m.madに格納 data.m.mad <- t(data.t.m.mad) #scale関数の適用が終わったので、もう一度行列の転置を行って元に戻し、結果をdata.m.madに格納 apply(data.m.mad, 1, median) #各行のmedianを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.m.mad), data.m.mad) #遺伝子IDの列を行列data.m.madの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. サンプル(列)方向にスケーリングしたい場合:
in_f <- "GDS1096.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.m.mad <- scale(data, apply(data,2,median), apply(data,2,mad,constant=1))#各列のmedian=0, MAD=1になるようにスケーリングし、結果をdata.m.madに格納 apply(data.m.mad, 2, median) #各列のmedianを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.m.mad), data.m.mad) #遺伝子IDの列を行列data.m.madの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献:Ge et al., Genomics, 2005
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(affy) #tukey.biweight関数が含まれているaffyパッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.t <- t(data) #行列の転置(この後に使うscale関数が列ごとの操作を行うため、scale関数をそのまま使えるように予め行列を入れ替えておく必要があるため) data.t.tukey.mad <- scale(data.t,apply(data.t,2,tukey.biweight),apply(data.t,2,mad,constant=1))#各列のTukey's biweight=0, MAD=1になるようにスケーリングし、結果をdata.t.tukey.madに格納 data.tukey.mad <- t(data.t.tukey.mad) #scale関数の適用が終わったので、もう一度行列の転置を行って元に戻し、結果をdata.tukey.madに格納 apply(data.tukey.mad, 1, tukey.biweight) #各行のTukey's biweightを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.tukey.mad), data.tukey.mad) #遺伝子IDの列を行列data.tukey.madの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. サンプル(列)方向にスケーリングしたい場合:
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(affy) #tukey.biweight関数が含まれているaffyパッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.tukey.mad <- scale(data,apply(data,2,tukey.biweight), apply(data,2,mad,constant=1))#各列のTukey's biweight=0, MAD=1になるようにスケーリングし、結果をdata.tukey.madに格納 apply(data.tukey.mad, 2, tukey.biweight) #各列のTukey's biweightを表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.tukey.mad), data.tukey.mad) #遺伝子IDの列を行列data.tukey.madの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.r <- genescale(data, axis=1, method="R") #スケーリングした結果をdata.rに格納 apply(data.r, 1, range) #各行の最小値と最大値を表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.r), data.r) #遺伝子IDの列を行列data.rの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.r <- genescale(data, axis=2, method="R") #スケーリングした結果をdata.rに格納 apply(data.r, 2, range) #各列の最小値と最大値を表示させ、正常に動作しているか確認 tmp <- cbind(rownames(data.r), data.r) #遺伝子IDの列を行列data.rの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "sample2_log.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 summary(data) #シグナル強度の分布を確認し、ダイナミックレンジが4桁程度あることを確認 data[data < 1] <- 1 #シグナル強度が1未満のものを1にする data.log <- log(data, base=2) #log2-transformed dataをdata.logに格納 summary(data.log) #対数変換後のシグナル強度の分布を確認 tmp <- cbind(rownames(data.log), data.log) #遺伝子IDの列を行列data.logの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. GDS1096.txtのような"IDENTIFIER"という余分な一列を含むファイルを処理したいとき:
in_f <- "GDS1096.txt" #入力ファイル名を指定 out_f <- "GDS1096_log.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data$IDENTIFIER <- NULL #余分なIDENTIFIER列の消去 summary(data) #シグナル強度の分布を確認し、ダイナミックレンジが4桁程度あることを確認 data[data < 1] <- 1 #シグナル強度が1未満のものを1にする data.log <- log(data, base=2) #log2-transformed dataをdata.logに格納 summary(data.log) #対数変換後のシグナル強度の分布を確認 tmp <- cbind(rownames(data.log), data.log) #遺伝子IDの列を行列data.logの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge_q1.txt" #出力ファイル名を指定 #必要なパッケージをロード library(limma) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.q <- normalizeQuantiles(as.matrix(data)) #Quantile normalizationを実行し、結果をdata.qに格納 rownames(data.q) <- rownames(data) #行の名前を追加 colnames(data.q) <- colnames(data) #列の名前を追加 tmp <- cbind(rownames(data.q), data.q) #遺伝子IDの列を行列data.qの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. sample19.txtの場合:
in_f <- "sample19.txt" #入力ファイル名を指定 out_f <- "hoge_q2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(limma) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.q <- normalizeQuantiles(as.matrix(data)) #Quantile normalizationを実行し、結果をdata.qに格納 rownames(data.q) <- rownames(data) #行の名前を追加 colnames(data.q) <- colnames(data) #列の名前を追加 tmp <- cbind(rownames(data.q), data.q) #遺伝子IDの列を行列data.qの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. sample19_plus1.txtの場合:
in_f <- "sample19_plus1.txt" #入力ファイル名を指定 out_f <- "hoge_q3.txt" #出力ファイル名を指定 #必要なパッケージをロード library(limma) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.q <- normalizeQuantiles(as.matrix(data)) #Quantile normalizationを実行し、結果をdata.qに格納 rownames(data.q) <- rownames(data) #行の名前を追加 colnames(data.q) <- colnames(data) #列の名前を追加 tmp <- cbind(rownames(data.q), data.q) #遺伝子IDの列を行列data.qの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献(Jeffery et al., BMC Bioinformatics, 2006)
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 5 #組織数kを指定 param2 <- 50 #シグナル強度Aを指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 f1 <- kOverA(param1, A=param2) #「k組織以上でシグナル強度A以上を持つ遺伝子を抽出」という条件(filter)をf1に格納 ffun <- filterfun(f1) #フィルタリング用の関数(filtering function)を作成しffunに格納 which <- genefilter(data, ffun) #フィルタリングを実行し、結果をwhichに格納 which #whichの中身を表示 (この場合はgene1, 2, 5がTRUEとなる) sum(which) #条件を満たす遺伝子がいくつあったかを表示 (この場合は3) data.f <- data[which,] #条件を満たす遺伝子群の発現データをdata.fに格納 data.f #結果を表示 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. シグナル強度>20(A=20)の組織数の割合が>70%(p=0.7)を満たす遺伝子のみを抽出したい場合:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 0.7 #組織数の割合pを指定 param2 <- 20 #シグナル強度Aを指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 f1 <- pOverA(p=param1, A=param2) #「シグナル強度がAよりも大きい組織数の割合がpよりも大きい遺伝子を抽出」という条件(filter)をf1に格納 ffun <- filterfun(f1) #フィルタリング用の関数(filtering function)を作成しffunに格納 which <- genefilter(data, ffun) #フィルタリングを実行し、結果をwhichに格納 which #whichの中身を表示 (この場合はgene1, 2, 5がTRUEとなる) sum(which) #条件を満たす遺伝子がいくつあったかを表示 (この場合は3) data.f <- data[which,] #条件を満たす遺伝子群の発現データをdata.fに格納 data.f #結果を表示 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. 少なくとも一つの組織でシグナル強度が92(A=92)以上の遺伝子を抽出したい場合:
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param <- 92 #シグナル強度Aを指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 f1 <- maxA(param) #「少なくとも一つの組織でシグナル強度がparam以上の遺伝子を抽出」という条件(filter)をf1に格納 ffun <- filterfun(f1) #フィルタリング用の関数(filtering function)を作成しffunに格納 which <- genefilter(data, ffun) #フィルタリングを実行し、結果をwhichに格納 which #whichの中身を表示 (この場合はgene2, 5がTRUEとなる) sum(which) #条件を満たす遺伝子がいくつあったかを表示 (この場合は3) data.f <- data[which,] #条件を満たす遺伝子群の発現データをdata.fに格納 data.f #結果を表示 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。Bioconductorのgenefilterのwebページ
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 10 #シグナル強度の下限を指定 param2 <- 100 #シグナル強度の上限を指定 param3 <- 2.9 #シグナル強度最大と最小の発現比を指定 param4 <- 42 #シグナル強度最大と最小の差を指定 library(som) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.f <- filtering(data, lt=param1, ut=param2, mmr=param3, mmd=param4)#フィルタリングを実行し、結果をdata.fに格納 data.f #結果を表示 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 「発現強度max/min < 2.9」の行(遺伝子)だけを解析から除く場合: 以下では、上限値と下限値をそれぞれ「読み込んだ遺伝子発現データの最大値と最小値」として param1とparam2に自動的に与えているので、結果として入力時に明示的に指定する必要はありません。 発現強度max-minの値は0を条件として与えています。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param3 <- 2.9 #シグナル強度最大と最小の発現比を指定 #必要なパッケージをロード library(som) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 param1 <- min(data) #シグナル強度の下限を計算 param2 <- max(data) #シグナル強度の上限を計算 param4 <- 0 #シグナル強度最大と最小の差を0として指定 data.f <- filtering(data, lt=param1, ut=param2, mmr=param3, mmd=param4)#フィルタリングを実行し、結果をdata.fに格納 data.f #結果を表示 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。CRANのsomのwebページ
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 out <- apply(data, 1, allNA) #全ての要素がNAならFALSE, それ以外ならTRUEを返すallNA関数を各行に対して適用し、結果をoutに格納 data.f <- data[out,] #行列dataの中から一つでも要素がNAでない(TRUEに対応)行のみ抽出し、結果をdata.fに格納 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。1-2. 全ての要素がNAとなっている行を除く場合(やり方2):
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 out <- t(apply(data, 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行に対して適用し、結果をoutに格納 out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を各行に対して適用し、結果をout2に格納 data.f <- data[out2 < ncol(data),] #行列dataの中から全ての要素がNAである(out2の値がncol(data)未満に相当)行のみ抽出し、結果をdata.fに格納 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 一つでもNAがある行を除く場合:
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 out <- t(apply(data, 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行に対して適用し、結果をoutに格納 out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を各行に対して適用し、結果をout2に格納 data.f <- data[out2 == 0,] #行列dataの中から全ての要素がNAでない(out2の値が0に相当)行のみ抽出し、結果をdata.fに格納 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. 「A群はX(=2)個以上且つB群でY(=4)個以上」のNAでない(≒数値)要素を含む行のみ抽出したい場合:
in_f <- "sample13_7vs7.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 7 #A群のサンプル数を指定 param2 <- 7 #B群のサンプル数を指定 param3 <- 2 #Xの数を指定 param4 <- 4 #Yの数を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #A群のデータについてNAでない要素数を各行についてカウント out <- t(apply(data[data.cl == 0], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のA群のみに対して適用し、結果をoutに格納 out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をout2に格納 outA <- param1 - out2 #param1で指定した数からout2の値を引くことで得た「NAでないA群の要素数」をoutAに格納 #B群のデータについてNAでない要素数を各行についてカウント out <- t(apply(data[data.cl == 1], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のB群のみに対して適用し、結果をoutに格納 out2 <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をout2に格納 outB <- param2 - out2 #param2で指定した数からout2の値を引くことで得た「NAでないB群の要素数」をoutBに格納 data.f <- data[((outA >= param3) & (outB >= param4)),] #行列dataの中から条件を満たす行のみ抽出し、結果をdata.fに格納 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。4. 解析したいファイルがsample13_7vs7_nr.txtで「A群はX(=3)個以上且つB群でY(=3)個以上」のNAやNaNでない(≒数値)要素を含む行のみ抽出したい場合:
in_f <- "sample13_7vs7_nr.txt" #入力ファイル名を指定 out_f <- "sample13_7vs7_nr2.txt" #出力ファイル名を指定 param1 <- 7 #A群のサンプル数を指定 param2 <- 7 #B群のサンプル数を指定 param3 <- 3 #Xの数を指定 param4 <- 3 #Yの数を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #A群のデータについてNAでない要素数を各行についてカウント out <- t(apply(data[data.cl == 0], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のA群のみに対して適用し、結果をoutに格納 outNA <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をoutNAに格納 out <- t(apply(data[data.cl == 0], 1, is.nan)) #各要素がNaNであるかどうか(TRUE or FALSE)を返すis.nan関数を各行のA群のみに対して適用し、結果をoutに格納 outNaN <- apply(out, 1, sum) #TRUEの数(NaNの数)を返すsum関数を適用し、結果をoutNaNに格納 outA <- param1 - outNA - outNaN #param1で指定した数からoutNAとoutNaNの値を引くことで得た「NA or NaNでないA群の要素数」をoutAに格納 #B群のデータについてNAでない要素数を各行についてカウント out <- t(apply(data[data.cl == 1], 1, is.na)) #各要素がNAであるかどうか(TRUE or FALSE)を返すis.na関数を各行のB群のみに対して適用し、結果をoutに格納 outNA <- apply(out, 1, sum) #TRUEの数(NAの数)を返すsum関数を適用し、結果をoutNAに格納 out <- t(apply(data[data.cl == 1], 1, is.nan)) #各要素がNaNであるかどうか(TRUE or FALSE)を返すis.nan関数を各行のB群のみに対して適用し、結果をoutに格納 outNaN <- apply(out, 1, sum) #TRUEの数(NaNの数)を返すsum関数を適用し、結果をoutNaNに格納 outB <- param2 - outNA - outNaN #param2で指定した数からoutNAとoutNaNの値を引くことで得た「NA or NaNでないB群の要素数」をoutBに格納 data.f <- data[((outA >= param3) & (outB >= param4)),] #行列dataの中から条件を満たす行のみ抽出し、結果をdata.fに格納 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "data_GSE7623_rma.txt" #入力ファイル名を指定 param <- 0.2 #CV値(X)を指定 out_f <- "data_GSE7623_rma_cv.txt" #出力ファイル名を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 out <- genefilter(data, cv(param, Inf)) #CV値によるフィルタリングを実行し、結果をoutに格納 data.f <- data[out,] #行列dataの中から一つでも要素がNAでない(TRUEに対応)行のみ抽出し、結果をdata.fに格納 tmp <- cbind(rownames(data.f), data.f) #遺伝子IDの列を行列data.fの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f1 <- "data_rma_2.txt" #入力ファイル1(発現データ)を指定 in_f2 <- "GPL1355-14795_symbol.txt" #入力ファイル2(Gene symbolとIDの対応表のデータ)を指定 param <- mean #代表値を指定 out_f <- "data_rma_2_nr.txt" #出力ファイル名を指定 #IDとGene symbolとの対応関係を含む情報を入手 sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル2を読み込んでsymに格納。 symbols <- as.vector(sym[,1]) #Gene symbol情報をベクトルに変換し、symbolsに格納 names(symbols) <- rownames(sym) #symbolsをIDで対応づけられるようにしている unique_sym <- unique(symbols) #symbolsの中からnon-redundantな情報のみを抽出し、unique_symに格納 unique_sym <- unique_sym[unique_sym != ""] #unique_symの中から、Gene symbolがないものを除く unique_sym <- unique_sym[!is.na(unique_sym)] #unique_symの中から、Gene symbolが"NA"のものを除く unique_sym <- unique_sym[!is.nan(unique_sym)] #unique_symの中から、Gene symbolが"NaN"のものを除く #メイン部分 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #入力ファイル1を読み込んでdataに格納 hoge <- NULL #最終的に欲しい情報を格納するためのプレースホルダ for(i in 1:length(unique_sym)){ #non-redundant gene symbol数分だけループを回す hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))#dataの中からi番目のgene symbolと同じprobesを全て抽出し、その平均値(mean)をhogeの一番下の行に追加 } #non-redundant gene symbol数分だけループを回す rownames(hoge) <- unique_sym #non-redundant gene symbolsをhogeの行の名前として利用 tmp <- cbind(rownames(hoge), hoge) #遺伝子IDの列を行列hogeの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. Agilent Human 1A (V2)チップの発現データ(サンプルマイクロアレイデータの12で得たsample13_7vs7.txt)と アノテーション情報取得 | GEOからの6までを行って得たGPL887-5640_symbol.txt の二つのファイルを用いて行う場合: (sample13_7vs7.txtの一列目のID情報とGPL887-5640_symbol.txtの一列目のID情報の対応がとれる(同じ行の位置でなくてもよい)ことが前提です)
in_f1 <- "sample13_7vs7.txt" #入力ファイル1(発現データ)を指定 in_f2 <- "GPL887-5640_symbol.txt" #入力ファイル2(Gene symbolとIDの対応表のデータ)を指定 param <- mean #代表値を指定 out_f <- "sample13_7vs7_nr.txt" #出力ファイル名を指定 #IDとGene symbolとの対応関係を含む情報を入手 sym <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル2を読み込んでsymに格納。 symbols <- as.vector(sym[,1]) #Gene symbol情報をベクトルに変換し、symbolsに格納 names(symbols) <- rownames(sym) #symbolsをIDで対応づけられるようにしている unique_sym <- unique(symbols) #symbolsの中からnon-redundantな情報のみを抽出し、unique_symに格納 unique_sym <- unique_sym[unique_sym != ""] #unique_symの中から、Gene symbolがないものを除く unique_sym <- unique_sym[!is.na(unique_sym)] #unique_symの中から、Gene symbolが"NA"のものを除く unique_sym <- unique_sym[!is.nan(unique_sym)] #unique_symの中から、Gene symbolが"NaN"のものを除く #メイン部分 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #入力ファイル1を読み込んでdataに格納 hoge <- NULL #最終的に欲しい情報を格納するためのプレースホルダ for(i in 1:length(unique_sym)){ #non-redundant gene symbol数分だけループを回す hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))#dataの中からi番目のgene symbolと同じprobesを全て抽出し、その平均値(mean)をhogeの一番下の行に追加 } #non-redundant gene symbol数分だけループを回す rownames(hoge) <- unique_sym #non-redundant gene symbolsをhogeの行の名前として利用 tmp <- cbind(rownames(hoge), hoge) #遺伝子IDの列を行列hogeの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. Affymetrix Rat Genome 230 2.0 Arrayを用いて得られた参考文献1のデータ (data_GSE7623_rma.txt)を入力として、アノテーション情報取得 | Rのパッケージからの1 を参考にして得られたprobe IDとGene symbolとの対応関係を含む情報を用いて行う場合:
in_f <- "data_GSE7623_rma.txt" #入力ファイル名を指定 param <- mean #代表値を指定 out_f <- "data_GSE7623_rma_nr.txt" #出力ファイル名を指定 #probe IDとGene symbolとの対応関係を含む情報を入手 source("http://bioconductor.org/biocLite.R") #おまじない biocLite("rat2302.db") #アノテーション情報取得 library(rat2302.db) #ライブラリ読み込み library(help=rat2302.db) #rat2302.db中にどんな情報が含まれているか見る sym_info <- rat2302SYMBOL #何度も必要箇所を書き換えなくてもいいようにrat2302SYMBOLを以後sym_infoとして取り扱う symbols <- unlist(as.list(sym_info)) #全31099 probesに対応するGeneSymbol(SYMBOL)情報を抽出し、symbolsに格納 unique_sym <- unique(symbols) #non-redundantなGeneSymbol(SYMBOL)情報を抽出し、unique_symに格納 unique_sym <- unique_sym[unique_sym != ""] #unique_symの中から、Gene symbolがないものを除く unique_sym <- unique_sym[!is.na(unique_sym)] #unique_symの中から、Gene symbolが"NA"のものを除く unique_sym <- unique_sym[!is.nan(unique_sym)] #unique_symの中から、Gene symbolが"NaN"のものを除く #メイン部分 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 hoge <- NULL #最終的に欲しい情報を格納するためのプレースホルダ for(i in 1:length(unique_sym)){ #non-redundant gene symbol数分だけループを回す hoge <- rbind(hoge, apply(data[which(symbols == unique_sym[i]),], 2, param, na.rm=TRUE))#dataの中からi番目のgene symbolと同じprobesを全て抽出し、その平均値(mean)をhogeの一番下の行に追加 } #non-redundant gene symbol数分だけループを回す rownames(hoge) <- unique_sym #non-redundant gene symbolsをhogeの行の名前として利用 tmp <- cbind(rownames(hoge), hoge) #遺伝子IDの列を行列hogeの左端に挿入し、結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。4. sample18_5vs5.txt(図3)を入力として、4列目の情報をもとにでエクソンごとに分かれている同じ遺伝子のものをまとめる(図4のようにする)場合: (同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合にはエラーを吐くように設計)
in_f <- "sample18_5vs5.txt" #入力ファイルを指定 out_f <- "sample18_5vs5_nr.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, sep="\t", quote="") #入力ファイルを読み込んでdataに格納 #genenameに相当する4列目の情報を抽出して加工("-ex"よりも左側の文字列のみ抽出) hoge <- strsplit(as.character(data[,4]), "-ex", fixed=TRUE) #data[,param]を文字列に変換し、"-ex"で区切った結果をリスト形式でhogeに格納 genename <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素("-ex"で区切った左側部分に相当)のみ抽出してgenenameに格納 unique_genename <- unique(genename) #non-redundantなgenename情報を抽出し、unique_genenameに格納 #1,6列目の情報(chrとstrand)はそのまま、5, 7-16列の情報(lengthとカウントデータ)のみsumしたいので、それぞれをサブセットに分ける sub1 <- data[,c(1,6)] #1,6列目の情報のみ抽出しsub1に格納 sub2 <- data[,c(5,7:16)] #5,7-16列目の情報のみ抽出しsub2に格納 out <- NULL #最終的に欲しい情報を格納するためのプレースホルダ for(i in 1:length(unique_genename)){ #unique_genenameの要素数分だけループを回す out_sub1 <- apply(sub1[which(genename == unique_genename[i]),], 2, unique, na.rm=TRUE)#sub1のところは、複数エクソンの場合は同じ情報がエクソン数分だけあることになるので、unique関数を実行した結果をout_sub1に格納 out_sub2 <- apply(sub2[which(genename == unique_genename[i]),], 2, sum, na.rm=TRUE)#sub2のところでは、複数エクソンの場合にsum関数を実行した結果(和をとった結果)をout_sub2に格納 out <- rbind(out, c(out_sub1, unique_genename[i], out_sub2)) #「out_sub1, unique_genename[i], out_sub2」の順番で行列outの下に結果をどんどん追加 } write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。5. sample18_5vs5.txt(図3)を入力として、4列目の情報をもとにでエクソンごとに分かれている同じ遺伝子のものをまとめる(図4のようにする)場合: (同じ遺伝子上の複数のエクソンのstrand情報が+と-両方ある場合には「2」を、そうでない場合には「1」としたベクトルを最初の一列目に追加で出力するように設計)
in_f <- "sample18_5vs5.txt" #入力ファイルを指定 out_f <- "sample18_5vs5_nr.txt" #出力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, sep="\t", quote="") #入力ファイルを読み込んでdataに格納 #genenameに相当する4列目の情報を抽出して加工("-ex"よりも左側の文字列のみ抽出) hoge <- strsplit(as.character(data[,4]), "-ex", fixed=TRUE) #data[,param]を文字列に変換し、"-ex"で区切った結果をリスト形式でhogeに格納 genename <- unlist(lapply(hoge, "[[", 1)) #hogeのリスト中の1番目の要素("-ex"で区切った左側部分に相当)のみ抽出してgenenameに格納 unique_genename <- unique(genename) #non-redundantなgenename情報を抽出し、unique_genenameに格納 #1,6列目の情報(chrとstrand)はそのまま、5, 7-16列の情報(lengthとカウントデータ)のみsumしたいので、それぞれをサブセットに分ける sub1 <- data[,c(1,6)] #1,6列目の情報のみ抽出しsub1に格納 sub2 <- data[,c(5,7:16)] #5,7-16列目の情報のみ抽出しsub2に格納 out <- NULL #最終的に欲しい情報を格納するためのプレースホルダ for(i in 1:length(unique_genename)){ #unique_genenameの要素数分だけループを回す tmp <- unlist(apply(sub1[which(genename == unique_genename[i]),], 2, unique, na.rm=TRUE))#sub1のところは、複数エクソンの場合は同じ情報がエクソン数分だけあることになるはずであるが、そうでない可能性があるときに見つけられるようにしている out_flag <- length(tmp) #ベクトルtmpの要素数をout_flagに格納(通常はtmpの要素数が2だが、3以上のものを検出するのが目的) out_sub1 <- tmp[1:2] #どんな状況になっていようと、とにかくベクトルtmpの最初の二つの要素を出力すべくout_sub1に格納 out_sub2 <- apply(sub2[which(genename == unique_genename[i]),], 2, sum, na.rm=TRUE)#sub2のところでは、複数エクソンの場合にsum関数を実行した結果(和をとった結果)をout_sub2に格納 out <- rbind(out, c(out_flag, out_sub1, unique_genename[i], out_sub2)) #「out_sub1, unique_genename[i], out_sub2」の順番で行列outの下に結果をどんどん追加 } write.table(out, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。GSEAの「Run GSEA Page」のところ
in_f1 <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(テンプレート情報)を指定 out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定 out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定 param1 <- 10 #上位X個のXを指定 param2 <- "none" #類似度計算前の発現データのスケーリング法を指定 param3 <- "correlation" #距離を定義する方法を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。(read.tableで読み込んで得られたdataの型は"データフレーム"のため) data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納 template <- data_cl[,2] #バイナリ(0 or 1)情報(2列目)のみ抽出し、templateに格納 template #バイナリ(0 or 1)情報の確認 tmp <- rbind(data, template) #templateというテンプレートパターンを行列dataの最後の行に追加 template_posi <- which(rownames(tmp) == "template") #行のラベル情報が"template"に相当する行番号をtemplate_posiに格納 closeg <- genefinder(tmp, template_posi, param1, scale=param2, method=param3)#上位"param1"個の情報をclosegに格納 closeg[[1]]$indices #上位"param1"個の行番号を表示 closeg[[1]]$dists #上位"param1"個の類似度を表示 topranked <- tmp[closeg[[1]]$indices,] #上位"param1"個の遺伝子発現データを抽出し、toprankedに格納 tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納 write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。 write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 似ている順に全遺伝子をソートした結果を得たい場合: ここでは、予め作成した「心臓特異的発現パターン」を示す遺伝子群を抽出するための "理想的なパターン(テンプレート)"を含むファイルGDS1096_cl_heart.txtを読み込んで、 「心臓特異的発現パターン」に似ている順に全遺伝子をソートした二つのファイル data_topranked.txt(発現データ含む)とdata_topranked_ID.txt(発現データ含まず遺伝子IDのみ) に保存するやり方を示します。 (発現ベクトルをZスケーリング(zscore)し、類似度は「1 - 相関係数」(correlation)で定義)
in_f1 <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(テンプレート情報)を指定 out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定 out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定 param2 <- "zscore" #類似度計算前の発現データのスケーリング法を指定 param3 <- "correlation" #距離を定義する方法を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。(read.tableで読み込んで得られたdataの型は"データフレーム"のため) data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納 template <- data_cl[,2] #バイナリ(0 or 1)情報(2列目)のみ抽出し、templateに格納 template #バイナリ(0 or 1)情報の確認 tmp <- rbind(data, template) #templateというテンプレートパターンを行列dataの最後の行に追加 template_posi <- which(rownames(tmp) == "template") #行のラベル情報が"template"に相当する行番号をtemplate_posiに格納 param1 <- nrow(data) #遺伝子数をparam1に格納 closeg <- genefinder(tmp, template_posi, param1, scale=param2, method=param3)#特異的発現の度合いでランキングされた結果をclosegに格納 topranked <- tmp[closeg[[1]]$indices,] #特異的発現の度合いでランキングされた遺伝子発現データをtoprankedに格納 tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納 write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。 write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。3. 遺伝子ID: 207003_atの遺伝子発現プロファイルと発現パターンが似ている上位5個をリストアップしたい場合: (発現ベクトルをRangeスケーリング(range)し、類似度はマンハッタン距離(manhattan)で定義)
in_f <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定 out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定 out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定 param1 <- 5 #上位X個のXを指定 param2 <- "range" #類似度計算前の発現データのスケーリング法を指定 param3 <- "manhattan" #距離を定義する方法を指定 param4 <- "207003_at" #遺伝子IDを指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。(read.tableで読み込んで得られたdataの型は"データフレーム"のため) template_posi <- which(rownames(data) == param4) #param4で指定した遺伝子IDに相当する行番号をtemplate_posiに格納 closeg <- genefinder(data, template_posi, param1, scale=param2, method=param3)#上位"param1"個の情報をclosegに格納 topranked <- data[closeg[[1]]$indices,] #上位"param1"個の遺伝子発現データを抽出し、toprankedに格納 tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納 write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。 write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。4. (ヘッダー行を除く)15987行目(ID_REF: "216617_s_at"の行に相当)の遺伝子発現プロファイルと 発現パターンが似ている上位10個をリストアップしたい場合: (発現ベクトルをZスケーリング(zscore)し、類似度は「1 - 相関係数」(correlation)で定義)
in_f <- "GDS1096_rma.txt" #入力ファイル名1(発現データ)を指定 out_f1 <- "data_torranded.txt" #出力ファイル名(発現データ含むほう)を指定 out_f2 <- "data_topranked_ID.txt" #出力ファイル名(遺伝子IDのみのほう)を指定 param1 <- 10 #上位X個のXを指定 param2 <- "zscore" #類似度計算前の発現データのスケーリング法を指定 param3 <- "correlation" #距離を定義する方法を指定 param4 <- 15987 #目的遺伝子の行番号を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。(read.tableで読み込んで得られたdataの型は"データフレーム"のため) closeg <- genefinder(data, param4, param1, scale=param2, method=param3)#上位"param1"個の情報をclosegに格納 topranked <- data[closeg[[1]]$indices,] #上位"param1"個の遺伝子発現データを抽出し、toprankedに格納 tmp2 <- cbind(rownames(topranked), topranked) #遺伝子IDの列を行列toprankedの左端に挿入し、結果をtmp2に格納 write.table(tmp2, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f1で指定したファイル名で保存。 write.table(rownames(topranked), out_f2, sep="\t", append=F, quote=F, row.names=F, col.names=F)#遺伝子IDに関する情報のみ、out_f2で指定したファイル名で保存。Bioconductorのgenefilterのwebページ
in_f <- "sample14.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 #必要なパッケージをロード library(OCplus) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 out1 <- fdr1d(data, data.cl, verb=FALSE) #入力データ中の発現変動していない遺伝子(non-DEGs)の割合を調べた結果をout1に格納 out2 <- EOC(data, data.cl) #入力データ中の発現変動していない遺伝子(non-DEGs)の割合を調べた結果をout2に格納 p0(out1) #得られたout1の中から目的のnon-DEGsの割合の数値を表示 p0(out2) #得られたout2の中から目的のnon-DEGsの割合の数値を表示参考文献1(Ploner et al., Bioinformatics, 2006)
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param_A <- 50 #A群のサンプル数を指定 param_B <- 52 #B群のサンプル数を指定 #WAD統計量を計算するための関数を定義 WAD <- function(data=NULL, data.cl=NULL){ #WAD統計量を計算するための関数 x <- data #WAD統計量を計算するための関数 cl <- data.cl #WAD統計量を計算するための関数 mean1 <- rowMeans(as.matrix(x[, cl==0])) #WAD統計量を計算するための関数 mean2 <- rowMeans(as.matrix(x[, cl==1])) #WAD統計量を計算するための関数 x_ave <- (mean1 + mean2)/2 #WAD統計量を計算するための関数 weight <- (x_ave - min(x_ave))/(max(x_ave) - min(x_ave)) #WAD統計量を計算するための関数 statistic <- (mean2 - mean1)*weight #WAD統計量を計算するための関数 return(statistic) #WAD統計量を計算するための関数 } #WAD統計量を計算するための関数 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 #WAD統計量の計算とファイル出力 stat_wad <- WAD(data=data, data.cl=data.cl) #WADを実行し、WAD統計量を計算した結果をstat_wadに格納 rank_wad <- rank(-abs(stat_wad)) #WAD統計量の順位を計算した結果をrank_wadに格納 tmp <- cbind(rownames(data), data, stat_wad, rank_wad) #入力データの右側に、「WAD統計量」と「その順位」を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 入力ファイルがlogged dataでない場合: 以下では(遺伝子名の列を除く)最初の6列(X=6)がA群、残りの5列(Y=5)がB群からなる(まだ対数変換されていない) 遺伝子発現データファイル(sample2.txt)の二群間比較を例とします。 「ファイル」−「ディレクトリの変更」で解析したいファイル(sample2.txt)を置いてあるディレクトリに移動し、以下をコピペ。
in_f <- "sample2.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param_A <- 6 #A群のサンプル数を指定 param_B <- 5 #B群のサンプル数を指定 #WAD統計量を計算するための関数を定義 WAD <- function(data=NULL, data.cl=NULL){ #WAD統計量を計算するための関数 x <- data #WAD統計量を計算するための関数 cl <- data.cl #WAD統計量を計算するための関数 mean1 <- rowMeans(as.matrix(x[, cl==0])) #WAD統計量を計算するための関数 mean2 <- rowMeans(as.matrix(x[, cl==1])) #WAD統計量を計算するための関数 x_ave <- (mean1 + mean2)/2 #WAD統計量を計算するための関数 weight <- (x_ave - min(x_ave))/(max(x_ave) - min(x_ave)) #WAD統計量を計算するための関数 statistic <- (mean2 - mean1)*weight #WAD統計量を計算するための関数 return(statistic) #WAD統計量を計算するための関数 } #WAD統計量を計算するための関数 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 #発現データのシグナル強度が1未満のものを1にした後にlog2変換 data[data < 1] <- 1 #1未満のシグナル強度のものを1とする data <- log(data, 2) #log2スケーリング #WAD統計量の計算とファイル出力 stat_wad <- WAD(data=data, data.cl=data.cl) #WADを実行し、WAD統計量を計算した結果をstat_wadに格納 rank_wad <- rank(-abs(stat_wad)) #WAD統計量の順位を計算した結果をrank_wadに格納 tmp <- cbind(rownames(data), data, stat_wad, rank_wad) #入力データの右側に、「WAD統計量」と「その順位」を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献(Kadota et al., Algorithms Mol. Biol., 2008)
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要なパッケージをロード library(varSelRF) #varSelRFパッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- factor(c(rep(1, param1), rep(2, param2))) #A群を1、B群を2としたベクトルdata.clを作成 rf.vs1 <- varSelRF(t(data), data.cl) #RFをデフォルトのパラメータを用いて実行 rf.vs1$selected.vars #最終的に選ばれた遺伝子を表示CRAN中のvarSelRFパッケージのサイト
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要なパッケージをロード library(st) #shrinkage t statisticを計算するためのパッケージの読み込み library(samr) #SAMを計算するためのパッケージの読み込み library(limma) #empirical Bayesを計算するためのパッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 stat_st <- shrinkt.stat(t(data), data.cl) #Shrinkage t統計量を計算し結果をstat_stに格納 rank_st <- rank(-abs(stat_st)) #Shrinkage t統計量の順位を計算し結果をrankt_stに格納 stat_efron <- efront.stat(t(data), data.cl) #Efron's t統計量を計算し結果をstat_efronに格納 rank_efron <- rank(-abs(stat_efron)) #Efron's t統計量の順位を計算し結果をrank_efronに格納 stat_ebayes <- modt.stat(t(data), data.cl) #Empirical Bayes t統計量を計算し結果をstat_ebayesに格納 rank_ebayes <- rank(-abs(stat_ebayes)) #Empirical Bayes t統計量の順位を計算し結果をrank_ebayesに格納 stat_sam <- sam.stat(t(data), data.cl) #SAM's t統計量を計算し結果をstat_samに格納 rank_sam <- rank(-abs(stat_sam)) #SAM's t統計量の順位を計算し結果をrank_samに格納 tmp <- cbind(rownames(data), data, stat_st, rank_st, stat_efron, rank_efron, stat_ebayes, rank_ebayes, stat_sam, rank_sam)#「それぞれの計算方法で得られた統計量」と「その順位」をShrinkage, Efron, empirical Bayes, SAMの順に右のカラムに結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。CRANのstのwebページ
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 param3 <- "pareto" #ランキング法を指定 #必要なパッケージなどをロード #source("http://gap.stat.sinica.edu.tw/Software/mvo.R") #layer ranking algorithmのRスクリプトの読み込み source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #layer ranking algorithmのRスクリプトの読み込み library(samr) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 data.tmp = list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpという入力データを作成 out <- samr(data.tmp, resp.type="Two class unpaired", nperms=20) #samr関数を実行し、結果をoutに格納 stat_sam <- out$tt #SAM統計量をstat_samに格納 rank_sam <- rank(-abs(stat_sam)) #SAM統計量の順位をrank_samに格納 stat_fc <- log2(out$foldchange) #log(FC)統計量をstat_fcに格納 rank_fc <- rank(-abs(stat_fc)) #log(FC)統計量の順位をrank_fcに格納 ranks <- cbind(stat_sam, stat_fc) #SAM統計量とFC統計量をまとめたものをranksに格納。 ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)#param3で指定した総合ランキングを実行 tmp <- cbind(rownames(data), data, stat_sam, stat_fc, rank_sam, rank_fc, ranks.out)#入力データの右側に「SAM統計量」「log(FC)」「SAM統計量の順位」「log(FC)の順位」「layer ranking」情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。以下の計算を実行すると(結構時間がかかります)一位に"37639_at"と"41468_at"の2つが、二位に"1740_g_at"と"37366_at"が、そして三位に"1890_at"など計三つがランキングされていることが分かります。(hoge.txtをエクセルのタブ区切りテキストで開くとFカラムからこれらの情報が分かります。) ここではPareto layer ranking (method="pareto"で指定)で総合ランキングを得ているので、同じ順位内の遺伝子群は「log2(Fold change)の絶対値でのランキング」または「SAMのd統計量の絶対値でのランキング」いずれかで、同じ順位内の他の遺伝子に対して勝っています。 例えば、総合ランキング三位の三つの遺伝子は、(総合ランキング一位と二位を除いて)"1890_at"は「log ratioの絶対値での順位」がトップ(4位)です。"32598_at"は「d統計量の絶対値での順位」がトップ(4位)。"38827_at"はそれぞれのランキングはともに5位ですが、「log ratioの絶対値での順位」は"32598_at"に勝っており、「d統計量の絶対値での順位」は"1890_at"に勝っているので、順位的に劣っているとはみなさない、というのがここでのPareto layer rankingの考え方です。 2. 「log2(幾何平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」の場合:
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 param3 <- "pareto" #ランキング法を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #layer ranking algorithmのRスクリプトの読み込み source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Welch t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 out <- t(apply(data, 1, Welch_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 stat_t <- out[,1] #t統計量をstat_tに格納 rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納 stat_fc <- apply(data, 1, AD, data.cl) #log(FC)統計量(AD統計量)をstat_fcに格納 rank_fc <- rank(-abs(stat_fc)) #log(FC)統計量の順位をrank_fcに格納 ranks <- cbind(stat_t, stat_fc) #t統計量とFC統計量をまとめたものをranksに格納。 ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)#param3で指定した総合ランキングを実行 tmp <- cbind(rownames(data), data, stat_t, stat_fc, rank_t, rank_fc, ranks.out)#入力データの右側に「t統計量」「log(FC)」「t統計量の順位」「log(FC)の順位」「layer ranking」情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. 「log2(算術平均版のFold change)の絶対値でのランキング」と「Welch t統計量の絶対値でのランキング」の場合:
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 param3 <- "pareto" #ランキング法を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/mvo.R") #layer ranking algorithmのRスクリプトの読み込み source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Welch t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 out <- t(apply(data, 1, Welch_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 stat_t <- out[,1] #t統計量をstat_tに格納 rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納 stat_fc <- apply(data, 1, FC, data.cl) #log(FC)統計量をstat_fcに格納 rank_fc <- rank(-abs(stat_fc)) #log(FC)統計量の順位をrank_fcに格納 ranks <- cbind(stat_t, stat_fc) #t統計量とFC統計量をまとめたものをranksに格納。 ranks.out <- mvo(ranks,ignore=c(T,T),opposite=c(F,F), empty=F, method=param3)#param3で指定した総合ランキングを実行 tmp <- cbind(rownames(data), data, stat_t, stat_fc, rank_t, rank_fc, ranks.out)#入力データの右側に「t統計量」「log(FC)」「t統計量の順位」「log(FC)の順位」「layer ranking」情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "sample14.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 #必要なパッケージをロード library(OCplus) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 tmpout <- fdr1d(data, data.cl, verb=FALSE) #入力データ中の発現変動していない遺伝子(non-DEGs)の割合を調べた結果をtmpoutに格納 p0(tmpout) #得られたtmpoutの中から目的のnon-DEGsの割合の数値を表示 out <- fdr2d(data, data.cl, p0=p0(tmpout), verb=FALSE) #「標準誤差のlog」と「t統計量」の二つの統計量の値を使って総合FDRを計算 tmp <- cbind(rownames(data), data, out) #入力データの右側に「t統計量(tstat)」「標準誤差のlog(logse)」「総合FDR」情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Ploner et al., Bioinformatics, 2006)
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要なパッケージなどをロード library(limma) #パッケージの読み込み source("http://eh3.uc.edu/r/ibmtR.R") #IBMTのRスクリプトの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 design <- model.matrix(~data.cl) #おまじない data <- as.matrix(data) #おまじない fit <- lmFit(data, design) #おまじない fit$Amean<-rowMeans(data) #おまじない fit <- IBMT(fit,2) #IBMTプログラムの実行 stat_ibmt <- fit$IBMT.t #得られた統計量をstat_ibmtに格納 rank_ibmt <- rank(-abs(stat_ibmt)) #統計量の絶対値でランキングした結果をrank_ibmtに格納 tmp <- cbind(rownames(data), data, stat_ibmt, rank_ibmt) #入力データの右側に「IBMT統計量」「その順位」情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。Rスクリプトのある場所
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 #必要なパッケージをロード library(puma) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset_mmgmos <- mmgmos(data) #multi-mgMOSを実行し、結果をeset_mmgmosに保存 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 pData(eset_mmgmos) <- data.frame( #各CELファイルとラベル情報を対応づける "label" = data.cl, #各CELファイルとラベル情報を対応づける row.names = list.files(pattern = ".CEL") #各CELファイルとラベル情報を対応づける eset_mmgmos_normd <- pumaNormalize(eset_mmgmos) #median scalingを行う eset_comb <- pumaComb(eset_mmgmos_normd) #PPLRの実行1 (6 hrほどかかるもよう...) eset_DE <- pumaDE(eset_comb) #PPLRの実行2 stat_pplr <- abs(statistic(eset_DE) - 0.5) #PPLRが出力する統計量は[0,1]の範囲で0.5が発現変動なしに相当するので、WADやSAMと同じ枠組みで処理できるように得られた統計量から0.5を引いておく rank_pplr <- rank(-abs(stat_pplr)) #統計量の絶対値でランキングした結果をrank_pplrに格納 tmp <- cbind(rownames(data), data, stat_pplr, rank_pplr) #入力データの右側に「変換後のPPLR統計量」「その順位」情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. (logスケールで)シグナル強度が0以下のものを0にしてからPPLRを実行するやり方(WADなどの手順とそろえたいとき)
out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 #必要なパッケージをロード library(puma) #パッケージの読み込み data <- ReadAffy() #*.CELファイルの読み込み eset_mmgmos <- mmgmos(data) #multi-mgMOSを実行し、結果をeset_mmgmosに保存 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 pData(eset_mmgmos) <- data.frame( #各CELファイルとラベル情報を対応づける "label" = data.cl, #各CELファイルとラベル情報を対応づける row.names = list.files(pattern = ".CEL") #各CELファイルとラベル情報を対応づける eset_mmgmos_normd <- pumaNormalize(eset_mmgmos) #median scalingを行う exprs(eset_mmgmos_normd)[exprs(eset_mmgmos_normd) < 0] <- 0 #シグナル強度が0以下のものを0にする eset_comb <- pumaComb(eset_mmgmos_normd) #PPLRの実行1 (6 hrほどかかるもよう...) eset_DE <- pumaDE(eset_comb) #PPLRの実行2 stat_pplr <- abs(statistic(eset_DE) - 0.5) #PPLRが出力する統計量は[0,1]の範囲で0.5が発現変動なしに相当するので、WADやSAMと同じ枠組みで処理できるように得られた統計量から0.5を引いておく rank_pplr <- rank(-abs(stat_pplr)) #統計量の絶対値でランキングした結果をrank_pplrに格納 tmp <- cbind(rownames(data), data, stat_pplr, rank_pplr) #入力データの右側に「変換後のPPLR統計量」「その順位」情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
Bioconductorの(PPLRとmulti-mgMOSを含むパッケージ)pumaのwebページ
参考文献1(Liu et al., Bioinformatics, 2006)in_f <- "data_rma_2_BAT.txt" #入力ファイル名を指定 out_f <- "result_rankprod_BAT.txt" #出力ファイル名を指定 param_A <- 4 #A群のサンプル数を指定 param_B <- 4 #B群のサンプル数を指定 param3 <- 100 #FDR計算のための並べ替え回数を指定(ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう) #必要なパッケージをロード library(RankProd) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 out <- RP(data, data.cl, num.perm = param3, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 123)#Rank Product (RP)の実行。 stat_RP <- apply(out$RPs, 1, min) #総合RP統計量を計算(20090527追加) rank_RP <- as.matrix(rank(stat_RP, ties.method = "min")) #総合順位を計算(20090527追加) stat_fc <- -out$AveFC #総合log(FC)統計量を計算 rank_fc <- rank(-abs(stat_fc)) #総合log(FC)統計量の順位を計算 colnames(out$pfp) <- c("FDR(A群 < B群)","FDR(A群 > B群)") #列名を変更(20090527追加) colnames(out$RPs) <- c("stat(A群 < B群)","stat(A群 > B群)") #列名を変更(20090527追加) colnames(out$RPrank) <- c("rank(A群 < B群)","rank(A群 > B群)") #列名を変更(20090527追加) tmp <- cbind(rownames(data), data, out$pfp, out$RPs, out$RPrank, stat_fc, rank_fc, stat_RP, rank_RP)#入力データの右側にFDR値, 各統計量, 各順位, 総合log(FC)統計量, その順位, 総合RP統計量, その順位の情報を付加したtmpを用意。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. RMA-preprocessed data (A群:4 samples vs. B群:4 samples)でFDR < 0.05を満たすprobesetIDの情報のみ抽出したい場合: サンプルマイクロアレイデータ21中のdata_rma_2_BAT.txt (若干IDの数に変動はあると思いますが概ね1800 IDsが得られると思います)出力ファイル例:result_rankprod_BAT_id.txt
in_f <- "data_rma_2_BAT.txt" #入力ファイル名を指定 out_f <- "result_rankprod_BAT_id.txt" #出力ファイル名を指定 param_A <- 4 #A群のサンプル数を指定 param_B <- 4 #B群のサンプル数を指定 param3 <- 100 #FDR計算のための並べ替え回数を指定(ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう) param4 <- 0.05 #FDR閾値を指定 #必要なパッケージをロード library(RankProd) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 out <- RP(data, data.cl, num.perm = param3, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 123)#Rank Product (RP)の実行。 hoge_upB <- rownames(data)[out$pfp[1] < param4] #「B群 > A群」の中で指定したFDR閾値を満たすIDを抽出 hoge_upA <- rownames(data)[out$pfp[2] < param4] #「B群 < A群」の中で指定したFDR閾値を満たすIDを抽出 tmp <- union(hoge_upA, hoge_upB) #(両方で共通して出現しているIDがごくまれにあるので念のため)和集合をとっている writeLines(tmp, out_f) #tmpの中身をout_fで指定したファイル名で保存。3. RMA-preprocessed data (A群:50 samples vs. B群:52 samples)の場合: (サンプルマイクロアレイデータ7中のdata_Singh_RMA_3274.txt)
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param_A <- 50 #A群のサンプル数を指定 param_B <- 52 #B群のサンプル数を指定 param3 <- 20 #FDR計算のための並べ替え回数を指定(ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう) #必要なパッケージをロード library(RankProd) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 out <- RP(data, data.cl, num.perm = param3, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 123)#Rank Product (RP)の実行。 stat_RP <- apply(out$RPs, 1, min) #総合RP統計量を計算(20090527追加) rank_RP <- as.matrix(rank(stat_RP, ties.method = "min")) #総合順位を計算(20090527追加) stat_fc <- -out$AveFC #総合log(FC)統計量を計算 rank_fc <- rank(-abs(stat_fc)) #総合log(FC)統計量の順位を計算 colnames(out$pfp) <- c("FDR(A群 < B群)","FDR(A群 > B群)") #列名を変更(20090527追加) colnames(out$RPs) <- c("stat(A群 < B群)","stat(A群 > B群)") #列名を変更(20090527追加) colnames(out$RPrank) <- c("rank(A群 < B群)","rank(A群 > B群)") #列名を変更(20090527追加) tmp <- cbind(rownames(data), data, out$pfp, out$RPs, out$RPrank, stat_fc, rank_fc, stat_RP, rank_RP)#入力データの右側にFDR値, 各統計量, 各順位, 総合log(FC)統計量, その順位, 総合RP統計量, その順位の情報を付加したtmpを用意。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ plotRP(out, cutoff = 0.05) #FDRを5%に設定したときのB群(この場合Tumourサンプル)で高発現(2つの図の上)および低発現(2つの図の下)のdifferentially expressed genesが赤色で示される。この場合だとそれぞれ500個程度あることが分かる。 topGene(out, cutoff = 0.0001, gene.names = rownames(data)) #FDR0.01%を満たす遺伝子をリストアップ。(いっぱいあることが分かります。)尚、オプションのgene.namesはrownames(data)とちゃんと指定してあげないと遺伝子名のところがシリアル番号?!(gene.indexカラムの数字と同じ)になってしまいます。 topGene(out, num.gene = 10, gene.names = rownames(data)) #上位10遺伝子をリストアップしたいとき summary(out) #outからどのような情報を抽出できるか調べる。得られるhoge.txtについて。 FDR列:pfp (percentage of false positive predictionの略;FDRそのもの)値。この列で昇順にソートして0.05未満のもののリストなどをゲットしたりする。 stat列:RPs (RP or RPadvance関数を使ったときはrank product;RSadvance関数を使ったときはrank sum)値。統計量そのものです。低いほど発現変動の度合いが高いことを意味する。 rank列:順位 stat_fc列:log比(Bの算術平均 - A群の算術平均)値。 rank_fc列:stat_fc値の絶対値が大きい順に並べた順位。 stat_RP列:二つある"stat"列の統計量のうち、小さいほうの値。この値が小さいほど発現変動の度合いが大きいと解釈する。 rank_RP列:総合順位。Rank列は、「A群 < B群での順位」と「A群 > B群での順位」が独立に出てくるので、WADの順位との比較を行いたいなどの場合には、この総合順位を用いて行います。 参考文献1(Rank products; Breitling et al., FEBS Lett., 2004)
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要なパッケージをロード library(st) #shrinkage t statisticを計算するためのパッケージの読み込み library(limma) #empirical Bayesを計算するためのパッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 stat_ebayes <- modt.stat(t(data), data.cl) #Empirical Bayes t統計量を計算し結果をstat_ebayesに格納 rank_ebayes <- rank(-abs(stat_ebayes)) #Empirical Bayes t統計量の順位を計算し結果をrank_ebayesに格納 tmp <- cbind(rownames(data), data, stat_ebayes, rank_ebayes) #入力データの右側に「統計量」と「その順位」を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Smyth, GK, Stat Appl Genet Mol Biol., 2004)
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要なパッケージをロード library(SAGx) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 out <- samrocNboot(data=data, formula=~as.factor(data.cl)) #samrocを実行 show(out) #結果を表示 stat_samroc <- out@d #samroc統計量をstat_samrocに格納 rank_samroc <- rank(-abs(stat_samroc)) #samroc統計量の順位をrank_samrocに格納 p_samroc <- out@pvalues #p値をp_samrocに格納 tmp <- cbind(rownames(data), data, stat_samroc, p_samroc, rank_samroc)#入力データの右側に統計量、p値、順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。参考文献1(Broberg P., Genome Biol., 2003)
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 param3 <- 20 #FDR計算のための並べ替え回数を指定(ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう) #必要なパッケージをロード library(samr) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成 data.tmp = list(x=as.matrix(data), y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpを作成 out <- samr(data.tmp, resp.type="Two class unpaired", nperms=param3)#samr関数を実行し、結果をoutに格納。 summary(out) #outからどのような情報が抜き出せるか調べる。 stat_sam <- out$tt #SAM統計量をstat_samに格納 rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納 stat_fc <- log2(out$foldchange) #log(FC)統計量をstat_fcに格納 rank_fc <- rank(-abs(stat_fc)) #統計量の絶対値でランキングした結果をrank_fcに格納 tmp <- cbind(rownames(data), data, stat_sam, rank_sam, stat_fc, rank_fc)#入力データの右側に「SAM統計量」「その順位」「log(FC)統計量」「その順位」を結合した結果をtmpに格納。ここでのFold changeの値はunlogged dataのaverage fold change(B群/A群)が計算されています。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。CRANのsamrのwebページ
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "sample16_cl.txt" #入力ファイル名2(テンプレート情報)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納 data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成 #等分散性を仮定(var.equal=T)してt.testを行い、t統計量とp-valueの値を返す関数Students_ttestを作成。 Students_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=T) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Students_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している tmp <- cbind(rownames(data), data, out) #入力データの右側にt検定結果を結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 入力データがsample16.txtで、クラスラベル情報ファイルを使わない別のやり方で解析する場合:
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定 param1 <- 6 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #等分散性を仮定(var.equal=T)してt.testを行い、t統計量とp-valueの値を返す関数Students_ttestを作成。 Students_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=T) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Students_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している tmp <- cbind(rownames(data), data, out) #入力データの右側にt検定結果を結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp-value < 0.0015を満たす遺伝子数を表示させたい場合: param3 <- 0.0015 #閾値を指定 sum(out[,2] < param3) #out[,2]に相当する部分がp-value情報のところなので、ここが(param3)未満となっている行数をsum関数を用いてカウントしている3. 10000行×6列分の標準正規分布に従う乱数を発生させて、A群3サンプル vs. B群3サンプルの二群間比較として解析を行う場合:
param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 10000 #遺伝子数(行数)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #ランダムデータの生成とラベル情報の作成 data_tmp <- rnorm(param3*(param1+param2)) #param3*(param1+param2)個分の乱数を発生させた結果をdata_tmpに格納 data <- matrix(data_tmp, nrow=param3) #param3*(param1+param2)個分の要素からなるベクトルdata_tmpを変換して(param3)個の行数からなる行列を作成した結果をdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #等分散性を仮定(var.equal=T)してt.testを行い、t統計量とp-valueの値を返す関数Students_ttestを作成。 Students_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=T) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Students_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している tmp <- cbind(rownames(data), data, out) #入力データの右側にt検定結果を結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp-value < 0.05を満たす遺伝子数を表示させたい場合: param4 <- 0.05 #閾値を指定 sum(out[,2] < param4) #out[,2]に相当する部分がp-value情報のところなので、ここが(param4)未満となっている行数をsum関数を用いてカウントしている4. 10000行×6列分の標準正規分布に従う乱数を発生させて、A群3サンプル vs. B群3サンプルの二群間比較として解析を行う場合(FDR値も出力させる):
param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 10000 #遺伝子数(行数)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #ランダムデータの生成とラベル情報の作成 data_tmp <- rnorm(param3*(param1+param2)) #param3*(param1+param2)個分の乱数を発生させた結果をdata_tmpに格納 data <- matrix(data_tmp, nrow=param3) #param3*(param1+param2)個分の要素からなるベクトルdata_tmpを変換して(param3)個の行数からなる行列を作成した結果をdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #等分散性を仮定(var.equal=T)してt.testを行い、t統計量とp-valueの値を返す関数Students_ttestを作成。 Students_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=T) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Students_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している FDR <- p.adjust(out[,2], method="BH") #Benjamini and Hochberg (1995)の方法でFDRを計算した結果をFDRに格納。 tmp <- cbind(rownames(data), data, out, FDR) #入力データの右側にt検定結果とFDRを結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp-value < 0.05を満たす遺伝子数を表示させたい場合: param4 <- 0.05 #閾値を指定 sum(out[,2] < param4) #out[,2]に相当する部分がp-value情報のところなので、ここが(param4)未満となっている要素数をsum関数を用いてカウントしている sum(FDR < param4) #FDR < param4を満たす要素数をsum関数を用いてカウントしている5. 10000行×6列分の標準正規分布に従う乱数を発生させて、A群3サンプル vs. B群3サンプルの二群間比較として解析を行う場合(FDR値も出力させる): さらに最初の1000行分についてA群に相当するところのみ数値を+3している(つまり10%がA群で高発現というシミュレーションデータを作成している)
param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 10000 #遺伝子数(行数)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #ランダムデータの生成とラベル情報の作成 data_tmp <- rnorm(param3*(param1+param2)) #param3*(param1+param2)個分の乱数を発生させた結果をdata_tmpに格納 data <- matrix(data_tmp, nrow=param3) #param3*(param1+param2)個分の要素からなるベクトルdata_tmpを変換して(param3)個の行数からなる行列を作成した結果をdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #最初の1000行分について1-3列分のデータを+3している head(data) #+3する前のデータの一部を表示させている data[1:1000,1:3] <- data[1:1000,1:3] + 3 #+3を実行 head(data) #+3した後のデータの一部を表示させている #等分散性を仮定(var.equal=T)してt.testを行い、t統計量とp-valueの値を返す関数Students_ttestを作成。 Students_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=T) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Students_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している FDR <- p.adjust(out[,2], method="BH") #Benjamini and Hochberg (1995)の方法でFDRを計算した結果をFDRに格納。 tmp <- cbind(rownames(data), data, out, FDR) #入力データの右側にt検定結果とFDRを結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp-value < 0.05を満たす遺伝子数を表示させたい場合: param4 <- 0.05 #閾値を指定 sum(out[,2] < param4) #out[,2]に相当する部分がp-value情報のところなので、ここが(param4)未満となっている要素数をsum関数を用いてカウントしている sum(FDR < 0.05) #FDR < 0.05を満たす要素数をsum関数を用いてカウントしている sum(FDR < 0.10) #FDR < 0.10を満たす要素数をsum関数を用いてカウントしている sum(FDR < 0.15) #FDR < 0.15を満たす要素数をsum関数を用いてカウントしている sum(FDR < 0.20) #FDR < 0.20を満たす要素数をsum関数を用いてカウントしている sum(FDR < 0.25) #FDR < 0.25を満たす要素数をsum関数を用いてカウントしている6. 入力データがdata_Singh_RMA_3274.txtの場合1:
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #等分散性を仮定(var.equal=T)してt.testを行い、t統計量とp-valueの値を返す関数Students_ttestを作成。 Students_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=T) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Students_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 stat_t <- out[,1] #t統計量をstat_tに格納 rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納 p_t <- out[,2] #p値をp_tに格納 tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合: param3 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。7. 入力データがdata_Singh_RMA_3274.txtの場合2(関数の定義の部分が少し違うだけです):
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Student's t-testを行うStudents_ttest関数を含むファイルをあらかじめ読み込む #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 out <- t(apply(data, 1, Students_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 stat_t <- out[,1] #t統計量をstat_tに格納 rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納 p_t <- out[,2] #p値をp_tに格納 tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合: param3 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmpに格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "sample16_cl.txt" #入力ファイル名2(テンプレート情報)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納 data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成 #不等分散性を仮定(var.equal=F)してt.testを行い、t統計量とp-valueの値を返す関数Welch_ttestを作成。 Welch_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=F) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Welch_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している tmp <- cbind(rownames(data), data, out) #入力データの右側にt検定結果を結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 入力データがsample16.txtで、クラスラベル情報ファイルを使わない別のやり方で解析する場合:
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定 param1 <- 6 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #不等分散性を仮定(var.equal=F)してt.testを行い、t統計量とp-valueの値を返す関数Welch_ttestを作成。 Welch_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=F) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Welch_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している tmp <- cbind(rownames(data), data, out) #入力データの右側にt検定結果を結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。3. 10000行×8列分の標準正規分布に従う乱数を発生させて、A群4サンプル vs. B群4サンプルの二群間比較として解析を行う場合:
param1 <- 4 #A群のサンプル数を指定 param2 <- 4 #B群のサンプル数を指定 param3 <- 10000 #遺伝子数(行数)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #ランダムデータの生成とラベル情報の作成 data_tmp <- rnorm(param3*(param1+param2)) #param3*(param1+param2)個分の乱数を発生させた結果をdata_tmpに格納 data <- matrix(data_tmp, nrow=param3) #param3*(param1+param2)個分の要素からなるベクトルdata_tmpを変換して(param3)個の行数からなる行列を作成した結果をdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #不等分散性を仮定(var.equal=F)してt.testを行い、t統計量とp-valueの値を返す関数Welch_ttestを作成。 Welch_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=F) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Welch_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 colnames(out) <- c("t-statistic", "p-value") #オブジェクトoutに列名を付加している tmp <- cbind(rownames(data), data, out) #入力データの右側にt検定結果を結合したものをtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。4. 入力データがdata_Singh_RMA_3274.txtの場合1:
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #ランダムデータの生成とラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #不等分散性を仮定(var.equal=F)してt.testを行い、t統計量とp-valueの値を返す関数Welch_ttestを作成。 Welch_ttest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合は計算できないので... stat <- 0 #統計量を0 pval <- 1 #p値を1 return(c(stat, pval)) #として結果を返す } else{ #A, Bどちらかの群の標準偏差が0(上記条件以外)の場合は hoge <- t.test(x.class1, x.class0, var.equal=F) #通常のt検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } } out <- t(apply(data, 1, Welch_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 stat_t <- out[,1] #t統計量をstat_tに格納 rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納 p_t <- out[,2] #p値をp_tに格納 tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合: param3 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。5. 入力データがdata_Singh_RMA_3274.txtの場合2(関数の定義の部分が少し違うだけです):
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Welch t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 out <- t(apply(data, 1, Welch_ttest, data.cl)) #各(行)遺伝子についてt検定を行った結果のt統計量とp値をoutに格納 stat_t <- out[,1] #t統計量をstat_tに格納 rank_t <- rank(-abs(stat_t)) #t統計量の順位をrank_tに格納 p_t <- out[,2] #p値をp_tに格納 tmp <- cbind(rownames(data), data, stat_t, p_t, rank_t) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) t-testでp<0.05を満たす遺伝子群のみを抽出したい場合: param3 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_t < param3) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_t < param3,] #条件を満たす遺伝子群の発現データをtmpに格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_t),] #順位(rank_t)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #MWのU検定を行い、t統計量とp-valueの値を返す関数MW_Utestを作成。 MW_Utest <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 hoge <- wilcox.test(x.class1, x.class0) #MWのU検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } out <- t(apply(data, 1, MW_Utest, data.cl)) #各(行)遺伝子についてMWのU検定を行った結果の統計量とp値をoutに格納 stat_u <- out[,1] #統計量をstat_uに格納 rank_u <- rank(-abs(stat_u)) #統計量の順位をrank_uに格納 p_u <- out[,2] #p値をp_uに格納 tmp <- cbind(rownames(data), data, stat_u, p_u, rank_u) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) MWのU検定でp<0.05を満たす遺伝子群のみを抽出したい場合: param3 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_u < param3) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_u < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_u),] #順位(rank_u)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。2. やり方2(関数の定義の部分が少し違うだけです):
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 50 #A群のサンプル数を指定 param2 <- 52 #B群のサンプル数を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Student's t-testを行うWelch_ttest関数を含むファイルをあらかじめ読み込む #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 out <- t(apply(data, 1, MW_Utest, data.cl)) #各(行)遺伝子についてMWのU検定を行った結果の統計量とp値をoutに格納 stat_u <- out[,1] #統計量をstat_uに格納 rank_u <- rank(-abs(stat_u)) #統計量の順位をrank_uに格納 p_u <- out[,2] #p値をp_uに格納 tmp <- cbind(rownames(data), data, stat_u, p_u, rank_u) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(A群 vs. B群) MWのU検定でp<0.05を満たす遺伝子群のみを抽出したい場合: param3 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_u < param3) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_u < param3,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_u),] #順位(rank_u)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "sample16_cl.txt" #入力ファイル名2(テンプレート情報)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納 data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成 r <- apply(data, 1, cor, y=data.cl) #各(行)遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納 tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. クラスラベル情報ファイル(sample16_cl.txt)を読み込まずにテンプレートパターン情報を得る場合:
in_f1 <- "sample16.txt" #入力ファイル名1(発現データ)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 6 #A群のサンプル数を指定 param2 <- 5 #B群のサンプル数を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 r <- apply(data, 1, cor, y=data.cl) #各(行)遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納 tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 51 #症例数を指定 param3 <- 60 #FDR計算のための並べ替え回数を指定(ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう) #必要なパッケージをロード library(samr) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(-(1:param1), 1:param1) #症例の正常と腫瘍サンプルを対にして情報を与えたベクトルdata.clを作成(症例1の正常が-1、腫瘍が1などという感じで同じ数字のプラスとマイナスで対になっていることを認識させている) data.tmp = list(x=as.matrix(data), y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpを作成 out <- samr(data.tmp, resp.type="Two class paired", nperms=param3)#samr関数を実行し、結果をoutに格納。 summary(out) #outからどのような情報が抜き出せるか調べる。 stat_sam <- out$tt #SAM統計量をstat_samに格納 rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納 stat_fc <- log2(out$foldchange) #log(FC)統計量をstat_fcに格納 rank_fc <- rank(-abs(stat_fc)) #統計量の絶対値でランキングした結果をrank_fcに格納 tmp <- cbind(rownames(data), data, stat_sam, rank_sam, stat_fc, rank_fc)#入力データの右側に「SAM統計量」「その順位」「log(FC)統計量」「その順位」を結合した結果をtmpに格納。ここでのFold changeの値はunlogged dataのaverage fold change(B群/A群)が計算されています。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。CRANのsamrのwebページ
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 51 #症例数を指定 param3 <- 60 #FDR計算のための並べ替え回数を指定(ここの数値が大きければ大きいほどより正確だがその分だけ時間がかかる。実際の解析ではサンプル数にもよるが最低でも1000程度の数を指定しましょう) #必要なパッケージをロード library(samr) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(-(1:param1), 1:param1) #症例の正常と腫瘍サンプルを対にして情報を与えたベクトルdata.clを作成(症例1の正常が-1、腫瘍が1などという感じで同じ数字のプラスとマイナスで対になっていることを認識させている) data.tmp = list(x=as.matrix(data), y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE)#SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpを作成 out <- samr(data.tmp, resp.type="Two class paired", nperms=param3)#samr関数を実行し、結果をoutに格納。 stat_sam <- out$tt #SAM統計量をstat_samに格納 rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納 data.cl <- c(rep(0, param1), rep(1, param1)) #A群を0、B群を1としたベクトルdata.clを作成 tmp.class1 <- apply(data[,data.cl == 0], 1, mean) #A群の(遺伝子ごとの)平均シグナル強度を計算 tmp.class2 <- apply(data[,data.cl == 1], 1, mean) #B群の(遺伝子ごとの)平均シグナル強度を計算 ave_vector <- (tmp.class1 + tmp.class2)/2 #全サンプルの(遺伝子ごとの)平均シグナル強度を計算しave_vectorに格納 dr <- max(ave_vector) - min(ave_vector) #全サンプルの(遺伝子ごとの)平均シグナル強度のダイナミックレンジ(最大値-最小値)を計算しdrに格納 weight <- (ave_vector - min(ave_vector))/dr #WADの重みの項を計算しweightに格納 stat_sam_wad <- stat_sam*weight #SAM統計量にWADの重みの項をかけたもの(stat_sam*weight)を計算しstat_sam_wadに格納 rank_sam_wad <- rank(-abs(stat_sam_wad)) #the weighted SAM統計量(stat_sam_wad)の絶対値でランキングした結果をrank_sam_wadに格納 tmp <- cbind(rownames(data), data, stat_sam, rank_sam, weight, stat_sam_wad, rank_sam_wad)#入力データの右側に「SAM統計量」「その順位」「weight」「weighted SAM統計量(=SAM*weitht)」「その順位」を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。CRANのsamrのwebページ
in_f1 <- "sample10_2groups.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "sample10_2groups_cl.txt" #入力ファイル名(実験デザインファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 0.1 #閾値(FDR; "発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合)を指定 #必要なパッケージをロード library(maSigPro) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み edesign <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="") #実験デザインファイルの読み込み design <- make.design.matrix(edesign, degree=2) #regression(回帰)行列の作成。degree=2は、2次の回帰モデルで考えることを意味する fit <- p.vector(data, design, Q=param1) #発現変動遺伝子の同定。 tstep <- T.fit(fit) #得られた発現変動遺伝子群の各々について最もよい回帰モデルを決める out <- get.siggenes(tstep, rsq=0.7, vars="groups") #回帰モデルのRsquaredの値が0.7(この値がデフォルト)よりも大きいものを抽出し、outに格納 gene_id <- out$summary$BvsA[1:out$sig.genes$BvsA$g] #発現変動遺伝子のIDをgene_idに格納。 gene_profile <- out$sig.genes$BvsA$sig.profiles #発現変動遺伝子の発現プロファイルをgene_profileに格納。 p_masigpro <- out$sig.genes$BvsA$sig.pvalues[,1] #p値をp_masigproに格納。 rank_masigpro <- rank(abs(p_masigpro)) #p値の順位をrank_masigproに格納。 tmp <- cbind(gene_id, gene_profile, p_masigpro, rank_masigpro) #発現変動遺伝子についてのみ、その遺伝子ID、発現データ、p値、その順位を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #発現変動の度合いでソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_masigpro),] #順位(rank_masigpro)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献(Conesa et al., Bioinformatics, 2006)
in_f <- "sample2_log.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 5 #C群のサンプル数を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成 #Oneway ANOVAを行い、F統計量とp値を返す関数Oneway_anovaを作成。 Oneway_anova <- function(x, cl){ hoge <- oneway.test(x ~ cl, var=T) #Oneway ANOVA (一元配置分散分析)を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } out <- t(apply(data, 1, Oneway_anova, data.cl)) #各(行)遺伝子についてOneway ANOVAを行った結果の統計量とp値をoutに格納 stat_f <- out[,1] #統計量をstat_fに格納 rank_f <- rank(-abs(stat_f)) #統計量の順位をrank_fに格納 p_f <- out[,2] #p値をp_fに格納 tmp <- cbind(rownames(data), data, stat_f, p_f, rank_f) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #Oneway ANOVA (一元配置分散分析)でp<0.05を満たす遺伝子群のみを抽出したい場合: param4 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_f < param4) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_f < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_f),] #順位(rank_f)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。2. やり方2(関数の定義の部分が少し違うだけです):
in_f <- "sample2_log.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 5 #C群のサンプル数を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Oneway ANOVAを行い、F統計量とp値を返す関数Oneway_anova関数を含むファイルをあらかじめ読み込む #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成 out <- t(apply(data, 1, Oneway_anova, data.cl)) #各(行)遺伝子についてOneway ANOVAを行った結果の統計量とp値をoutに格納 stat_f <- out[,1] #統計量をstat_fに格納 rank_f <- rank(-abs(stat_f)) #統計量の順位をrank_fに格納 p_f <- out[,2] #p値をp_fに格納 tmp <- cbind(rownames(data), data, stat_f, p_f, rank_f) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #Oneway ANOVA (一元配置分散分析)でp<0.05を満たす遺伝子群のみを抽出したい場合: param4 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_f < param4) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_f < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_f),] #順位(rank_f)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。参考文献1(Norris et al., J. Neurosci., 2005)
in_f <- "sample2_log.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 5 #C群のサンプル数を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成 #KW検定を行い、統計量とp値を返す関数Kruskal_wallisを作成。 Kruskal_wallis <- function(x, cl){ hoge <- kruskal.test(x ~ cl) #KW検定を行って、 return(c(hoge$statistic, hoge$p.value)) #統計量とp値を結果として返す } out <- t(apply(data, 1, Kruskal_wallis, data.cl)) #各(行)遺伝子についてKW検定検定を行った結果の統計量とp値をoutに格納 stat_kw <- out[,1] #統計量をstat_kwに格納 rank_kw <- rank(-abs(stat_kw)) #統計量の順位をrank_kwに格納 p_kw <- out[,2] #p値をp_kwに格納 tmp <- cbind(rownames(data), data, stat_kw, p_kw, rank_kw) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #KW検定でp<0.05を満たす遺伝子群のみを抽出したい場合: param4 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_kw < param4) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_kw < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_kw),] #順位(rank_kw)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。2. やり方2(関数の定義の部分が少し違うだけです):
in_f <- "sample2_log.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #A群のサンプル数を指定 param2 <- 3 #B群のサンプル数を指定 param3 <- 5 #C群のサンプル数を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #KW検定を行い、統計量とp値を返す関数Kruskal_wallis関数を含むファイルをあらかじめ読み込む #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(1, param1), rep(2, param2), rep(3, param3)) #A群を1、B群を2、C群を3としたベクトルdata.clを作成 out <- t(apply(data, 1, Kruskal_wallis, data.cl)) #各(行)遺伝子についてKW検定検定を行った結果の統計量とp値をoutに格納 stat_kw <- out[,1] #統計量をstat_kwに格納 rank_kw <- rank(-abs(stat_kw)) #統計量の順位をrank_kwに格納 p_kw <- out[,2] #p値をp_kwに格納 tmp <- cbind(rownames(data), data, stat_kw, p_kw, rank_kw) #入力データの右側に統計量、p値、その順位を結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #KW検定でp<0.05を満たす遺伝子群のみを抽出したい場合: param4 <- 0.05 #閾値を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 sum(p_kw < param4) #条件を満たす遺伝子がいくつあったかを表示 tmp2 <- tmp[p_kw < param4,] #条件を満たす遺伝子群の発現データをtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。 #発現変動の度合いでソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_kw),] #順位(rank_kw)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #ROKUを実行するkadota_2006_bmc_bioinformatics関数を含むファイルをあらかじめ読み込む library(affy) #Tukey's Biweightを計算するためのtukey.biweight関数が含まれているパッケージの読み込み library(som) #各遺伝子発現ベクトルを正規化(平均=0, 標準偏差=1)するためのnormalize関数が含まれているパッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.z <- normalize(data, byrow=TRUE) #正規化を実行し、結果をdata.zに格納 out <- t(apply(data.z, 1, kadota_2003_physiol_genomics_0.25)) #各遺伝子発現ベクトルについて、Ueda's AIC-based methodを適用し、「特異的高発現=1, 低発現=-1, それ以外=0」の三状態の結果を返す colnames(out) <- colnames(data) #outの列名をdataの列名で置換する entropy_score <- apply(data, 1, kadota_2006_bmc_bioinformatics) #一行(一遺伝子)づつ、遺伝子発現ベクトルxを変換(x' = |x - Tbw|> )してからエントロピーH(x')を計算し、entropy_scoreに格納 tmp <- cbind(rownames(data), out, entropy_score) #左端の列が遺伝子ID, 次にサンプル数分だけの列からなる「外れ値行列情報」、そして最後の列にエントロピー値H(x')からなる行列としてtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #心臓特異的高発現遺伝子群のみのサブセットをentropy_scoreの低い順に得たい場合: in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(心臓で1、それ以外で0のテンプレートパターンファイル)を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 library(genefilter) #似た発現パターンを示す遺伝子をランキングするためのgenefinder関数が含まれているパッケージの読み込み data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納 template <- data_cl[,2] #バイナリ(0 or 1)情報(2列目)のみ抽出し、templateに格納 tmp <- rbind(out, template) #templateというテンプレートパターンを得られたはずれ値行列outの最後の行に追加した結果をtmpに格納 closeg <- genefinder(tmp, nrow(out)+1, nrow(out)) #特異的発現の度合いでランキングされた結果をclosegに格納 obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0] #テンプレートと完全に同じ遺伝子の行番号情報をobjに格納 length(obj) #目的の特異的発現遺伝子がいくつあったかを表示 tmp <- cbind(rownames(data), data, entropy_score) #入力データの右側にエントロピー値H(x')を結合した結果をtmpに格納 tmp2 <- tmp[obj,] #行列tmpの中からobjで示された行番号に相当する行のみ抽出してtmp2に格納 tmp3 <- tmp2[order(tmp2$entropy_score),] #目的の特異的発現遺伝子群をエントロピーの低い順にソートしてtmp3に格納 write.table(tmp3, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp3の中身をout_f2で指定したファイル名で保存。 #全遺伝子をentropy_scoreの低い順にソートした結果を得たい場合: out_f3 <- "hoge3.txt" #出力ファイル名を指定 tmp <- cbind(rownames(data), out, entropy_score) #左端の列が遺伝子ID, 次にサンプル数分だけの列からなる「外れ値行列情報」、そして最後の列にエントロピー値H(x')からなる行列としてtmpに格納 tmp2 <- tmp[order(entropy_score),] #順位(entropy_score)でソートした結果をtmp2に格納 write.table(tmp2, out_f3, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f3で指定したファイル名で保存。おまけまでやって得られるhoge2.txtをエクセルなどで開くと、心臓特異的高発現遺伝子が231個検出されていることがわかります。ここまで(231個のうちのどれが一番特異的な遺伝子かなどはわからないということ)しかできなかったのがUeda's AIC-based methodですが、ROKUではエントロピーH(x')も計算するので、得られたサブセット内のランキング(hoge.txt中の“最後の列”H(x')の低い順にソート)が可能になりました。
Bioconductorのgenefilterのwebページ
参考文献(Kadota et al., BMC Bioinformatics, 2006)in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 5 #Xの値を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.t <- t(data) #行列の転置(この後に使うscale関数が列ごとの操作を行うため、scale関数をそのまま使えるように予め行列を入れ替えておく必要があるため) data.t.m.mad <- scale(data.t, apply(data.t, 2, median), apply(data.t, 2, mad, constant=1))#各列のmedian=0, MAD=1になるようにスケーリングし、結果をdata.t.m.madに格納 data.m.mad <- t(data.t.m.mad) #scale関数の適用が終わったので、もう一度行列の転置を行って元に戻し、結果をdata.m.madに格納 out <- data.m.mad #out.m.madをoutにコピー out[(out <= param1) & (out >= -param1)] <- 0 #スケーリング後の値で"-param1"以上"param1"以下の値を0に置換 out[out < -param1] <- -1 #スケーリング後の値で-param1未満の値を-1に置換 out[out > param1] <- 1 #スケーリング後の値でparam1より大きい値を1に置換 colnames(out) <- colnames(data) #outの列名をdataの列名で置換する tmp <- cbind(rownames(data), out) #遺伝子IDの右側に, サンプル数分だけの「外れ値行列」を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #心臓特異的高発現遺伝子群のみのサブセットを得たい場合: in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(心臓で1、それ以外で0のテンプレートパターンファイル)を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 library(genefilter) #似た発現パターンを示す遺伝子をランキングするためのgenefinder関数が含まれているパッケージの読み込み data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納 template <- data_cl[,2] #バイナリ(0 or 1)情報(2列目)のみ抽出し、templateに格納 tmp <- rbind(out, template) #templateというテンプレートパターンを得られたはずれ値行列outの最後の行に追加した結果をtmpに格納 closeg <- genefinder(tmp, nrow(out)+1, nrow(out)) #特異的発現の度合いでランキングされた結果をclosegに格納 obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0] #テンプレートと完全に同じ遺伝子の行番号情報をobjに格納 length(obj) #目的の特異的発現遺伝子がいくつあったかを表示 tmp <- cbind(rownames(data[obj,]), data[obj,]) #dataの中からobjで示された行番号に相当する行のみの遺伝子IDと発現データを結合してtmpに格納 write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f2で指定したファイル名で保存。参考文献1(Kadota et al., GRSB, 2007)
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #エントロピーを計算するshannon.entropy関数を含むファイルをあらかじめ読み込む #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 entropy_score <- apply(data, 1, shannon.entropy) #エントロピーを計算した結果をentropy_scoreに格納 tmp <- cbind(rownames(data), data, entropy_score) #入力データの右側に計算したentropy_scoreを結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #全遺伝子をentropy_scoreの低い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(entropy_score),] #順位(entropy_score)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。2. 入力ファイルがsample15.txtの場合:
in_f <- "sample15.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #エントロピーを計算するshannon.entropy関数を含むファイルをあらかじめ読み込む #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 entropy_score <- apply(data, 1, shannon.entropy) #エントロピーを計算した結果をentropy_scoreに格納 tmp <- cbind(rownames(data), data, entropy_score) #入力データの右側に計算したentropy_scoreを結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #全遺伝子をentropy_scoreの低い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(entropy_score),] #順位(entropy_score)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献 (Schug et al., Genome Biol., 2005)
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Schug's Q statisticを計算するshannon.entropy.q関数を含むファイルをあらかじめ読み込む #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 entropy_score <- apply(data, 1, shannon.entropy) #エントロピーを計算した結果をentropy_scoreに格納 q_score <- t(apply(data, 1, shannon.entropy.q)) #Schug's Q statisticを計算した結果をq_scoreに格納 tmp <- cbind(rownames(data), q_score, entropy_score) #遺伝子IDの右側に計算したQスコアの行列とentropy_scoreを結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #入力データの左からX番目の組織について特異性の度合いの高い順(その列のQスコアの低い順)にソートした結果を得たい場合: #(X=2の場合は"Amygdala"に相当します) out_f2 <- "hoge2.txt" #出力ファイル名を指定 param1 <- 2 #Xの値を指定 tmp2 <- tmp[order(q_score[,param1]),] #行列q_scoreを"param1"列でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献(Schug et al., Genome Biol., 2005)
in_f <- "GDS1096_rma.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要な関数などをロード source("http://www.iu.a.u-tokyo.ac.jp/~kadota/R/R_functions.R") #Ueda's AIC-based methodを実行するkadota_2003_physiol_genomics_0.50関数を含むファイルをあらかじめ読み込む library(som) #各遺伝子発現ベクトルを正規化(平均=0, 標準偏差=1)するためのnormalize関数が含まれているパッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.z <- normalize(data, byrow=TRUE) #正規化を実行し、結果をdata.zに格納 out <- t(apply(data.z, 1, kadota_2003_physiol_genomics_0.50)) #各遺伝子発現ベクトルについて、Ueda's AIC-based methodを適用し、「特異的高発現=1, 低発現=-1, それ以外=0」の三状態の結果を返す colnames(out) <- colnames(data) #outの列名をdataの列名で置換する tmp <- cbind(rownames(data), out) #左端の列が遺伝子IDとサンプル数分だけの列からなる「外れ値行列」を結合してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #心臓特異的高発現遺伝子群のみのサブセットを得たい場合: in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名2(心臓で1、それ以外で0のテンプレートパターンファイル)を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 library(genefilter) #似た発現パターンを示す遺伝子をランキングするためのgenefinder関数が含まれているパッケージの読み込み data_cl <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでdata_clに格納 template <- data_cl[,2] #バイナリ(0 or 1)情報(2列目)のみ抽出し、templateに格納 tmp <- rbind(out, template) #templateというテンプレートパターンを得られたはずれ値行列outの最後の行に追加した結果をtmpに格納 closeg <- genefinder(tmp, nrow(out)+1, nrow(out)) #特異的発現の度合いでランキングされた結果をclosegに格納 obj <- closeg[[1]]$indices[closeg[[1]]$dists == 0] #テンプレートと完全に同じ遺伝子の行番号情報をobjに格納 length(obj) #目的の特異的発現遺伝子がいくつあったかを表示 tmp <- cbind(rownames(data[obj,]), data[obj,]) #dataの中からobjで示された行番号に相当する行のみの遺伝子IDと発現データを結合してtmpに格納 write.table(tmp, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_f2で指定したファイル名で保存。CRANのsomのwebページ
in_f1 <- "sample15.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "sample15_cl.txt" #入力ファイル名2(テンプレート情報)を指定 out_f <- "hoge1.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納 data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成 r <- apply(data, 1, cor, y=data.cl) #各(行)遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納 tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。2. 相関係数の高い順(降順)にソートしたい場合:
in_f1 <- "sample15.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "sample15_cl.txt" #入力ファイル名2(テンプレート情報)を指定 out_f <- "hoge2.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納 data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成 r <- apply(data, 1, cor, y=data.cl) #各(行)遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納 tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。 tmp2 <- tmp[order(r, decreasing=TRUE),] #相関係数で降順にソート結果をtmp2に格納。 write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_fで指定したファイル名で保存。3. 相関係数の低い順(昇順)にソートしたい場合:
in_f1 <- "sample15.txt" #入力ファイル名1(発現データ)を指定 in_f2 <- "sample15_cl.txt" #入力ファイル名2(テンプレート情報)を指定 out_f <- "hoge3.txt" #出力ファイル名を指定 #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイル1を読み込んでdataに格納 hoge <- read.table(in_f2, sep="\t", quote="") #入力ファイル2を読み込んでhogeに格納 data.cl <- hoge[,2] #テンプレートパターンベクトルdata.clを作成 r <- apply(data, 1, cor, y=data.cl) #各(行)遺伝子についてテンプレートパターンdata.clとの相関係数を計算した結果をrに格納 tmp <- cbind(rownames(data), data, r) #入力データの右側に相関係数rのベクトルを結合した結果をtmpに格納。 tmp2 <- tmp[order(r, decreasing=FALSE),] #相関係数で昇順にソート結果をtmp2に格納。 write.table(tmp2, out_f, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_fで指定したファイル名で保存。
in_f <- "sample12.txt" #入力ファイル名を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(GeneCycle) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 out1 <- avgp(t(data)) #平均のピリオドグラムを計算し周波数(frequency)成分ごとの平均パワースペクトル密度(average power spectral density)の結果をout1に格納 out2 <- t(dominant.freqs(t(data),3)) #dominantな周波数(frequency)成分の上位3つをout2に格納 tmp_p <- fisher.g.test(t(data)) #Fisher’s Exact g Testを行って得たp値をtmp_pに格納 tmp_fdr <- fdrtool(tmp_p, statistic="pvalue") #False Discovery Rate (FDR)を計算した結果をtmp_fdrに格納 tmp_robust_p <- robust.g.test(robust.spectrum(t(data))) #Fisher’s Exact g Testのa robust nonparametric versionでp値を計算した結果をtmp_robust_pに格納 p_gc <- tmp_fdr$pval #p値をp_gcに格納 lfdr_gc <- tmp_fdr$lfdr #local FDR値をlfdr_gcに格納 tmp <- cbind(rownames(data), data, p_gc, lfdr_gc) #入力データの右側にp値、local FDRを結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #(local)FDRがX未満(たとえば0.1を指定するとこの閾値を満たす遺伝子数のうち本当は発現変動遺伝子でないものが含まれる割合を0.1)の遺伝子数を表示したい場合: param1 <- 0.1 #Xの値を指定 sum(fdr_gc$lfdr < param1) #条件を満たす遺伝子数を表示 #平均のピリオドグラムを得たい場合: avgp(t(data)) #平均のピリオドグラムを計算し周波数(frequency)成分ごとの平均パワースペクトル密度(average power spectral density)の結果をout1に格納 #dominantな周波数(frequency)成分の上位3つを得たい場合: out2 <- t(dominant.freqs(t(data),3)) #dominantな周波数(frequency)成分の上位3つをout2に格納 dim(out2) #out2の行数と列数を表示(1441遺伝子の一つにつき上位3つの周波数成分が格納されているので1441行3列になる)GeneCycleのウェブページ
参考文献(Aryee et al., BMC Bioinformatics, 2009)
in_f1 <- "sample10_1group.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "sample10_1group_cl.txt" #入力ファイル名(実験デザインファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 0.5 #閾値(FDR; "発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合)を指定 #必要なパッケージをロード library(maSigPro) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み edesign <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="") #実験デザインファイルの読み込み design <- make.design.matrix(edesign, degree=2) #regression(回帰)行列の作成。degree=2は、2次の回帰モデルで考えることを意味する fit <- p.vector(data, design, Q=param1) #発現変動遺伝子の同定。 tstep <- T.fit(fit) #得られた発現変動遺伝子群の各々について最もよい回帰モデルを決める gene_profile <- tstep$sig.profiles #発現変動遺伝子の発現プロファイルをgene_profileに格納。 gene_id <- rownames(gene_profile) #発現変動遺伝子のIDをgene_idに格納。 p_masigpro <- tstep$sol[,1] #p値をp_masigproに格納。 rank_masigpro <- rank(abs(p_masigpro)) #p値の順位をrank_masigproに格納。 tmp <- cbind(gene_id, gene_profile, p_masigpro, rank_masigpro) #発現変動遺伝子についてのみ、その遺伝子ID、発現データ、p値、その順位を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #発現変動の度合いでソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_masigpro),] #順位(rank_masigpro)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。2. 発現データファイル: sample11_1group.txt, 実験デザインファイル: sample11_1group_cl.txtの場合:
in_f1 <- "sample11_1group.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "sample11_1group_cl.txt" #入力ファイル名(実験デザインファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 0.5 #閾値(FDR; "発現変動している"としたもののうち"本当は発現変動していない"ものが含まれる割合)を指定 #必要なパッケージをロード library(maSigPro) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み edesign <- read.table(in_f2, header=TRUE, row.names=1, sep="\t", quote="") #実験デザインファイルの読み込み design <- make.design.matrix(edesign, degree=2) #regression(回帰)行列の作成。degree=2は、2次の回帰モデルで考えることを意味する fit <- p.vector(data, design, Q=param1) #発現変動遺伝子の同定。 tstep <- T.fit(fit) #得られた発現変動遺伝子群の各々について最もよい回帰モデルを決める gene_profile <- tstep$sig.profiles #発現変動遺伝子の発現プロファイルをgene_profileに格納。 gene_id <- rownames(gene_profile) #発現変動遺伝子のIDをgene_idに格納。 p_masigpro <- tstep$sol[,1] #p値をp_masigproに格納。 rank_masigpro <- rank(abs(p_masigpro)) #p値の順位をrank_masigproに格納。 tmp <- cbind(gene_id, gene_profile, p_masigpro, rank_masigpro) #発現変動遺伝子についてのみ、その遺伝子ID、発現データ、p値、その順位を結合した結果をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #発現変動の度合いでソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_masigpro),] #順位(rank_masigpro)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献(Conesa et al., Bioinformatics, 2006)
in_f <- "sample10_1group.txt" #入力ファイル名(発現データファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(samr) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み data <- as.matrix(data) #データの型を変換 cl.tmp <- strsplit(colnames(data), "_") #ラベル情報を"One class timecourse"用に変更1 data.cl <- NULL #ラベル情報を"One class timecourse"用に変更2 for(i in 1:ncol(data)){ data.cl[i] <- cl.tmp[[i]][1] } #ラベル情報を"One class timecourse"用に変更3 data.cl <- paste(1, data.cl, sep="") #ラベル情報を"One class timecourse"用に変更4 data.cl[1] <- paste(data.cl[1], "Start", sep="") #ラベル情報を"One class timecourse"用に変更5 data.cl[ncol(data)] <- paste(data.cl[ncol(data)], "End", sep="") #ラベル情報を"One class timecourse"用に変更6 data.tmp <- list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE) #SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpという入力データを作成 out <- samr(data.tmp, resp.type="One class timecourse", nperms=30, time.summary.type="slope") #samr関数を実行し、結果をsamr.objに格納。 stat_sam <- out$tt #統計量をstat_samに格納。 rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納。 delta.table <- samr.compute.delta.table(out, min.foldchange=0, dels=NULL, nvals=100) #FDRの計算1 out2 <- samr.compute.siggenes.table(out, del, data.tmp, delta.table, min.foldchange=0, all.genes=T)#FDRの計算2 fdr.tmp <- as.numeric(c(out2$genes.up[,7], out2$genes.lo[,7])) #up-regulated側とdown-regulated側の%FDR値をfdr.tmpに格納 fdr.tmp <- fdr.tmp/100 #%FDR値を100で割る names(fdr.tmp) <- c(out2$genes.up[,2], out2$genes.lo[,2]) #fdr.tmpはup側とdown側で発現変動の度合いでランキングされているので、遺伝子名との対応づけを行っている fdr_sam <- fdr.tmp[rownames(data)] #もとの入力データの遺伝子名の並びに変更した結果をfdr_samに格納 tmp <- cbind(rownames(data), data, stat_sam, rank_sam, fdr_sam) #読み込んだ元データの右側に統計量、その順位、FDRを追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #発現変動の度合いでソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_sam),] #順位(rank_sam)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。2. 発現データファイル: sample11_1group.txt, 実験デザインファイル: sample11_1group_cl.txtの場合:
in_f <- "sample11_1group.txt" #入力ファイル名(発現データファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(samr) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み data <- as.matrix(data) #データの型を変換 data.cl <- paste(1, colnames(data), sep="") #ラベル情報を"One class timecourse"用に変更1 data.cl[1] <- paste(data.cl[1], "Start", sep="") #ラベル情報を"One class timecourse"用に変更2 data.cl[ncol(data)] <- paste(data.cl[ncol(data)], "End", sep="") #ラベル情報を"One class timecourse"用に変更3 data.tmp <- list(x=data, y=data.cl, geneid=rownames(data), genenames=rownames(data), logged2=TRUE) #SAMを実行するsamr関数の入力フォーマットに合わせたdata.tmpという入力データを作成 out <- samr(data.tmp, resp.type="One class timecourse", nperms=30, time.summary.type="slope") #samr関数を実行し、結果をsamr.objに格納。 stat_sam <- out$tt #統計量をstat_samに格納。 rank_sam <- rank(-abs(stat_sam)) #統計量の絶対値でランキングした結果をrank_samに格納。 delta.table <- samr.compute.delta.table(out, min.foldchange=0, dels=NULL, nvals=100) #FDRの計算1 out2 <- samr.compute.siggenes.table(out, del, data.tmp, delta.table, min.foldchange=0, all.genes=T)#FDRの計算2 fdr.tmp <- as.numeric(c(out2$genes.up[,7], out2$genes.lo[,7])) #up-regulated側とdown-regulated側の%FDR値をfdr.tmpに格納 fdr.tmp <- fdr.tmp/100 #%FDR値を100で割る names(fdr.tmp) <- c(out2$genes.up[,2], out2$genes.lo[,2]) #fdr.tmpはup側とdown側で発現変動の度合いでランキングされているので、遺伝子名との対応づけを行っている fdr_sam <- fdr.tmp[rownames(data)] #もとの入力データの遺伝子名の並びに変更した結果をfdr_samに格納 tmp <- cbind(rownames(data), data, stat_sam, rank_sam, fdr_sam) #読み込んだ元データの右側に統計量、その順位、FDRを追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #発現変動の度合いでソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(rank_sam),] #順位(rank_sam)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。sample11の解析結果のhoge2.txtにおいて、rank_samのランキング結果とFDR値(fdr_sam)の対応がちゃんととれていないのは、up-regulated側とdown-regulated側がごちゃまぜになっているためです。
in_f1 <- "reannotate_select_cal.eis" #入力ファイル名(発現データファイル)を指定 in_f2 <- "OXPHOS_HG-U133A_probes" #入力ファイル名(遺伝子リストファイル)を指定 param1 <- 1:17 #遺伝子発現行列中のA群(NGTサンプルに相当)の位置(X-Y列)のXとYを指定 param2 <- 26:43 #遺伝子発現行列中のB群(DM2サンプルに相当)の位置(X-Y列)のXとYを指定 param3 <- 1:8 #列名(サンプル名)の文字列のX-Y文字目のXとYを指定 #データファイルの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="") #発現データファイルの読み込み data$NAME <- NULL #余分な列(NAMEという名前の列に相当)の削除 data <- data[-1,] #余分な行(EWEIGHTという名前の行に相当)の削除 #参考文献1に記載されている通りのデータの前処理(preprocessing)を実行 mean_value <- 1000 #各サンプルの平均発現強度を1000にすべく、mean_valueに格納 floor_value <- 100 #シグナル強度が100未満のものを100にすべく、floor_valueに格納 tmp_mean <- apply(data, 2, mean, na.rm=TRUE) #各サンプル(列)の平均シグナル強度を計算した結果をtmp_meanに格納 data.tmp <- sweep(data, 2, mean_value/tmp_mean, "*") #各列中の全てのシグナル値にmean_value/tmp_meanを掛け、その結果をdata.tmpに格納 data.tmp[data.tmp < floor_value] <- floor_value #シグナル強度がfloor_value未満のものをfloor_valueにする data.tmp <- log(data.tmp, base=2) #log(底は2)をとる rownames(data.tmp) <- rownames(data) #data_tmpの行の名前をdataの行の名前として利用する colnames(data.tmp) <- substr(colnames(data),param3[1],param3[length(param3)])#data_tmpの列の名前が長いのでparam3で指定した領域をdata.tmpの列の名前にする #全遺伝子(母集団)の倍率変化の平均(myu)と標準偏差(sigma)をまずは求める dim(data.tmp) #行数と列数を確認 logratio <- apply(data.tmp[,param2], 1, mean, na.rm=TRUE) - apply(data.tmp[,param1], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(DM2/NGT; logスケールデータなのでこの場合引き算となっている)を計算し、logratioに格納 mean_set <- mean(logratio) #全遺伝子の倍率変化の平均を計算し、mean_setに格納 sd_set <- sd(logratio) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納 #"in_f2"で指定した中の遺伝子セット(標本)のみの倍率変化の平均(mean_sample)と遺伝子数(標本サイズ)nを求める probe_OXPHOS <- read.table(in_f2, row.names=1, quote="") #遺伝子リストファイルの読み込み mean_sample <- mean(logratio[rownames(probe_OXPHOS)]) #rownames(probe_OXPHOS)で見られる遺伝子セットのみの倍率変化の平均を計算し、mean_sampleに格納 n <- nrow(probe_OXPHOS) #rownames(probe_OXPHOS)で見られる遺伝子数をnに格納 #Z-score算出式を参考にして、「mean_set, sd_set, mean_sample, n」をもとにZ-scoreおよびそのp値を求める zscore <- (mean_sample - mean_set)*sqrt(n)/sd_set #zscoreを計算 pvalue <- (1 - pnorm(abs(zscore)))*2 #pvalueを計算 zscore #zscoreを表示 pvalue #pvalueを表示参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
in_f1 <- "data_GSE7623_rma_nr.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c5.bp.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定 param1 <- 17:20 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定 param2 <- 21:24 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(PGSEA) #PGSEAパッケージ(ライブラリ)の読み込み #データファイルの読み込み gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 colnames(data) #dataの列名を表示。GSM184414-184437まで順番に並んでいることを確認 #Zスコアを算出する関数calc_zを作成 calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成 hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成 return(hoge) #Zスコアを算出する関数calc_zを作成 } #Zスコアを算出する関数calc_zを作成 #PAGE解析のメイン部分 AD <- apply(data[,param2], 1, mean, na.rm=TRUE) - apply(data[,param1], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納 names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納 sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納 z_page <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納 } #length(gmt)回だけループを回す p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納 #結果をまとめてファイルに保存 out <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納 GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納 Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納 Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納 out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納 } #length(gmt)回だけループを回す colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更 tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #p値の低い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
in_f1 <- "data_GSE7623_rma_nr.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c5.bp.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定 param1 <- 17:20 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定 param2 <- 21:24 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(PGSEA) #PGSEAパッケージ(ライブラリ)の読み込み #データファイルの読み込み gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 colnames(data) #dataの列名を表示。GSM184414-184437まで順番に並んでいることを確認 #PAGE解析のメイン部分 AD <- apply(data[,param2], 1, mean, na.rm=TRUE) - apply(data[,param1], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納 names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する stat_page <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す genenames <- intersect(names(AD), gmt[[i]]@ids) #i番目の遺伝子セット中の遺伝子リストの中からチップに搭載されている遺伝子のみのGene symbolsをgenenamesに格納 stat_page <- c(stat_page, mean(abs(AD[genenames]))) #genenamesで表された遺伝子リストのAD統計量の絶対値の平均を計算し、stat_pageに格納 } #length(gmt)回だけループを回す #結果をまとめてファイルに保存 out <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納 GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納 Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納 Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納 out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納 } #length(gmt)回だけループを回す colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更 tmp <- cbind(out, stat_page) #outの右側にPAGE解析結果のAD統計量の絶対値の平均を追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #AD統計量の絶対値の平均が高い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(-stat_page),] #stat_pageでソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
in_f1 <- "sample13_7vs7_nr2.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c2.kegg.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定 param1 <- 7 #A群のサンプル数を指定 param2 <- 7 #B群のサンプル数を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(PGSEA) #PGSEAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #Zスコアを算出する関数calc_zを作成 calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成 hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成 return(hoge) #Zスコアを算出する関数calc_zを作成 } #Zスコアを算出する関数calc_zを作成 #PAGE解析のメイン部分 AD <- apply(data[,data.cl == 1], 1, mean, na.rm=TRUE) - apply(data[,data.cl == 0], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納 names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納 sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納 z_page <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納 } #length(gmt)回だけループを回す p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納 #結果をまとめてファイルに保存 out <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納 Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納 Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納 out <- rbind(out, c(Geneset_name, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納 } #length(gmt)回だけループを回す colnames(out) <- c("Geneset_name", "Member_num", "Member_num_thischip") #outの列名をGeneset_name, Member_num, Member_num_thischipに変更 tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #p値の低い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
in_f1 <- "sample13_7vs7_nr2.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c2.kegg.v2.5.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定 param1 <- 7 #A群のサンプル数を指定 param2 <- 7 #B群のサンプル数を指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(PGSEA) #PGSEAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 #AD統計量を計算 AD <- apply(data[,data.cl == 1], 1, mean, na.rm=TRUE) - apply(data[,data.cl == 0], 1, mean, na.rm=TRUE)#全遺伝子の倍率変化(logなので引き算)を計算し、ADに格納 names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する stat_page <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す genenames <- intersect(names(AD), gmt[[i]]@ids) #i番目の遺伝子セット中の遺伝子リストの中からチップに搭載されている遺伝子のみのGene symbolsをgenenamesに格納 stat_page <- c(stat_page, mean(abs(AD[genenames]))) #genenamesで表された遺伝子リストのAD統計量の絶対値の平均を計算し、stat_pageに格納 } #length(gmt)回だけループを回す #結果をまとめてファイルに保存 out <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納 Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納 Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納 out <- rbind(out, c(Geneset_name, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納 } #length(gmt)回だけループを回す colnames(out) <- c("Geneset_name", "Member_num", "Member_num_thischip") #outの列名をGeneset_name, Member_num, Member_num_thischipに変更 tmp <- cbind(out, stat_page) #outの右側にPAGE解析結果のAD統計量の絶対値の平均を追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #AD統計量の絶対値の平均が高い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(-stat_page),] #stat_pageでソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
param <- "HSA04612" #解析したいパスウェイIDを指定 param1 <- "#FF00FF" #AD > 0(B群で発現上昇)のものの色(ピンク色)を指定 param2 <- "#0099FF" #AD < 0(A群で発現上昇)のものの色(水色)を指定 out_f3 <- "hoge_detail.txt" #元となるAD統計量情報を含む出力ファイル名を指定 out_f4 <- "hoge_kegg.txt" #KEGG Pathway用出力ファイル名を指定 calc_color <- function(x){ #AD統計量から色の16進数値を返す関数calc_colorを作成 if(x > 0){ tmp_color <- param1 } #AD統計量>0のときはparam1で指定した色を返すべくtmp_colorに格納 if(x < 0){ tmp_color <- param2 } #AD統計量<0のときはparam2で指定した色を返すべくtmp_colorに格納 return(tmp_color) #tmp_colorの中身を結果として返す } #AD統計量から色の16進数値を返す関数calc_colorを作成 posi <- pmatch(param, tmp[,1]) #paramで指定したパスウェイIDのgmtファイル中での位置を同定しposiに格納 genenames <- intersect(names(AD), gmt[[posi]]@ids) #チップに搭載されている遺伝子のGene symbolsをgenenamesに格納 tmpAD <- AD[genenames] out <- apply(as.matrix(tmpAD), 1, calc_color) tmp3 <- cbind(genenames, tmpAD) #genenamesの右側にAD統計量情報を追加してtmp3に格納 write.table(tmp3, out_f3, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f3で指定したファイル名で保存。 tmp4 <- cbind(genenames, out) #genenamesの右側に色の16進数値情報を追加してtmp4に格納 write.table(tmp4, out_f4, sep=" ", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f4で指定したファイル名で保存。・上記の色使いを基本としつつ、AD <= -1を水色、-1 < AD < 0を薄水色、0 < AD < 1を薄ピンク色、AD >= 1をピンク色の4諧調で図示したい場合 (ちなみにAD統計量は「log2 scaleでの各群の算術平均値の差」なので、 AD <= -1は「A群で2倍以上発現上昇」に相当し、AD >= 1は「B群で2倍以上発現上昇」に相当します。)
param <- "HSA04612" #解析したいパスウェイIDを指定 param1 <- "#FF00FF" #AD >= 1(B群で2倍以上発現上昇)のものの色(ピンク色)を指定 param2 <- "#FFCCFF" #0 < AD < 1(B群で2倍未満発現上昇)のものの色(薄ピンク色)を指定 param3 <- "#CCFFFF" #-1 < AD< 0(A群で2倍未満発現上昇)のものの色(薄水色)を指定 param4 <- "#0099FF" #AD <= -1(A群で2倍以上発現上昇)のものの色(水色)を指定 out_f3 <- "hoge_detail.txt" #元となるAD統計量情報を含む出力ファイル名を指定 out_f4 <- "hoge_kegg.txt" #KEGG Pathway用出力ファイル名を指定 calc_color <- function(x){ #AD統計量から色の16進数値を返す関数calc_colorを作成 if(x >= 1){ tmp_color <- param1 } #AD >= 1のときはparam1で指定した色を返すべくtmp_colorに格納 if((0 < x) & (x < 1)){ tmp_color <- param2 } #0 < AD < 1のときはparam2で指定した色を返すべくtmp_colorに格納 if((-1 < x) & (x < 0)){ tmp_color <- param3 } #-1 < AD < 0のときはparam3で指定した色を返すべくtmp_colorに格納 if(x <= -1){ tmp_color <- param4 } #AD <= -1のときはparam4で指定した色を返すべくtmp_colorに格納 return(tmp_color) #tmp_colorの中身を結果として返す } #AD統計量から色の16進数値を返す関数calc_colorを作成 posi <- pmatch(param, tmp[,1]) #paramで指定したパスウェイIDのgmtファイル中での位置を同定しposiに格納 genenames <- intersect(names(AD), gmt[[posi]]@ids) #チップに搭載されている遺伝子のGene symbolsをgenenamesに格納 tmpAD <- AD[genenames] out <- apply(as.matrix(tmpAD), 1, calc_color) tmp3 <- cbind(genenames, tmpAD) #genenamesの右側にAD統計量情報を追加してtmp3に格納 write.table(tmp3, out_f3, sep="\t", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f3で指定したファイル名で保存。 tmp4 <- cbind(genenames, out) #genenamesの右側に色の16進数値情報を追加してtmp4に格納 write.table(tmp4, out_f4, sep=" ", append=F, quote=F, row.names=F, col.names=F)#tmpの中身をout_f4で指定したファイル名で保存。2. Color Objects in KEGG Pathwaysのページを開き、以下を実行 ・「Search against:」のところを自分がマップしたい生物種(この場合は「Homo Sapiens (Human)」)を選択 ・「Alternatively, enter the file name containing the data:」のところの ”参照”ボタンをクリックして、KEGG Pathway用出力ファイル(out_f4で指定したファイル名:この場合はhoge_kegg.txt) を読み込ませ、Execボタンを押す ・”Pathway Search Result”のページに切り替わるので、 paramで指定した解析したいパスウェイID(候補リストのトップのほうに位置している場合がほとんど:この場合HSA04612)のものをクリック 参考文献(KEGG; Kanehisa et al., Nucleic Acids Res, 2008)
in_f1 <- "sample17_unlog.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c5.bp.v3.0.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定 param1 <- 4 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定 param2 <- 4 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(PGSEA) #PGSEAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 colnames(data) #dataの列名を表示させてるだけ #列(サンプル)ごとにZスコアを算出 data_log10 <- log10(data) #log10変換した結果をdata_log10に格納 zscore <- scale(data_log10) #Z-score化した結果をzscoreに格納 apply(zscore, 2, sd) #Z-score化した結果の各列の標準偏差がちゃんと1になっているか確認している apply(zscore, 2, mean) #Z-score化した結果の各列の平均がちゃんと0になっているか確認している #比較する二群間のZ ratioを算出 mean_zscore_A <- apply(zscore[,data.cl == 0], 1, mean) #A群の行(遺伝子)ごとのzscoreの平均値を計算した結果をmean_zscore_Aに格納 mean_zscore_B <- apply(zscore[,data.cl == 1], 1, mean) #B群の行(遺伝子)ごとのzscoreの平均値を計算した結果をmean_zscore_Bに格納 zratio <- (mean_zscore_B - mean_zscore_A)/sd(mean_zscore_B - mean_zscore_A)#Z ratioを計算した結果をzratioに格納 #Zスコアを算出する関数calc_zを作成 calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成 hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成 return(hoge) #Zスコアを算出する関数calc_zを作成 } #Zスコアを算出する関数calc_zを作成 #PAGE解析のメイン部分 AD <- zratio #この行以下の記述を他のPAGE法のものと統一すべくzratioをADとして取り扱う names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納 sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納 z_page <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納 } #length(gmt)回だけループを回す p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納 #結果をまとめてファイルに保存 out <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納 GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納 Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納 Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納 out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納 } #length(gmt)回だけループを回す colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更 tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #p値の低い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。(b) log2変換されたデータ(sample17.txt)を読み込んでそのまま解析する場合:
in_f1 <- "sample17.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c5.bp.v3.0.symbols.gmt" #入力ファイル名(遺伝子セットファイル)を指定 param1 <- 4 #遺伝子発現行列中のA群(fedサンプルに相当)の位置(X-Y列)のXとYを指定 param2 <- 4 #遺伝子発現行列中のB群(24h-fastedサンプルに相当)の位置(X-Y列)のXとYを指定 out_f <- "hoge.txt" #出力ファイル名を指定 #必要なパッケージをロード library(PGSEA) #PGSEAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- readGmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.cl <- c(rep(0, param1), rep(1, param2)) #A群を0、B群を1としたベクトルdata.clを作成 colnames(data) #dataの列名を表示させてるだけ #列(サンプル)ごとにZスコアを算出 zscore <- scale(data) #Z-score化した結果をzscoreに格納 apply(zscore, 2, sd) #Z-score化した結果の各列の標準偏差がちゃんと1になっているか確認している apply(zscore, 2, mean) #Z-score化した結果の各列の平均がちゃんと0になっているか確認している #比較する二群間のZ ratioを算出 mean_zscore_A <- apply(zscore[,data.cl == 0], 1, mean) #A群の行(遺伝子)ごとのzscoreの平均値を計算した結果をmean_zscore_Aに格納 mean_zscore_B <- apply(zscore[,data.cl == 1], 1, mean) #B群の行(遺伝子)ごとのzscoreの平均値を計算した結果をmean_zscore_Bに格納 zratio <- (mean_zscore_B - mean_zscore_A)/sd(mean_zscore_B - mean_zscore_A)#Z ratioを計算した結果をzratioに格納 #Zスコアを算出する関数calc_zを作成 calc_z <- function(x, AD1, mean_set1, sd_set1){ #Zスコアを算出する関数calc_zを作成 hoge <- (mean_set1 - mean(AD1[intersect(names(AD1), x)], na.rm=TRUE))*sqrt(length(intersect(names(AD1), x)))/sd_set1#Zスコアを算出する関数calc_zを作成 return(hoge) #Zスコアを算出する関数calc_zを作成 } #Zスコアを算出する関数calc_zを作成 #PAGE解析のメイン部分 AD <- zratio #この行以下の記述を他のPAGE法のものと統一すべくzratioをADとして取り扱う names(AD) <- toupper(names(AD)) #.gmtファイルは大文字の遺伝子名なのでnames(AD)でみられる遺伝子名も大文字に変換する mean_set <- mean(AD) #全遺伝子の倍率変化の平均を計算し、mean_setに格納 sd_set <- sd(AD) #全遺伝子の倍率変化の標準偏差を計算し、sd_setに格納 z_page <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す z_page <- c(z_page, calc_z(gmt[[i]]@ids, AD, mean_set, sd_set))#gmt[[i]]@idsで表されるi番目の遺伝子セットの遺伝子群のZスコアを計算し、z_pageに格納 } #length(gmt)回だけループを回す p_page <- (1 - pnorm(abs(z_page)))*2 #Zスコアに対応するp値を計算し、p_pageに格納 #結果をまとめてファイルに保存 out <- NULL #おまじない for(i in 1:length(gmt)){ #length(gmt)回だけループを回す Geneset_name <- gmt[[i]]@reference #遺伝子セット名をGeneset_nameに格納 GO_ID <- substring(gmt[[i]]@desc, 32, 41) #遺伝子セット名に対応するGene Ontology IDをGO_IDに格納 Member_num <- length(gmt[[i]]@ids) #各遺伝子セットを構成する遺伝子数をMember_numに格納 Member_num_thischip <- length(intersect(names(AD), gmt[[i]]@ids))#各遺伝子セットを構成する"このチップに搭載されている"遺伝子数をMember_num_thischipに格納 out <- rbind(out, c(Geneset_name, GO_ID, Member_num, Member_num_thischip)) #Geneset_name, Member_num, Member_num_thischipの情報をoutに格納 } #length(gmt)回だけループを回す colnames(out) <- c("Geneset_name", "GO_ID", "Member_num", "Member_num_thischip")#outの列名をGeneset_name, GO_ID, Member_num, Member_num_thischipに変更 tmp <- cbind(out, z_page, p_page) #outの右側にPAGE解析結果のZスコアとp値を追加してtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #p値の低い順にソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(p_page),] #p値(p_page)でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。参考文献1(PAGE法: Kim and Volsky, BMC Bioinformatics, 2005)
library(PGSEA) #パッケージの読み込み library(GSEABase) #パッケージの読み込み library(org.Hs.eg.db) #パッケージの読み込み参考文献(Kim and Volsky, BMC Bioinformatics, 2005)
in_f1 <- "data_rma_2_nr.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c2.cp.kegg.v3.0.symbols.gmt" #入力ファイル名(gmtファイル)を指定 param1 <- 1:4 #遺伝子発現行列中のA群(満腹サンプルに相当)の位置(X-Y列)のXとYを指定 param2 <- 5:8 #遺伝子発現行列中のB群(空腹サンプルに相当)の位置(X-Y列)のXとYを指定 param3 <- 0.1 #FDRの閾値を指定 out_f1 <- "hoge_upregulated_in_B.txt" #出力ファイル名1を指定 out_f2 <- "hoge_upregulated_in_A.txt" #出力ファイル名2を指定 #必要なパッケージをロード library(GSA) #GSAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 colnames(data) #dataの列名を表示。GSM184414-184437まで順番に並んでいることを確認 rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している(gmtファイルに合わせるためです) data <- data[,c(param1, param2)] #発現データの中から、ここで比較するLIVサンプルの列のみを抽出した結果をdataに格納 data.cl <- c(rep(1, length(param1)), rep(2, length(param2))) #A群を1、B群を2としたベクトルdata.clを作成。 #GSA本番 out <- GSA(data, data.cl, genesets=gmt$genesets, genenames=rownames(data), resp.type="Two class unpaired")#GSAを実行し、結果をoutに格納 tmp <- GSA.listsets(out, geneset.names=gmt$geneset.names, maxchar=max(nchar(gmt$geneset.names)), FDRcut=param3)#(param3)で指定したFDR閾値を満たす遺伝子セットのみ、発現変動の向き(「A群が高発現」と「B群が高発現」)ごとにリストアップした結果をtmpに格納 write.table(tmp$positive, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp$positiveの中身をout_f1で指定したファイル名で保存。 write.table(tmp$negative, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp$negativeの中身をout_f2で指定したファイル名で保存。2.褐色脂肪の「満腹 vs. 空腹」のKEGG Pathway解析の場合(発現データファイルが異なり、褐色脂肪のみに予めなっている場合:data_rma_2_nr_BAT.txt)
in_f1 <- "data_rma_2_nr_BAT.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c2.cp.kegg.v3.0.symbols.gmt" #入力ファイル名(gmtファイル)を指定 param1 <- 4 #A群のサンプル数を指定 param2 <- 4 #B群のサンプル数を指定 param3 <- 0.1 #FDRの閾値を指定 out_f1 <- "hoge_upregulated_in_B.txt" #出力ファイル名1を指定 out_f2 <- "hoge_upregulated_in_A.txt" #出力ファイル名2を指定 #必要なパッケージをロード library(GSA) #GSAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している(gmtファイルに合わせるためです) data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成。 #GSA本番 out <- GSA(data, data.cl, genesets=gmt$genesets, genenames=rownames(data), resp.type="Two class unpaired")#GSAを実行し、結果をoutに格納 tmp <- GSA.listsets(out, geneset.names=gmt$geneset.names, maxchar=max(nchar(gmt$geneset.names)), FDRcut=param3)#(param3)で指定したFDR閾値を満たす遺伝子セットのみ、発現変動の向き(「A群が高発現」と「B群が高発現」)ごとにリストアップした結果をtmpに格納 write.table(tmp$positive, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp$positiveの中身をout_f1で指定したファイル名で保存。 write.table(tmp$negative, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp$negativeの中身をout_f2で指定したファイル名で保存。3.肝臓の「満腹 vs. 空腹」のGene Ontology(Biological Process)解析の場合(FDR < 0.1を満たす遺伝子セットを抽出)
in_f1 <- "data_rma_2_nr.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c5.bp.v3.0.symbols.gmt" #入力ファイル名(gmtファイル)を指定 param1 <- 17:20 #遺伝子発現行列中のA群(満腹サンプルに相当)の位置(X-Y列)のXとYを指定 param2 <- 21:24 #遺伝子発現行列中のB群(空腹サンプルに相当)の位置(X-Y列)のXとYを指定 param3 <- 0.1 #FDRの閾値を指定 out_f1 <- "hoge_upregulated_in_B.txt" #出力ファイル名1を指定 out_f2 <- "hoge_upregulated_in_A.txt" #出力ファイル名2を指定 #必要なパッケージをロード library(GSA) #GSAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 colnames(data) #dataの列名を表示。GSM184414-184437まで順番に並んでいることを確認 rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している(gmtファイルに合わせるためです) data <- data[,c(param1, param2)] #発現データの中から、ここで比較するLIVサンプルの列のみを抽出した結果をdataに格納 data.cl <- c(rep(1, length(param1)), rep(2, length(param2))) #A群を1、B群を2としたベクトルdata.clを作成。 #GSA本番 out <- GSA(data, data.cl, genesets=gmt$genesets, genenames=rownames(data), resp.type="Two class unpaired")#GSAを実行し、結果をoutに格納 tmp <- GSA.listsets(out, geneset.names=gmt$geneset.names, maxchar=max(nchar(gmt$geneset.names)), FDRcut=param3)#(param3)で指定したFDR閾値を満たす遺伝子セットのみ、発現変動の向き(「A群が高発現」と「B群が高発現」)ごとにリストアップした結果をtmpに格納 write.table(tmp$positive, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp$positiveの中身をout_f1で指定したファイル名で保存。 write.table(tmp$negative, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp$negativeの中身をout_f2で指定したファイル名で保存。4.肝臓の「満腹 vs. 空腹」のGene Ontology(Biological Process)解析の場合(発現データファイルが異なり、褐色脂肪のみに予めなっている場合:data_rma_2_nr_LIV.txt)
in_f1 <- "data_rma_2_nr_LIV.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c5.bp.v3.0.symbols.gmt" #入力ファイル名(gmtファイル)を指定 param1 <- 4 #A群のサンプル数を指定 param2 <- 4 #B群のサンプル数を指定 param3 <- 0.1 #FDRの閾値を指定 out_f1 <- "hoge_upregulated_in_B.txt" #出力ファイル名1を指定 out_f2 <- "hoge_upregulated_in_A.txt" #出力ファイル名2を指定 #必要なパッケージをロード library(GSA) #GSAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している(gmtファイルに合わせるためです) data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成。 #GSA本番 out <- GSA(data, data.cl, genesets=gmt$genesets, genenames=rownames(data), resp.type="Two class unpaired")#GSAを実行し、結果をoutに格納 tmp <- GSA.listsets(out, geneset.names=gmt$geneset.names, maxchar=max(nchar(gmt$geneset.names)), FDRcut=param3)#(param3)で指定したFDR閾値を満たす遺伝子セットのみ、発現変動の向き(「A群が高発現」と「B群が高発現」)ごとにリストアップした結果をtmpに格納 write.table(tmp$positive, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp$positiveの中身をout_f1で指定したファイル名で保存。 write.table(tmp$negative, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp$negativeの中身をout_f2で指定したファイル名で保存。5.肝臓の「満腹 vs. 空腹」のmotif解析の場合(発現データファイルが異なり、褐色脂肪のみに予めなっている場合:data_rma_2_nr_LIV.txt)
in_f1 <- "data_rma_2_nr_LIV.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c3.all.v3.0.symbols.gmt" #入力ファイル名(gmtファイル)を指定 param1 <- 4 #A群のサンプル数を指定 param2 <- 4 #B群のサンプル数を指定 param3 <- 0.1 #FDRの閾値を指定 out_f1 <- "upregulated_in_B_LIV_motif.txt" #出力ファイル名1を指定 out_f2 <- "upregulated_in_A_LIV_motif.txt" #出力ファイル名2を指定 #必要なパッケージをロード library(GSA) #GSAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している(gmtファイルに合わせるためです) data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成。 #GSA本番 out <- GSA(data, data.cl, genesets=gmt$genesets, genenames=rownames(data), resp.type="Two class unpaired")#GSAを実行し、結果をoutに格納 tmp <- GSA.listsets(out, geneset.names=gmt$geneset.names, maxchar=max(nchar(gmt$geneset.names)), FDRcut=param3)#(param3)で指定したFDR閾値を満たす遺伝子セットのみ、発現変動の向き(「A群が高発現」と「B群が高発現」)ごとにリストアップした結果をtmpに格納 write.table(tmp$positive, out_f1, sep="\t", append=F, quote=F, row.names=F)#tmp$positiveの中身をout_f1で指定したファイル名で保存。 write.table(tmp$negative, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp$negativeの中身をout_f2で指定したファイル名で保存。
in_f1 <- "data_rma_2_nr_BAT.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c2.cp.kegg.v3.0.symbols.gmt" #入力ファイル名(gmtファイル)を指定 param1 <- 4 #A群のサンプル数を指定 param2 <- 4 #B群のサンプル数を指定 out_f1 <- "hoge1.txt" #出力ファイル名を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(GSA) #GSAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している(gmtファイルに合わせるためです) data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成。 #log2(B/A)の計算 logratio <- rowMeans(data[,data.cl==2]) - rowMeans(data[,data.cl==1]) #検証本番 out1 <- NULL out2 <- NULL for(i in 1:length(gmt$geneset.names)){ geneset <- is.element(rownames(data), gmt$genesets[[i]]) out1 <- rbind(out1, c(gmt$geneset.names[i], length(gmt$genesets[[i]]), sum(geneset), mean(logratio[geneset]), median(logratio[geneset]))) out2 <- cbind(out2, geneset) } colnames(out2) <- gmt$geneset.names colnames(out1) <- c("GeneSet_name", "Member_num", "Member_num_in_thischip", "mean(logratio)", "median(logratio)") write.table(out1, out_f1, sep="\t", append=F, quote=F, row.names=F)#out1の中身をout_f1で指定したファイル名で保存。 tmp2 <- cbind(rownames(data), data, logratio, out2) write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。2. data_rma_2_nr_LIV.txtのデータ
in_f1 <- "data_rma_2_nr_LIV.txt" #入力ファイル名(発現データファイル)を指定 in_f2 <- "c5.bp.v3.0.symbols.gmt" #入力ファイル名(gmtファイル)を指定 param1 <- 4 #A群のサンプル数を指定 param2 <- 4 #B群のサンプル数を指定 out_f1 <- "hoge1.txt" #出力ファイル名を指定 out_f2 <- "hoge2.txt" #出力ファイル名を指定 #必要なパッケージをロード library(GSA) #GSAパッケージ(ライブラリ)の読み込み #データファイルの読み込みとラベル情報の作成 gmt <- GSA.read.gmt(in_f2) #遺伝子セット情報を読み込んでgmtに格納(不完全な最終行が見つかりました、と警告が出ますが気にしなくてよい) data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 rownames(data) <- toupper(rownames(data)) #gene symbolを大文字に変換している(gmtファイルに合わせるためです) data.cl <- c(rep(1, param1), rep(2, param2)) #A群を1、B群を2としたベクトルdata.clを作成。 #log2(B/A)の計算 logratio <- rowMeans(data[,data.cl==2]) - rowMeans(data[,data.cl==1]) #検証本番 out1 <- NULL out2 <- NULL for(i in 1:length(gmt$geneset.names)){ geneset <- is.element(rownames(data), gmt$genesets[[i]]) out1 <- rbind(out1, c(gmt$geneset.names[i], length(gmt$genesets[[i]]), sum(geneset), mean(logratio[geneset]), median(logratio[geneset]))) out2 <- cbind(out2, geneset) } colnames(out2) <- gmt$geneset.names colnames(out1) <- c("GeneSet_name", "Member_num", "Member_num_in_thischip", "mean(logratio)", "median(logratio)") write.table(out1, out_f1, sep="\t", append=F, quote=F, row.names=F)#out1の中身をout_f1で指定したファイル名で保存。 tmp2 <- cbind(rownames(data), data, logratio, out2) write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。
library(globaltest) #パッケージの読み込み
Bioconductorのglobaltestのwebページ
参考文献(Goeman et al., Bioinformatics, 2004)in_f <- "GDS1096_rma.txt" #入力ファイル名(発現データファイル)を指定 param1 <- "correlation" #類似度(method.dist)を指定 param2 <- "average" #方法(method.hclust)を指定 param3 <- 20 #resampling回数を指定(この値が大きいほどより正確にブートストラップ確率を求めることができる。実際には100とか500とか...) #データファイルの読み込みとラベル情報の作成 library(pvclust) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 out <- pvclust(data, method.hclust=param2, method.dist=param1, nboot=param3)#クラスタリングの実行 plot(out) #樹形図(デンドログラム)の表示 #以下は(こんなこともできますという)おまけ #Approximately Unbiased (au) probability > 0.95を満たす頑健なクラスターを四角で囲み、その条件を満たすクラスターのメンバーをリストアップしたい場合: param4 <- "au" #ブートストラップ確率計算手段を指定 param5 <- 0.95 #ブートストラップ確率の閾値を指定 pvrect(out, alpha=param5, pv=param4) #条件を満たすクラスターを四角で囲む pvpick(out, alpha=param5, pv=param4) #条件を満たすクラスターのメンバーをリストアップする2. 10 sample×45 genesからなるsample3.txtのサンプル間クラスタリングを特に何も考えずデフォルト設定(resampling回数が1000となるのですごく時間がかかります...)で行う場合:
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 library(pvclust) #パッケージの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 out <- pvclust(data) #クラスタリングの実行 plot(out) #樹形図(デンドログラム)の表示3. 10 sample×45 genesからなるsample3.txtの遺伝子間クラスタリングをやる場合(pvclustでの遺伝子間クラスタリングは時間がかかりすぎるのでお勧めできません...):
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 param1 <- "correlation" #類似度(method.dist)を指定 param2 <- "average" #方法(method.hclust)を指定 param3 <- 30 #resampling回数を指定(この値が大きいほどより正確にブートストラップ確率を求めることができる。実際には100とか500とか...) #必要なパッケージをロード library(pvclust) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 out <- pvclust(t(data), method.hclust=param2, method.dist=param1, nboot=param3)#クラスタリングの実行 plot(out) #樹形図(デンドログラム)の表示CRANのpvclustのwebページ
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 param2 <- "average" #方法(method)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.dist <- as.dist(1 - cor(data)) #サンプル間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 plot(out) #樹形図(デンドログラム)の表示2. サンプル間クラスタリング(類似度:「1-Pearson相関係数」、方法:平均連結法(average))でpng形式のファイルで図の大きさを指定して得たい場合:
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 param2 <- "average" #方法(method)を指定 out_f <- "hoge.png" #出力ファイル名(クラスタリング結果ファイル)を指定 param3 <- 500 #クラスタリング結果の横幅(width; 単位はピクセル)を指定 param4 <- 400 #クラスタリング結果の縦幅(height; 単位はピクセル)を指定 param5 <- 14 #クラスタリング結果の文字の大きさ(単位はpoint)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.dist <- as.dist(1 - cor(data, method="pearson")) #サンプル間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(out) #樹形図(デンドログラム)の表示 dev.off() #おまじない3. サンプル間クラスタリング(類似度:「1-Spearman相関係数」、方法:平均連結法(average))でpng形式のファイルで図の大きさを指定して得たい場合:
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 out_f <- "hoge.png" #出力ファイル名(クラスタリング結果ファイル)を指定 param2 <- "average" #方法(method)を指定 param3 <- 500 #クラスタリング結果の横幅(width; 単位はピクセル)を指定 param4 <- 400 #クラスタリング結果の縦幅(height; 単位はピクセル)を指定 param5 <- 14 #クラスタリング結果の文字の大きさ(単位はpoint)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.dist <- as.dist(1 - cor(data, method="spearman")) #サンプル間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(out) #樹形図(デンドログラム)の表示 dev.off() #おまじない4. サンプル間クラスタリング(類似度:ユークリッド距離(euclidean)、方法:平均連結法(average))でR Graphics画面上に表示したい場合:
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 param1 <- "euclidean" #類似度(dist)を指定 param2 <- "average" #方法(method)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.dist <- dist(t(data), method=param1) #サンプル間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 plot(out) #樹形図(デンドログラム)の表示5. サンプル間クラスタリング(類似度:ユークリッド距離(euclidean)、方法:平均連結法(average))でpng形式のファイルで図の大きさを指定して得たい場合:
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 out_f <- "hoge.png" #出力ファイル名(クラスタリング結果ファイル)を指定 param1 <- "euclidean" #類似度(dist)を指定 param2 <- "average" #方法(method)を指定 param3 <- 500 #クラスタリング結果の横幅(width; 単位はピクセル)を指定 param4 <- 400 #クラスタリング結果の縦幅(height; 単位はピクセル)を指定 param5 <- 14 #クラスタリング結果の文字の大きさ(単位はpoint)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.dist <- dist(t(data), method=param1) #サンプル間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(out) #樹形図(デンドログラム)の表示 dev.off() #おまじない6. 遺伝子間クラスタリング(類似度:ユークリッド距離(euclidean)、方法:平均連結法(average))の場合:
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 param1 <- "euclidean" #類似度(dist)を指定 param2 <- "average" #方法(method)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.dist <- dist(data, method=param1) #遺伝子間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 plot(out) #樹形図(デンドログラム)の表示7. 遺伝子間クラスタリング(類似度:1 - 相関係数、方法:平均連結法(average))の場合:
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 param2 <- "average" #方法(method)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.dist <- as.dist(1 - cor(t(data))) #遺伝子間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 plot(out) #樹形図(デンドログラム)の表示
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名(発現データファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 10 #K個のクラスターに分割のKを指定 param2 <- "average" #方法(method)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 #まずはクラスタリングを実行 data.dist <- as.dist(1 - cor(t(data))) #遺伝子間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 #param1で指定した数に分割しファイルに保存 cluster <- cutree(out, k=param1) #param1個のクラスターに分割し、結果をclusterに格納 tmp <- cbind(rownames(data), data, cluster) #入力データの右側にclusterの情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #クラスターごとにソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(cluster),] #cluster列の値でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。2. sample3.txt遺伝子間クラスタリングの場合(類似度:ユークリッド距離(euclidean)、方法:平均連結法(average)):
in_f <- "sample3.txt" #入力ファイル名(発現データファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 3 #K個のクラスターに分割のKを指定 param2 <- "euclidean" #類似度(dist)を指定 param3 <- "average" #方法(method)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 #まずはクラスタリングを実行 data.dist <- dist(data, method=param2) #遺伝子間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param3) #階層的クラスタリングを実行し、結果をoutに格納 #param1で指定した数に分割しファイルに保存 cluster <- cutree(out, k=param1) #param1個のクラスターに分割し、結果をclusterに格納 tmp <- cbind(rownames(data), data, cluster) #入力データの右側にclusterの情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。 #以下は(こんなこともできますという)おまけ #クラスターごとにソートした結果を得たい場合: out_f2 <- "hoge2.txt" #出力ファイル名を指定 tmp2 <- tmp[order(cluster),] #cluster列の値でソートした結果をtmp2に格納 write.table(tmp2, out_f2, sep="\t", append=F, quote=F, row.names=F)#tmp2の中身をout_f2で指定したファイル名で保存。3. data_GSE7623_rma.txtのサンプル間クラスタリングの場合(類似度:1 - 相関係数、方法:平均連結法(average)):
in_f <- "data_GSE7623_rma.txt" #入力ファイル名(発現データファイル)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 param1 <- 2:10 #K個のクラスターに分割のKを指定(ここでは2-10を一度に指定←こんなこともできます) param2 <- "average" #方法(method)を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 colnames(data) <- c( #サンプル名を変更している "BAT_fed1", "BAT_fed2", "BAT_fed3", "BAT_fed4", #サンプル名を変更している "BAT_fasted1", "BAT_fasted2", "BAT_fasted3", "BAT_fasted4", #サンプル名を変更している "WAT_fed1", "WAT_fed2", "WAT_fed3", "WAT_fed4", #サンプル名を変更している "WAT_fasted1", "WAT_fasted2", "WAT_fasted3", "WAT_fasted4", #サンプル名を変更している "LIV_fed1", "LIV_fed2", "LIV_fed3", "LIV_fed4", #サンプル名を変更している "LIV_fasted1", "LIV_fasted2", "LIV_fasted3", "LIV_fasted4") #サンプル名を変更している #まずはクラスタリングを実行 data.dist <- as.dist(1 - cor(data)) #遺伝子間の距離を計算し、結果をdata.distに格納 out <- hclust(data.dist, method=param2) #階層的クラスタリングを実行し、結果をoutに格納 #param1で指定した数に分割しファイルに保存 cluster <- cutree(out, k=param1) #param1個のクラスターに分割し、結果をclusterに格納 tmp <- cbind(colnames(data), cluster) #サンプル名の右側にk個に分割した(例ではk=2,3,...,10)場合のclusterの情報を追加してtmpに格納。 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
in_f <- "data_GSE7623_rma_cv.txt" #入力ファイル名を指定 param1 <- 9 #クラスター数の探索範囲の上限 param2 <- "average" #方法(method)を指定 param3 <- 100 #ランダムサンプリング回数を指定(できれば1000くらいを指定したほうがよいと思います) #必要なパッケージをロード library(clusterStab) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data <- as.matrix(data) #dataのデータ形式をmatrix型に変更 out <- benhur(data, 0.7, param1, seednum=12345, iterations=param3, linkmeth=param2)#最適クラスター数の探索を実行し、結果をoutに格納 hist(out) #候補クラスター数ごと(2, 3, ..., param)のJaccard係数分布を表示解説:
ecdf(out)ここまでで、最適なクラスター数が2 or 3個であることがわかりました。次に参考文献3の方法を用いて各クラスターがどれだけ安定なのかをclusterComp関数を用いて調べるとともに、各サンプルがどのクラスターに属しているかの結果を指定した出力ファイル名で保存します。
param3 <- 2 #得られた最適なクラスター数(例では2)を指定 out_f <- "hoge.txt" #出力ファイル名を指定 out2 <- clusterComp(data, param3, method=param2) #各クラスターの安定性を見積る out2 #out2の中身を表示(cluster1,2ともに100%の安定性であることが分かる) str(out2) #out2というオブジェクトの内容を情報付きで表示 out2@clusters #各サンプルがどのクラスターに属するのかを表示 tmp <- cbind(names(out2@clusters), out2@clusters) #サンプル名とクラスター番号との対応関係をtmpに格納 write.table(tmp, out_f, sep="\t", append=F, quote=F, row.names=F)#tmpの中身をout_fで指定したファイル名で保存。
BioconductorのclusterStabのwebページ
参考文献1(Ben-Hur et al., Pac. Symp. Biocomput., 2002)in_f <- "sample3.txt" #入力ファイル名を指定 #必要なパッケージをロード library(cclust) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data <- as.matrix(data) #dataのデータ形式をmatrix型に変更 #まずはKをいろいろ変えて得られるクラスターを眺める sample3_k2 <- cclust(data, 2, 20, verbose=TRUE, method="kmeans") #K=2として遺伝子のクラスタリングを実行 sample3_k3 <- cclust(data, 3, 20, verbose=TRUE, method="kmeans") #K=3として遺伝子のクラスタリングを実行 sample3_k4 <- cclust(data, 4, 20, verbose=TRUE, method="kmeans") #K=4として遺伝子のクラスタリングを実行 sample3_k5 <- cclust(data, 5, 20, verbose=TRUE, method="kmeans") #K=5として遺伝子のクラスタリングを実行 sample3_k2 sample3_k3 sample3_k4 sample3_k5 #Cluster validity Indexの一つであるDB(Davies-Bouldin) Indexを用いて、K=2, 3, 4, 5として得られたクラスターを評価する clustIndex(sample3_k2, data, index="db") clustIndex(sample3_k3, data, index="db") clustIndex(sample3_k4, data, index="db") clustIndex(sample3_k5, data, index="db") #K=3でクラスタリングした結果(sample3_k3)から詳細な情報を入手したい場合。(2005.6.6追加) names(sample3_k3) #sample3_k3からどのような情報を入手できるのか調べる。 sample3_k3$cluster #遺伝子の並び順に、どのクラスに属するかをざっと表示 for(i in 1:nrow(sample3)) cat(rownames(data[i,])," ",sample3_k3$cluster[i],"\n")#遺伝子の並び順に、どの遺伝子がどのクラスに属するか全体を表示DB Indexは、その値が低いものほど分割数が妥当であることを意味する。したがって、いろいろ調べた中で最も値の低かったものを採用(この場合、おそらくK=3)する。 (特にK=5とした場合に、Sizes of Clustersが1になるクラスターがときどき出現する。このような場合clustIndexで調べたときにエラーとなるようだ)
in_f <- "sample2.txt" #入力ファイル名を指定 #必要なパッケージをロード library(som) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 sample2.f <- filtering(data, lt=10, ut=100, mmr=2.9, mmd=42) #解析に用いる遺伝子のフィルタリング(発現強度が10以下のものを10に、100以上のものを100に、「発現強度max/min < 2.9」または「(max-min) < 42」の行(遺伝子)を解析から除く) sample2.f.n <- normalize(sample2.f, byrow=TRUE) #行(row)方向の正規化(平均=0,分散=1); (列方向にしたいときはcolにする) foo <- som(t(sample2.f.n), xdim=3, ydim=5) #SOMの実行(「x軸方向3分割×y軸方向5分割」にする場合) plot(foo) #結果のプロット2. 遺伝子(gene)間クラスタリングの場合:
in_f <- "sample2.txt" #入力ファイル名を指定 #必要なパッケージをロード library(som) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 sample2.f <- filtering(data, lt=10, ut=100, mmr=2.9, mmd=42) #解析に用いる遺伝子のフィルタリング(発現強度が10以下のものを10に、100以上のものを100に、「発現強度max/min < 2.9」または「(max-min) < 42」の行(遺伝子)を解析から除く) sample2.f.n <- normalize(sample2.f, byrow=TRUE) #行(row)方向の正規化(平均=0,分散=1); (列方向にしたいときはcolにする) foo <- som(sample2.f.n, xdim=3, ydim=5) #SOMの実行(「x軸方向3分割×y軸方向5分割」にする場合) plot(foo) #結果のプロットCRANのsomのwebページ
in_f <- "sample3.txt" #入力ファイル名を指定 #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#発現データを読み込んでdataに格納。 data.pca <- prcomp(t(data)) names(data.pca) plot(data.pca$sdev, type="h", main="PCA s.d.") data.pca.sample <- t(data) %*% data.pca$rotation[,1:2] #第一、二主成分を抽出 plot(data.pca.sample, main="PCA") #第一、二主成分を抽出した結果をプロット text(data.pca.sample, colnames(data), col = c(rep("red", 7), rep("black", 3)))#tissue1-7を赤、残りの3つの組織を黒で表示。
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "result_loocv.txt" #出力ファイル名を指定 param_A <- 50 #A群のサンプル数を指定 param_B <- 52 #B群のサンプル数を指定 #必要なパッケージをロード library(class) #パッケージの読み込み #ラベルが「0の群」と「1の群」間で不等分散性を仮定(var.equal=F)してt.testを行い、t統計量の値を返す関数Welch_tstatを作成。 Welch_tstat <- function(x, cl){ x.class0 <- x[(cl == 0)] #ラベルが0のものをx.class0に格納 x.class1 <- x[(cl == 1)] #ラベルが1のものをx.class1に格納 if((sd(x.class0)+sd(x.class1)) == 0){ #両方の群の標準偏差が共に0の場合はt統計量を計算できない(無限大になる)ので、この場合の統計量を0にする statistic <- 0 return(statistic) } else{ hoge <- t.test(x.class1, x.class0, var.equal=F) return(hoge$statistic) } } #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 rank.matrix <- rownames(data) #おまじない(出力ファイルの一列目にrownames(data)情報(つまり遺伝子名に関する情報)を付加するため for (i in 1:length(data.cl)){ #LOOCVなので、length(data.cl)回数分だけループを回す data.tmp <- data[,-i] #i番目の列データを削除した結果をdata.tmpに格納 data.cl.tmp <- data.cl[-i] #i番目の列データに対応するラベル情報を削除した結果をdata.cl.tmpに格納 tmpall <- apply(data.tmp, 1, Welch_tstat, data.cl.tmp) #i番目の列データがないサブセットに対してWelch t-statisticを計算し、結果をtmpallに格納 rank.matrix <- cbind(rank.matrix, rank(-abs(tmpall))) #i番目の列データがないサブセットに対してWelch t-statisticを計算して得られたランキング結果をrank.matrixの右側の列に追加 } write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F)#LOOCV用の「leave-one-outで得られたi番目の列(サンプル)データを削除した場合のランキング結果」を"hoge_loocv.txt"に出力 result <- c("No. of genes", "Accuracy", "MCC") #おまじない(出力ファイルの一行目に左記情報を付加するため) data.tmp <- read.table("hoge_loocv.txt", header=TRUE, row.names=1, sep="\t", quote="") #上記出力ファイルの読み込み for(g_num in 2:15){ #ランキング上位2, 3, ..., 15個を分類に用いた場合の精度を調べるためのループ pred.vector <- NULL #おまじない for(j in 1:ncol(data.tmp)){ #LOOCV用のループ(サンプル数分だけループが回る) data.rank <- data.tmp[,j] #j番目のカラム中のランキング情報をdata.rankに格納 data.s <- data[order(data.rank),] #もとの遺伝子発現行列data中の並びをdata.rankの並びでソートし直し、その結果をdata.sに格納 data.sub.train <- data.s[1:g_num,-j] #data.sに対して上位g_num個分までのj列目を除く遺伝子発現データをdata.sub.trainに格納(トレーニングデータ) data.sub.test <- data.s[1:g_num,j] #data.sに対して上位g_num個分までのj列目の遺伝子発現データをdata.sub.testに格納(テストデータ) data.cl.train <- data.cl[-j] #data.cl中のj番目を除くラベルデータをdata.cl.trainに格納(トレーニングデータ) data.cl.test <- data.cl[j] #data.cl中のj番目のラベルデータをdata.cl.testに格納(テストデータ) predicted <- knn(t(data.sub.train), t(data.sub.test), k=3, factor(data.cl.train))#k-Nearest Neighbor(k=3)の実行 pred.vector <- c(pred.vector, as.vector(predicted)) #j番目のテストデータの結果をどんどんpred.vectorに格納していく } CrossTable <- table(true = data.cl, pred = pred.vector) #当たり外れのクロス集計表を作成 TN <- CrossTable[1,1] #True Negative(実際のラベルが0のものを正しく0と予測できた数)をTNに格納 FP <- CrossTable[1,2] #False Positive(実際のラベルが0のものを誤って1と予測してしまった数)をFPに格納 FN <- CrossTable[2,1] #False Positive(実際のラベルが1のものを誤って0と予測してしまった数)をFNに格納 TP <- CrossTable[2,2] #True Positive(実際のラベルが1のものを正しく1と予測できた数)をTPに格納 accuracy = (TP+TN)/(TP+FP+FN+TN) #Accuracyの計算 MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN)) #Matthews correlation coefficient(マシュー相関係数)の計算 result <- rbind(result, c(g_num, accuracy, MCC)) #g_num, accuracy, MCCの値をベクトル化して、ベクトルresultの下の行に追加 } write.table(result, out_f, sep = "\t", append=F, quote=F, row.names=F)#結果をout_fで指定したファイル名で出力
library(class) #パッケージの読み込み
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "result_loocv.txt" #出力ファイル名を指定 param_A <- 50 #A群のサンプル数を指定 param_B <- 52 #B群のサンプル数を指定 #必要なパッケージをロード library(e1071) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 rank.matrix <- rownames(data) #おまじない(出力ファイルの一列目にrownames(data)情報(つまり遺伝子名に関する情報)を付加するため for (i in 1:length(data.cl)){ #LOOCVなので、length(data.cl)回数分だけループを回す data.tmp <- data[,-i] #i番目の列データを削除した結果をdata.tmpに格納 data.cl.tmp <- data.cl[-i] #i番目の列データに対応するラベル情報を削除した結果をdata.cl.tmpに格納 tmpall <- RP(data.tmp, data.cl.tmp, num.perm=1, logged=TRUE, na.rm = FALSE, plot = FALSE, rand = 123)#i番目の列データがないサブセットに対してRank productを実行し、結果をtmpallに格納 tmprankall <- rank(apply(tmpall$RPs, 1, min)) #Rank productは(1) Normal > Tumorの統計量RPと(2) Normal < Tumorの統計量RPの2つを別々の列として結果を返すため、各遺伝子(各行)に対して2つの値の低いほうの値をその遺伝子の統計量とした結果をtmprankallとして返す rank.matrix <- cbind(rank.matrix, tmprankall) #i番目の列データがないサブセットに対してRank productを実行して得られたランキング結果をrank.matrixの右側の列に追加 } write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F) #LOOCV用の「leave-one-outで得られたi番目の列(サンプル)データを削除した場合のランキング結果」を"hoge_loocv.txt"に出力 result <- c("No. of genes", "Accuracy", "MCC") #おまじない(出力ファイルの一行目に左記情報を付加するため) data.tmp <- read.table("hoge_loocv.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記出力ファイルの読み込み for(g_num in 2:100){ #ランキング上位2, 3, ..., 100個を分類に用いた場合の精度を調べるためのループ pred.vector <- NULL #おまじない for(j in 1:ncol(data.tmp)){ #LOOCV用のループ(サンプル数分だけループが回る) data.rank <- data.tmp[,j] #j番目のカラム中のランキング情報をdata.rankに格納 data.s <- data[order(data.rank),] #もとの遺伝子発現行列data中の並びをdata.rankの並びでソートし直し、その結果をdata.sに格納 data.sub.train <- data.s[1:g_num,-j] #data.sに対して上位g_num個分までのj列目を除く遺伝子発現データをdata.sub.trainに格納(トレーニングデータ) data.sub.test <- data.s[1:g_num,j] #data.sに対して上位g_num個分までのj列目の遺伝子発現データをdata.sub.testに格納(テストデータ) data.cl.train <- data.cl[-j] #data.cl中のj番目を除くラベルデータをdata.cl.trainに格納(トレーニングデータ) data.cl.test <- data.cl[j] #data.cl中のj番目のラベルデータをdata.cl.testに格納(テストデータ) svm.model <- svm(x=t(data.sub.train), y=factor(data.cl.train), scale=T, type="C-classification", kernel="linear")#トレーニングデータでsvmの実行 predicted <- predict(svm.model, t(data.sub.test)) #得られたsvm.modelを用いてj番目のテストデータの予測を行い、結果をpredictedに格納 pred.vector <- c(pred.vector, as.vector(predicted)) #j番目のテストデータの結果をどんどんpred.vectorに格納していく } CrossTable <- table(true = data.cl, pred = pred.vector) #当たり外れのクロス集計表を作成 TN <- CrossTable[1,1] #True Negative(実際のラベルが0のものを正しく0と予測できた数)をTNに格納 FP <- CrossTable[1,2] #False Positive(実際のラベルが0のものを誤って1と予測してしまった数)をFPに格納 FN <- CrossTable[2,1] #False Positive(実際のラベルが1のものを誤って0と予測してしまった数)をFNに格納 TP <- CrossTable[2,2] #True Positive(実際のラベルが1のものを正しく1と予測できた数)をTPに格納 accuracy = (TP+TN)/(TP+FP+FN+TN) #Accuracyの計算 MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN)) #Matthews correlation coefficient(マシュー相関係数)の計算 result <- rbind(result, c(g_num, accuracy, MCC)) #g_num, accuracy, MCCの値をベクトル化して、ベクトルresultの下の行に追加 } write.table(result, out_f, sep = "\t", append=F, quote=F, row.names=F)#結果をout_fで指定したファイル名で出力2. Feature selectionをEmpirical bayes statistic (経験ベイズ; Smyth GK, Stat. Appl, Genet. Mol. Biol., 2004))で行う場合:
in_f <- "data_Singh_RMA_3274.txt" #入力ファイル名を指定 out_f <- "result_loocv.txt" #出力ファイル名を指定 param_A <- 50 #A群のサンプル数を指定 param_B <- 52 #B群のサンプル数を指定 #必要なパッケージをロード library(e1071) #パッケージの読み込み #データファイルの読み込みとラベル情報の作成 data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data.cl <- c(rep(0, param_A), rep(1, param_B)) #A群を0、B群を1としたベクトルdata.clを作成 rank.matrix <- rownames(data) #おまじない(出力ファイルの一列目にrownames(data)情報(つまり遺伝子名に関する情報)を付加するため for (i in 1:length(data.cl)){ #LOOCVなので、length(data.cl)回数分だけループを回す data.tmp <- data[,-i] #i番目の列データを削除した結果をdata.tmpに格納 data.cl.tmp <- data.cl[-i] #i番目の列データに対応するラベル情報を削除した結果をdata.cl.tmpに格納 design <- model.matrix(~data.cl.tmp) #おまじない fit <- lmFit(data.tmp, design) #おまじない eb2 <- eBayes(fit) #おまじない tmp.out <- topTable(eb2, coef=2, number=(length(row.names(data))),adjust="fdr")#おまじない tmpall <- tmp.out[order(tmp.out[,1]),] #おまじない rank.matrix <- cbind(rank.matrix, rank(-abs(tmpall$t))) #i番目の列データがないサブセットに対してEmpirical bayesを実行して得られたランキング結果をrank.matrixの右側の列に追加 } write.table(rank.matrix, "hoge_loocv.txt", sep = "\t", append=F, quote=F, row.names=F) #LOOCV用の「leave-one-outで得られたi番目の列(サンプル)データを削除した場合のランキング結果」をhoge_loocv.txtに出力 result <- c("No. of genes", "Accuracy", "MCC") #おまじない(出力ファイルの一行目に左記情報を付加するため) data.tmp <- read.table("hoge_loocv.txt", header=TRUE, row.names=1, sep="\t", quote="")#上記出力ファイルの読み込み for(g_num in 2:100){ #ランキング上位2, 3, ..., 100個を分類に用いた場合の精度を調べるためのループ pred.vector <- NULL #おまじない for(j in 1:ncol(data.tmp)){ #LOOCV用のループ(サンプル数分だけループが回る) data.rank <- data.tmp[,j] #j番目のカラム中のランキング情報をdata.rankに格納 data.s <- data[order(data.rank),] #もとの遺伝子発現行列data中の並びをdata.rankの並びでソートし直し、その結果をdata.sに格納 data.sub.train <- data.s[1:g_num,-j] #data.sに対して上位g_num個分までのj列目を除く遺伝子発現データをdata.sub.trainに格納(トレーニングデータ) data.sub.test <- data.s[1:g_num,j] #data.sに対して上位g_num個分までのj列目の遺伝子発現データをdata.sub.testに格納(テストデータ) data.cl.train <- data.cl[-j] #data.cl中のj番目を除くラベルデータをdata.cl.trainに格納(トレーニングデータ) data.cl.test <- data.cl[j] #data.cl中のj番目のラベルデータをdata.cl.testに格納(テストデータ) svm.model <- svm(x=t(data.sub.train), y=factor(data.cl.train), scale=T, type="C-classification", kernel="linear") #トレーニングデータでsvmの実行 predicted <- predict(svm.model, t(data.sub.test)) #得られたsvm.modelを用いてj番目のテストデータの予測を行い、結果をpredictedに格納 pred.vector <- c(pred.vector, as.vector(predicted)) #j番目のテストデータの結果をどんどんpred.vectorに格納していく } CrossTable <- table(true = data.cl, pred = pred.vector) #当たり外れのクロス集計表を作成 TN <- CrossTable[1,1] #True Negative(実際のラベルが0のものを正しく0と予測できた数)をTNに格納 FP <- CrossTable[1,2] #False Positive(実際のラベルが0のものを誤って1と予測してしまった数)をFPに格納 FN <- CrossTable[2,1] #False Positive(実際のラベルが1のものを誤って0と予測してしまった数)をFNに格納 TP <- CrossTable[2,2] #True Positive(実際のラベルが1のものを正しく1と予測できた数)をTPに格納 accuracy = (TP+TN)/(TP+FP+FN+TN) #Accuracyの計算 MCC = (TP*TN-FP*FN)/sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN)) #Matthews correlation coefficient(マシュー相関係数)の計算 result <- rbind(result, c(g_num, accuracy, MCC)) #g_num, accuracy, MCCの値をベクトル化して、ベクトルresultの下の行に追加 } write.table(result, out_f, sep = "\t", append=F, quote=F, row.names=F)#結果をout_fで指定したファイル名で出力CRANのe1071のwebページ
library(e1071) #パッケージの読み込み
CRANのe1071のwebページin_f <- "GDS1096_best10_heart.txt" #入力ファイル名を指定 #必要なパッケージをロード library(stats) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 colnames(data) <- substring(colnames(data), 8, nchar(colnames(data)))#列ラベル中の最初の8文字分(つまり "Normal_")を削除 heatmap(as.matrix(data), Rowv =NA, Colv=NA, scale="row", col = cm.colors(100), main="Heart-specific genes (Best 10)", xlab="Tissue", ylab="Clone ID", margin=c(8,10))2.(「解析 | 似た発現パターンを持つ遺伝子の同定」などで得た)手持ちのファイル(GDS1096_best10_heart.txt)を読み込ませて、ヒートマップを描きたい場合: 条件1:読み込んだそのままの数値情報を用いて作図。 条件2:色は、「heat.colors」の20段階で表す。
in_f <- "GDS1096_best10_heart.txt" #入力ファイル名を指定 #必要なパッケージをロード library(stats) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 colnames(data) <- substring(colnames(data), 8, nchar(colnames(data)))#列ラベル中の最初の8文字分(つまり "Normal_")を削除 heatmap(as.matrix(data), Rowv =NA, Colv=NA, scale="none", col = heat.colors(20), main="Heart-specific genes (Best 10)", xlab="Tissue", ylab="Clone ID", margin=c(8,10)) #pseudo-color imageの作成3. 手持ちのファイル(GDS1096.txt)を読み込ませて、ヒートマップを描きたい場合: 条件1:行(遺伝子; row)方向にZ scalingした数値(the rows are scaled to have mean zero and standard deviation one)情報を用いて作図(参考:Golub et al., Science, 1999の図3)。 条件2:色は、「heat.colors」の20段階で表す。
in_f <- "GDS1096.txt" #入力ファイル名を指定 #必要なパッケージをロード library(stats) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f, header=TRUE, row.names=1, sep="\t", quote="")#入力ファイルを読み込んでdataに格納 data$IDENTIFIER <- NULL #おまじない(余分なカラム「IDENTIFIER」の消去) colnames(data) <- substring(colnames(data), 8, nchar(colnames(data)))#列ラベル中の最初の8文字分(つまり "Normal_")を削除 heatmap(as.matrix(data), Rowv =NA, Colv=NA, scale="row", col = heat.colors(100), main="data", xlab="Tissue", ylab="Clone ID", margin=c(8,6))4.「解析 | 似た発現パターンを持つ遺伝子の同定」の解析で得られた(GDS1096を心臓得意的パターン順にソートした)GDS1096_sort_by_heartを読み込ませて、ヒートマップを描きたい場合: 条件1:行(遺伝子; row)方向にZ scalingした数値(the rows are scaled to have mean zero and standard deviation one)情報を用いて作図(参考:Golub et al., Science, 1999の図3)。 条件2:色は、「heat.colors」の20段階で表す。
in_f1 <- "GDS1096.txt" #入力ファイル名を指定 in_f2 <- "GDS1096_cl_heart.txt" #入力ファイル名を指定 #必要なパッケージをロード library(genefilter) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#in_f1で指定したファイルを読み込んでdataに格納 data.cl <- read.table(in_f2, sep="\t", quote="") #in_f2で指定したファイルを読み込んでdata.clに格納 data$IDENTIFIER <- NULL #おまじない(余分なカラム「IDENTIFIER」の消去) data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。(read.tableで読み込んで得られたdataのデータの型は"データフレーム"なので、そのままではこの場合は使用不可なのでやる必要があります) template_heart <- data.cl[,2] #ラベル情報(2列目)のみ抽出し、template_heartに格納 tmp <- rbind(data, template_heart) #template_heartというテンプレートパターンを行列dataの最後の行に追加 ID_REF <- rownames(tmp) #行のラベル情報(つまり遺伝子IDに関する情報)をID_REFに格納 template_posi <- which(ID_REF == "template_heart") #行のラベル情報が"template_heart"に相当する行情報をtemplate_posiに格納 gene_num <- nrow(data) #行数をgene_numに格納 closeg <- genefinder(tmp, template_posi, gene_num, scale="none", method="correlation")#結果をclosegに格納 GDS1096_sort_by_heart <- tmp[closeg[[1]]$indices,] #heart-specificな順に並べられている遺伝子発現データを抽出し、GDS1096_sort_by_heartに格納 colnames(GDS1096_sort_by_heart) <- substring(colnames(GDS1096_sort_by_heart), 8, nchar(colnames(GDS1096_sort_by_heart)))#列ラベル中の最初の8文字分(つまり "Normal_")を削除 heatmap(as.matrix(GDS1096_sort_by_heart), Rowv =NA, Colv=NA, scale="row", col = heat.colors(100), main="GDS1096_sort_by_heart", xlab="Tissue", ylab="Clone ID", margin=c(8,6))使える色に関する参考URL
param1 <- c(1,3,4) #真のDEGの順位情報を指定 param2 <- 10 #xの値(全遺伝子数のこと、ここでは例として10としてるだけ)を入力 #必要なパッケージをロード library(ROC) #パッケージの読み込み DEG_posi <- rep(0,param2) #DEGの位置情報の初期値(0)を指定 DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換 out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納 AUC(out) #AUC値を計算2. このROC曲線の図:
param1 <- c(1,3,4) #真のDEGの順位情報を指定 param2 <- 10 #xの値(全遺伝子数のこと、ここでは例として10としてるだけ)を入力 #必要なパッケージをロード library(ROC) #パッケージの読み込み DEG_posi <- rep(0,param2) #DEGの位置情報の初期値(0)を指定 DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換 out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納 plot(out) #ROC曲線をプロット3. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合:
param1 <- c(1,3,4) #真のDEGの順位情報を指定 param2 <- 10 #xの値(全遺伝子数のこと、ここでは例として10としてるだけ)を入力 param3 <- 400 #横幅(width; 単位はピクセル)を指定 param4 <- 400 #縦幅(height; 単位はピクセル)を指定 param5 <- 14 #文字の大きさ(単位はpoint)を指定 out_f <- "hoge.png" #出力ファイル名を指定 #必要なパッケージをロード library(ROC) #パッケージの読み込み DEG_posi <- rep(0,param2) #DEGの位置情報の初期値(0)を指定 DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換 out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納 png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(out) #ROC曲線をプロット dev.off() #おまじない4. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合(x,y軸の文字も指定):
param1 <- c(1,3,4) #真のDEGの順位情報を指定 param2 <- 10 #xの値(全遺伝子数のこと、ここでは例として10としてるだけ)を入力 param3 <- 400 #横幅(width; 単位はピクセル)を指定 param4 <- 400 #縦幅(height; 単位はピクセル)を指定 param5 <- 14 #文字の大きさ(単位はpoint)を指定 param6 <- "1 - specificity" #x軸のラベルを指定 param7 <- "sensitivity" #y軸のラベルを指定 out_f <- "hoge.png" #出力ファイル名を指定 #必要なパッケージをロード library(ROC) #パッケージの読み込み DEG_posi <- rep(0,param2) #DEGの位置情報の初期値(0)を指定 DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換 out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納 png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(out, xlab=param6, ylab=param7) #ROC曲線をプロット dev.off() #おまじない 5. このROC曲線をpng形式のファイルで図の大きさを指定して得たい場合(x,y軸のラベルを描かないようにしたい):param1 <- c(1,3,4) #真のDEGの順位情報を指定 param2 <- 10 #xの値(全遺伝子数のこと、ここでは例として10としてるだけ)を入力 param3 <- 400 #横幅(width; 単位はピクセル)を指定 param4 <- 400 #縦幅(height; 単位はピクセル)を指定 param5 <- 14 #文字の大きさ(単位はpoint)を指定 param6 <- "1 - specificity" #x軸のラベルを指定 param7 <- "sensitivity" #y軸のラベルを指定 out_f <- "hoge.png" #出力ファイル名を指定 #必要なパッケージをロード library(ROC) #パッケージの読み込み DEG_posi <- rep(0,param2) #DEGの位置情報の初期値(0)を指定 DEG_posi <- replace(DEG_posi, param1, 1) #DEGに相当する位置を1に置換 out <- rocdemo.sca(truth=DEG_posi, data=-(1:param2), rule=dxrule.sca)#ROC情報をoutに格納 png(out_f, pointsize=param5, width=param3, height=param4) #出力ファイルの各種パラメータを指定 plot(out, xlab="", ylab="") #ROC曲線をプロット dev.off() #おまじない
in_f1 <- "sample1.txt" #入力ファイル1を指定 in_f2 <- "sample1_designmatrix.txt" #入力ファイル2を指定 #必要なパッケージをロード library(permtest) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#in_f1の読み込み data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。 data_designmatrix <- read.table(in_f2, sep="\t", quote="") #in_f2の読み込み data_designmatrix <- as.matrix(data_designmatrix) #as.matrixの意味は、「データの型を"行列として(as matrix)"data_designmatrixに格納せよ」です。 #本番 permtest(data, data_designmatrix) #permtestの実行2. サンプル間の距離=logr(-log(Pearson相関係数));並べ替え回数=10000の条件でで解析したい場合:
in_f1 <- "sample1.txt" #入力ファイル1を指定 in_f2 <- "sample1_designmatrix.txt" #入力ファイル2を指定 #必要なパッケージをロード library(permtest) #パッケージの読み込み #データファイルの読み込み data <- read.table(in_f1, header=TRUE, row.names=1, sep="\t", quote="")#in_f1の読み込み data <- as.matrix(data) #as.matrixの意味は、「データの型を"行列として(as matrix)"dataに格納せよ」です。 data_designmatrix <- read.table(in_f2, sep="\t", quote="") #in_f2の読み込み data_designmatrix <- as.matrix(data_designmatrix) #as.matrixの意味は、「データの型を"行列として(as matrix)"data_designmatrixに格納せよ」です。 #本番 permtest(data, data_designmatrix, distance="logr", nperms=10000) #permtestの実行CRANのpermtestのwebページ