Mercurial > repos > pavlo-lutsik > rnbeads

comparison RnBeadsGalaxy.R @ 45:6b0981ab063e draft default tip

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