diff lib.r @ 34:9714270678a7 draft

planemo upload for repository https://github.com/workflow4metabolomics/xcms commit f01148783819c37e474790dbd56619862960448a

--- a/lib.r	Thu Mar 08 05:54:22 2018 -0500
+++ b/lib.r	Tue Apr 03 11:39:48 2018 -0400
@@ -28,6 +28,58 @@
 }
 
 #@author G. Le Corguille
+# This function merge several xdata into one.
+mergeXData <- function(args) {
+    for(image in args$images) {
+        load(image)
+        # Handle infiles
+        if (!exists("singlefile")) singlefile <- NULL
+        if (!exists("zipfile")) zipfile <- NULL
+        rawFilePath <- getRawfilePathFromArguments(singlefile, zipfile, args)
+        zipfile <- rawFilePath$zipfile
+        singlefile <- rawFilePath$singlefile
+        retrieveRawfileInTheWorkingDirectory(singlefile, zipfile)
+        if (exists("raw_data")) xdata <- raw_data
+        if (!exists("xdata")) stop("\n\nERROR: The RData doesn't contain any object called 'xdata'. This RData should have been created by an old version of XMCS 2.*")
+        cat(sampleNamesList$sampleNamesOrigin,"\n")
+        if (!exists("xdata_merged")) {
+            xdata_merged <- xdata
+            singlefile_merged <- singlefile
+            md5sumList_merged <- md5sumList
+            sampleNamesList_merged <- sampleNamesList
+        } else {
+            if (is(xdata, "XCMSnExp")) xdata_merged <- c(xdata_merged,xdata)
+            else if (is(xdata, "OnDiskMSnExp")) xdata_merged <- .concatenate_OnDiskMSnExp(xdata_merged,xdata)
+            else stop("\n\nERROR: The RData either a OnDiskMSnExp object called raw_data or a XCMSnExp object called xdata")
+            singlefile_merged <- c(singlefile_merged,singlefile)
+            md5sumList_merged$origin <- rbind(md5sumList_merged$origin,md5sumList$origin)
+            sampleNamesList_merged$sampleNamesOrigin <- c(sampleNamesList_merged$sampleNamesOrigin,sampleNamesList$sampleNamesOrigin)
+            sampleNamesList_merged$sampleNamesMakeNames <- c(sampleNamesList_merged$sampleNamesMakeNames,sampleNamesList$sampleNamesMakeNames)
+        }
+    }
+    rm(image)
+    xdata <- xdata_merged; rm(xdata_merged)
+    singlefile <- singlefile_merged; rm(singlefile_merged)
+    md5sumList <- md5sumList_merged; rm(md5sumList_merged)
+    sampleNamesList <- sampleNamesList_merged; rm(sampleNamesList_merged)
+
+    if (!is.null(args$sampleMetadata)) {
+        cat("\tXSET PHENODATA SETTING...\n")
+        sampleMetadataFile <- args$sampleMetadata
+        sampleMetadata <- getDataFrameFromFile(sampleMetadataFile, header=F)
+        xdata@phenoData@data$sample_group=sampleMetadata$V2[match(xdata@phenoData@data$sample_name,sampleMetadata$V1)]
+
+        if (any(is.na(pData(xdata)$sample_group))) {
+            sample_missing <- pData(xdata)$sample_name[is.na(pData(xdata)$sample_group)]
+            error_message <- paste("Those samples are missing in your sampleMetadata:", paste(sample_missing, collapse=" "))
+            print(error_message)
+            stop(error_message)
+        }
+    }
+    return(list("xdata"=xdata, "singlefile"=singlefile, "md5sumList"=md5sumList,"sampleNamesList"=sampleNamesList))
+}
+
+#@author G. Le Corguille
 # This function convert if it is required the Retention Time in minutes
 RTSecondToMinute <- function(variableMetadata, convertRTMinute) {
     if (convertRTMinute){
@@ -79,9 +131,11 @@
 
     # Color by group
     group_colors <- brewer.pal(3, "Set1")[1:length(unique(xdata$sample_group))]
-    names(group_colors) <- unique(xdata$sample_group)
-    plotAdjustedRtime(xdata, col = group_colors[xdata$sample_group])
-    legend("topright", legend=names(group_colors), col=group_colors, cex=0.8, lty=1)
+    if (length(group_colors) > 1) {
+        names(group_colors) <- unique(xdata$sample_group)
+        plotAdjustedRtime(xdata, col = group_colors[xdata$sample_group])
+        legend("topright", legend=names(group_colors), col=group_colors, cex=0.8, lty=1)
+    }
 
     # Color by sample
     plotAdjustedRtime(xdata, col = rainbow(length(xdata@phenoData@data$sample_name)))
@@ -109,6 +163,19 @@
 }
 
 #@author G. Le Corguille
+# It allow different of field separators
+getDataFrameFromFile <- function(filename, header=T) {
+    myDataFrame <- read.table(filename, header=header, sep=";", stringsAsFactors=F)
+    if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header=header, sep="\t", stringsAsFactors=F)
+    if (ncol(myDataFrame) < 2) myDataFrame <- read.table(filename, header=header, sep=",", stringsAsFactors=F)
+    if (ncol(myDataFrame) < 2) {
+        error_message="Your tabular file seems not well formatted. The column separators accepted are ; , and tabulation"
+        print(error_message)
+        stop(error_message)
+    }
+    return(myDataFrame)
+}
+
 getPlotChromatogram <- function(xdata, pdfname="Chromatogram.pdf", aggregationFun = "max") {
 
     chrom <- chromatogram(xdata, aggregationFun = aggregationFun)
@@ -127,9 +194,11 @@
 
     # Color by group
     group_colors <- brewer.pal(3, "Set1")[1:length(unique(xdata$sample_group))]
-    names(group_colors) <- unique(xdata$sample_group)
-    plot(chrom, col = group_colors[chrom$sample_group], main=main)
-    legend("topright", legend=names(group_colors), col=group_colors, cex=0.8, lty=1)
+    if (length(group_colors) > 1) {
+        names(group_colors) <- unique(xdata$sample_group)
+        plot(chrom, col = group_colors[chrom$sample_group], main=main)
+        legend("topright", legend=names(group_colors), col=group_colors, cex=0.8, lty=1)
+    }
 
     # Color by sample
     plot(chrom, col = rainbow(length(xdata@phenoData@data$sample_name)), main=main)
@@ -345,10 +414,7 @@
             singlefile[[singlefile_sampleName]] <- singlefile_galaxyPath
         }
     }
-    for (argument in c("zipfile","zipfilePositive","zipfileNegative","singlefile_galaxyPath","singlefile_sampleName","singlefile_galaxyPathPositive","singlefile_sampleNamePositive","singlefile_galaxyPathNegative","singlefile_sampleNameNegative")) {
-        args[[argument]] <- NULL
-    }
-    return(list(zipfile=zipfile, singlefile=singlefile, args=args))
+    return(list(zipfile=zipfile, singlefile=singlefile))
 }
 
 
@@ -559,3 +625,9 @@
 c.XCMSnExp <- function(...) {
     .concatenate_XCMSnExp(...)
 }
+
+#@TODO: remove this function as soon as we can use xcms 3.x.x from Bioconductor 3.7
+# https://github.com/sneumann/xcms/issues/247
+c.MSnbase <- function(...) {
+    .concatenate_OnDiskMSnExp(...)
+}