diff xcms_summary.r @ 15:97ca0321931b draft

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

--- a/xcms_summary.r	Tue Feb 13 04:51:37 2018 -0500
+++ b/xcms_summary.r	Tue Sep 18 16:14:05 2018 -0400
@@ -1,51 +1,82 @@
 #!/usr/bin/env Rscript
-# version="1.0.0"
-#@author Gildas Le Corguille [e-mail] ABIMS TEAM
 
 
 
 # ----- ARGUMENTS BLACKLIST -----
 #xcms.r
-argBlacklist=c("zipfile","singlefile_galaxyPath","singlefile_sampleName","xfunction","xsetRdataOutput","sampleMetadataOutput","ticspdf","bicspdf","rplotspdf")
+argBlacklist <- c("zipfile", "singlefile_galaxyPath", "singlefile_sampleName", "xfunction", "xsetRdataOutput", "sampleMetadataOutput", "ticspdf", "bicspdf", "rplotspdf")
 #CAMERA.r
-argBlacklist=c(argBlacklist,"dataMatrixOutput","variableMetadataOutput","new_file_path")
+argBlacklist <- c(argBlacklist, "dataMatrixOutput", "variableMetadataOutput", "new_file_path")
+
 
 # ----- PACKAGE -----
+cat("\tSESSION INFO\n")
 
-pkgs=c("parallel","BiocGenerics", "Biobase", "Rcpp", "mzR", "igraph", "xcms","CAMERA","batch")
-for(pkg in pkgs) {
-    cat(pkg,"\n")
-    suppressPackageStartupMessages( stopifnot( library(pkg, quietly=TRUE, logical.return=TRUE, character.only=TRUE)))
-}
+#Import the different functions
+source_local <- function(fname){ argv <- commandArgs(trailingOnly=FALSE); base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)); source(paste(base_dir, fname, sep="/")) }
+source_local("lib.r")
+source_local("lib-xcms3.x.x.r")
+
+pkgs <- c("CAMERA","batch")
+loadAndDisplayPackages(pkgs)
+cat("\n\n");
 
 
 # ----- FUNCTION -----
-writehtml = function(...) { cat(...,"\n", file=htmlOutput,append = TRUE,sep="") }
+writehtml <- function(...) { cat(...,"\n", file=htmlOutput,append = TRUE,sep="") }
+writeraw <- function(htmlOutput, object, open="at") {
+    log_file <- file(htmlOutput, open = open)
+    sink(log_file)
+    sink(log_file, type = "output")
+        print(object)
+    sink()
+    close(log_file)
+}
+getSampleNames <- function(xobject) {
+    if (class(xobject) == "xcmsSet")
+        return (sampnames(xobject))
+    if (class(xobject) == "XCMSnExp")
+        return (xobject@phenoData@data$sample_name)
+}
+getFilePaths <- function(xobject) {
+    if (class(xobject) == "xcmsSet")
+        return (xobject@filepaths)
+    if (class(xobject) == "XCMSnExp")
+        return (fileNames(xobject))
+}
+equalParams <- function(param1, param2) {
+    writeraw("param1.txt", param1, open="wt")
+    writeraw("param2.txt", param2, open="wt")
+    return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt"))
+}
 
 
 # ----- ARGUMENTS -----
 
-listArguments = parseCommandArgs(evaluate=FALSE) #interpretation of arguments given in command line as an R list of objects
+args <- parseCommandArgs(evaluate=FALSE) #interpretation of arguments given in command line as an R list of objects
 
 
 # ----- ARGUMENTS PROCESSING -----
 
 #image is an .RData file necessary to use xset variable given by previous tools
-load(listArguments[["image"]]);
+load(args$image);
 
-htmlOutput = "summary.html"
-if (!is.null(listArguments[["htmlOutput"]])) htmlOutput = listArguments[["htmlOutput"]];
+htmlOutput <- "summary.html"
+if (!is.null(args$htmlOutput)) htmlOutput = args$htmlOutput;
 
-user_email = NULL
-if (!is.null(listArguments[["user_email"]])) user_email = listArguments[["user_email"]];
+user_email <- NULL
+if (!is.null(args$user_email)) user_email = args$user_email;
 
-# if the RData come from CAMERA
-if (!exists("xset") & exists("xa")) xset=xa@xcmsSet
-
+# if the RData come from XCMS 1.x
+if (exists("xset")) xobject <- xset
 # retrocompatability
-if (!exists("sampleNamesList")) sampleNamesList=list("sampleNamesMakeNames"=make.names(sampnames(xset)))
+if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames"=make.names(sampnames(xobject)))
+# if the RData come from CAMERA
+if (exists("xa")) xobject <- xa@xcmsSet
+# if the RData come from XCMS 3.x
+if (exists("xdata")) xobject <- xdata
 
-if (!exists("xset")) stop("You need at least a xset or a xa object.")
+if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.")
 
 
 
@@ -71,37 +102,37 @@
     writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>")
     # to pass the planemo shed_test
     if (user_email != "[e-mail]") {
-        if (!is.null(user_email)) writehtml("By: ",user_email," - ")
-        writehtml("Date: ",format(Sys.time(), "%y%m%d-%H:%M:%S"))
+        if (!is.null(user_email)) writehtml("By: ", user_email," - ")
+        writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S"))
     }
     writehtml("</div>")
 
     writehtml("<h2>Samples used:</h2>")
     writehtml("<div><table>")
-        if (all(sampnames(xset) == sampleNamesList$sampleNamesMakeNames)) {
-            sampleNameHeaderHtml = paste("<th>sample</th>")
-            sampleNameHtml = paste("<td>",sampnames(xset),"</td>")
+        if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) {
+            sampleNameHeaderHtml <- paste0("<th>sample</th>")
+            sampleNameHtml <- paste0("<td>",getSampleNames(xobject),"</td>")
         } else {
-            sampleNameHeaderHtml = paste("<th>sample</th><th>sample renamed</th>")
-            sampleNameHtml = paste("<td>",sampnames(xset),"</td><td>",sampleNamesList$sampleNamesMakeNames,"</td>")
+            sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>")
+            sampleNameHtml <- paste0("<td>",getSampleNames(xobject),"</td><td>",sampleNamesList$sampleNamesMakeNames,"</td>")
         }
 
         if (!exists("md5sumList")) {
-            md5sumHeaderHtml = ""
-            md5sumHtml = ""
-            md5sumLegend=""
+            md5sumHeaderHtml <- ""
+            md5sumHtml <- ""
+            md5sumLegend <- ""
         } else if (is.null(md5sumList$removalBadCharacters)) {
-            md5sumHeaderHtml = paste("<th>md5sum<sup>*</sup></th>")
-            md5sumHtml = paste("<td>",md5sumList$origin,"</td>")
-            md5sumLegend = "<br/><sup>*</sup>The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process."
+            md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>")
+            md5sumHtml <- paste0("<td>",md5sumList$origin,"</td>")
+            md5sumLegend <- "<br/><sup>*</sup>The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process."
         } else {
-            md5sumHeaderHtml = paste("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>")
-            md5sumHtml = paste("<td>",md5sumList$origin,"</td><td>",md5sumList$removalBadCharacters,"</td>")
-            md5sumLegend = "<br/><sup>*</sup>The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process.<br/><sup>**</sup>Because some bad characters (eg: accent) were removed from your original file, the checksum have changed too.<br/>"
+            md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>")
+            md5sumHtml <- paste0("<td>",md5sumList$origin,"</td><td>",md5sumList$removalBadCharacters,"</td>")
+            md5sumLegend <- "<br/><sup>*</sup>The program md5sum is designed to verify data integrity. So you can check if the data were uploaded correctly or if the data were changed during the process.<br/><sup>**</sup>Because some bad characters (eg: accent) were removed from your original file, the checksum have changed too.<br/>"
         }
 
         writehtml("<tr>",sampleNameHeaderHtml,"<th>filename</th>",md5sumHeaderHtml,"</tr>")
-        writehtml(paste("<tr>",sampleNameHtml,"<td>",xset@filepaths,"</td>",md5sumHtml,"</tr>"))
+        writehtml(paste0("<tr>",sampleNameHtml,"<td>",getFilePaths(xobject),"</td>",md5sumHtml,"</tr>"))
 
     writehtml("</table>")
     writehtml(md5sumLegend)
@@ -110,32 +141,57 @@
     writehtml("<h2>Function launched:</h2>")
     writehtml("<div><table>")
         writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>")
-        for(tool in names(listOFlistArguments)) {
-            listOFlistArgumentsDisplay=listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)]
+        # XCMS 3.x
+        if (class(xobject) == "XCMSnExp") {
+            xcmsFunction <- NULL
+            params <- NULL
+            for (processHistoryItem in processHistory(xobject)) {
+                if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem)))
+                    next
+                timestamp <- processDate(processHistoryItem)
+                xcmsFunction <- processType(processHistoryItem)
+                params <- processParam(processHistoryItem)
+                writehtml("<tr><td>",timestamp,"</td><td>",xcmsFunction,"</td><td colspan='2'><pre>")
+                writeraw(htmlOutput, params)
+                writehtml("</pre></td></tr>")
+            }
+        }
+        # CAMERA and retrocompatability XCMS 1.x
+        if (exists("listOFlistArguments")) {
+            for(tool in names(listOFlistArguments)) {
+                listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)]
 
-            timestamp = strsplit(tool,"_")[[1]][1]
-            xcmsFunction = strsplit(tool,"_")[[1]][2]
-            writehtml("<tr><td rowspan='",length(listOFlistArgumentsDisplay),"'>",timestamp,"</td><td rowspan='",length(listOFlistArgumentsDisplay),"'>",xcmsFunction,"</td>")
-            line_begin=""
-            for (arg in names(listOFlistArgumentsDisplay)) {
-                writehtml(line_begin,"<td>",arg,"</td><td>",unlist(listOFlistArgumentsDisplay[arg][1]),"</td></tr>")
-                line_begin="<tr>"
+                timestamp <- strsplit(tool,"_")[[1]][1]
+                xcmsFunction <- strsplit(tool,"_")[[1]][2]
+                writehtml("<tr><td rowspan='",length(listOFlistArgumentsDisplay),"'>",timestamp,"</td><td rowspan='",length(listOFlistArgumentsDisplay),"'>",xcmsFunction,"</td>")
+                line_begin <- ""
+                for (arg in names(listOFlistArgumentsDisplay)) {
+                    writehtml(line_begin,"<td>",arg,"</td><td>",unlist(listOFlistArgumentsDisplay[arg][1]),"</td></tr>")
+                    line_begin <- "<tr>"
+                }
             }
         }
     writehtml("</table>")
-    writehtml("<br/><sup>***</sup>timestamp format: yymmdd-hh:mm:ss")
+    writehtml("<br/><sup>***</sup>timestamp format: DD MM dd hh:mm:ss YYYY or yymmdd-hh:mm:ss")
     writehtml("</div>")
 
+    if (class(xobject) == "XCMSnExp") {
+        writehtml("<h2>Informations about the XCMSnExp object:</h2>")
+
+        writehtml("<div><pre>")
+            writeraw(htmlOutput, xobject)
+        writehtml("</pre></div>")
+    }
+
     writehtml("<h2>Informations about the xcmsSet object:</h2>")
 
     writehtml("<div><pre>")
-        log_file=file(htmlOutput, open = "at")
-        sink(log_file)
-        sink(log_file, type = "output")
-            xset
-        sink()
+        # Get the legacy xcmsSet object
+        xset <- getxcmsSetObject(xobject)
+        writeraw(htmlOutput, xset)
     writehtml("</pre></div>")
 
+    # CAMERA
     if (exists("xa")) {
         writehtml("<h2>Informations about the CAMERA object:</h2>")