Mercurial > repos > pavlo-lutsik > rnbeads

comparison RnBeadsGalaxy.R @ 39:c8fcc50e1263 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author pavlo-lutsik
date Fri, 05 Jul 2013 15:14:26 -0400
parents
children
comparison
equal deleted inserted replaced
38:05220e275e4b 39:c8fcc50e1263
1 #msg.file<-file("RnBeads.messages.out", open="w")
2 #sink(file=msg.file)
3
4
5 ## add the RnBeads dependencies if we are on a cloud share-instance
6 if("Rsitelibrary" %in% list.files("/mnt")){
7
8 .libPaths("/mnt/Rsitelibrary")
9
10 }
11
12 suppressWarnings(suppressPackageStartupMessages(library(RnBeads)))
13 suppressWarnings(suppressPackageStartupMessages(library(getopt)))
14
15 #all.opts<-names(rnb.options())
16 opt.class<-RnBeads:::OPTION.TYPES[-28]
17 all.opts<-names(opt.class)
18 #all.opts<-paste("--", all.opts, sep="")
19 #all.opts<-gsub("\\.([a-z])", "\\U\\1", all.opts, perl=TRUE)
20 all.opts<-gsub("\\.","-", all.opts)
21 #opt.class<-sapply(rnb.options(), class)
22
23 rnb.opt.spec<-data.frame(
24 Long=all.opts,
25 Short=as.character(1:length(all.opts)),
26 Mask=c(1,2)[as.integer((opt.class=="logical"))+1],
27 Type=opt.class)
28
29 ### automated xml file preparation
30 xml.strings<-apply(rnb.opt.spec,1, function(row){
31
32 opt.lab<-gsub("-", ".", row[1])
33 opt.def.val<-rnb.getOption(opt.lab)
34 opt.name<-gsub("-([0-9a-z])", "\\U\\1", row[1], perl=TRUE)
35 tf.opt<-"\t\t\t<option value=\"True\">True</option>\n\t\t\t<option value=\"False\">False</option>"
36 opt.lab<-paste(opt.lab, gsub("\\."," ", row[4]), sep=", ")
37 if(row[4]=="logical"){
38 opt.type<-'select'
39 if(!is.null(opt.def.val) && opt.def.val)
40 opt.def.val<-"1" else
41 opt.def.val<-"0"
42 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)
43 }else{
44 opt.type<-'text'
45 if(!is.null(opt.def.val) && opt.def.val!="")
46 opt.def.val<-paste(opt.def.val, collapse=",") else
47 opt.def.val<-""
48 string<-sprintf("\t\t<param name=\"%s\" type=\"%s\" label=\"%s\" value=\"%s\"/>\n", opt.name, opt.type, opt.lab, opt.def.val)
49 }
50 string
51 })
52
53 cat(xml.strings, sep="", file="automated.settings.xml.txt")
54
55 opt.def.strings<-apply(rnb.opt.spec,1, function(row){
56
57 opt.name<-gsub("-([0-9a-z])", "\\U\\1", row[1], perl=TRUE)
58 opt.long<-row[1]
59 opt.short<-row[2]
60
61 if(row[4]=="logical"){
62 def.string<-sprintf("#if str( $options.%s ) == \"True\"\n\t--%s\n#end if\n", opt.name, opt.long)
63 }else{
64 def.string<-sprintf("#if str( $options.%s ) != \"\"\n\t--%s=\"$options.%s\" \n#end if\n", opt.name, opt.long, opt.name)
65 }
66 def.string
67
68 })
69 cat(opt.def.strings, sep="", file="automated.option.assignments.txt")
70
71
72 rnb.opt.spec$Type<-gsub("\\.vector", "", rnb.opt.spec$Type)
73 rnb.opt.spec$Type<-gsub("numeric", "double", rnb.opt.spec$Type)
74 rnb.opt.spec<-rbind(data.frame(
75 Long=c("data-type", "pheno", "idat-dir","idat-files","bed-files", "gs-report", "geo-series", "betas", "pvals","output-file", "report-dir"),
76 Short=c("d","s","a","i","f","g","e","b","p","r","o"),
77 Mask=c(1,2,2,2,2,2,2,2,2,1,1),
78 Type=c("character","character","character","character","character","character","character","character","character","character", "character")),
79 rnb.opt.spec)
80
81 opts<-getopt(as.matrix(rnb.opt.spec))
82 #opts<-getopt(as.matrix(rnb.opt.spec), opt=list("--data-type=idats","--report-dir=dir", "--idats=file1\tfile2"))
83 print(opts)
84
85 if(opts[["data-type"]]=="idatDir"){
86
87 data.source<-list()
88 data.type<-"idat.dir"
89 data.source[["idat.dir"]]<-opts[["idat-dir"]]
90 data.source[["sample.sheet"]]<-opts[["pheno"]]
91
92 }else if(opts[["data-type"]]=="idatFiles"){
93
94 data.type<-"idat.dir"
95 file.string<-gsub(" ","", opts[["idat-files"]])
96 files<-strsplit(file.string, ",")[[1]]
97 files<-files[files!=""]
98 bed.dir<-sprintf("%s_beds",opts[["report-dir"]])
99 dir.create(bed.dir)
100 file.copy(files, bed.dir)
101 for(dat.file in list.files(bed.dir, full.names = TRUE)){
102 file.rename(dat.file, gsub("\\.dat", ".bed", dat.file))
103 }
104 data.source<-list()
105 data.source[["bed.dir"]]<-bed.dir
106 data.source[["sample.sheet"]]<-opts[["pheno"]]
107
108
109 }else if(opts[["data-type"]]=="GS.report"){
110
111 data.type<-"GS.report"
112 data.source<-opts[["gs-report"]]
113
114 }else if(opts[["data-type"]]=="GEO"){
115
116 data.type<-"GEO"
117 data.source<-opts[["geo-series"]]
118
119 }else if(opts[["data-type"]]=="data.files"){
120
121 data.type<-"GEO"
122 data.source<-opts[["geo-series"]]
123
124 }else if(opts[["data-type"]]=="data.files"){
125
126 data.type<-"data.files"
127 data.source<-c(opts[["pheno"]], opts[["betas"]])
128 if(!is.null(opts[["pvals"]]))
129 data.source<-c(data.source, opts[["pvals"]])
130
131 }else if(opts[["data-type"]]=="bed.dir"){
132
133 data.type<-"bed.dir"
134 file.string<-gsub(" ","", opts[["bed-files"]])
135 files<-strsplit(file.string, ",")[[1]]
136 files<-files[files!=""]
137 bed.dir<-sprintf("%s_beds",opts[["report-dir"]])
138 dir.create(bed.dir)
139 file.copy(files, bed.dir)
140 for(dat.file in list.files(bed.dir, full.names = TRUE)){
141 file.rename(dat.file, gsub("\\.dat", ".bed", dat.file))
142 }
143 data.source<-list()
144 data.source[["bed.dir"]]<-bed.dir
145
146 logger.start(fname="NA")
147 sample.sheet<-rnb.read.annotation(opts[["pheno"]])
148 logger.close()
149 if(length(files) < nrow(sample.sheet))
150 stop("Not all bed files are present")
151
152 cn<-colnames(sample.sheet)
153 dat.files<-sapply(strsplit(files, "\\/"), function(el) el[length(el)])
154 sample.sheet<-cbind(sample.sheet, gsub("\\.dat", ".bed", dat.files))
155 colnames(sample.sheet)<-c(cn, "BED_files")
156 data.source[["sample.sheet"]]<-sample.sheet
157 }
158
159 if("logging" %in% names(opts)){ # TODO create a cleaner way of checking whether the full options set was supplied
160
161 dump<-sapply(names(opt.class), function(on){
162 getoptname<-gsub("-", "\\.","-",on)
163 if(getoptname %in% names(opts)){
164 if(opt.class[on]=="logical"){
165 ov<-TRUE
166 }else if(opt.class %in% c("character","character.vector")){
167 ov<-opts[[getoptname]]
168 ov<-gsub("\"", "", ov)
169 if(opt.class=="character.vector"){
170 ov<-as.character(strsplit(ov,","))
171 }
172
173 }else if(opt.class %in% c("integer","numeric","integer.vector","numeric.vector")){
174 ov<-opts[[getoptname]]
175 ov<-gsub("\"", "", ov)
176 if(opt.class %in% c("integer.vector","numeric.vector")){
177 ov<-as.character(strsplit(ov,","))
178 }
179 }
180 eval(parse(text=sprintf("rnb.options(%s=ov)",on)))
181 }
182 })
183
184 logical.opts<-names(opt.class[opt.class=="logical"])
185 logical.opts.false<-logical.opts[!logical.opts %in% gsub("-",".",names(opts))]
186
187
188 dump<-sapply(logical.opts.false, function(on){
189 eval(parse(text=sprintf("rnb.options(%s=FALSE)",on)))
190 })
191 }
192
193 print(rnb.options())
194
195 #report.out.dir<-sprintf("%s_rnbReport", tempdir())
196 report.out.dir<-opts[["report-dir"]]
197 print("Starting RnBeads with the following inputs:")
198 print(data.source)
199 print(report.out.dir)
200 print(data.type)
201 rnb.run.analysis(data.source=data.source, dir.report=report.out.dir, data.type=data.type)
202
203
204 #sink(file=NULL)
205 #flush(msg.file)
206 #close(msg.file)