Mercurial > repos > lecorguille > xcms_summary

comparison xcms_summary.r @ 31:1ae878634ab3 draft default tip

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 95721ced8347c09e79340e6d67ecb41c5cc64163
author workflow4metabolomics
date Mon, 03 Feb 2025 14:48:46 +0000
parents 2a2850fdf29e
children
comparison
equal deleted inserted replaced
30:444e3ed135e3 31:1ae878634ab3
1 #!/usr/bin/env Rscript 1 #!/usr/bin/env Rscript
2 2
3 3
4 4
5 # ----- ARGUMENTS BLACKLIST ----- 5 # ----- ARGUMENTS BLACKLIST -----
6 #xcms.r 6 # xcms.r
7 argBlacklist <- c("zipfile", "singlefile_galaxyPath", "singlefile_sampleName", "xfunction", "xsetRdataOutput", "sampleMetadataOutput", "ticspdf", "bicspdf", "rplotspdf") 7 argBlacklist <- c("zipfile", "singlefile_galaxyPath", "singlefile_sampleName", "xfunction", "xsetRdataOutput", "sampleMetadataOutput", "ticspdf", "bicspdf", "rplotspdf")
8 #CAMERA.r 8 # CAMERA.r
9 argBlacklist <- c(argBlacklist, "dataMatrixOutput", "variableMetadataOutput", "new_file_path") 9 argBlacklist <- c(argBlacklist, "dataMatrixOutput", "variableMetadataOutput", "new_file_path")
10 10
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) { 16 source_local <- function(fname) {
17 argv <- commandArgs(trailingOnly = FALSE) 17 argv <- commandArgs(trailingOnly = FALSE)
18 base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)) 18 base_dir <- dirname(substring(argv[grep("--file=", argv)], 8))
19 source(paste(base_dir, fname, sep = "/")) 19 source(paste(base_dir, fname, sep = "/"))
20 } 20 }
21 source_local("lib.r") 21 source_local("lib.r")
22 22
23 pkgs <- c("CAMERA", "batch") 23 pkgs <- c("CAMERA", "batch")
24 loadAndDisplayPackages(pkgs) 24 loadAndDisplayPackages(pkgs)
25 cat("\n\n") 25 cat("\n\n")
26 26
27 27
28 # ----- FUNCTION ----- 28 # ----- FUNCTION -----
29 writehtml <- function(...) { 29 writehtml <- function(...) {
30 cat(..., "\n", file = htmlOutput, append = TRUE, sep = "") 30 cat(..., "\n", file = htmlOutput, append = TRUE, sep = "")
31 } 31 }
32 writeraw <- function(htmlOutput, object, open = "at") { 32 writeraw <- function(htmlOutput, object, open = "at") {
33 log_file <- file(htmlOutput, open = open) 33 log_file <- file(htmlOutput, open = open)
34 sink(log_file) 34 sink(log_file)
35 sink(log_file, type = "output") 35 sink(log_file, type = "output")
36 print(object) 36 print(object)
37 sink() 37 sink()
38 close(log_file) 38 close(log_file)
39 } 39 }
40 getSampleNames <- function(xobject) { 40 getSampleNames <- function(xobject) {
41 if (class(xobject) == "xcmsSet") 41 if (class(xobject) == "xcmsSet") {
42 return(sampnames(xobject)) 42 return(sampnames(xobject))
43 if (class(xobject) == "XCMSnExp") 43 }
44 return(xobject@phenoData@data$sample_name) 44 if (class(xobject) == "XCMSnExp") {
45 return(xobject@phenoData@data$sample_name)
46 }
45 } 47 }
46 getFilePaths <- function(xobject) { 48 getFilePaths <- function(xobject) {
47 if (class(xobject) == "xcmsSet") 49 if (class(xobject) == "xcmsSet") {
48 return(xobject@filepaths) 50 return(xobject@filepaths)
49 if (class(xobject) == "XCMSnExp") 51 }
50 return(fileNames(xobject)) 52 if (class(xobject) == "XCMSnExp") {
53 return(fileNames(xobject))
54 }
51 } 55 }
52 equalParams <- function(param1, param2) { 56 equalParams <- function(param1, param2) {
53 writeraw("param1.txt", param1, open = "wt") 57 writeraw("param1.txt", param1, open = "wt")
54 writeraw("param2.txt", param2, open = "wt") 58 writeraw("param2.txt", param2, open = "wt")
55 return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt")) 59 return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt"))
56 } 60 }
57 61
58 62
59 # ----- ARGUMENTS ----- 63 # ----- ARGUMENTS -----
60 64
61 args <- parseCommandArgs(evaluate = FALSE) #interpretation of arguments given in command line as an R list of objects 65 args <- parseCommandArgs(evaluate = FALSE) # interpretation of arguments given in command line as an R list of objects
62 66
63 67
64 # ----- ARGUMENTS PROCESSING ----- 68 # ----- ARGUMENTS PROCESSING -----
65 69
66 #image is an .RData file necessary to use xset variable given by previous tools 70 # image is an .RData file necessary to use xset variable given by previous tools
67 load(args$image) 71 load(args$image)
68 72
69 htmlOutput <- "summary.html" 73 htmlOutput <- "summary.html"
70 if (!is.null(args$htmlOutput)) htmlOutput <- args$htmlOutput 74 if (!is.null(args$htmlOutput)) htmlOutput <- args$htmlOutput
71 75
72 user_email <- NULL 76 user_email <- NULL
73 if (!is.null(args$user_email)) user_email <- args$user_email 77 if (!is.null(args$user_email)) user_email <- args$user_email
74 78
75 # if the RData come from XCMS 1.x 79 # if the RData come from XCMS 1.x
76 if (exists("xset")) { 80 if (exists("xset")) {
77 xobject <- xset 81 xobject <- xset
78 # retrocompatability 82 # retrocompatability
79 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject))) 83 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(sampnames(xobject)))
80 } 84 }
81 # if the RData come from CAMERA 85 # if the RData come from CAMERA
82 if (exists("xa")) { 86 if (exists("xa")) {
83 xobject <- xa@xcmsSet 87 xobject <- xa@xcmsSet
84 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name)) 88 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xa@xcmsSet@phenoData$sample_name))
85 } 89 }
86 # if the RData come from XCMS 3.x 90 # if the RData come from XCMS 3.x
87 if (exists("xdata")) { 91 if (exists("xdata")) {
88 xobject <- xdata 92 xobject <- xdata
89 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name)) 93 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames" = make.names(xdata@phenoData@data$sample_name))
90 } 94 }
91 95
92 if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.") 96 if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.")
93 97
94 98
112 116
113 writehtml("<BODY>") 117 writehtml("<BODY>")
114 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>") 118 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>")
115 # to pass the planemo shed_test 119 # to pass the planemo shed_test
116 if (user_email != "test@bx.psu.edu") { 120 if (user_email != "test@bx.psu.edu") {
117 if (!is.null(user_email)) writehtml("By: ", user_email, " - ") 121 if (!is.null(user_email)) writehtml("By: ", user_email, " - ")
118 writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S")) 122 writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S"))
119 } 123 }
120 writehtml("</div>") 124 writehtml("</div>")
121 125
122 writehtml("<h2>Samples used:</h2>") 126 writehtml("<h2>Samples used:</h2>")
123 writehtml("<div><table>") 127 writehtml("<div><table>")
124 if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) { 128 if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) {
125 sampleNameHeaderHtml <- paste0("<th>sample</th>") 129 sampleNameHeaderHtml <- paste0("<th>sample</th>")
126 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td>") 130 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td>")
127 } else { 131 } else {
128 sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>") 132 sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>")
129 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td><td>", sampleNamesList$sampleNamesMakeNames, "</td>") 133 sampleNameHtml <- paste0("<td>", getSampleNames(xobject), "</td><td>", sampleNamesList$sampleNamesMakeNames, "</td>")
130 } 134 }
131 135
132 if (!exists("md5sumList")) { 136 if (!exists("md5sumList")) {
133 md5sumHeaderHtml <- "" 137 md5sumHeaderHtml <- ""
134 md5sumHtml <- "" 138 md5sumHtml <- ""
135 md5sumLegend <- "" 139 md5sumLegend <- ""
136 } else if (is.null(md5sumList$removalBadCharacters)) { 140 } else if (is.null(md5sumList$removalBadCharacters)) {
137 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>") 141 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>")
138 md5sumHtml <- paste0("<td>", md5sumList$origin, "</td>") 142 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." 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."
140 } else { 144 } else {
141 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>") 145 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>") 146 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/>" 147 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 } 148 }
145 149
146 writehtml("<tr>", sampleNameHeaderHtml, "<th>filename</th>", md5sumHeaderHtml, "</tr>") 150 writehtml("<tr>", sampleNameHeaderHtml, "<th>filename</th>", md5sumHeaderHtml, "</tr>")
147 writehtml(paste0("<tr>", sampleNameHtml, "<td>", getFilePaths(xobject), "</td>", md5sumHtml, "</tr>")) 151 writehtml(paste0("<tr>", sampleNameHtml, "<td>", getFilePaths(xobject), "</td>", md5sumHtml, "</tr>"))
148 152
153 writehtml("<h2>Function launched:</h2>") 157 writehtml("<h2>Function launched:</h2>")
154 writehtml("<div><table>") 158 writehtml("<div><table>")
155 writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>") 159 writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>")
156 # XCMS 3.x 160 # XCMS 3.x
157 if (class(xobject) == "XCMSnExp") { 161 if (class(xobject) == "XCMSnExp") {
158 xcmsFunction <- NULL 162 xcmsFunction <- NULL
159 params <- NULL 163 params <- NULL
160 for (processHistoryItem in processHistory(xobject)) { 164 for (processHistoryItem in processHistory(xobject)) {
161 if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem))) 165 if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem))) {
162 next 166 next
163 timestamp <- processDate(processHistoryItem) 167 }
164 xcmsFunction <- processType(processHistoryItem) 168 timestamp <- processDate(processHistoryItem)
165 params <- processParam(processHistoryItem) 169 xcmsFunction <- processType(processHistoryItem)
166 writehtml("<tr><td>", timestamp, "</td><td>", xcmsFunction, "</td><td colspan='2'><pre>") 170 params <- processParam(processHistoryItem)
167 writeraw(htmlOutput, params) 171 writehtml("<tr><td>", timestamp, "</td><td>", xcmsFunction, "</td><td colspan='2'><pre>")
168 writehtml("</pre></td></tr>") 172 writeraw(htmlOutput, params)
169 } 173 writehtml("</pre></td></tr>")
174 }
170 } 175 }
171 # CAMERA and retrocompatability XCMS 1.x 176 # CAMERA and retrocompatability XCMS 1.x
172 if (exists("listOFlistArguments")) { 177 if (exists("listOFlistArguments")) {
173 for (tool in names(listOFlistArguments)) { 178 for (tool in names(listOFlistArguments)) {
174 listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)] 179 listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)]
175 180
176 timestamp <- strsplit(tool, "_")[[1]][1] 181 timestamp <- strsplit(tool, "_")[[1]][1]
177 xcmsFunction <- strsplit(tool, "_")[[1]][2] 182 xcmsFunction <- strsplit(tool, "_")[[1]][2]
178 writehtml("<tr><td rowspan='", length(listOFlistArgumentsDisplay), "'>", timestamp, "</td><td rowspan='", length(listOFlistArgumentsDisplay), "'>", xcmsFunction, "</td>") 183 writehtml("<tr><td rowspan='", length(listOFlistArgumentsDisplay), "'>", timestamp, "</td><td rowspan='", length(listOFlistArgumentsDisplay), "'>", xcmsFunction, "</td>")
179 line_begin <- "" 184 line_begin <- ""
180 for (arg in names(listOFlistArgumentsDisplay)) { 185 for (arg in names(listOFlistArgumentsDisplay)) {
181 writehtml(line_begin, "<td>", arg, "</td><td>", unlist(listOFlistArgumentsDisplay[arg][1]), "</td></tr>") 186 writehtml(line_begin, "<td>", arg, "</td><td>", unlist(listOFlistArgumentsDisplay[arg][1]), "</td></tr>")
182 line_begin <- "<tr>" 187 line_begin <- "<tr>"
183 } 188 }
184 } 189 }
185 } 190 }
186 writehtml("</table>") 191 writehtml("</table>")
187 writehtml("<br/><sup>***</sup>timestamp format: DD MM dd hh:mm:ss YYYY or yymmdd-hh:mm:ss") 192 writehtml("<br/><sup>***</sup>timestamp format: DD MM dd hh:mm:ss YYYY or yymmdd-hh:mm:ss")
188 writehtml("</div>") 193 writehtml("</div>")
189 194
190 if (class(xobject) == "XCMSnExp") { 195 if (class(xobject) == "XCMSnExp") {
191 writehtml("<h2>Informations about the XCMSnExp object:</h2>") 196 writehtml("<h2>Informations about the XCMSnExp object:</h2>")
192 writehtml("<div><pre>") 197 writehtml("<div><pre>")
193 writeraw(htmlOutput, xobject) 198 writeraw(htmlOutput, xobject)
194 writehtml("</pre></div>") 199 writehtml("</pre></div>")
195 } 200 }
196 201
197 writehtml("<h2>Informations about the xcmsSet object:</h2>") 202 writehtml("<h2>Informations about the xcmsSet object:</h2>")
198 203
199 writehtml("<div><pre>") 204 writehtml("<div><pre>")
202 writeraw(htmlOutput, xset) 207 writeraw(htmlOutput, xset)
203 writehtml("</pre></div>") 208 writehtml("</pre></div>")
204 209
205 # CAMERA 210 # CAMERA
206 if (exists("xa")) { 211 if (exists("xa")) {
207 writehtml("<h2>Informations about the CAMERA object:</h2>") 212 writehtml("<h2>Informations about the CAMERA object:</h2>")
208 writehtml("<div>") 213 writehtml("<div>")
209 writehtml("Number of pcgroup: ", length(xa@pspectra)) 214 writehtml("Number of pcgroup: ", length(xa@pspectra))
210 writehtml("</div>") 215 writehtml("</div>")
211 } 216 }
212 217
213 writehtml("<h2>Citations:</h2>") 218 writehtml("<h2>Citations:</h2>")
214 writehtml("<div><ul>") 219 writehtml("<div><ul>")
215 writehtml("<li>To cite the <b>XCMS</b> package in publications use:") 220 writehtml("<li>To cite the <b>XCMS</b> package in publications use:")