Mercurial > repos > mmonsoor > probmetab
comparison lib.r @ 0:e13ec2c3fabe draft
planemo upload commit 25fd6a739741295e3f434e0be0286dee61e06825
author | mmonsoor |
---|---|
date | Mon, 04 Jul 2016 04:29:25 -0400 |
parents | |
children | abcfa1648b66 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:e13ec2c3fabe |
---|---|
1 # lib.r ProbMetab version="1.0.0" | |
2 # Author: Misharl Monsoor ABIMS TEAM mmonsoor@sb-roscoff.fr | |
3 # Contributors: Yann Guitton and Jean-francois Martin | |
4 | |
5 | |
6 ##Main probmetab function launch by the Galaxy ProbMetab wrapper | |
7 probmetab = function(xa, xaP, xaN, variableMetadata, variableMetadataP, variableMetadataN, listArguments){ | |
8 ##ONE MODE ACQUISITION## | |
9 if(listArguments[["mode_acquisition"]]=="one") { | |
10 comb=NULL | |
11 | |
12 #Get the polarity from xa object | |
13 polarity=xa@polarity | |
14 #SNR option | |
15 if ("xsetnofill" %in% names(listArguments)) { | |
16 load(listArguments[["xsetnofill"]]) | |
17 xsetnofill=xset | |
18 } | |
19 else{ | |
20 xsetnofill=NULL | |
21 } | |
22 #Exclude samples | |
23 if ("toexclude" %in% names(listArguments)) { | |
24 toexclude=listArguments[["toexclude"]] | |
25 } | |
26 else { | |
27 toexclude=NULL | |
28 } | |
29 ionAnnot=get.annot(xa, polarity=polarity, allowMiss=listArguments[["allowMiss"]],xset=xsetnofill,toexclude=toexclude) | |
30 comb=NULL | |
31 } | |
32 | |
33 ##TWO MODES ACQUISITION## | |
34 #Mode annotatediffreport | |
35 else if(listArguments[["inputs_mode"]]=="two"){ | |
36 ##Prepare the objects that will be used for the get.annot function | |
37 comb=1 | |
38 | |
39 | |
40 xsetPnofill=NULL | |
41 xsetNnofill=NULL | |
42 # TODO: a reactiver | |
43 #if ("xsetPnofill" %in% names(listArguments)) { | |
44 # load(listArguments[["xsetPnofill"]]) | |
45 # xsetPnofill=xset | |
46 #} | |
47 #if ("xsetNnofill" %in% names(listArguments)) { | |
48 # load(listArguments[["xsetNnofill"]]) | |
49 # xsetNnofill=xset | |
50 #} | |
51 # include CAMERA non-annotated compounds, and snr retrieval | |
52 # comb 2+ - used on Table 1 | |
53 ionAnnotP2plus = get.annot(axP, allowMiss=listArguments[["allowMiss"]], xset=xsetPnofill,toexclude=listArguments[["toexclude"]]) | |
54 ionAnnotN2plus = get.annot(axN, polarity="negative", allowMiss=listArguments[["allowMiss"]], xset=xsetNnofill,toexclude=listArguments[["toexclude"]]) | |
55 ionAnnot = combineMolIon(ionAnnotP2plus, ionAnnotN2plus) | |
56 print(sum(ionAnnot$molIon[,3]==1)) | |
57 print(sum(ionAnnot$molIon[,3]==0)) | |
58 write.table(ionAnnot[1], sep="\t", quote=FALSE, row.names=FALSE, file="CombineMolIon.tsv") | |
59 #Merge variableMetadata Negative and positive acquisitions mode | |
60 | |
61 | |
62 #Mode combinexsannos TODO bug avec tableau issus de combinexsannos | |
63 #else { | |
64 #load(listArguments[["image_combinexsannos"]]) | |
65 #image_combinexsannos=cAnnot | |
66 ##Prepare the objects that will be used for the combineMolIon function | |
67 #load(listArguments[["image_pos"]]) | |
68 #image_pos=xa | |
69 #ionAnnot=combineMolIon(peaklist=cAnnot, cameraobj=image_pos, polarity="pos") | |
70 #} | |
71 | |
72 } | |
73 | |
74 ##DATABASE MATCHING## | |
75 if (listArguments[["kegg_db"]]=="KEGG"){ | |
76 DB=build.database.kegg(orgID = NULL) | |
77 } | |
78 else{ | |
79 table_list <<- NULL | |
80 ids=strsplit(listArguments[["kegg_db"]],",") | |
81 ids=ids[[1]] | |
82 if(length(ids)>1){ | |
83 for(i in 1:length(ids)){ | |
84 table_list[[i]] <- build.database.kegg(ids[i]) | |
85 } | |
86 db_table=do.call("rbind",table_list) | |
87 DB=unique(db_table) | |
88 } | |
89 else{ | |
90 DB=build.database.kegg(listArguments[["kegg_db"]]) | |
91 } | |
92 } | |
93 #Matching des mass exactes mesurees avec les masses des compounds KEGG (pas M+H ou M-H) | |
94 reactionM = create.reactionM(DB, ionAnnot, ppm.tol=listArguments[["ppm_tol"]]) | |
95 ##PROBABILITY RANKING## | |
96 # number of masses with candidates inside the fixed mass window | |
97 # and masses with more than one candidate | |
98 length(unique(reactionM[reactionM[,"id"]!="unknown",1])) | |
99 sum(table(reactionM[reactionM[,"id"]!="unknown",1])>1) | |
100 #if (listArguments[["useIso"]]){ | |
101 #BUG TODO | |
102 # Calculate the ratio between observed and theoretical isotopic patterns. | |
103 # If you don't have an assessment of carbon offset to carbon number prediction | |
104 # skip this step and use the reactionM as input to weigthM function. | |
105 #isoPatt < incorporate.isotopes(comb2plus, reactionM, , samp=12:23, DB=DB) | |
106 # calculate the likelihood of each mass to compound assignment using mass accuracy,and isotopic pattern, when present | |
107 #wl < weightM(isoPatt,intervals=seq(0,1000,by=500), offset=c(3.115712, 3.434146, 2.350798)) | |
108 | |
109 #isoPatt=incorporate.isotopes(ionAnnot, reactionM,comb=comb,var=listArguments[["var"]],DB=DB) | |
110 | |
111 #wl = weightM(reactionM, useIso=true) | |
112 #} | |
113 #else { | |
114 #wl = weightM(reactionM, useIso=FALSE) | |
115 #} | |
116 wl =weightM(reactionM, useIso=FALSE) | |
117 w = design.connection(reactionM) | |
118 # Probability calculations | |
119 x = 1:ncol(wl$wm) | |
120 y = 1:nrow(wl$wm) | |
121 conn = gibbs.samp(x, y, 5000, w, wl$wm) | |
122 ansConn = export.class.table(conn, reactionM, ionAnnot, DB=DB,html=listArguments[["html"]],filename="AnalysisExample",prob=listArguments[["prob"]]) | |
123 if(listArguments[["html"]]){ | |
124 #Zip the EICS plot | |
125 system(paste('zip -r "Analysis_Report.zip" "AnalysisExample_fig"')) | |
126 } | |
127 | |
128 # calculate the correlations and partial correlations and cross reference then with reactions | |
129 mw=which(w==1,arr.ind=TRUE) | |
130 #reac2cor function : Use the intensity of putative molecules in repeated samples to calculate correlations and partial | |
131 #correlation in a user defined threshold of false discovery rate for significance testing. After the | |
132 #correlation test the function also overlay significant correlations with all putative reactions between | |
133 #two masses. | |
134 #It generates a list of estimated correlations and reactions. | |
135 corList=reac2cor(mw,ansConn$classTable,listArguments[["opt"]],listArguments[["corths"]],listArguments[["corprob"]],listArguments[["pcorprob"]]) | |
136 ans=list("ansConn"=ansConn,"corList"=corList) | |
137 #Generate the siff table for CytoScape | |
138 cytoscape_output(corList,ansConn) | |
139 | |
140 | |
141 #Execute the merge_probmetab function to merge the variableMetadata table and annotations from ProbMetab results | |
142 | |
143 if(listArguments[["mode_acquisition"]]=="one") { | |
144 #Retrocompatibility with previous annotateDiffreport variableMetadata dataframe (must replace mzmed column by mz, and rtmed by rt) | |
145 names(variableMetadata)[names(variableMetadata)=="mzmed"] <- "mz" | |
146 names(variableMetadata)[names(variableMetadata)=="rtmed"] <- "rt" | |
147 variableM=merge_probmetab(variableMetadata, ansConn) | |
148 write.table(variableM, sep="\t", quote=FALSE, row.names=FALSE, file="variableMetadata.tsv") | |
149 } else if (listArguments[["mode_acquisition"]]=="two") { | |
150 #Retrocompatibility with previous annotateDiffreport variableMetadata dataframe (must replace mzmed column by mz, and rtmed by rt) | |
151 names(variableMetadataP)[names(variableMetadata)=="mzmed"] <- "mz" | |
152 names(variableMetadataP)[names(variableMetadata)=="rtmed"] <- "rt" | |
153 names(variableMetadataN)[names(variableMetadata)=="mzmed"] <- "mz" | |
154 names(variableMetadataN)[names(variableMetadata)=="rtmed"] <- "rt" | |
155 variableMP=merge_probmetab(variableMetadataP, ansConn) | |
156 write.table(variableMP, sep="\t", quote=FALSE, row.names=FALSE, file="variableMetadata_Positive.tsv") | |
157 variableMN=merge_probmetab(variableMetadataN, ansConn) | |
158 write.table(variableMN, sep="\t", quote=FALSE, row.names=FALSE, file="variableMetadata_Negative.tsv") | |
159 } | |
160 | |
161 return(ans) | |
162 | |
163 } | |
164 | |
165 ##Function that generates a siff table for CytoScape | |
166 cytoscape_output=function(corList,ansConn){ | |
167 signif_cor=as.data.frame(corList$signif.cor) | |
168 classTable=as.data.frame(ansConn$classTable) | |
169 #Siff table | |
170 siff_table=cbind(signif_cor["node1"],signif_cor["cor"],signif_cor["node2"]) | |
171 #attribute table output for Cytoscape | |
172 | |
173 ## START Code part from the export2cytoscape function of ProbMetab written by Ricardo R. Silva | |
174 for (i in 1:nrow(classTable)) if (classTable[i, 1] == ""){ | |
175 classTable[i, c(1, 4, 6, 7)] <- classTable[i - 1, c(1, 4, 6, 7)] | |
176 } | |
177 msel <- as.matrix(classTable[, 1:7]) | |
178 msel <- cbind(msel[, 6], msel[,-6]) | |
179 colnames(msel)[1] <- "Id" | |
180 msel[, 1] <- sub("^\\s+", "", msel[, 1]) | |
181 colnames(msel)[1] <- "Id" | |
182 ids <- unique(msel[, 1]) | |
183 attrMatrix <- matrix("", nrow = length(ids), ncol = ncol(msel)-1) | |
184 for (i in 1:length(ids)) { | |
185 attrMatrix[i, 1] <- unique(msel[msel[, 1] == ids[i], | |
186 2]) | |
187 attrMatrix[i, 2] <- paste("[", paste(msel[msel[, | |
188 1] == ids[i], 3], collapse = ", "), "]", sep = "") | |
189 attrMatrix[i, 3] <- paste("[", paste(msel[msel[, | |
190 1] == ids[i], 4], collapse = ", "), "]", sep = "") | |
191 attrMatrix[i, 4] <- unique(msel[msel[, 1] == ids[i], | |
192 5]) | |
193 attrMatrix[i, 5] <- paste("[", paste(msel[msel[, | |
194 1] == ids[i], 6], collapse = ", "), "]", sep = "") | |
195 attrMatrix[i, 6] <- unique(msel[msel[, 1] == ids[i], | |
196 7]) | |
197 } | |
198 ids <- as.numeric(unique(msel[, 1])) | |
199 attrMatrix <- cbind(ids, attrMatrix) | |
200 colnames(attrMatrix) <- colnames(msel) | |
201 ## END Code part from the export2cytoscape function of ProbMetab writieen by Ricardo R. Silva | |
202 write.table(attrMatrix, sep="\t", quote=FALSE, row.names=FALSE, file="Analysis_Report.tsv") | |
203 write.table(siff_table, sep="\t", quote=FALSE, row.names=FALSE, file="sif.tsv") | |
204 | |
205 return(attrMatrix) | |
206 } | |
207 | |
208 ##Functions written by Jean-Francois Martin | |
209 | |
210 deter_ioni <- function (aninfo, pm) | |
211 { | |
212 # determine ionisation in ProbMetab result file, used in function merge_probmetab | |
213 # input : for 1 ion, aninfo = string with m/z rt and CAMERA annotation from ProbMetab result file | |
214 # if the difference between m/z and the probmetab proposed mass is ~1 we use the sign (positive or negative) of this diference | |
215 # to define the type of ionisation | |
216 # If adduct or fragment was detected, therefore diff >>1 and so, we search for substring "+" ou "2+" ou "3+" ou "-"... | |
217 # to define the type of ionisation | |
218 # aninfo : vecteur of character resulting of the parsing(sep="#") of the probmetab annotation | |
219 if (round(abs(as.numeric(aninfo[1]) - pm),0) ==1) { | |
220 if (as.numeric(aninfo[1]) - pm <0) {esi <- "n"} else {esi <- "p"} | |
221 } else | |
222 if (!is.na(aninfo[4])) { | |
223 anstr <- aninfo[4] | |
224 # cat(anstr) | |
225 if ((grepl("]+",anstr,fixed=T)==T) || (grepl("]2+",anstr,fixed=T)==T) || (grepl("]3+",anstr,fixed=T)==T)) { esi <- "p"} | |
226 else | |
227 if ((grepl("]-",anstr,fixed=T)==T) || (grepl("]2-",anstr,fixed=T)==T) || (grepl("]3-",anstr,fixed=T)==T)) { esi <- "n"} | |
228 # cat(" ioni ",esi,"\n") | |
229 } else | |
230 { esi <- "u"} | |
231 | |
232 return(esi) | |
233 } | |
234 | |
235 | |
236 merge_probmetab <- function(metaVar,ansConn) { | |
237 ## Parse ProbMetab information result file and merge in variable_metaData initial file | |
238 ## inputs : | |
239 ## metaVar : data.frame of metadataVariable input of probmetab function | |
240 ## ansConn : data.frame of ProbMetab result | |
241 ## output : dataframe with Probmetab results merge with variableMetadata | |
242 ## Constante | |
243 ## iannot : indice de la colonne annotation dans le resultat de probMetab | |
244 iannot <- 4 | |
245 | |
246 ## definition of an unique identification of ions mz with 3 decimals and rt(sec) with 1 decimal to avoid | |
247 ## duplicate ions name in the diffreport result file | |
248 ions <- paste ("M",round(metaVar$mz,3),"T",round(metaVar$rt,1),sep="") | |
249 metaVar <- data.frame(ions,metaVar) | |
250 | |
251 ###### Result data.frame from ProbMetab result list | |
252 an_ini <- ansConn$classTable | |
253 | |
254 ## Suppression of rows without mz and rt or unknown and columns of intensities | |
255 ## COLUMNS SUBSCRIPTS HAVE TO BE CHECKED WITh DIFFERENT RESULTS FILES | |
256 an <- an_ini[(an_ini[,2]!="unknown"),c(1,2,3,7)] | |
257 ## initialisation of vectors receiving the result of the parse of the column annotation (subscrip iannot) | |
258 mz <- rep(0,dim(an)[1]) | |
259 rt <- rep(0,dim(an)[1]) | |
260 propmz <- rep(0,dim(an)[1]) | |
261 ioni <- rep("u",dim(an)[1]) | |
262 | |
263 ## parse the column annotation and define ionisation mode | |
264 for (i in 1:dim(an)[1]) { | |
265 if (an[i,1] != "") { | |
266 info_mzrt <- unlist(strsplit(an[i,iannot],"#")) | |
267 propmz[i] <- as.numeric(an[i,1]) | |
268 mz[i] <- as.numeric(info_mzrt[1]) | |
269 rt[i] <- as.numeric(info_mzrt[2]) | |
270 ioni[i] <- deter_ioni(info_mzrt,as.numeric(an[i,1])) | |
271 } | |
272 else { | |
273 propmz[i] <- as.numeric(propmz[i-1]) | |
274 mz[i] <- as.numeric(mz[i-1]) | |
275 rt[i] <- as.numeric(rt[i-1]) | |
276 ioni[i] <- ioni[i-1] | |
277 } | |
278 } | |
279 | |
280 ## definition of an unique identification of ions : mz with 3 decimals and rt(sec) with 1 decimal | |
281 ## The same as for the metadataVariable data.frame to match with. | |
282 ions <- paste ("M",round(mz,3),"T",round(rt,1),sep="") | |
283 an <- data.frame(ions,ioni,propmz,mz,rt,an) | |
284 | |
285 ## transposition of the different probmetab annotations which are in different rows in the initial result data.frame | |
286 ## on only 1 row separated with a ";" | |
287 li <- as.matrix(table(an$propmz)) | |
288 li <- data.frame(dimnames(li)[1],li) | |
289 dimnames(li)[[2]][1] <- "propmz" | |
290 ions <- rep("u",dim(li)[1]) | |
291 propmz <- rep(0,dim(li)[1]) | |
292 mpc <- rep("c",dim(li)[1]) | |
293 proba <- rep("p",dim(li)[1]) | |
294 c <- 0 | |
295 while (c < dim(li)[1]) { | |
296 c <- c + 1 | |
297 suban <- an[an$propmz==li[c,1],] | |
298 ions[c] <- as.character(suban[1,1]) | |
299 propmz[c] <- as.numeric(suban[1,3]) | |
300 mpc[c] <- paste(suban[,7],collapse=";") | |
301 proba[c] <- paste(as.character(suban[,8]),collapse=";") | |
302 } | |
303 | |
304 ## Creation of the data.frame with 1 row per ions | |
305 anc <- data.frame(ions,propmz,mpc,proba) | |
306 anc <- anc[order(anc[,1]),] | |
307 | |
308 metaVarFinal <- merge(metaVar, anc, by.x=1, by.y=1, all.x=T, all.y=T) | |
309 metaVarFinal <- metaVarFinal[,-1] | |
310 #write.table(metaVarFinal,file="res.txt", sep="\t", row.names=F, quote=F) | |
311 | |
312 return (metaVarFinal) | |
313 } | |
314 | |
315 # RETROCOMPATIBILITE avec ancienne version de annotate | |
316 getVariableMetadata = function(xa) { | |
317 # --- variableMetadata --- | |
318 peakList=getPeaklist(xa) | |
319 peakList=cbind(groupnames(xa@xcmsSet),peakList); colnames(peakList)[1] = c("name"); | |
320 variableMetadata=peakList[,!(colnames(peakList) %in% c(sampnames(xa@xcmsSet)))] | |
321 variableMetadata$name= paste("M",round(variableMetadata$mz),"T",round(variableMetadata$rt),sep="") | |
322 return (variableMetadata) | |
323 } |