Mercurial > repos > lecorguille > xcms_summary

comparison xcms_summary.r @ 29:2a2850fdf29e 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/tools-metabolomics/ commit 2cb157bd9a8701a3d6874e084032cbd050b8953e
author workflow4metabolomics
date Mon, 11 Sep 2023 09:23:36 +0000
parents 018a9771de28
children
comparison
equal deleted inserted replaced
28:018a9771de28 29:2a2850fdf29e
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) { 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 = "/")) 17 argv <- commandArgs(trailingOnly = FALSE)
18 base_dir <- dirname(substring(argv[grep("--file=", argv)], 8))
19 source(paste(base_dir, fname, sep = "/"))
18 } 20 }
19 source_local("lib.r") 21 source_local("lib.r")
20 22
21 pkgs <- c("CAMERA", "batch") 23 pkgs <- c("CAMERA", "batch")
22 loadAndDisplayPackages(pkgs) 24 loadAndDisplayPackages(pkgs)
23 cat("\n\n"); 25 cat("\n\n")
24 26
25 27
26 # ----- FUNCTION ----- 28 # ----- FUNCTION -----
27 writehtml <- function(...) { 29 writehtml <- function(...) {
28 cat(..., "\n", file = htmlOutput, append = TRUE, sep = "") 30 cat(..., "\n", file = htmlOutput, append = TRUE, sep = "")
29 } 31 }
30 writeraw <- function(htmlOutput, object, open = "at") { 32 writeraw <- function(htmlOutput, object, open = "at") {
31 log_file <- file(htmlOutput, open = open) 33 log_file <- file(htmlOutput, open = open)
32 sink(log_file) 34 sink(log_file)
33 sink(log_file, type = "output") 35 sink(log_file, type = "output")
34 print(object) 36 print(object)
35 sink() 37 sink()
36 close(log_file) 38 close(log_file)
37 } 39 }
38 getSampleNames <- function(xobject) { 40 getSampleNames <- function(xobject) {
39 if (class(xobject) == "xcmsSet") 41 if (class(xobject) == "xcmsSet")
40 return(sampnames(xobject)) 42 return(sampnames(xobject))
41 if (class(xobject) == "XCMSnExp") 43 if (class(xobject) == "XCMSnExp")
42 return(xobject@phenoData@data$sample_name) 44 return(xobject@phenoData@data$sample_name)
43 } 45 }
44 getFilePaths <- function(xobject) { 46 getFilePaths <- function(xobject) {
45 if (class(xobject) == "xcmsSet") 47 if (class(xobject) == "xcmsSet")
46 return(xobject@filepaths) 48 return(xobject@filepaths)
47 if (class(xobject) == "XCMSnExp") 49 if (class(xobject) == "XCMSnExp")
48 return(fileNames(xobject)) 50 return(fileNames(xobject))
49 } 51 }
50 equalParams <- function(param1, param2) { 52 equalParams <- function(param1, param2) {
51 writeraw("param1.txt", param1, open = "wt") 53 writeraw("param1.txt", param1, open = "wt")
52 writeraw("param2.txt", param2, open = "wt") 54 writeraw("param2.txt", param2, open = "wt")
53 return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt")) 55 return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt"))
54 } 56 }
55 57
56 58
57 # ----- ARGUMENTS ----- 59 # ----- ARGUMENTS -----
58 60
60 62
61 63
62 # ----- ARGUMENTS PROCESSING ----- 64 # ----- ARGUMENTS PROCESSING -----
63 65
64 #image is an .RData file necessary to use xset variable given by previous tools 66 #image is an .RData file necessary to use xset variable given by previous tools
65 load(args$image); 67 load(args$image)
66 68
67 htmlOutput <- "summary.html" 69 htmlOutput <- "summary.html"
68 if (!is.null(args$htmlOutput)) htmlOutput <- args$htmlOutput; 70 if (!is.null(args$htmlOutput)) htmlOutput <- args$htmlOutput
69 71
70 user_email <- NULL 72 user_email <- NULL
71 if (!is.null(args$user_email)) user_email <- args$user_email; 73 if (!is.null(args$user_email)) user_email <- args$user_email
72 74
73 # if the RData come from XCMS 1.x 75 # if the RData come from XCMS 1.x
74 if (exists("xset")) { 76 if (exists("xset")) {
75 xobject <- xset 77 xobject <- xset
76 # retrocompatability 78 # retrocompatability
77 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject))) 79 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject)))
78 } 80 }
79 # if the RData come from CAMERA 81 # if the RData come from CAMERA
80 if (exists("xa")) { 82 if (exists("xa")) {
81 xobject <- xa@xcmsSet 83 xobject <- xa@xcmsSet
82 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name)) 84 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name))
83 } 85 }
84 # if the RData come from XCMS 3.x 86 # if the RData come from XCMS 3.x
85 if (exists("xdata")) { 87 if (exists("xdata")) {
86 xobject <- xdata 88 xobject <- xdata
87 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name)) 89 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name))
88 } 90 }
89 91
90 if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.") 92 if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.")
91 93
92 94
93 # ----- MAIN PROCESSING INFO ----- 95 # ----- MAIN PROCESSING INFO -----
94 writehtml("<!DOCTYPE html>") 96 writehtml("<!DOCTYPE html>")
95 writehtml("<HTML lang='en'>") 97 writehtml("<HTML lang='en'>")
96 98
97 writehtml("<HEAD>") 99 writehtml("<HEAD>")
98 writehtml("<meta http-equiv='Content-Type' content='text/html; charset=UTF-8' />") 100 writehtml("<meta http-equiv='Content-Type' content='text/html; charset=UTF-8' />")
99 101
100 writehtml("<title>[W4M] XCMS analysis summary</title>") 102 writehtml("<title>[W4M] XCMS analysis summary</title>")
101 103
102 writehtml("<style>") 104 writehtml("<style>")
103 writehtml("table, tr, td, th { border: 1px solid #000000; border-collapse:collapse; }") 105 writehtml("table, tr, td, th { border: 1px solid #000000; border-collapse:collapse; }")
104 writehtml("td, th { padding: 5px; padding-right: 12px; }") 106 writehtml("td, th { padding: 5px; padding-right: 12px; }")
105 writehtml("th { background: #898989; text-align:left;color: white;}") 107 writehtml("th { background: #898989; text-align:left;color: white;}")
106 writehtml("h2 { color: #FFA212; }") 108 writehtml("h2 { color: #FFA212; }")
107 writehtml("ul li { margin-bottom:10px; }") 109 writehtml("ul li { margin-bottom:10px; }")
108 writehtml("</style>") 110 writehtml("</style>")
109 writehtml("</HEAD>") 111 writehtml("</HEAD>")
110 112
111 writehtml("<BODY>") 113 writehtml("<BODY>")
112 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>") 114 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>")
113 # to pass the planemo shed_test 115 # to pass the planemo shed_test
114 if (user_email != "test@bx.psu.edu") { 116 if (user_email != "test@bx.psu.edu") {
115 if (!is.null(user_email)) writehtml("By: ", user_email, " - ") 117 if (!is.null(user_email)) writehtml("By: ", user_email, " - ")
116 writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S")) 118 writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S"))
119 }
120 writehtml("</div>")
121
122 writehtml("<h2>Samples used:</h2>")
123 writehtml("<div><table>")
124 if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) {
125 sampleNameHeaderHtml <- paste0("<th>sample</th>")
126 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td>")
127 } else {
128 sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>")
129 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td><td>", sampleNamesList$sampleNamesMakeNames, "</td>")
130 }
131
132 if (!exists("md5sumList")) {
133 md5sumHeaderHtml <- ""
134 md5sumHtml <- ""
135 md5sumLegend <- ""
136 } else if (is.null(md5sumList$removalBadCharacters)) {
137 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>")
138 md5sumHtml <- paste0("<td>", md5sumList$origin, "</td>")
139 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."
140 } else {
141 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>")
142 md5sumHtml <- paste0("<td>", md5sumList$origin, "</td><td>", md5sumList$removalBadCharacters, "</td>")
143 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/>"
144 }
145
146 writehtml("<tr>", sampleNameHeaderHtml, "<th>filename</th>", md5sumHeaderHtml, "</tr>")
147 writehtml(paste0("<tr>", sampleNameHtml, "<td>", getFilePaths(xobject), "</td>", md5sumHtml, "</tr>"))
148
149 writehtml("</table>")
150 writehtml(md5sumLegend)
151 writehtml("</div>")
152
153 writehtml("<h2>Function launched:</h2>")
154 writehtml("<div><table>")
155 writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>")
156 # XCMS 3.x
157 if (class(xobject) == "XCMSnExp") {
158 xcmsFunction <- NULL
159 params <- NULL
160 for (processHistoryItem in processHistory(xobject)) {
161 if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem)))
162 next
163 timestamp <- processDate(processHistoryItem)
164 xcmsFunction <- processType(processHistoryItem)
165 params <- processParam(processHistoryItem)
166 writehtml("<tr><td>", timestamp, "</td><td>", xcmsFunction, "</td><td colspan='2'><pre>")
167 writeraw(htmlOutput, params)
168 writehtml("</pre></td></tr>")
169 }
170 }
171 # CAMERA and retrocompatability XCMS 1.x
172 if (exists("listOFlistArguments")) {
173 for (tool in names(listOFlistArguments)) {
174 listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)]
175
176 timestamp <- strsplit(tool, "_")[[1]][1]
177 xcmsFunction <- strsplit(tool, "_")[[1]][2]
178 writehtml("<tr><td rowspan='", length(listOFlistArgumentsDisplay), "'>", timestamp, "</td><td rowspan='", length(listOFlistArgumentsDisplay), "'>", xcmsFunction, "</td>")
179 line_begin <- ""
180 for (arg in names(listOFlistArgumentsDisplay)) {
181 writehtml(line_begin, "<td>", arg, "</td><td>", unlist(listOFlistArgumentsDisplay[arg][1]), "</td></tr>")
182 line_begin <- "<tr>"
117 } 183 }
118 writehtml("</div>") 184 }
119 185 }
120 writehtml("<h2>Samples used:</h2>") 186 writehtml("</table>")
121 writehtml("<div><table>") 187 writehtml("<br/><sup>***</sup>timestamp format: DD MM dd hh:mm:ss YYYY or yymmdd-hh:mm:ss")
122 if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) { 188 writehtml("</div>")
123 sampleNameHeaderHtml <- paste0("<th>sample</th>") 189
124 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td>") 190 if (class(xobject) == "XCMSnExp") {
125 } else { 191 writehtml("<h2>Informations about the XCMSnExp object:</h2>")
126 sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>") 192 writehtml("<div><pre>")
127 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td><td>", sampleNamesList$sampleNamesMakeNames, "</td>") 193 writeraw(htmlOutput, xobject)
128 } 194 writehtml("</pre></div>")
129 195 }
130 if (!exists("md5sumList")) { 196
131 md5sumHeaderHtml <- "" 197 writehtml("<h2>Informations about the xcmsSet object:</h2>")
132 md5sumHtml <- "" 198
133 md5sumLegend <- "" 199 writehtml("<div><pre>")
134 } else if (is.null(md5sumList$removalBadCharacters)) { 200 # Get the legacy xcmsSet object
135 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>") 201 xset <- getxcmsSetObject(xobject)
136 md5sumHtml <- paste0("<td>", md5sumList$origin, "</td>") 202 writeraw(htmlOutput, xset)
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." 203 writehtml("</pre></div>")
138 } else { 204
139 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>") 205 # CAMERA
140 md5sumHtml <- paste0("<td>", md5sumList$origin, "</td><td>", md5sumList$removalBadCharacters, "</td>") 206 if (exists("xa")) {
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/>" 207 writehtml("<h2>Informations about the CAMERA object:</h2>")
142 } 208 writehtml("<div>")
143 209 writehtml("Number of pcgroup: ", length(xa@pspectra))
144 writehtml("<tr>", sampleNameHeaderHtml, "<th>filename</th>", md5sumHeaderHtml, "</tr>") 210 writehtml("</div>")
145 writehtml(paste0("<tr>", sampleNameHtml, "<td>", getFilePaths(xobject), "</td>", md5sumHtml, "</tr>")) 211 }
146 212
147 writehtml("</table>") 213 writehtml("<h2>Citations:</h2>")
148 writehtml(md5sumLegend) 214 writehtml("<div><ul>")
149 writehtml("</div>") 215 writehtml("<li>To cite the <b>XCMS</b> package in publications use:")
150 216 writehtml("<ul>")
151 writehtml("<h2>Function launched:</h2>") 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>")
152 writehtml("<div><table>") 218 writehtml("<li>", "Ralf Tautenhahn, Christoph Boettcher, Steffen Neumann: Highly sensitive feature detection for high resolution LC/MS BMC Bioinformatics, 9:504 (2008)", "</li>")
153 writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>") 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>")
154 # XCMS 3.x 220 writehtml("</ul>")
155 if (class(xobject) == "XCMSnExp") { 221 writehtml("</li>")
156 xcmsFunction <- NULL 222
157 params <- NULL 223 writehtml("<li>To cite the <b>CAMERA</b> package in publications use:")
158 for (processHistoryItem in processHistory(xobject)) { 224 writehtml("<ul>")
159 if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem))) 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>")
160 next 226 writehtml("</ul>")
161 timestamp <- processDate(processHistoryItem) 227 writehtml("</li>")
162 xcmsFunction <- processType(processHistoryItem) 228
163 params <- processParam(processHistoryItem) 229 writehtml("<li>To cite the <b>Workflow4Metabolimics (W4M)</b> project in publications use:")
164 writehtml("<tr><td>", timestamp, "</td><td>", xcmsFunction, "</td><td colspan='2'><pre>") 230 writehtml("<ul>")
165 writeraw(htmlOutput, params) 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>")
166 writehtml("</pre></td></tr>") 232 writehtml("</ul>")
167 } 233 writehtml("</li>")
168 } 234 writehtml("</ul></div>")
169 # CAMERA and retrocompatability XCMS 1.x
170 if (exists("listOFlistArguments")) {
171 for (tool in names(listOFlistArguments)) {
172 listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)]
173
174 timestamp <- strsplit(tool, "_")[[1]][1]
175 xcmsFunction <- strsplit(tool, "_")[[1]][2]
176 writehtml("<tr><td rowspan='", length(listOFlistArgumentsDisplay), "'>", timestamp, "</td><td rowspan='", length(listOFlistArgumentsDisplay), "'>", xcmsFunction, "</td>")
177 line_begin <- ""
178 for (arg in names(listOFlistArgumentsDisplay)) {
179 writehtml(line_begin, "<td>", arg, "</td><td>", unlist(listOFlistArgumentsDisplay[arg][1]), "</td></tr>")
180 line_begin <- "<tr>"
181 }
182 }
183 }
184 writehtml("</table>")
185 writehtml("<br/><sup>***</sup>timestamp format: DD MM dd hh:mm:ss YYYY or yymmdd-hh:mm:ss")
186 writehtml("</div>")
187
188 if (class(xobject) == "XCMSnExp") {
189 writehtml("<h2>Informations about the XCMSnExp object:</h2>")
190
191 writehtml("<div><pre>")
192 writeraw(htmlOutput, xobject)
193 writehtml("</pre></div>")
194 }
195
196 writehtml("<h2>Informations about the xcmsSet object:</h2>")
197
198 writehtml("<div><pre>")
199 # Get the legacy xcmsSet object
200 xset <- getxcmsSetObject(xobject)
201 writeraw(htmlOutput, xset)
202 writehtml("</pre></div>")
203
204 # CAMERA
205 if (exists("xa")) {
206 writehtml("<h2>Informations about the CAMERA object:</h2>")
207
208 writehtml("<div>")
209 writehtml("Number of pcgroup: ", length(xa@pspectra))
210 writehtml("</div>")
211 }
212
213 writehtml("<h2>Citations:</h2>")
214 writehtml("<div><ul>")
215 writehtml("<li>To cite the <b>XCMS</b> package in publications use:")
216 writehtml("<ul>")
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>")
218 writehtml("<li>", "Ralf Tautenhahn, Christoph Boettcher, Steffen Neumann: Highly sensitive feature detection for high resolution LC/MS BMC Bioinformatics, 9:504 (2008)", "</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>")
220 writehtml("</ul>")
221 writehtml("</li>")
222
223 writehtml("<li>To cite the <b>CAMERA</b> package in publications use:")
224 writehtml("<ul>")
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>")
226 writehtml("</ul>")
227 writehtml("</li>")
228
229 writehtml("<li>To cite the <b>Workflow4Metabolimics (W4M)</b> project in publications use:")
230 writehtml("<ul>")
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>")
232 writehtml("</ul>")
233 writehtml("</li>")
234 writehtml("</ul></div>")
235 235
236 writehtml("</BODY>") 236 writehtml("</BODY>")
237 237
238 writehtml("</HTML>") 238 writehtml("</HTML>")