################################################### ### chunk number 1: init ################################################### options(width=60) options(max.print=5) # 長い文字列の抑止 print<-function(x){ base::print(substring(x,1,getOption("width"))) } # BiBTeX myBibtex<-function(pkg){ if (missing(pkg)){ name <- "R" cita <- citation() }else{ name <- pkg cita <- citation(name) } bib<-gsub("^@([0-9A-z]+)\\{,", paste("@\\1{",name,",",sep=""), unlist(toBibtex(cita))) bib } con<-file("RdeDDBJ2.bib",open="wt") writeLines(myBibtex(),con) writeLines(myBibtex("XML"),con) writeLines(myBibtex("RCurl"),con) writeLines(myBibtex("SSOAP"),con) writeLines(myBibtex("Biobase"),con) close(con) ################################################### ### chunk number 2: XML1 ################################################### library(XML) f <- system.file("exampleData", "mathmlMatrix.xml", package = "XML") doc <- xmlTreeParse(f,useInternalNodes=T) # 内部形式はXPATHが使えます unlist(xpathApply(doc,"//*",xmlName)) sapply(getNodeSet(doc, "/mrow/reln/apply/vector"), saveXML) free(doc) ################################################### ### chunk number 3: XML2 ################################################### f <- system.file("exampleData", "mathmlMatrix.xml", package = "XML") doc <- xmlTreeParse(f,useInternalNodes=T) # XPATHでの値の取りだし path <- "/mrow/reln/apply/matrix/matrixrow/cn" unlist(xpathApply(doc, path, xmlValue)) free(doc) ################################################### ### chunk number 4: XML3 ################################################### doc<-xmlTreeParse(f,useInternalNodes=T) # 内部形式をXMLに戻します sapply(getNodeSet(doc, "/"), saveXML) free(doc) ################################################### ### chunk number 5: XML4 ################################################### doc <- xmlTreeParse(system.file("exampleData", "mtcars.xml", package="XML")) # 内部形式では無い場合 names(xmlRoot(doc)) r <- xmlRoot(doc) r[names(r) == "variables"] ################################################### ### chunk number 6: proxyoverview ################################################### library(grid) ## TOP grid.newpage() vp <- viewport(x=0.5,y=0.5,width=1, height=1) pushViewport(vp) grid.rect(gp=gpar(col=0,fill=rgb(.9,.9,.9))) grid.text("R PROXY 概要図", y=unit(1, "npc") - unit(1, "lines"), gp=gpar(col="black")) popViewport() pushViewport(viewport(x=.175, y=.48,width=0.3, height=0.85, name="Windows")) grid.rect(gp=gpar(col=0,fill=rgb(.9,.6,.5))) grid.text("internet2", y=unit(1, "npc") - unit(1, "lines"), gp=gpar(col="black")) grid.text("(Windows)", y=unit(1, "npc") - unit(2, "lines"), gp=gpar(col="black")) popViewport() pushViewport(viewport(x=.5, y=.48,width=0.3, height=0.85, name="other")) grid.rect(gp=gpar(col=0,fill=rgb(.9,.6,.5))) grid.text("socket module", y=unit(1, "npc") - unit(1, "lines"), gp=gpar(col="black")) grid.text("(標準&共通)", y=unit(1, "npc") - unit(2, "lines"), gp=gpar(col="black")) popViewport() pushViewport(viewport(x=.825, y=.48,width=0.3, height=0.85, name="RCurl")) grid.rect(gp=gpar(col=0,fill=rgb(.9,.6,.5))) grid.text("RCurl", y=unit(1, "npc") - unit(1, "lines"), gp=gpar(col="black")) grid.text("(libcurl)", y=unit(1, "npc") - unit(2, "lines"), gp=gpar(col="black")) popViewport() pushViewport(viewport(x=.175, y=.4,width=0.28, height=0.64, name="Windows")) grid.rect(gp=gpar(col=0,fill=rgb(.6,.6,.8))) grid.text("IEのPROXY設定を ", y=unit(1, "npc") - unit(1, "lines"), gp=gpar(col="black")) grid.text(" 引き継ぐ", y=unit(1, "npc") - unit(2, "lines"), gp=gpar(col="black")) grid.text("(起動オプション ", y=unit(1, "npc") - unit(3, "lines"), gp=gpar(col="black")) grid.text(" ‐‐internet2)", y=unit(1, "npc") - unit(4, "lines"), gp=gpar(col="black")) popViewport() pushViewport(viewport(x=.5, y=.4,width=0.28, height=0.64, name="other")) grid.rect(gp=gpar(col=0,fill=rgb(.6,.6,.8))) grid.text(" 環境変数 ", y=unit(1, "npc") - unit(1, "lines"), gp=gpar(col="black")) grid.text("HTTP_PROXY", y=unit(1, "npc") - unit(2, "lines"), gp=gpar(col="black")) grid.text(" 又は ", y=unit(1, "npc") - unit(3, "lines"), gp=gpar(col="black")) grid.text("http_proxy", y=unit(1, "npc") - unit(4, "lines"), gp=gpar(col="black")) popViewport() pushViewport(viewport(x=.825, y=.4,width=0.28, height=0.64, name="RCurl")) grid.rect(gp=gpar(col=0,fill=rgb(.6,.6,.8))) grid.text(" 環境変数 ", y=unit(1, "npc") - unit(1, "lines"), gp=gpar(col="black")) grid.text("http_proxy", y=unit(1, "npc") - unit(2, "lines"), gp=gpar(col="black")) popViewport() popViewport(0) ################################################### ### chunk number 7: ex1 ################################################### # 1. SSOAP のロード library(SSOAP) # 2. WSDLの指定 url <- "http://xml.nig.ac.jp/wsdl/GetEntry.wsdl" GetEntry <- processWSDL (url) iface <- genSOAPClientInterface(def = GetEntry) # 3. WEBサービスの呼び出し result<-iface@functions$getXML_DDBJEntry("AB000003") # 4. 視覚的な確認 xmlRoot(xmlTreeParse(result)) ################################################### ### chunk number 8: ex2 ################################################### # ※前の頁の1-2は実行済み # 3. アクセッション番号AB000002-AB000005を一度の実行で取得 acsession <- c("AB000002","AB000003","AB000004","AB000005") # 4. WEBサービスの呼び出し result <- sapply(acsession, iface@functions$getFASTA_DDBJEntry) # 5. 視覚的な確認 print(result) ################################################### ### chunk number 9: srs1 ################################################### # SSOAP のロード library(SSOAP) # WSDLの指定 SRS <- processWSDL("http://xml.nig.ac.jp/wsdl/SRS.wsdl") SRSiface<-genSOAPClientInterface(def=SRS) # WEBサービスの呼び出し (条件 & は & にすること) result<-SRSiface@functions$searchSimple( "[ddbj-AllText:prion*] & [ddbj-Division:hum] & [ddbj-Molecule:mrna]") print(result) ################################################### ### chunk number 10: srs2 ################################################### # 検索結果を改行で分割し, 配列に格納 id <- unlist(strsplit(result,"\n")) url <- "http://xml.nig.ac.jp/wsdl/GetEntry.wsdl" getentry<-genSOAPClientInterface(def = processWSDL(url)) # アクセッションNo(substringでDDBJ:をサプレス) # sapplyでアクセッションNoを引数にして # DADエントリーをFASTA形式で取得 result<-sapply(substring(id,6), getentry@functions$getFASTA_DADEntry) print(result) ################################################### ### chunk number 11: srs3 ################################################### blastiface<-genSOAPClientInterface(def=processWSDL( "http://xml.nig.ac.jp/wsdl/Blast.wsdl")) # blastサービスを呼び出す result<-blastiface@functions$searchParam("blastp", "SWISS", unlist(result), "-m 8") print(result) ################################################### ### chunk number 12: srs4 ################################################### # 結果を改行コードで分割する blastline<-unlist(strsplit(result,"\n")) print(blastline[1:3]) # 多いので三つだけ表示 # IDを抜き出す id <- as.vector(sapply(blastline,function(x){ unlist(strsplit(x,"\\|"))[5] })) print(id) ################################################### ### chunk number 13: srs5 ################################################### # IDからGetUNIPROTEntry取得 entry<-sapply(id, getentry@functions$getUNIPROTEntry) # 空白を圧縮 entry<-gsub("\\s{2,}"," ",entry) # 改行で分割 entry<-strsplit(entry,"\n") print(entry) ################################################### ### chunk number 14: srs6 ################################################### # IDの編集 ID<-sapply(entry, function(x) paste(substring(x[grep("^ID",x)],4),collapse=" ")) # DEの編集 DE<-sapply(entry, function(x) paste(substring(x[grep("^DE",x)],4),collapse=" ")) ENTRY<-cbind(ID,DE) print(ENTRY)