Mercurial > repos > lecorguille > xcms_summary

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