# HG changeset patch
# User lecorguille
# Date 1460290499 14400
# Node ID c02d80efba80f44006090df5dbdfed8b55629afa
# Parent 821f2d271ea898a1475266022d3d41894f19f52b
planemo upload commit d8cc436fd91f5748dc396d0527a0a303d3221835
diff -r 821f2d271ea8 -r c02d80efba80 CAMERA.r
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CAMERA.r Sun Apr 10 08:14:59 2016 -0400
@@ -0,0 +1,146 @@
+#!/usr/bin/env Rscript
+# CAMERA.r version="2.2.1"
+
+
+
+# ----- PACKAGE -----
+cat("\tPACKAGE INFO\n")
+
+#pkgs=c("xcms","batch")
+pkgs=c("parallel","BiocGenerics", "Biobase", "Rcpp", "mzR", "tcltk","igraph", "xcms","snow","CAMERA","multtest","batch")
+for(p in pkgs) {
+ suppressPackageStartupMessages(suppressWarnings(library(p, quietly=TRUE, logical.return=TRUE, character.only=TRUE)))
+ cat(p,"\t",as.character(packageVersion(p)),"\n",sep="")
+}
+source_local <- function(fname){ argv <- commandArgs(trailingOnly = FALSE); base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)); source(paste(base_dir, fname, sep="/")) }
+
+cat("\n\n");
+
+
+
+# ----- ARGUMENTS -----
+cat("\tARGUMENTS INFO\n")
+
+listArguments = parseCommandArgs(evaluate=FALSE) #interpretation of arguments given in command line as an R list of objects
+write.table(as.matrix(listArguments), col.names=F, quote=F, sep='\t')
+
+cat("\n\n");
+
+
+# ----- PROCESSING INFILE -----
+cat("\tINFILE PROCESSING INFO\n")
+
+#image is an .RData file necessary to use xset variable given by previous tools
+if (!is.null(listArguments[["image"]])){
+ load(listArguments[["image"]]); listArguments[["image"]]=NULL
+}
+
+if (listArguments[["xfunction"]] %in% c("combinexsAnnos")) {
+ load(listArguments[["image_pos"]])
+ xaP=xa
+ if (exists("xsAnnotate_object")) xaP=xsAnnotate_object
+
+ diffrepP=NULL
+ if (exists("diffrep")) diffrepP=diffrep
+
+ load(listArguments[["image_neg"]])
+ xaN=xa
+ if (exists("xsAnnotate_object")) xaN=xsAnnotate_object
+
+ diffrepN=NULL
+ if (exists("diffrep")) diffrepN=diffrep
+}
+
+
+cat("\n\n")
+
+
+# ----- ARGUMENTS PROCESSING -----
+cat("\tARGUMENTS PROCESSING INFO\n")
+
+# Save arguments to generate a report
+if (!exists("listOFlistArguments")) listOFlistArguments=list()
+listOFlistArguments[[paste(format(Sys.time(), "%y%m%d-%H:%M:%S_"),listArguments[["xfunction"]],sep="")]] = listArguments
+
+
+#saving the commun parameters
+thefunction = listArguments[["xfunction"]]
+listArguments[["xfunction"]]=NULL #delete from the list of arguments
+
+xsetRdataOutput = paste(thefunction,"RData",sep=".")
+if (!is.null(listArguments[["xsetRdataOutput"]])){
+ xsetRdataOutput = listArguments[["xsetRdataOutput"]]; listArguments[["xsetRdataOutput"]]=NULL
+}
+
+rplotspdf = "Rplots.pdf"
+if (!is.null(listArguments[["rplotspdf"]])){
+ rplotspdf = listArguments[["rplotspdf"]]; listArguments[["rplotspdf"]]=NULL
+}
+
+dataMatrixOutput = "dataMatrix.tsv"
+if (!is.null(listArguments[["dataMatrixOutput"]])){
+ dataMatrixOutput = listArguments[["dataMatrixOutput"]]; listArguments[["dataMatrixOutput"]]=NULL
+}
+
+variableMetadataOutput = "variableMetadata.tsv"
+if (!is.null(listArguments[["variableMetadataOutput"]])){
+ variableMetadataOutput = listArguments[["variableMetadataOutput"]]; listArguments[["variableMetadataOutput"]]=NULL
+}
+
+if (!is.null(listArguments[["new_file_path"]])){
+ new_file_path = listArguments[["new_file_path"]]; listArguments[["new_file_path"]]=NULL
+}
+
+#Import the different functions
+source_local("lib.r")
+
+# We unzip automatically the chromatograms from the zip files.
+if (thefunction == "annotatediff") {
+ if(exists("zipfile") && (zipfile!="")) {
+ suppressWarnings(unzip(zipfile, unzip="unzip"))
+ }
+}
+
+
+#addition of xset object to the list of arguments in the first position
+if (exists("xset") != 0){
+ listArguments=append(list(xset), listArguments)
+}
+
+cat("\n\n")
+
+
+
+
+# ----- PROCESSING INFO -----
+cat("\tMAIN PROCESSING INFO\n")
+
+#change the default display settings
+pdf(file=rplotspdf, width=16, height=12)
+
+
+if (thefunction %in% c("annotatediff")) {
+ results_list=annotatediff(xset=xset,listArguments=listArguments,variableMetadataOutput=variableMetadataOutput,dataMatrixOutput=dataMatrixOutput,new_file_path=new_file_path)
+ xa=results_list[["xa"]]
+ diffrep=results_list[["diffrep"]]
+ variableMetadata=results_list[["variableMetadata"]]
+
+ cat("\n\n")
+ cat("\tXSET OBJECT INFO\n")
+ print(xa)
+}
+
+if (thefunction %in% c("combinexsAnnos")) {
+ cAnnot=combinexsAnnos_function(xaP=xaP,xaN=xaN,diffrepP=diffrepP,diffrepN=diffrepN,convert_param=listArguments[["convert_param"]],pos=listArguments[["pos"]],tol=listArguments[["tol"]],ruleset=listArguments[["ruleset"]],keep_meta=listArguments[["keep_meta"]],variableMetadataOutput=variableMetadataOutput)
+}
+
+dev.off()
+
+
+#saving R data in .Rdata file to save the variables used in the present tool
+objects2save = c("xa","variableMetadata","diffrep","cAnnot","listOFlistArguments","zipfile")
+save(list=objects2save[objects2save %in% ls()], file=xsetRdataOutput)
+
+cat("\n\n")
+
+cat("\tDONE\n")
diff -r 821f2d271ea8 -r c02d80efba80 abims_CAMERA_annotateDiffreport.xml
--- a/abims_CAMERA_annotateDiffreport.xml Mon Feb 22 17:09:43 2016 -0500
+++ b/abims_CAMERA_annotateDiffreport.xml Sun Apr 10 08:14:59 2016 -0400
@@ -2,23 +2,15 @@
CAMERA annotate function. Returns annotation results (isotope peaks, adducts and fragments) and a diffreport if more than one condition.
-
- R
- Rscript
- xcms
- camera
- camera_w4m_script
- CAMERA.r
- graphicsmagick
- convert
-
-
-
-
-
+
+ macros.xml
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
@@ -189,18 +180,7 @@
-
- 10.1021/ac202450g
- 10.1093/bioinformatics/btu813
-
+
diff -r 821f2d271ea8 -r c02d80efba80 lib.r
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib.r Sun Apr 10 08:14:59 2016 -0400
@@ -0,0 +1,185 @@
+# lib.r version="2.2.1"
+
+#The function create a pdf from the different png generated by diffreport
+diffreport_png2pdf <- function(filebase, new_file_path) {
+
+ pdfEicOutput = paste(new_file_path,filebase,"-eic_visible_pdf",sep="")
+ pdfBoxOutput = paste(new_file_path,filebase,"-box_visible_pdf",sep="")
+
+ system(paste("convert ",filebase,"_eic/*.png ",filebase,"_eic.pdf",sep=""))
+ system(paste("convert ",filebase,"_box/*.png ",filebase,"_box.pdf",sep=""))
+
+ file.copy(paste(filebase,"_eic.pdf",sep=""), pdfEicOutput)
+ file.copy(paste(filebase,"_box.pdf",sep=""), pdfBoxOutput)
+}
+
+#The function annotateDiffreport without the corr function which bugs
+annotatediff <- function(xset=xset, listArguments=listArguments, variableMetadataOutput="variableMetadata.tsv", dataMatrixOutput="dataMatrix.tsv",new_file_path=NULL) {
+ # Resolve the bug with x11, with the function png
+ options(bitmapType='cairo')
+
+ #Check if the fillpeaks step has been done previously, if it hasn't, there is an error message and the execution is stopped.
+ res=try(is.null(xset@filled))
+
+ # ------ annot -------
+ listArguments[["calcCiS"]]=as.logical(listArguments[["calcCiS"]])
+ listArguments[["calcIso"]]=as.logical(listArguments[["calcIso"]])
+ listArguments[["calcCaS"]]=as.logical(listArguments[["calcCaS"]])
+
+ #graphMethod parameter bugs where this parameter is not defined in quick=true
+ if(listArguments[["quick"]]==TRUE) {
+ xa= annotate(object=xset,nSlaves=1,sigma=listArguments[["sigma"]],perfwhm=listArguments[["perfwhm"]],maxcharge=listArguments[["maxcharge"]],maxiso=listArguments[["maxiso"]],minfrac=listArguments[["minfrac"]],ppm=listArguments[["ppm"]],mzabs=listArguments[["mzabs"]],quick=listArguments[["quick"]],polarity=listArguments[["polarity"]],max_peaks=listArguments[["max_peaks"]],intval=listArguments[["intval"]])
+ }
+ else {
+ xa= annotate(object=xset,nSlaves=1,sigma=listArguments[["sigma"]],perfwhm=listArguments[["perfwhm"]],graphMethod=listArguments[["graphMethod"]],cor_eic_th=listArguments[["cor_eic_th"]],pval=listArguments[["pval"]],calcCiS=listArguments[["calcCiS"]],calcIso=listArguments[["calcIso"]],calcCaS=listArguments[["calcCaS"]],multiplier=listArguments[["multiplier"]],maxcharge=listArguments[["maxcharge"]],maxiso=listArguments[["maxiso"]],minfrac=listArguments[["minfrac"]],ppm=listArguments[["ppm"]],mzabs=listArguments[["mzabs"]],quick=listArguments[["quick"]],polarity=listArguments[["polarity"]],max_peaks=listArguments[["max_peaks"]],intval=listArguments[["intval"]])
+
+ }
+ peakList=getPeaklist(xa,intval=listArguments[["intval"]])
+ peakList=cbind(groupnames(xa@xcmsSet),peakList); colnames(peakList)[1] = c("name");
+
+
+ # --- Multi condition : diffreport ---
+ diffrep=NULL
+ if (!is.null(listArguments[["runDiffreport"]]) & nlevels(sampclass(xset))>=2) {
+ #Check if the fillpeaks step has been done previously, if it hasn't, there is an error message and the execution is stopped.
+ res=try(is.null(xset@filled))
+ classes=levels(sampclass(xset))
+ x=1:(length(classes)-1)
+ for (i in seq(along=x) ) {
+ y=1:(length(classes))
+ for (n in seq(along=y)){
+ if(i+n <= length(classes)){
+ filebase=paste(classes[i],class2=classes[i+n],sep="-vs-")
+
+ diffrep=diffreport(object=xset,class1=classes[i],class2=classes[i+n],filebase=filebase,eicmax=listArguments[["eicmax"]],eicwidth=listArguments[["eicwidth"]],sortpval=TRUE,value=listArguments[["value"]],h=listArguments[["h"]],w=listArguments[["w"]],mzdec=listArguments[["mzdec"]])
+ #combines results
+ diffreportTSV=merge(peakList, diffrep[,c("name","fold","tstat","pvalue")], by.x="name", by.y="name", sort=F)
+ diffreportTSV=cbind(diffreportTSV[,!(colnames(diffreportTSV) %in% c(sampnames(xa@xcmsSet)))],diffreportTSV[,(colnames(diffreportTSV) %in% c(sampnames(xa@xcmsSet)))])
+
+ if(listArguments[["sortpval"]]){
+ diffreportTSV=diffreportTSV[order(diffreportTSV$pvalue), ]
+ }
+
+ if (listArguments[["convert_param"]]){
+ #converting the retention times (seconds) into minutes
+ diffreportTSV$rt=diffreportTSV$rt/60;diffreportTSV$rtmin=diffreportTSV$rtmin/60; diffreportTSV$rtmax=diffreportTSV$rtmax/60;
+ }
+ write.table(diffreportTSV, sep="\t", quote=FALSE, row.names=FALSE, file=paste(new_file_path,filebase,"-tabular_visible_tabular",sep=""))
+
+ if (listArguments[["eicmax"]] != 0) {
+ diffreport_png2pdf(filebase, new_file_path)
+ }
+ }
+ }
+ }
+ }
+
+
+
+
+ # --- variableMetadata ---
+ variableMetadata=peakList[,!(make.names(colnames(peakList)) %in% c(make.names(sampnames(xa@xcmsSet))))]
+ # if we have 2 conditions, we keep stat of diffrep
+ if (!is.null(listArguments[["runDiffreport"]]) & nlevels(sampclass(xset))==2) {
+ variableMetadata = merge(variableMetadata, diffrep[,c("name","fold","tstat","pvalue")],by.x="name", by.y="name", sort=F)
+ if(exists("listArguments[[\"sortpval\"]]")){
+ variableMetadata=variableMetadata[order(variableMetadata$pvalue), ]
+ }
+ }
+
+ variableMetadataOri=variableMetadata
+ if (listArguments[["convert_param"]]){
+ #converting the retention times (seconds) into minutes
+ print("converting the retention times into minutes in the variableMetadata")
+ variableMetadata$rt=variableMetadata$rt/60;variableMetadata$rtmin=variableMetadata$rtmin/60; variableMetadata$rtmax=variableMetadata$rtmax/60;
+ }
+ #Transform metabolites name
+ variableMetadata$name= paste("M",round(variableMetadata$mz,digits=listArguments[["num_digits"]]),"T",round(variableMetadata$rt),sep="")
+ write.table(variableMetadata, sep="\t", quote=FALSE, row.names=FALSE, file=variableMetadataOutput)
+
+ # --- dataMatrix ---
+ dataMatrix = peakList[,(make.names(colnames(peakList)) %in% c(make.names(sampnames(xa@xcmsSet))))]
+ dataMatrix=cbind(peakList$name,dataMatrix); colnames(dataMatrix)[1] = c("name");
+
+ if (listArguments[["convert_param"]]){
+ #converting the retention times (seconds) into minutes
+ print("converting the retention times into minutes in the dataMatrix ids")
+ peakList$rt=peakList$rt/60
+ }
+ dataMatrix$name= paste("M",round(peakList$mz,digits=listArguments[["num_digits"]]),"T",round(peakList$rt),sep="")
+ write.table(dataMatrix, sep="\t", quote=FALSE, row.names=FALSE, file=dataMatrixOutput)
+
+ return(list("xa"=xa,"diffrep"=diffrep,"variableMetadata"=variableMetadataOri));
+
+}
+
+
+combinexsAnnos_function <- function(xaP, xaN, diffrepP=NULL,diffrepN=NULL,convert_param=FALSE,pos=TRUE,tol=2,ruleset=NULL,keep_meta=TRUE, variableMetadataOutput="variableMetadata.tsv"){
+
+ #Load the two Rdata to extract the xset objects from positive and negative mode
+ cat("\tObject xset from positive mode\n")
+ print(xaP)
+ cat("\n")
+
+ cat("\tObject xset from negative mode\n")
+ print(xaN)
+ cat("\n")
+
+ cat("\n")
+ cat("\tCombining...\n")
+ #Convert the string to numeric for creating matrix
+ row=as.numeric(strsplit(ruleset,",")[[1]][1])
+ column=as.numeric(strsplit(ruleset,",")[[1]][2])
+ ruleset=cbind(row,column)
+ #Test if the file comes from an older version tool
+ if ((!is.null(xaP)) & (!is.null(xaN))) {
+ #Launch the combinexsannos function from CAMERA
+ cAnnot=combinexsAnnos(xaP, xaN,pos=pos,tol=tol,ruleset=ruleset)
+ } else {
+ stop("You must relauch the CAMERA.annotate step with the lastest version.")
+ }
+
+
+
+ if(pos){
+ xa=xaP
+ mode="neg. Mode"
+ } else {
+ xa=xaN
+ mode="pos. Mode"
+ }
+ peakList=getPeaklist(xa,intval=listArguments[["intval"]])
+ peakList=cbind(groupnames(xa@xcmsSet),peakList); colnames(peakList)[1] = c("name");
+ variableMetadata=cbind(peakList, cAnnot[, c("isotopes", "adduct", "pcgroup",mode)]);
+ variableMetadata=variableMetadata[,!(colnames(variableMetadata) %in% c(sampnames(xa@xcmsSet)))]
+
+ #Test if there are more than two classes (conditions)
+ if ( nlevels(sampclass(xaP@xcmsSet))==2 & (!is.null(diffrepN)) & (!is.null(diffrepP))) {
+ diffrepP = diffrepP[,c("name","fold","tstat","pvalue")]; colnames(diffrepP) = paste("P.",colnames(diffrepP),sep="")
+ diffrepN = diffrepN[,c("name","fold","tstat","pvalue")]; colnames(diffrepN) = paste("N.",colnames(diffrepN),sep="")
+
+ variableMetadata = merge(variableMetadata, diffrepP, by.x="name", by.y="P.name")
+ variableMetadata = merge(variableMetadata, diffrepN, by.x="name", by.y="N.name")
+ }
+
+ rownames(variableMetadata) = NULL
+ #TODO: checker
+ #colnames(variableMetadata)[1:2] = c("name","mz/rt");
+
+ #If the user want to convert the retention times (seconds) into minutes.
+ if (listArguments[["convert_param"]]){
+ #converting the retention times (seconds) into minutes
+ cat("\tConverting the retention times into minutes\n")
+ variableMetadata$rtmed=cAnnot$rt/60; variableMetadata$rtmin=cAnnot$rtmin/60; variableMetadata$rtmax=cAnnot$rtmax/60;
+ }
+
+ #If the user want to keep only the metabolites which match a difference
+ if(keep_meta){
+ variableMetadata=variableMetadata[variableMetadata[,c(mode)]!="",]
+ }
+
+ #Write the output into a tsv file
+ write.table(variableMetadata, sep="\t", quote=FALSE, row.names=FALSE, file=variableMetadataOutput)
+ return(variableMetadata);
+
+}
diff -r 821f2d271ea8 -r c02d80efba80 macros.xml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/macros.xml Sun Apr 10 08:14:59 2016 -0400
@@ -0,0 +1,44 @@
+
+
+
+
+ R
+ r-snow
+ bioconductor-camera
+ r-batch
+ graphicsmagick
+
+
+
+
+
+
+
+
+
+ LANG=C Rscript $__tool_directory__/CAMERA.r
+
+
+
+.. class:: infomark
+
+**Authors** Colin A. Smith csmith@scripps.edu, Ralf Tautenhahn rtautenh@gmail.com, Steffen Neumann sneumann@ipb-halle.de, Paul Benton hpaul.benton08@imperial.ac.uk and Christopher Conley cjconley@ucdavis.edu
+
+.. class:: infomark
+
+**Galaxy integration** ABiMS TEAM - UPMC/CNRS - Station biologique de Roscoff and Yann Guitton yann.guitton@oniris-nantes.fr - part of Workflow4Metabolomics.org [W4M]
+
+ | Contact support@workflow4metabolomics.org for any questions or concerns about the Galaxy implementation of this tool.
+
+---------------------------------------------------
+
+
+
+
+
+
+ 10.1021/ac202450g
+ 10.1093/bioinformatics/btu813
+
+
+
diff -r 821f2d271ea8 -r c02d80efba80 planemo.sh
--- a/planemo.sh Mon Feb 22 17:09:43 2016 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-planemo shed_init -f --name=camera_annotate --owner=lecorguille --description="[W4M][GC-MS] CAMERA R Package - Preprocessing - Returns annotation results (isotope peaks, adducts and fragments)" --homepage_url="http://workflow4metabolomics.org" --long_description="Part of the W4M project: http://workflow4metabolomics.org CAMERA: http://bioconductor.org/packages/release/bioc/html/CAMERA.html Wrapper skript for automatic annotation of isotope peaks, adducts and fragments for a (grouped) xcmsSet xs. The function returns an xsAnnotate object. BEWARE: this tool don't come with its script. You will need to install the dedicated package_camara_w4m_script too" --category="Metabolomics"
diff -r 821f2d271ea8 -r c02d80efba80 tool_dependencies.xml
--- a/tool_dependencies.xml Mon Feb 22 17:09:43 2016 -0500
+++ b/tool_dependencies.xml Sun Apr 10 08:14:59 2016 -0400
@@ -3,13 +3,10 @@
-
-
+
+
-
-
-
-
-
+
+