Mercurial > repos > lecorguille > xcms_summary

comparison xcms_summary.r @ 15:97ca0321931b 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 9f72e947d9c241d11221cad561f3525d27231857
author lecorguille
date Tue, 18 Sep 2018 16:14:05 -0400
parents a5347d57899f
children 46be2c523a7f
comparison
equal deleted inserted replaced
14:4c757d1ba7b4 15:97ca0321931b
1 #!/usr/bin/env Rscript 1 #!/usr/bin/env Rscript
2 # version="1.0.0"
3 #@author Gildas Le Corguille lecorguille@sb-roscoff.fr ABIMS TEAM
4 2
5 3
6 4
7 # ----- ARGUMENTS BLACKLIST ----- 5 # ----- ARGUMENTS BLACKLIST -----
8 #xcms.r 6 #xcms.r
9 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")
10 #CAMERA.r 8 #CAMERA.r
11 argBlacklist=c(argBlacklist,"dataMatrixOutput","variableMetadataOutput","new_file_path") 9 argBlacklist <- c(argBlacklist, "dataMatrixOutput", "variableMetadataOutput", "new_file_path")
10
12 11
13 # ----- PACKAGE ----- 12 # ----- PACKAGE -----
14 13 cat("\tSESSION INFO\n")
15 pkgs=c("parallel","BiocGenerics", "Biobase", "Rcpp", "mzR", "igraph", "xcms","CAMERA","batch") 14
16 for(pkg in pkgs) { 15 #Import the different functions
17 cat(pkg,"\n") 16 source_local <- function(fname){ argv <- commandArgs(trailingOnly=FALSE); base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)); source(paste(base_dir, fname, sep="/")) }
18 suppressPackageStartupMessages( stopifnot( library(pkg, quietly=TRUE, logical.return=TRUE, character.only=TRUE))) 17 source_local("lib.r")
19 } 18 source_local("lib-xcms3.x.x.r")
19
20 pkgs <- c("CAMERA","batch")
21 loadAndDisplayPackages(pkgs)
22 cat("\n\n");
20 23
21 24
22 # ----- FUNCTION ----- 25 # ----- FUNCTION -----
23 writehtml = function(...) { cat(...,"\n", file=htmlOutput,append = TRUE,sep="") } 26 writehtml <- function(...) { cat(...,"\n", file=htmlOutput,append = TRUE,sep="") }
27 writeraw <- function(htmlOutput, object, open="at") {
28 log_file <- file(htmlOutput, open = open)
29 sink(log_file)
30 sink(log_file, type = "output")
31 print(object)
32 sink()
33 close(log_file)
34 }
35 getSampleNames <- function(xobject) {
36 if (class(xobject) == "xcmsSet")
37 return (sampnames(xobject))
38 if (class(xobject) == "XCMSnExp")
39 return (xobject@phenoData@data$sample_name)
40 }
41 getFilePaths <- function(xobject) {
42 if (class(xobject) == "xcmsSet")
43 return (xobject@filepaths)
44 if (class(xobject) == "XCMSnExp")
45 return (fileNames(xobject))
46 }
47 equalParams <- function(param1, param2) {
48 writeraw("param1.txt", param1, open="wt")
49 writeraw("param2.txt", param2, open="wt")
50 return(tools::md5sum("param1.txt") == tools::md5sum("param2.txt"))
51 }
24 52
25 53
26 # ----- ARGUMENTS ----- 54 # ----- ARGUMENTS -----
27 55
28 listArguments = parseCommandArgs(evaluate=FALSE) #interpretation of arguments given in command line as an R list of objects 56 args <- parseCommandArgs(evaluate=FALSE) #interpretation of arguments given in command line as an R list of objects
29 57
30 58
31 # ----- ARGUMENTS PROCESSING ----- 59 # ----- ARGUMENTS PROCESSING -----
32 60
33 #image is an .RData file necessary to use xset variable given by previous tools 61 #image is an .RData file necessary to use xset variable given by previous tools
34 load(listArguments[["image"]]); 62 load(args$image);
35 63
36 htmlOutput = "summary.html" 64 htmlOutput <- "summary.html"
37 if (!is.null(listArguments[["htmlOutput"]])) htmlOutput = listArguments[["htmlOutput"]]; 65 if (!is.null(args$htmlOutput)) htmlOutput = args$htmlOutput;
38 66
39 user_email = NULL 67 user_email <- NULL
40 if (!is.null(listArguments[["user_email"]])) user_email = listArguments[["user_email"]]; 68 if (!is.null(args$user_email)) user_email = args$user_email;
41 69
70 # if the RData come from XCMS 1.x
71 if (exists("xset")) xobject <- xset
72 # retrocompatability
73 if (!exists("sampleNamesList")) sampleNamesList <- list("sampleNamesMakeNames"=make.names(sampnames(xobject)))
42 # if the RData come from CAMERA 74 # if the RData come from CAMERA
43 if (!exists("xset") & exists("xa")) xset=xa@xcmsSet 75 if (exists("xa")) xobject <- xa@xcmsSet
44 76 # if the RData come from XCMS 3.x
45 # retrocompatability 77 if (exists("xdata")) xobject <- xdata
46 if (!exists("sampleNamesList")) sampleNamesList=list("sampleNamesMakeNames"=make.names(sampnames(xset))) 78
47 79 if (!exists("xobject")) stop("You need at least a xdata, a xset or a xa object.")
48 if (!exists("xset")) stop("You need at least a xset or a xa object.")
49 80
50 81
51 82
52 # ----- MAIN PROCESSING INFO ----- 83 # ----- MAIN PROCESSING INFO -----
53 writehtml("<!DOCTYPE html>") 84 writehtml("<!DOCTYPE html>")
69 100
70 writehtml("<BODY>") 101 writehtml("<BODY>")
71 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>") 102 writehtml("<div><h1>___ XCMS analysis summary using Workflow4Metabolomics ___</h1>")
72 # to pass the planemo shed_test 103 # to pass the planemo shed_test
73 if (user_email != "test@bx.psu.edu") { 104 if (user_email != "test@bx.psu.edu") {
74 if (!is.null(user_email)) writehtml("By: ",user_email," - ") 105 if (!is.null(user_email)) writehtml("By: ", user_email," - ")
75 writehtml("Date: ",format(Sys.time(), "%y%m%d-%H:%M:%S")) 106 writehtml("Date: ", format(Sys.time(), "%y%m%d-%H:%M:%S"))
76 } 107 }
77 writehtml("</div>") 108 writehtml("</div>")
78 109
79 writehtml("<h2>Samples used:</h2>") 110 writehtml("<h2>Samples used:</h2>")
80 writehtml("<div><table>") 111 writehtml("<div><table>")
81 if (all(sampnames(xset) == sampleNamesList$sampleNamesMakeNames)) { 112 if (all(getSampleNames(xobject) == sampleNamesList$sampleNamesMakeNames)) {
82 sampleNameHeaderHtml = paste("<th>sample</th>") 113 sampleNameHeaderHtml <- paste0("<th>sample</th>")
83 sampleNameHtml = paste("<td>",sampnames(xset),"</td>") 114 sampleNameHtml <- paste0("<td>",getSampleNames(xobject),"</td>")
84 } else { 115 } else {
85 sampleNameHeaderHtml = paste("<th>sample</th><th>sample renamed</th>") 116 sampleNameHeaderHtml <- paste0("<th>sample</th><th>sample renamed</th>")
86 sampleNameHtml = paste("<td>",sampnames(xset),"</td><td>",sampleNamesList$sampleNamesMakeNames,"</td>") 117 sampleNameHtml <- paste0("<td>",getSampleNames(xobject),"</td><td>",sampleNamesList$sampleNamesMakeNames,"</td>")
87 } 118 }
88 119
89 if (!exists("md5sumList")) { 120 if (!exists("md5sumList")) {
90 md5sumHeaderHtml = "" 121 md5sumHeaderHtml <- ""
91 md5sumHtml = "" 122 md5sumHtml <- ""
92 md5sumLegend="" 123 md5sumLegend <- ""
93 } else if (is.null(md5sumList$removalBadCharacters)) { 124 } else if (is.null(md5sumList$removalBadCharacters)) {
94 md5sumHeaderHtml = paste("<th>md5sum<sup>*</sup></th>") 125 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th>")
95 md5sumHtml = paste("<td>",md5sumList$origin,"</td>") 126 md5sumHtml <- paste0("<td>",md5sumList$origin,"</td>")
96 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." 127 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."
97 } else { 128 } else {
98 md5sumHeaderHtml = paste("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>") 129 md5sumHeaderHtml <- paste0("<th>md5sum<sup>*</sup></th><th>md5sum<sup>**</sup> after bad characters removal</th>")
99 md5sumHtml = paste("<td>",md5sumList$origin,"</td><td>",md5sumList$removalBadCharacters,"</td>") 130 md5sumHtml <- paste0("<td>",md5sumList$origin,"</td><td>",md5sumList$removalBadCharacters,"</td>")
100 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/>" 131 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/>"
101 } 132 }
102 133
103 writehtml("<tr>",sampleNameHeaderHtml,"<th>filename</th>",md5sumHeaderHtml,"</tr>") 134 writehtml("<tr>",sampleNameHeaderHtml,"<th>filename</th>",md5sumHeaderHtml,"</tr>")
104 writehtml(paste("<tr>",sampleNameHtml,"<td>",xset@filepaths,"</td>",md5sumHtml,"</tr>")) 135 writehtml(paste0("<tr>",sampleNameHtml,"<td>",getFilePaths(xobject),"</td>",md5sumHtml,"</tr>"))
105 136
106 writehtml("</table>") 137 writehtml("</table>")
107 writehtml(md5sumLegend) 138 writehtml(md5sumLegend)
108 writehtml("</div>") 139 writehtml("</div>")
109 140
110 writehtml("<h2>Function launched:</h2>") 141 writehtml("<h2>Function launched:</h2>")
111 writehtml("<div><table>") 142 writehtml("<div><table>")
112 writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>") 143 writehtml("<tr><th>timestamp<sup>***</sup></th><th>function</th><th>argument</th><th>value</th></tr>")
113 for(tool in names(listOFlistArguments)) { 144 # XCMS 3.x
114 listOFlistArgumentsDisplay=listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)] 145 if (class(xobject) == "XCMSnExp") {
115 146 xcmsFunction <- NULL
116 timestamp = strsplit(tool,"_")[[1]][1] 147 params <- NULL
117 xcmsFunction = strsplit(tool,"_")[[1]][2] 148 for (processHistoryItem in processHistory(xobject)) {
118 writehtml("<tr><td rowspan='",length(listOFlistArgumentsDisplay),"'>",timestamp,"</td><td rowspan='",length(listOFlistArgumentsDisplay),"'>",xcmsFunction,"</td>") 149 if ((xcmsFunction == processType(processHistoryItem)) && equalParams(params, processParam(processHistoryItem)))
119 line_begin="" 150 next
120 for (arg in names(listOFlistArgumentsDisplay)) { 151 timestamp <- processDate(processHistoryItem)
121 writehtml(line_begin,"<td>",arg,"</td><td>",unlist(listOFlistArgumentsDisplay[arg][1]),"</td></tr>") 152 xcmsFunction <- processType(processHistoryItem)
122 line_begin="<tr>" 153 params <- processParam(processHistoryItem)
154 writehtml("<tr><td>",timestamp,"</td><td>",xcmsFunction,"</td><td colspan='2'><pre>")
155 writeraw(htmlOutput, params)
156 writehtml("</pre></td></tr>")
123 } 157 }
124 } 158 }
159 # CAMERA and retrocompatability XCMS 1.x
160 if (exists("listOFlistArguments")) {
161 for(tool in names(listOFlistArguments)) {
162 listOFlistArgumentsDisplay <- listOFlistArguments[[tool]][!(names(listOFlistArguments[[tool]]) %in% argBlacklist)]
163
164 timestamp <- strsplit(tool,"_")[[1]][1]
165 xcmsFunction <- strsplit(tool,"_")[[1]][2]
166 writehtml("<tr><td rowspan='",length(listOFlistArgumentsDisplay),"'>",timestamp,"</td><td rowspan='",length(listOFlistArgumentsDisplay),"'>",xcmsFunction,"</td>")
167 line_begin <- ""
168 for (arg in names(listOFlistArgumentsDisplay)) {
169 writehtml(line_begin,"<td>",arg,"</td><td>",unlist(listOFlistArgumentsDisplay[arg][1]),"</td></tr>")
170 line_begin <- "<tr>"
171 }
172 }
173 }
125 writehtml("</table>") 174 writehtml("</table>")
126 writehtml("<br/><sup>***</sup>timestamp format: yymmdd-hh:mm:ss") 175 writehtml("<br/><sup>***</sup>timestamp format: DD MM dd hh:mm:ss YYYY or yymmdd-hh:mm:ss")
127 writehtml("</div>") 176 writehtml("</div>")
128 177
178 if (class(xobject) == "XCMSnExp") {
179 writehtml("<h2>Informations about the XCMSnExp object:</h2>")
180
181 writehtml("<div><pre>")
182 writeraw(htmlOutput, xobject)
183 writehtml("</pre></div>")
184 }
185
129 writehtml("<h2>Informations about the xcmsSet object:</h2>") 186 writehtml("<h2>Informations about the xcmsSet object:</h2>")
130 187
131 writehtml("<div><pre>") 188 writehtml("<div><pre>")
132 log_file=file(htmlOutput, open = "at") 189 # Get the legacy xcmsSet object
133 sink(log_file) 190 xset <- getxcmsSetObject(xobject)
134 sink(log_file, type = "output") 191 writeraw(htmlOutput, xset)
135 xset
136 sink()
137 writehtml("</pre></div>") 192 writehtml("</pre></div>")
138 193
194 # CAMERA
139 if (exists("xa")) { 195 if (exists("xa")) {
140 writehtml("<h2>Informations about the CAMERA object:</h2>") 196 writehtml("<h2>Informations about the CAMERA object:</h2>")
141 197
142 writehtml("<div>") 198 writehtml("<div>")
143 writehtml("Number of pcgroup: ",length(xa@pspectra)) 199 writehtml("Number of pcgroup: ",length(xa@pspectra))