view RnBeadsGalaxy.R @ 7:a1c96ef6c111 draft

Uploaded updated wrapper
author pavlo-lutsik
date Wed, 17 Apr 2013 08:45:05 -0400
parents
children 7bc6e673c8e8
line wrap: on
line source

library(RnBeads)
library(getopt)



#all.opts<-names(rnb.options())
opt.class<-RnBeads:::OPTION.TYPES[-28]
all.opts<-names(opt.class)
#all.opts<-paste("--", all.opts, sep="")
#all.opts<-gsub("\\.([a-z])", "\\U\\1", all.opts, perl=TRUE)
all.opts<-gsub("\\.","-", all.opts)
#opt.class<-sapply(rnb.options(), class)

rnb.opt.spec<-data.frame(
		Long=all.opts, 
		Short=as.character(1:length(all.opts)), 
		Mask=c(1,2)[as.integer((opt.class=="logical"))+1], 
		Type=opt.class)

### automated xml file preparation
#xml.strings<-apply(rnb.opt.spec,1, function(row){
#			
#			opt.lab<-gsub("-", ".", row[1])
#			opt.def.val<-rnb.getOption(opt.lab)
#			opt.name<-gsub("-([0-9a-z])", "\\U\\1", row[1], perl=TRUE)
#			tf.opt<-"\t\t\t<option value=\"True\">True</option>\n\t\t\t<option value=\"False\">False</option>"
#			opt.lab<-paste(opt.lab, gsub("\\."," ", row[4]), sep=", ")
#			if(row[4]=="logical"){
#				opt.type<-'select'
#				if(!is.null(opt.def.val) && opt.def.val)
#					opt.def.val<-"1" else
#					opt.def.val<-"0"
#				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)
#			}else{
#				opt.type<-'text'
#				if(!is.null(opt.def.val) && opt.def.val!="")
#					opt.def.val<-paste(opt.def.val, collapse=",") else
#					opt.def.val<-""
#				string<-sprintf("\t\t<param name=\"%s\" type=\"%s\"  label=\"%s\" value=\"%s\"/>\n", opt.name, opt.type, opt.lab, opt.def.val)
#			}
#			string
#		})
#
#cat(xml.strings, sep="", file="C:\\Users\\User\\workspace\\RnBeads\\Supplement\\galaxy\\automated.settings.xml.txt")
#
#opt.def.strings<-apply(rnb.opt.spec,1, function(row){
#			
#			opt.name<-gsub("-([0-9a-z])", "\\U\\1", row[1], perl=TRUE)
#			opt.long<-row[1]
#			opt.short<-row[2]
#			
#			if(row[4]=="logical"){
#				def.string<-sprintf("#if str( $options.%s ) == \"True\"\n\t--%s\n#end if\n", opt.name, opt.long)		
#			}else{
#				def.string<-sprintf("#if str( $options.%s ) != \"\"\n\t--%s = \"$options.%s\" \n#end if\n", opt.name, opt.long, opt.name)
#			}
#			def.string
#			
#		})
#cat(opt.def.strings, sep="", file="C:\\Users\\User\\workspace\\RnBeads\\Supplement\\galaxy\\automated.option.assignments.txt")


rnb.opt.spec$Type<-gsub("\\.vector", "", rnb.opt.spec$Type)
rnb.opt.spec$Type<-gsub("numeric", "double", rnb.opt.spec$Type)
rnb.opt.spec<-rbind(data.frame(
				Long=c("data-type", "pheno", "idat-dir","idat-files","bed-files", "gs-report", "geo-series", "betas", "pvals","report-dir"),
				Short=c("d","s","a","i","f","g","e","b","p","r"),
				Mask=c(1,2,2,2,2,2,2,2,2,1),
				Type=c("character","character","character","character","character","character","character","character","character","character")),
				rnb.opt.spec)
		
opts<-getopt(as.matrix(rnb.opt.spec))
#opts<-getopt(as.matrix(rnb.opt.spec), opt=list("--data-type=idats","--report-dir=dir", "--idats=file1\tfile2"))
print(opts)

if(opts[["data-type"]]=="idatDir"){
   
	data.source<-list()
	data.type<-"idat.dir"
	data.source[["idat.dir"]]<-opts[["idat-dir"]]
	data.source[["sample.sheet"]]<-opts[["pheno"]]
   
}else if(opts[["data-type"]]=="idatFiles"){
	
	data.type<-"idat.dir"
	files<-strsplit(opts[["idat-files"]], "\t")[[1]]
	idat.dir<-mkdir(file.path(opts[["report-dir"]], "idats"))
	file.copy(as.list(files), idat.dir)
	data.source<-list()
	data.source[["idat.dir"]]<-idat.dir
	data.source[["sample.sheet"]]<-opts[["pheno"]]
	
	
}else if(opts[["data-type"]]=="GS.report"){

	data.type<-"GS.report"
	data.source<-opts[["gs-report"]]
	
}else if(opts[["data-type"]]=="GEO"){
	
	data.type<-"GEO"
	data.source<-opts[["geo-series"]]
	

}else if(opts[["data-type"]]=="data.files"){
	
	data.type<-"GEO"
	data.source<-opts[["geo-series"]]
	
}else if(opts[["data-type"]]=="data.files"){
	
	data.type<-"data.files"
	data.source<-c(opts[["pheno"]], opts[["betas"]])
	if(!is.null(opts[["pvals"]]))
		data.source<-c(data.source, opts[["pvals"]])
		
}else if(opts[["data-type"]]=="beds"){

	data.type<-"idat.dir"
	files<-strsplit(opts[["bed-files"]], "\t")[[1]]
	bed.dir<-mkdir(file.path(opts[["report-dir"]], "beds"))
	file.copy(as.list(files), bed.dir)
	data.source<-list()
	data.source[["bed.dir"]]<-bed.dir
	data.source[["sample.sheet"]]<-opts[["pheno"]]

}

dump<-sapply(names(opt.class), function(on){
	getoptname<-gsub("\\.","-",on)
	if(getoptname %in% names(opts)){
		if(opt.class[on]=="logical"){
			rnb.options(on=TRUE)
		}else if(opt.class %in% c("character","character.vector")){
			ov<-opts[[getoptname]]
			ov<-gsub("\"", "", ov)
			if(opt.class=="character.vector"){
				ov<-as.character(strsplit(ov,","))
			}
			rnb.options(on=ov)
		}else if(opt.class %in% c("integer","numeric","integer.vector","numeric.vector")){
			ov<-opts[[getoptname]]
			ov<-gsub("\"", "", ov)
			if(opt.class %in% c("integer.vector","numeric.vector")){
				ov<-as.character(strsplit(ov,","))
			}
			rnb.options(on=ov)
		}
	}
})


rnb.run.analysis(data.source=data.source, dir.report=opts[["report-dir"]], data.type=data.type)