Mercurial > repos > lecorguille > xcms_summary
diff xcms_summary.r @ 31:1ae878634ab3 draft default tip
planemo upload for repository https://github.com/workflow4metabolomics/tools-metabolomics/ commit 95721ced8347c09e79340e6d67ecb41c5cc64163
author | workflow4metabolomics |
---|---|
date | Mon, 03 Feb 2025 14:48:46 +0000 |
parents | 2a2850fdf29e |
children |
line wrap: on
line diff
--- a/xcms_summary.r Mon Jul 15 16:02:39 2024 +0000 +++ b/xcms_summary.r Mon Feb 03 14:48:46 2025 +0000 @@ -3,20 +3,20 @@ # ----- ARGUMENTS BLACKLIST ----- -#xcms.r +# xcms.r argBlacklist <- c("zipfile", "singlefile_galaxyPath", "singlefile_sampleName", "xfunction", "xsetRdataOutput", "sampleMetadataOutput", "ticspdf", "bicspdf", "rplotspdf") -#CAMERA.r +# CAMERA.r argBlacklist <- c(argBlacklist, "dataMatrixOutput", "variableMetadataOutput", "new_file_path") # ----- PACKAGE ----- cat("\tSESSION INFO\n") -#Import the different functions +# 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 = "/")) + argv <- commandArgs(trailingOnly = FALSE) + base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)) + source(paste(base_dir, fname, sep = "/")) } source_local("lib.r") @@ -27,43 +27,47 @@ # ----- FUNCTION ----- writehtml <- function(...) { - cat(..., "\n", file = htmlOutput, append = TRUE, sep = "") + 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) + 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) + 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)) + 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")) + writeraw("param1.txt", param1, open = "wt") + writeraw("param2.txt", param2, open = "wt") + return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt")) } # ----- ARGUMENTS ----- -args <- 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 +# image is an .RData file necessary to use xset variable given by previous tools load(args$image) htmlOutput <- "summary.html" @@ -74,19 +78,19 @@ # if the RData come from XCMS 1.x if (exists("xset")) { - xobject <- xset - # retrocompatability - if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject))) + xobject <- xset + # retrocompatability + if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject))) } # if the RData come from CAMERA if (exists("xa")) { - xobject <- xa@xcmsSet - if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name)) + xobject <- xa@xcmsSet + if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name)) } # if the RData come from XCMS 3.x if (exists("xdata")) { - xobject <- xdata - if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name)) + xobject <- xdata + if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name)) } if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.") @@ -114,33 +118,33 @@ writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>") # to pass the planemo shed_test if (user_email != "test@bx.psu.edu") { - 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(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) { - sampleNameHeaderHtml <- paste0("<th>sample</th>") - sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td>") + sampleNameHeaderHtml <- paste0("<th>sample</th>") + sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td>") } else { - sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>") - sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</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 <- 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." + 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 <- 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/>" + 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>") @@ -155,43 +159,44 @@ writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>") # 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>") - } + 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)] + 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: 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 XCMSnExp object:</h2>") + writehtml("<div><pre>") + writeraw(htmlOutput, xobject) + writehtml("</pre></div>") } writehtml("<h2>Informations about the xcmsSet object:</h2>") @@ -204,10 +209,10 @@ # CAMERA if (exists("xa")) { - writehtml("<h2>Informations about the CAMERA object:</h2>") - writehtml("<div>") - writehtml("Number of pcgroup: ", length(xa@pspectra)) - writehtml("</div>") + writehtml("<h2>Informations about the CAMERA object:</h2>") + writehtml("<div>") + writehtml("Number of pcgroup: ", length(xa@pspectra)) + writehtml("</div>") } writehtml("<h2>Citations:</h2>")