# HG changeset patch
# User lecorguille
# Date 1464133754 14400
# Node ID b2032600d98fad8c64e830fdecc451c0b6c21c51
planemo upload commit ddb46a9ade365cbe01b3ff9f50dffa0140136632
diff -r 000000000000 -r b2032600d98f README.rst
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/README.rst Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,14 @@
+
+Changelog/News
+--------------
+
+**Version X.X.X - XX/XX/XXXX**
+
+- NEW:
+
+Test Status
+-----------
+
+Planemo test using conda: failed on the faahKO_reduce.zip
+
+Planemo shed_test : unbuild
diff -r 000000000000 -r b2032600d98f ipo.r
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ipo.r Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,134 @@
+#!/usr/bin/env Rscript
+#Authors Gildas Le Corguille and Yann Guitton
+
+
+# ----- LOG FILE -----
+log_file=file("log.txt", open = "wt")
+sink(log_file)
+sink(log_file, type = "output")
+
+
+# ----- PACKAGE -----
+cat("\tPACKAGE INFO\n")
+#pkgs=c("xcms","batch")
+pkgs=c("parallel","BiocGenerics", "Biobase", "Rcpp", "mzR", "xcms","rsm","igraph","CAMERA","IPO","batch")
+for(pkg in pkgs) {
+ suppressWarnings( suppressPackageStartupMessages( stopifnot( library(pkg, quietly=TRUE, logical.return=TRUE, character.only=TRUE))))
+ cat(pkg,"\t",as.character(packageVersion(pkg)),"\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");
+
+
+# ----- ARGUMENTS PROCESSING -----
+cat("\tINFILE PROCESSING INFO\n")
+
+
+#Import the different functions
+source_local("lib.r")
+
+cat("\n\n")
+
+#Import the different functions
+
+# ----- PROCESSING INFILE -----
+cat("\tARGUMENTS PROCESSING INFO\n")
+
+
+parametersOutput = "parametersOutput.tsv"
+if (!is.null(listArguments[["parametersOutput"]])){
+ parametersOutput = listArguments[["parametersOutput"]]; listArguments[["parametersOutput"]]=NULL
+}
+
+samplebyclass = 2
+if (!is.null(listArguments[["samplebyclass"]])){
+ samplebyclass = listArguments[["samplebyclass"]]; listArguments[["samplebyclass"]]=NULL
+}
+
+#necessary to unzip .zip file uploaded to Galaxy
+#thanks to .zip file it's possible to upload many file as the same time conserving the tree hierarchy of directories
+
+
+if (!is.null(listArguments[["zipfile"]])){
+ zipfile= listArguments[["zipfile"]]; listArguments[["zipfile"]]=NULL
+}
+
+if (!is.null(listArguments[["library"]])){
+ directory=listArguments[["library"]]; listArguments[["library"]]=NULL
+ if(!file.exists(directory)){
+ error_message=paste("Cannot access the directory:",directory,". Please verify if the directory exists or not.")
+ print(error_message)
+ stop(error_message)
+ }
+}
+
+# We unzip automatically the chromatograms from the zip files.
+if(exists("zipfile") && (zipfile!="")) {
+ if(!file.exists(zipfile)){
+ error_message=paste("Cannot access the Zip file:",zipfile,". Please, contact your administrator ... if you have one!")
+ print(error_message)
+ stop(error_message)
+ }
+
+ #list all file in the zip file
+ #zip_files=unzip(zipfile,list=T)[,"Name"]
+
+
+ #unzip
+ suppressWarnings(unzip(zipfile, unzip="unzip"))
+
+ #get the directory name
+ filesInZip=unzip(zipfile, list=T);
+ directories=unique(unlist(lapply(strsplit(filesInZip$Name,"/"), function(x) x[1])));
+ directories=directories[!(directories %in% c("__MACOSX")) & file.info(directories)$isdir]
+ directory = "."
+ if (length(directories) == 1) directory = directories
+
+ cat("files_root_directory\t",directory,"\n")
+
+
+}
+
+#addition of the directory to the list of arguments in the first position
+checkXmlStructure(directory)
+checkFilesCompatibilityWithXcms(directory)
+
+cat("\n\n")
+
+
+
+
+
+
+# ----- MAIN PROCESSING INFO -----
+cat("\tMAIN PROCESSING INFO\n")
+
+
+ipo4xcmsSet(directory, parametersOutput, listArguments, samplebyclass)
+
+
+
+cat("\n\n")
+
+
+# ----- EXPORT -----
+
+cat("\tEXPORTING INFO\n")
+
+
+cat("\n\n")
+
+
+cat("\tDONE\n")
+
diff -r 000000000000 -r b2032600d98f ipo4xcmsSet.xml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ipo4xcmsSet.xml Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,239 @@
+
+
+ Filtration and Peak Identification using xcmsSet function from xcms R package to preprocess LC/MS data for relative quantification and statistical analysis
+
+
+ macros.xml
+
+
+
+
+
+ /tmp/log.err
+ ]]>
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff -r 000000000000 -r b2032600d98f lib.r
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib.r Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,96 @@
+
+##
+## This function launch IPO functions to get the best parameters for xcmsSet
+## A sample among the whole dataset is used to save time
+##
+ipo4xcmsSet = function(directory, parametersOutput, listArguments, samplebyclass=4) {
+ setwd(directory)
+ files = list.files(".", recursive=T) # "KO/ko15.CDF" "KO/ko16.CDF" "WT/wt15.CDF" "WT/wt16.CDF"
+ files_classes = basename(dirname(files)) # "KO", "KO", "WT", "WT"
+
+ mzmlfile = files
+ if (samplebyclass > 0) {
+ #random selection of N files for IPO in each class
+ classes<-unique(basename(dirname(files)))
+ mzmlfile = NULL
+ for (class_i in classes){
+ files_class_i = files[files_classes==class_i]
+ if (samplebyclass > length(files_class_i)) {
+ mzmlfile = c(mzmlfile, files_class_i)
+ } else {
+ mzmlfile = c(mzmlfile,sample(files_class_i,samplebyclass))
+ }
+ }
+ }
+ #TODO: else, must we keep the RData to been use directly by group?
+
+ cat("\t\tSamples used:\n")
+ print(mzmlfile)
+
+ paramsPP <- getDefaultXcmsSetStartingParams(listArguments[["method"]]) #load default parameters of IPO
+
+ #user defined new parameters
+ paramsPP$ppm <- listArguments[["ppm"]]
+ paramsPP$min_peakwidth <- listArguments[["min_peakwidth"]]
+ paramsPP$max_peakwidth <- listArguments[["max_peakwidth"]]
+ paramsPP$nSlaves <- listArguments[["nSlaves"]]
+
+ #paramsPP$profparam <- list(step=0.005) #not yet used by IPO have to think of it for futur improvement
+ resultPPpos <- optimizeXcmsSet(mzmlfile, paramsPP, subdir="IPO_results") #some images generated by IPO
+ write.table(resultPPpos$best_settings$parameters, file=parametersOutput, sep="\t",row.names=FALSE) #can be read by user
+
+}
+
+
+
+
+##
+## This function check if xcms will found all the files
+##
+#@author Gildas Le Corguille lecorguille@sb-roscoff.fr ABiMS TEAM
+checkFilesCompatibilityWithXcms <- function(directory) {
+ cat("Checking files filenames compatibilities with xmcs...\n")
+ # WHAT XCMS WILL FIND
+ filepattern <- c("[Cc][Dd][Ff]", "[Nn][Cc]", "([Mm][Zz])?[Xx][Mm][Ll]","[Mm][Zz][Dd][Aa][Tt][Aa]", "[Mm][Zz][Mm][Ll]")
+ filepattern <- paste(paste("\\.", filepattern, "$", sep = ""),collapse = "|")
+ info <- file.info(directory)
+ listed <- list.files(directory[info$isdir], pattern = filepattern,recursive = TRUE, full.names = TRUE)
+ files <- c(directory[!info$isdir], listed)
+ files_abs <- file.path(getwd(), files)
+ exists <- file.exists(files_abs)
+ files[exists] <- files_abs[exists]
+ files[exists] <- sub("//","/",files[exists])
+
+ # WHAT IS ON THE FILESYSTEM
+ filesystem_filepaths=system(paste("find $PWD/",directory," -not -name '\\.*' -not -path '*conda-env*' -type f -name \"*\"", sep=""), intern=T)
+ filesystem_filepaths=filesystem_filepaths[grep(filepattern, filesystem_filepaths, perl=T)]
+
+ # COMPARISON
+ if (!is.na(table(filesystem_filepaths %in% files)["FALSE"])) {
+ write("\n\nERROR: List of the files which will not be imported by xcmsSet",stderr())
+ write(filesystem_filepaths[!(filesystem_filepaths %in% files)],stderr())
+ stop("\n\nERROR: One or more of your files will not be import by xcmsSet. It may due to bad characters in their filenames.")
+
+ }
+}
+
+
+
+##
+## This function check if XML contains special caracters. It also checks integrity and completness.
+##
+#@author Misharl Monsoor misharl.monsoor@sb-roscoff.fr ABiMS TEAM
+checkXmlStructure <- function (directory) {
+ cat("Checking XML structure...\n")
+
+ cmd=paste("IFS=$'\n'; for xml in $(find",directory,"-not -name '\\.*' -not -path '*conda-env*' -type f -iname '*.*ml*'); do if [ $(xmllint --nonet --noout \"$xml\" 2> /dev/null; echo $?) -gt 0 ]; then echo $xml;fi; done;")
+ capture=system(cmd,intern=TRUE)
+
+ if (length(capture)>0){
+ #message=paste("The following mzXML or mzML file is incorrect, please check these files first:",capture)
+ write("\n\nERROR: The following mzXML or mzML file(s) are incorrect, please check these files first:", stderr())
+ write(capture, stderr())
+ stop("ERROR: xcmsSet cannot continue with incorrect mzXML or mzML files")
+ }
+
+}
diff -r 000000000000 -r b2032600d98f macros.xml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/macros.xml Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,50 @@
+
+
+
+
+ R
+ r-ipo
+ r-batch
+
+
+
+
+
+
+
+
+
+ LANG=C Rscript $__tool_directory__/ipo.r
+
+
+
+ ;
+ return=\$?;
+ mv log.txt $log;
+ cat $log;
+ sh -c "exit \$return"
+
+
+
+.. class:: infomark
+
+**Authors** Gunnar Libiseller, Michaela Dvorzak, Ulrike Kleb, Edgar Gander, Tobias Eisenberg, Frank Madeo, Steffen Neumann, Gert Trausinger, Frank Sinner, Thomas Pieber and Christoph Magnes
+
+.. 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.1186/s12859-015-0562-8
+ 10.1093/bioinformatics/btu813
+
+
+
diff -r 000000000000 -r b2032600d98f planemo_test.sh
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/planemo_test.sh Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,9 @@
+conda create -n r-ipo --use-local r-ipo r-batch
+. ~/miniconda2/bin/activate r-ipo
+planemo test --install_galaxy --galaxy_branch "dev" --update_test_data
+
+
+# -- Use of conda dependencies
+planemo conda_init --conda_prefix /tmp/mc
+planemo conda_install --conda_prefix /tmp/mc .
+planemo test --install_galaxy --conda_prefix /tmp/mc --conda_dependency_resolution --galaxy_branch "dev" --update_test_data
diff -r 000000000000 -r b2032600d98f repository_dependencies.xml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/repository_dependencies.xml Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,4 @@
+
+
+
+
diff -r 000000000000 -r b2032600d98f test-data/faahKO_IPO_parameters4xcmsSet.tsv
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test-data/faahKO_IPO_parameters4xcmsSet.tsv Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,2 @@
+"min_peakwidth" "max_peakwidth" "mzdiff" "ppm" "snthresh" "noise" "prefilter" "value_of_prefilter" "mzCenterFun" "integrate" "fitgauss" "verbose.columns" "nSlaves"
+6.6 56.5 0.01605 25 10 0 3 100 "wMean" 1 FALSE FALSE 1
diff -r 000000000000 -r b2032600d98f test-data/faahKO_reduce.zip
Binary file test-data/faahKO_reduce.zip has changed
diff -r 000000000000 -r b2032600d98f test-data/sacuri_2files.zip
Binary file test-data/sacuri_2files.zip has changed
diff -r 000000000000 -r b2032600d98f test-data/sacuri_2files_IPO_parameters4xcmsSet.tsv
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test-data/sacuri_2files_IPO_parameters4xcmsSet.tsv Tue May 24 19:49:14 2016 -0400
@@ -0,0 +1,2 @@
+"min_peakwidth" "max_peakwidth" "mzdiff" "ppm" "snthresh" "noise" "prefilter" "value_of_prefilter" "mzCenterFun" "integrate" "fitgauss" "verbose.columns" "nSlaves"
+7.5 42.5 0.01715 25 10 0 3 100 "wMean" 1 FALSE FALSE 1