Mercurial > repos > lecorguille > xcms_summary

comparison xcms_summary.r @ 28:018a9771de28 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"planemo upload for repository https://github.com/workflow4metabolomics/xcms commit dcc90f9cf76e6980c0a7d9698c89fab826e7adae"
author workflow4metabolomics
date Wed, 07 Apr 2021 16:46:50 +0000
parents bed23aa27b4b
children 2a2850fdf29e
comparison
equal deleted inserted replaced
27:bed23aa27b4b 28:018a9771de28
11 11
12 # ----- PACKAGE ----- 12 # ----- PACKAGE -----
13 cat("\tSESSION INFO\n") 13 cat("\tSESSION INFO\n")
14 14
15 #Import the different functions 15 #Import the different functions
16 source_local <- function(fname){ argv <- commandArgs(trailingOnly=FALSE); base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)); source(paste(base_dir, fname, sep="/")) } 16 source_local <- function(fname) {
17 argv <- commandArgs(trailingOnly = FALSE); base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)); source(paste(base_dir, fname, sep = "/"))
18 }
17 source_local("lib.r") 19 source_local("lib.r")
18 20
19 pkgs <- c("CAMERA","batch") 21 pkgs <- c("CAMERA", "batch")
20 loadAndDisplayPackages(pkgs) 22 loadAndDisplayPackages(pkgs)
21 cat("\n\n"); 23 cat("\n\n");
22 24
23 25
24 # ----- FUNCTION ----- 26 # ----- FUNCTION -----
25 writehtml <- function(...) { cat(...,"\n", file=htmlOutput,append = TRUE,sep="") } 27 writehtml <- function(...) {
26 writeraw <- function(htmlOutput, object, open="at") { 28 cat(..., "\n", file = htmlOutput, append = TRUE, sep = "")
29 }
30 writeraw <- function(htmlOutput, object, open = "at") {
27 log_file <- file(htmlOutput, open = open) 31 log_file <- file(htmlOutput, open = open)
28 sink(log_file) 32 sink(log_file)
29 sink(log_file, type = "output") 33 sink(log_file, type = "output")
30 print(object) 34 print(object)
31 sink() 35 sink()
32 close(log_file) 36 close(log_file)
33 } 37 }
34 getSampleNames <- function(xobject) { 38 getSampleNames <- function(xobject) {
35 if (class(xobject) == "xcmsSet") 39 if (class(xobject) == "xcmsSet")
36 return (sampnames(xobject)) 40 return(sampnames(xobject))
37 if (class(xobject) == "XCMSnExp") 41 if (class(xobject) == "XCMSnExp")
38 return (xobject@phenoData@data$sample_name) 42 return(xobject@phenoData@data$sample_name)
39 } 43 }
40 getFilePaths <- function(xobject) { 44 getFilePaths <- function(xobject) {
41 if (class(xobject) == "xcmsSet") 45 if (class(xobject) == "xcmsSet")
42 return (xobject@filepaths) 46 return(xobject@filepaths)
43 if (class(xobject) == "XCMSnExp") 47 if (class(xobject) == "XCMSnExp")
44 return (fileNames(xobject)) 48 return(fileNames(xobject))
45 } 49 }
46 equalParams <- function(param1, param2) { 50 equalParams <- function(param1, param2) {
47 writeraw("param1.txt", param1, open="wt") 51 writeraw("param1.txt", param1, open = "wt")
48 writeraw("param2.txt", param2, open="wt") 52 writeraw("param2.txt", param2, open = "wt")
49 return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt")) 53 return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt"))
50 } 54 }
51 55
52 56
53 # ----- ARGUMENTS ----- 57 # ----- ARGUMENTS -----
54 58
55 args <- parseCommandArgs(evaluate=FALSE) #interpretation of arguments given in command line as an R list of objects 59 args <- parseCommandArgs(evaluate = FALSE) #interpretation of arguments given in command line as an R list of objects
56 60
57 61
58 # ----- ARGUMENTS PROCESSING ----- 62 # ----- ARGUMENTS PROCESSING -----
59 63
60 #image is an .RData file necessary to use xset variable given by previous tools 64 #image is an .RData file necessary to use xset variable given by previous tools
61 load(args$image); 65 load(args$image);
62 66
63 htmlOutput <- "summary.html" 67 htmlOutput <- "summary.html"
64 if (!is.null(args$htmlOutput)) htmlOutput = args$htmlOutput; 68 if (!is.null(args$htmlOutput)) htmlOutput <- args$htmlOutput;
65 69
66 user_email <- NULL 70 user_email <- NULL
67 if (!is.null(args$user_email)) user_email = args$user_email; 71 if (!is.null(args$user_email)) user_email <- args$user_email;
68 72
69 # if the RData come from XCMS 1.x 73 # if the RData come from XCMS 1.x
70 if (exists("xset")) { 74 if (exists("xset")) {
71 xobject <- xset 75 xobject <- xset
72 # retrocompatability 76 # retrocompatability
73 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames"=make.names(sampnames(xobject))) 77 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject)))
74 } 78 }
75 # if the RData come from CAMERA 79 # if the RData come from CAMERA
76 if (exists("xa")) { 80 if (exists("xa")) {
77 xobject <- xa@xcmsSet 81 xobject <- xa@xcmsSet
78 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames"=make.names(xa@xcmsSet@phenoData$sample_name)) 82 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name))
79 } 83 }
80 # if the RData come from XCMS 3.x 84 # if the RData come from XCMS 3.x
81 if (exists("xdata")) { 85 if (exists("xdata")) {
82 xobject <- xdata 86 xobject <- xdata
83 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames"=make.names(xdata@phenoData@data$sample_name)) 87 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name))
84 } 88 }
85 89
86 if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.") 90 if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.")
87 91
88 92
95 99
96 writehtml("<title>[W4M] XCMS analysis summary</title>") 100 writehtml("<title>[W4M] XCMS analysis summary</title>")
97 101
98 writehtml("<style>") 102 writehtml("<style>")
99 writehtml("table, tr, td, th { border: 1px solid #000000; border-collapse:collapse; }") 103 writehtml("table, tr, td, th { border: 1px solid #000000; border-collapse:collapse; }")
100 writehtml("td,th { padding: 5px; padding-right: 12px; }") 104 writehtml("td, th { padding: 5px; padding-right: 12px; }")
101 writehtml("th { background: #898989; text-align:left;color: white;}") 105 writehtml("th { background: #898989; text-align:left;color: white;}")
102 writehtml("h2 { color: #FFA212; }") 106 writehtml("h2 { color: #FFA212; }")
103 writehtml("ul li { margin-bottom:10px; }") 107 writehtml("ul li { margin-bottom:10px; }")
104 writehtml("</style>") 108 writehtml("</style>")
105 writehtml("</HEAD>") 109 writehtml("</HEAD>")
106 110
107 writehtml("<BODY>") 111 writehtml("<BODY>")
108 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>") 112 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>")
109 # to pass the planemo shed_test 113 # to pass the planemo shed_test
110 if (user_email != "test@bx.psu.edu") { 114 if (user_email != "test@bx.psu.edu") {
111 if (!is.null(user_email)) writehtml("By: ", user_email," - ") 115 if (!is.null(user_email)) writehtml("By: ", user_email, " - ")
112 writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S")) 116 writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S"))
113 } 117 }
114 writehtml("</div>") 118 writehtml("</div>")
115 119
116 writehtml("<h2>Samples used:</h2>") 120 writehtml("<h2>Samples used:</h2>")
117 writehtml("<div><table>") 121 writehtml("<div><table>")
118 if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) { 122 if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) {
119 sampleNameHeaderHtml <- paste0("<th>sample</th>") 123 sampleNameHeaderHtml <- paste0("<th>sample</th>")
120 sampleNameHtml <- paste0("<td>",getSampleNames(xobject),"</td>") 124 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td>")
121 } else { 125 } else {
122 sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>") 126 sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>")
123 sampleNameHtml <- paste0("<td>",getSampleNames(xobject),"</td><td>",sampleNamesList$sampleNamesMakeNames,"</td>") 127 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td><td>", sampleNamesList$sampleNamesMakeNames, "</td>")
124 } 128 }
125 129
126 if (!exists("md5sumList")) { 130 if (!exists("md5sumList")) {
127 md5sumHeaderHtml <- "" 131 md5sumHeaderHtml <- ""
128 md5sumHtml <- "" 132 md5sumHtml <- ""
129 md5sumLegend <- "" 133 md5sumLegend <- ""
130 } else if (is.null(md5sumList$removalBadCharacters)) { 134 } else if (is.null(md5sumList$removalBadCharacters)) {
131 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>") 135 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>")
132 md5sumHtml <- paste0("<td>",md5sumList$origin,"</td>") 136 md5sumHtml <- paste0("<td>", md5sumList$origin, "</td>")
133 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." 137 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."
134 } else { 138 } else {
135 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>") 139 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>")
136 md5sumHtml <- paste0("<td>",md5sumList$origin,"</td><td>",md5sumList$removalBadCharacters,"</td>") 140 md5sumHtml <- paste0("<td>", md5sumList$origin, "</td><td>", md5sumList$removalBadCharacters, "</td>")
137 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/>" 141 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/>"
138 } 142 }
139 143
140 writehtml("<tr>",sampleNameHeaderHtml,"<th>filename</th>",md5sumHeaderHtml,"</tr>") 144 writehtml("<tr>", sampleNameHeaderHtml, "<th>filename</th>", md5sumHeaderHtml, "</tr>")
141 writehtml(paste0("<tr>",sampleNameHtml,"<td>",getFilePaths(xobject),"</td>",md5sumHtml,"</tr>")) 145 writehtml(paste0("<tr>", sampleNameHtml, "<td>", getFilePaths(xobject), "</td>", md5sumHtml, "</tr>"))
142 146
143 writehtml("</table>") 147 writehtml("</table>")
144 writehtml(md5sumLegend) 148 writehtml(md5sumLegend)
145 writehtml("</div>") 149 writehtml("</div>")
146 150
155 if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem))) 159 if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem)))
156 next 160 next
157 timestamp <- processDate(processHistoryItem) 161 timestamp <- processDate(processHistoryItem)
158 xcmsFunction <- processType(processHistoryItem) 162 xcmsFunction <- processType(processHistoryItem)
159 params <- processParam(processHistoryItem) 163 params <- processParam(processHistoryItem)
160 writehtml("<tr><td>",timestamp,"</td><td>",xcmsFunction,"</td><td colspan='2'><pre>") 164 writehtml("<tr><td>", timestamp, "</td><td>", xcmsFunction, "</td><td colspan='2'><pre>")
161 writeraw(htmlOutput, params) 165 writeraw(htmlOutput, params)
162 writehtml("</pre></td></tr>") 166 writehtml("</pre></td></tr>")
163 } 167 }
164 } 168 }
165 # CAMERA and retrocompatability XCMS 1.x 169 # CAMERA and retrocompatability XCMS 1.x
166 if (exists("listOFlistArguments")) { 170 if (exists("listOFlistArguments")) {
167 for(tool in names(listOFlistArguments)) { 171 for (tool in names(listOFlistArguments)) {
168 listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)] 172 listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)]
169 173
170 timestamp <- strsplit(tool,"_")[[1]][1] 174 timestamp <- strsplit(tool, "_")[[1]][1]
171 xcmsFunction <- strsplit(tool,"_")[[1]][2] 175 xcmsFunction <- strsplit(tool, "_")[[1]][2]
172 writehtml("<tr><td rowspan='",length(listOFlistArgumentsDisplay),"'>",timestamp,"</td><td rowspan='",length(listOFlistArgumentsDisplay),"'>",xcmsFunction,"</td>") 176 writehtml("<tr><td rowspan='", length(listOFlistArgumentsDisplay), "'>", timestamp, "</td><td rowspan='", length(listOFlistArgumentsDisplay), "'>", xcmsFunction, "</td>")
173 line_begin <- "" 177 line_begin <- ""
174 for (arg in names(listOFlistArgumentsDisplay)) { 178 for (arg in names(listOFlistArgumentsDisplay)) {
175 writehtml(line_begin,"<td>",arg,"</td><td>",unlist(listOFlistArgumentsDisplay[arg][1]),"</td></tr>") 179 writehtml(line_begin, "<td>", arg, "</td><td>", unlist(listOFlistArgumentsDisplay[arg][1]), "</td></tr>")
176 line_begin <- "<tr>" 180 line_begin <- "<tr>"
177 } 181 }
178 } 182 }
179 } 183 }
180 writehtml("</table>") 184 writehtml("</table>")
200 # CAMERA 204 # CAMERA
201 if (exists("xa")) { 205 if (exists("xa")) {
202 writehtml("<h2>Informations about the CAMERA object:</h2>") 206 writehtml("<h2>Informations about the CAMERA object:</h2>")
203 207
204 writehtml("<div>") 208 writehtml("<div>")
205 writehtml("Number of pcgroup: ",length(xa@pspectra)) 209 writehtml("Number of pcgroup: ", length(xa@pspectra))
206 writehtml("</div>") 210 writehtml("</div>")
207 } 211 }
208 212
209 writehtml("<h2>Citations:</h2>") 213 writehtml("<h2>Citations:</h2>")
210 writehtml("<div><ul>") 214 writehtml("<div><ul>")
211 writehtml("<li>To cite the <b>XCMS</b> package in publications use:") 215 writehtml("<li>To cite the <b>XCMS</b> package in publications use:")
212 writehtml("<ul>") 216 writehtml("<ul>")
213 writehtml("<li>","Smith, C.A. and Want, E.J. and O'Maille, G. and Abagyan,R. and Siuzdak, G.XCMS: Processing mass spectrometry data for metabolite profiling using nonlinear peak alignment, matching and identification, Analytical Chemistry, 78:779-787 (2006)","</li>") 217 writehtml("<li>", "Smith, C.A. and Want, E.J. and O'Maille, G. and Abagyan,R. and Siuzdak, G.XCMS: Processing mass spectrometry data for metabolite profiling using nonlinear peak alignment, matching and identification, Analytical Chemistry, 78:779-787 (2006)", "</li>")
214 writehtml("<li>","Ralf Tautenhahn, Christoph Boettcher, Steffen Neumann: Highly sensitive feature detection for high resolution LC/MS BMC Bioinformatics, 9:504 (2008)","</li>") 218 writehtml("<li>", "Ralf Tautenhahn, Christoph Boettcher, Steffen Neumann: Highly sensitive feature detection for high resolution LC/MS BMC Bioinformatics, 9:504 (2008)", "</li>")
215 writehtml("<li>","H. Paul Benton, Elizabeth J. Want and Timothy M. D. Ebbels Correction of mass calibration gaps in liquid chromatography-mass spectrometry metabolomics data Bioinformatics, 26:2488 (2010)","</li>") 219 writehtml("<li>", "H. Paul Benton, Elizabeth J. Want and Timothy M. D. Ebbels Correction of mass calibration gaps in liquid chromatography-mass spectrometry metabolomics data Bioinformatics, 26:2488 (2010)", "</li>")
216 writehtml("</ul>") 220 writehtml("</ul>")
217 writehtml("</li>") 221 writehtml("</li>")
218 222
219 writehtml("<li>To cite the <b>CAMERA</b> package in publications use:") 223 writehtml("<li>To cite the <b>CAMERA</b> package in publications use:")
220 writehtml("<ul>") 224 writehtml("<ul>")
221 writehtml("<li>","Kuhl, C., Tautenhahn, R., Boettcher, C., Larson, T. R. and Neumann,S. CAMERA: an integrated strategy for compound spectra extraction and annotation of liquid chromatography/mass spectrometry data sets. Analytical Chemistry, 84:283-289 (2012)","</li>") 225 writehtml("<li>", "Kuhl, C., Tautenhahn, R., Boettcher, C., Larson, T. R. and Neumann,S. CAMERA: an integrated strategy for compound spectra extraction and annotation of liquid chromatography/mass spectrometry data sets. Analytical Chemistry, 84:283-289 (2012)", "</li>")
222 writehtml("</ul>") 226 writehtml("</ul>")
223 writehtml("</li>") 227 writehtml("</li>")
224 228
225 writehtml("<li>To cite the <b>Workflow4Metabolimics (W4M)</b> project in publications use:") 229 writehtml("<li>To cite the <b>Workflow4Metabolimics (W4M)</b> project in publications use:")
226 writehtml("<ul>") 230 writehtml("<ul>")
227 writehtml("<li>","Franck Giacomoni, Gildas Le Corguillé, Misharl Monsoor, Marion Landi, Pierre Pericard, Mélanie Pétéra, Christophe Duperier, Marie Tremblay-Franco, Jean-François Martin, Daniel Jacob, Sophie Goulitquer, Etienne A. Thévenot and Christophe Caron (2014). Workflow4Metabolomics: A collaborative research infrastructure for computational metabolomics. Bioinformatics doi:10.1093/bioinformatics/btu813","</li>") 231 writehtml("<li>", "Franck Giacomoni, Gildas Le Corguillé, Misharl Monsoor, Marion Landi, Pierre Pericard, Mélanie Pétéra, Christophe Duperier, Marie Tremblay-Franco, Jean-François Martin, Daniel Jacob, Sophie Goulitquer, Etienne A. Thévenot and Christophe Caron (2014). Workflow4Metabolomics: A collaborative research infrastructure for computational metabolomics. Bioinformatics doi:10.1093/bioinformatics/btu813", "</li>")
228 writehtml("</ul>") 232 writehtml("</ul>")
229 writehtml("</li>") 233 writehtml("</li>")
230 writehtml("</ul></div>") 234 writehtml("</ul></div>")
231 235
232 writehtml("</BODY>") 236 writehtml("</BODY>")