Mercurial > repos > mmonsoor > probmetab
view lib.r @ 0:e13ec2c3fabe draft
planemo upload commit 25fd6a739741295e3f434e0be0286dee61e06825
author | mmonsoor |
---|---|
date | Mon, 04 Jul 2016 04:29:25 -0400 |
parents | |
children | abcfa1648b66 |
line wrap: on
line source
# lib.r ProbMetab version="1.0.0" # Author: Misharl Monsoor ABIMS TEAM mmonsoor@sb-roscoff.fr # Contributors: Yann Guitton and Jean-francois Martin ##Main probmetab function launch by the Galaxy ProbMetab wrapper probmetab = function(xa, xaP, xaN, variableMetadata, variableMetadataP, variableMetadataN, listArguments){ ##ONE MODE ACQUISITION## if(listArguments[["mode_acquisition"]]=="one") { comb=NULL #Get the polarity from xa object polarity=xa@polarity #SNR option if ("xsetnofill" %in% names(listArguments)) { load(listArguments[["xsetnofill"]]) xsetnofill=xset } else{ xsetnofill=NULL } #Exclude samples if ("toexclude" %in% names(listArguments)) { toexclude=listArguments[["toexclude"]] } else { toexclude=NULL } ionAnnot=get.annot(xa, polarity=polarity, allowMiss=listArguments[["allowMiss"]],xset=xsetnofill,toexclude=toexclude) comb=NULL } ##TWO MODES ACQUISITION## #Mode annotatediffreport else if(listArguments[["inputs_mode"]]=="two"){ ##Prepare the objects that will be used for the get.annot function comb=1 xsetPnofill=NULL xsetNnofill=NULL # TODO: a reactiver #if ("xsetPnofill" %in% names(listArguments)) { # load(listArguments[["xsetPnofill"]]) # xsetPnofill=xset #} #if ("xsetNnofill" %in% names(listArguments)) { # load(listArguments[["xsetNnofill"]]) # xsetNnofill=xset #} # include CAMERA non-annotated compounds, and snr retrieval # comb 2+ - used on Table 1 ionAnnotP2plus = get.annot(axP, allowMiss=listArguments[["allowMiss"]], xset=xsetPnofill,toexclude=listArguments[["toexclude"]]) ionAnnotN2plus = get.annot(axN, polarity="negative", allowMiss=listArguments[["allowMiss"]], xset=xsetNnofill,toexclude=listArguments[["toexclude"]]) ionAnnot = combineMolIon(ionAnnotP2plus, ionAnnotN2plus) print(sum(ionAnnot$molIon[,3]==1)) print(sum(ionAnnot$molIon[,3]==0)) write.table(ionAnnot[1], sep="\t", quote=FALSE, row.names=FALSE, file="CombineMolIon.tsv") #Merge variableMetadata Negative and positive acquisitions mode #Mode combinexsannos TODO bug avec tableau issus de combinexsannos #else { #load(listArguments[["image_combinexsannos"]]) #image_combinexsannos=cAnnot ##Prepare the objects that will be used for the combineMolIon function #load(listArguments[["image_pos"]]) #image_pos=xa #ionAnnot=combineMolIon(peaklist=cAnnot, cameraobj=image_pos, polarity="pos") #} } ##DATABASE MATCHING## if (listArguments[["kegg_db"]]=="KEGG"){ DB=build.database.kegg(orgID = NULL) } else{ table_list <<- NULL ids=strsplit(listArguments[["kegg_db"]],",") ids=ids[[1]] if(length(ids)>1){ for(i in 1:length(ids)){ table_list[[i]] <- build.database.kegg(ids[i]) } db_table=do.call("rbind",table_list) DB=unique(db_table) } else{ DB=build.database.kegg(listArguments[["kegg_db"]]) } } #Matching des mass exactes mesurees avec les masses des compounds KEGG (pas M+H ou M-H) reactionM = create.reactionM(DB, ionAnnot, ppm.tol=listArguments[["ppm_tol"]]) ##PROBABILITY RANKING## # number of masses with candidates inside the fixed mass window # and masses with more than one candidate length(unique(reactionM[reactionM[,"id"]!="unknown",1])) sum(table(reactionM[reactionM[,"id"]!="unknown",1])>1) #if (listArguments[["useIso"]]){ #BUG TODO # Calculate the ratio between observed and theoretical isotopic patterns. # If you don't have an assessment of carbon offset to carbon number prediction # skip this step and use the reactionM as input to weigthM function. #isoPatt < incorporate.isotopes(comb2plus, reactionM, , samp=12:23, DB=DB) # calculate the likelihood of each mass to compound assignment using mass accuracy,and isotopic pattern, when present #wl < weightM(isoPatt,intervals=seq(0,1000,by=500), offset=c(3.115712, 3.434146, 2.350798)) #isoPatt=incorporate.isotopes(ionAnnot, reactionM,comb=comb,var=listArguments[["var"]],DB=DB) #wl = weightM(reactionM, useIso=true) #} #else { #wl = weightM(reactionM, useIso=FALSE) #} wl =weightM(reactionM, useIso=FALSE) w = design.connection(reactionM) # Probability calculations x = 1:ncol(wl$wm) y = 1:nrow(wl$wm) conn = gibbs.samp(x, y, 5000, w, wl$wm) ansConn = export.class.table(conn, reactionM, ionAnnot, DB=DB,html=listArguments[["html"]],filename="AnalysisExample",prob=listArguments[["prob"]]) if(listArguments[["html"]]){ #Zip the EICS plot system(paste('zip -r "Analysis_Report.zip" "AnalysisExample_fig"')) } # calculate the correlations and partial correlations and cross reference then with reactions mw=which(w==1,arr.ind=TRUE) #reac2cor function : Use the intensity of putative molecules in repeated samples to calculate correlations and partial #correlation in a user defined threshold of false discovery rate for significance testing. After the #correlation test the function also overlay significant correlations with all putative reactions between #two masses. #It generates a list of estimated correlations and reactions. corList=reac2cor(mw,ansConn$classTable,listArguments[["opt"]],listArguments[["corths"]],listArguments[["corprob"]],listArguments[["pcorprob"]]) ans=list("ansConn"=ansConn,"corList"=corList) #Generate the siff table for CytoScape cytoscape_output(corList,ansConn) #Execute the merge_probmetab function to merge the variableMetadata table and annotations from ProbMetab results if(listArguments[["mode_acquisition"]]=="one") { #Retrocompatibility with previous annotateDiffreport variableMetadata dataframe (must replace mzmed column by mz, and rtmed by rt) names(variableMetadata)[names(variableMetadata)=="mzmed"] <- "mz" names(variableMetadata)[names(variableMetadata)=="rtmed"] <- "rt" variableM=merge_probmetab(variableMetadata, ansConn) write.table(variableM, sep="\t", quote=FALSE, row.names=FALSE, file="variableMetadata.tsv") } else if (listArguments[["mode_acquisition"]]=="two") { #Retrocompatibility with previous annotateDiffreport variableMetadata dataframe (must replace mzmed column by mz, and rtmed by rt) names(variableMetadataP)[names(variableMetadata)=="mzmed"] <- "mz" names(variableMetadataP)[names(variableMetadata)=="rtmed"] <- "rt" names(variableMetadataN)[names(variableMetadata)=="mzmed"] <- "mz" names(variableMetadataN)[names(variableMetadata)=="rtmed"] <- "rt" variableMP=merge_probmetab(variableMetadataP, ansConn) write.table(variableMP, sep="\t", quote=FALSE, row.names=FALSE, file="variableMetadata_Positive.tsv") variableMN=merge_probmetab(variableMetadataN, ansConn) write.table(variableMN, sep="\t", quote=FALSE, row.names=FALSE, file="variableMetadata_Negative.tsv") } return(ans) } ##Function that generates a siff table for CytoScape cytoscape_output=function(corList,ansConn){ signif_cor=as.data.frame(corList$signif.cor) classTable=as.data.frame(ansConn$classTable) #Siff table siff_table=cbind(signif_cor["node1"],signif_cor["cor"],signif_cor["node2"]) #attribute table output for Cytoscape ## START Code part from the export2cytoscape function of ProbMetab written by Ricardo R. Silva for (i in 1:nrow(classTable)) if (classTable[i, 1] == ""){ classTable[i, c(1, 4, 6, 7)] <- classTable[i - 1, c(1, 4, 6, 7)] } msel <- as.matrix(classTable[, 1:7]) msel <- cbind(msel[, 6], msel[,-6]) colnames(msel)[1] <- "Id" msel[, 1] <- sub("^\\s+", "", msel[, 1]) colnames(msel)[1] <- "Id" ids <- unique(msel[, 1]) attrMatrix <- matrix("", nrow = length(ids), ncol = ncol(msel)-1) for (i in 1:length(ids)) { attrMatrix[i, 1] <- unique(msel[msel[, 1] == ids[i], 2]) attrMatrix[i, 2] <- paste("[", paste(msel[msel[, 1] == ids[i], 3], collapse = ", "), "]", sep = "") attrMatrix[i, 3] <- paste("[", paste(msel[msel[, 1] == ids[i], 4], collapse = ", "), "]", sep = "") attrMatrix[i, 4] <- unique(msel[msel[, 1] == ids[i], 5]) attrMatrix[i, 5] <- paste("[", paste(msel[msel[, 1] == ids[i], 6], collapse = ", "), "]", sep = "") attrMatrix[i, 6] <- unique(msel[msel[, 1] == ids[i], 7]) } ids <- as.numeric(unique(msel[, 1])) attrMatrix <- cbind(ids, attrMatrix) colnames(attrMatrix) <- colnames(msel) ## END Code part from the export2cytoscape function of ProbMetab writieen by Ricardo R. Silva write.table(attrMatrix, sep="\t", quote=FALSE, row.names=FALSE, file="Analysis_Report.tsv") write.table(siff_table, sep="\t", quote=FALSE, row.names=FALSE, file="sif.tsv") return(attrMatrix) } ##Functions written by Jean-Francois Martin deter_ioni <- function (aninfo, pm) { # determine ionisation in ProbMetab result file, used in function merge_probmetab # input : for 1 ion, aninfo = string with m/z rt and CAMERA annotation from ProbMetab result file # if the difference between m/z and the probmetab proposed mass is ~1 we use the sign (positive or negative) of this diference # to define the type of ionisation # If adduct or fragment was detected, therefore diff >>1 and so, we search for substring "+" ou "2+" ou "3+" ou "-"... # to define the type of ionisation # aninfo : vecteur of character resulting of the parsing(sep="#") of the probmetab annotation if (round(abs(as.numeric(aninfo[1]) - pm),0) ==1) { if (as.numeric(aninfo[1]) - pm <0) {esi <- "n"} else {esi <- "p"} } else if (!is.na(aninfo[4])) { anstr <- aninfo[4] # cat(anstr) if ((grepl("]+",anstr,fixed=T)==T) || (grepl("]2+",anstr,fixed=T)==T) || (grepl("]3+",anstr,fixed=T)==T)) { esi <- "p"} else if ((grepl("]-",anstr,fixed=T)==T) || (grepl("]2-",anstr,fixed=T)==T) || (grepl("]3-",anstr,fixed=T)==T)) { esi <- "n"} # cat(" ioni ",esi,"\n") } else { esi <- "u"} return(esi) } merge_probmetab <- function(metaVar,ansConn) { ## Parse ProbMetab information result file and merge in variable_metaData initial file ## inputs : ## metaVar : data.frame of metadataVariable input of probmetab function ## ansConn : data.frame of ProbMetab result ## output : dataframe with Probmetab results merge with variableMetadata ## Constante ## iannot : indice de la colonne annotation dans le resultat de probMetab iannot <- 4 ## definition of an unique identification of ions mz with 3 decimals and rt(sec) with 1 decimal to avoid ## duplicate ions name in the diffreport result file ions <- paste ("M",round(metaVar$mz,3),"T",round(metaVar$rt,1),sep="") metaVar <- data.frame(ions,metaVar) ###### Result data.frame from ProbMetab result list an_ini <- ansConn$classTable ## Suppression of rows without mz and rt or unknown and columns of intensities ## COLUMNS SUBSCRIPTS HAVE TO BE CHECKED WITh DIFFERENT RESULTS FILES an <- an_ini[(an_ini[,2]!="unknown"),c(1,2,3,7)] ## initialisation of vectors receiving the result of the parse of the column annotation (subscrip iannot) mz <- rep(0,dim(an)[1]) rt <- rep(0,dim(an)[1]) propmz <- rep(0,dim(an)[1]) ioni <- rep("u",dim(an)[1]) ## parse the column annotation and define ionisation mode for (i in 1:dim(an)[1]) { if (an[i,1] != "") { info_mzrt <- unlist(strsplit(an[i,iannot],"#")) propmz[i] <- as.numeric(an[i,1]) mz[i] <- as.numeric(info_mzrt[1]) rt[i] <- as.numeric(info_mzrt[2]) ioni[i] <- deter_ioni(info_mzrt,as.numeric(an[i,1])) } else { propmz[i] <- as.numeric(propmz[i-1]) mz[i] <- as.numeric(mz[i-1]) rt[i] <- as.numeric(rt[i-1]) ioni[i] <- ioni[i-1] } } ## definition of an unique identification of ions : mz with 3 decimals and rt(sec) with 1 decimal ## The same as for the metadataVariable data.frame to match with. ions <- paste ("M",round(mz,3),"T",round(rt,1),sep="") an <- data.frame(ions,ioni,propmz,mz,rt,an) ## transposition of the different probmetab annotations which are in different rows in the initial result data.frame ## on only 1 row separated with a ";" li <- as.matrix(table(an$propmz)) li <- data.frame(dimnames(li)[1],li) dimnames(li)[[2]][1] <- "propmz" ions <- rep("u",dim(li)[1]) propmz <- rep(0,dim(li)[1]) mpc <- rep("c",dim(li)[1]) proba <- rep("p",dim(li)[1]) c <- 0 while (c < dim(li)[1]) { c <- c + 1 suban <- an[an$propmz==li[c,1],] ions[c] <- as.character(suban[1,1]) propmz[c] <- as.numeric(suban[1,3]) mpc[c] <- paste(suban[,7],collapse=";") proba[c] <- paste(as.character(suban[,8]),collapse=";") } ## Creation of the data.frame with 1 row per ions anc <- data.frame(ions,propmz,mpc,proba) anc <- anc[order(anc[,1]),] metaVarFinal <- merge(metaVar, anc, by.x=1, by.y=1, all.x=T, all.y=T) metaVarFinal <- metaVarFinal[,-1] #write.table(metaVarFinal,file="res.txt", sep="\t", row.names=F, quote=F) return (metaVarFinal) } # RETROCOMPATIBILITE avec ancienne version de annotate getVariableMetadata = function(xa) { # --- variableMetadata --- peakList=getPeaklist(xa) peakList=cbind(groupnames(xa@xcmsSet),peakList); colnames(peakList)[1] = c("name"); variableMetadata=peakList[,!(colnames(peakList) %in% c(sampnames(xa@xcmsSet)))] variableMetadata$name= paste("M",round(variableMetadata$mz),"T",round(variableMetadata$rt),sep="") return (variableMetadata) }