Mercurial > repos > pavlo-lutsik > rnbeads

comparison RnBeadsGalaxy.R @ 11:ce411254e4a9 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author pavlo-lutsik
date Sat, 20 Apr 2013 07:14:22 -0400
parents
children
comparison
equal deleted inserted replaced
10:945690943560 11:ce411254e4a9
1 msg.file<-file("RnBeads.messages.out")
2 sink(file=open(msg.file, "w"))
3
4 suppressWarnings(suppressPackageStartupMessages(library(RnBeads)))
5 suppressWarnings(suppressPackageStartupMessages(library(getopt)))
6
7 #all.opts<-names(rnb.options())
8 opt.class<-RnBeads:::OPTION.TYPES[-28]
9 all.opts<-names(opt.class)
10 #all.opts<-paste("--", all.opts, sep="")
11 #all.opts<-gsub("\\.([a-z])", "\\U\\1", all.opts, perl=TRUE)
12 all.opts<-gsub("\\.","-", all.opts)
13 #opt.class<-sapply(rnb.options(), class)
14
15 rnb.opt.spec<-data.frame(
16 Long=all.opts,
17 Short=as.character(1:length(all.opts)),
18 Mask=c(1,2)[as.integer((opt.class=="logical"))+1],
19 Type=opt.class)
20
21 ### automated xml file preparation
22 #xml.strings<-apply(rnb.opt.spec,1, function(row){
23 #
24 # opt.lab<-gsub("-", ".", row[1])
25 # opt.def.val<-rnb.getOption(opt.lab)
26 # opt.name<-gsub("-([0-9a-z])", "\\U\\1", row[1], perl=TRUE)
27 # tf.opt<-"\t\t\t<option value=\"True\">True</option>\n\t\t\t<option value=\"False\">False</option>"
28 # opt.lab<-paste(opt.lab, gsub("\\."," ", row[4]), sep=", ")
29 # if(row[4]=="logical"){
30 # opt.type<-'select'
31 # if(!is.null(opt.def.val) && opt.def.val)
32 # opt.def.val<-"1" else
33 # opt.def.val<-"0"
34 # string<-sprintf("\t\t<param name=\"%s\" type=\"%s\" label=\"%s\" value=\"%s\">\n%s\n\t\t</param>\n", opt.name, opt.type, opt.lab, opt.def.val, tf.opt)
35 # }else{
36 # opt.type<-'text'
37 # if(!is.null(opt.def.val) && opt.def.val!="")
38 # opt.def.val<-paste(opt.def.val, collapse=",") else
39 # opt.def.val<-""
40 # string<-sprintf("\t\t<param name=\"%s\" type=\"%s\" label=\"%s\" value=\"%s\"/>\n", opt.name, opt.type, opt.lab, opt.def.val)
41 # }
42 # string
43 # })
44 #
45 #cat(xml.strings, sep="", file="automated.settings.xml.txt")
46 #
47 #opt.def.strings<-apply(rnb.opt.spec,1, function(row){
48 #
49 # opt.name<-gsub("-([0-9a-z])", "\\U\\1", row[1], perl=TRUE)
50 # opt.long<-row[1]
51 # opt.short<-row[2]
52 #
53 # if(row[4]=="logical"){
54 # def.string<-sprintf("#if str( $options.%s ) == \"True\"\n\t--%s\n#end if\n", opt.name, opt.long)
55 # }else{
56 # def.string<-sprintf("#if str( $options.%s ) != \"\"\n\t--%s=\"$options.%s\" \n#end if\n", opt.name, opt.long, opt.name)
57 # }
58 # def.string
59 #
60 # })
61 #cat(opt.def.strings, sep="", file="automated.option.assignments.txt")
62
63
64 rnb.opt.spec$Type<-gsub("\\.vector", "", rnb.opt.spec$Type)
65 rnb.opt.spec$Type<-gsub("numeric", "double", rnb.opt.spec$Type)
66 rnb.opt.spec<-rbind(data.frame(
67 Long=c("data-type", "pheno", "idat-dir","idat-files","bed-files", "gs-report", "geo-series", "betas", "pvals","output-file", "report-dir"),
68 Short=c("d","s","a","i","f","g","e","b","p","r","o"),
69 Mask=c(1,2,2,2,2,2,2,2,2,1,1),
70 Type=c("character","character","character","character","character","character","character","character","character","character", "character")),
71 rnb.opt.spec)
72
73 opts<-getopt(as.matrix(rnb.opt.spec))
74 #opts<-getopt(as.matrix(rnb.opt.spec), opt=list("--data-type=idats","--report-dir=dir", "--idats=file1\tfile2"))
75 print(opts)
76
77 if(opts[["data-type"]]=="idatDir"){
78
79 data.source<-list()
80 data.type<-"idat.dir"
81 data.source[["idat.dir"]]<-opts[["idat-dir"]]
82 data.source[["sample.sheet"]]<-opts[["pheno"]]
83
84 }else if(opts[["data-type"]]=="idatFiles"){
85
86 data.type<-"idat.dir"
87 files<-strsplit(opts[["idat-files"]], "\t")[[1]]
88 idat.dir<-mkdir(file.path(opts[["report-dir"]], "idats"))
89 file.copy(as.list(files), idat.dir)
90 data.source<-list()
91 data.source[["idat.dir"]]<-idat.dir
92 data.source[["sample.sheet"]]<-opts[["pheno"]]
93
94
95 }else if(opts[["data-type"]]=="GS.report"){
96
97 data.type<-"GS.report"
98 data.source<-opts[["gs-report"]]
99
100 }else if(opts[["data-type"]]=="GEO"){
101
102 data.type<-"GEO"
103 data.source<-opts[["geo-series"]]
104
105 }else if(opts[["data-type"]]=="data.files"){
106
107 data.type<-"GEO"
108 data.source<-opts[["geo-series"]]
109
110 }else if(opts[["data-type"]]=="data.files"){
111
112 data.type<-"data.files"
113 data.source<-c(opts[["pheno"]], opts[["betas"]])
114 if(!is.null(opts[["pvals"]]))
115 data.source<-c(data.source, opts[["pvals"]])
116
117 }else if(opts[["data-type"]]=="beds"){
118
119 data.type<-"idat.dir"
120 files<-strsplit(opts[["bed-files"]], "\t")[[1]]
121 bed.dir<-mkdir(file.path(opts[["report-dir"]], "beds"))
122 file.copy(as.list(files), bed.dir)
123 data.source<-list()
124 data.source[["bed.dir"]]<-bed.dir
125 data.source[["sample.sheet"]]<-opts[["pheno"]]
126
127 }
128
129 dump<-sapply(names(opt.class), function(on){
130 getoptname<-gsub("-", "\\.","-",on)
131 if(getoptname %in% names(opts)){
132 if(opt.class[on]=="logical"){
133 ov<-TRUE
134 }else if(opt.class %in% c("character","character.vector")){
135 ov<-opts[[getoptname]]
136 ov<-gsub("\"", "", ov)
137 if(opt.class=="character.vector"){
138 ov<-as.character(strsplit(ov,","))
139 }
140
141 }else if(opt.class %in% c("integer","numeric","integer.vector","numeric.vector")){
142 ov<-opts[[getoptname]]
143 ov<-gsub("\"", "", ov)
144 if(opt.class %in% c("integer.vector","numeric.vector")){
145 ov<-as.character(strsplit(ov,","))
146 }
147 }
148 eval(parse(text=sprintf("rnb.options(%s=ov)",on)))
149 }
150 })
151
152
153 logical.opts<-names(opt.class[opt.class=="logical"])
154 logical.opts.false<-logical.opts[!logical.opts %in% gsub("-",".",names(opts))]
155
156 dump<-sapply(logical.opts.false, function(on){
157 eval(parse(text=sprintf("rnb.options(%s=FALSE)",on)))
158 })
159
160 #report.out.dir<-sprintf("%s_rnbReport", tempdir())
161 report.out.dir<-opts[["report-dir"]]
162 suppressMessages(suppressWarnings(rnb.run.analysis(data.source=data.source, dir.report=report.out.dir, data.type=data.type)))
163
164 #file.symlink(paste(report.out.dir, "index.html", sep="/"), opts[["output-file"]])
165
166 outfile<-file(opts[["output-file"]],open="w")
167 cat(sprintf("<html>\n<body>\n<a href=\"index.html\">RnBeads report</a>\n</body>\n</html>",report.out.dir),file=outfile)
168 close(outfile)
169
170 sink(file=NULL)
171 flush(msg.file)
172 close(msg.file)
173