Mercurial > repos > prog > lcmsmatching
changeset 0:e66bb061af06 draft
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit 3529b25417f8e1a5836474c9adec4b696d35099d-dirty
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/BiodbConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,78 @@ +if ( ! exists('BiodbConn')) { # Do not load again if already loaded + + source(file.path('UrlRequestScheduler.R'), chdir = TRUE) + source('biodb-common.R') + + ##################### + # CLASS DECLARATION # + ##################### + + BiodbConn <- setRefClass("BiodbConn", fields = list(.scheduler = "UrlRequestScheduler")) + + ############### + # CONSTRUCTOR # + ############### + + BiodbConn$methods( initialize = function(useragent = NA_character_, scheduler = NULL, ...) { + + # Check useragent + ! is.null(useragent) && ! is.na(useragent) || stop("You must specify a valid useragent.") + + # Set scheduler + if (is.null(scheduler)) + scheduler <- UrlRequestScheduler$new(n = 3) + inherits(scheduler, "UrlRequestScheduler") || stop("The scheduler instance must inherit from UrlRequestScheduler class.") + scheduler$setUserAgent(useragent) # set agent + .scheduler <<- scheduler + + callSuper(...) # calls super-class initializer with remaining parameters + }) + + ###################### + # HANDLES ENTRY TYPE # + ###################### + + BiodbConn$methods( handlesEntryType = function(type) { + return( ! is.null(.self$getEntryContentType(type))) + }) + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + BiodbConn$methods( getEntryContentType = function(type) { + stop("Method getEntryContentType() is not implemented in concrete class.") + }) + + ############# + # GET ENTRY # + ############# + + BiodbConn$methods( getEntry = function(type, id, drop = TRUE) { + content <- .self$getEntryContent(type, id) + return(.self$createEntry(type, content, drop = drop)) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + # Download entry content from the public database. + # type The entry type. + # id The ID of the enttry to get. + # RETURN An entry content downloaded from database. + BiodbConn$methods( getEntryContent = function(type, id) { + stop("Method getCompound() is not implemented in concrete class.") + }) + + ############################# + # CREATE ENTRY FROM CONTENT # + ############################# + + # Creates a Compound instance from file content. + # content A file content, downloaded from the public database. + # RETURN A compound instance. + BiodbConn$methods( createEntry = function(type, content, drop = TRUE) { + stop("Method createEntry() is not implemented in concrete class.") + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/BiodbEntry.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,125 @@ +if ( ! exists('BiodbEntry')) { # Do not load again if already loaded + + source('biodb-common.R') + + ######################## + # ENTRY ABSTRACT CLASS # + ######################## + + BiodbEntry <- setRefClass("BiodbEntry", fields = list(.fields ='list', .factory = "ANY")) + + ############### + # CONSTRUCTOR # + ############### + + BiodbEntry$methods( initialize = function(...) { + + .fields <<- list() + .factory <<- NULL + + callSuper(...) # calls super-class initializer with remaining parameters + }) + + ############# + # SET FIELD # + ############# + + BiodbEntry$methods( setField = function(field, value) { + + class = .self$getFieldClass(field) + + # Check cardinality + if (class != 'data.frame' && .self$getFieldCardinality(field) == RBIODB.CARD.ONE && length(value) > 1) + stop(paste0('Cannot set more that one value to single value field "', field, '" in BiodEntry.')) + + # Check value class + value <- switch(class, + 'character' = as.character(value), + 'double' = as.double(value), + 'integer' = as.integer(value), + 'logical' = as.logical(value), + value) + # TODO check value class + + .self$.fields[[field]] <- value + }) + + ################### + # GET FIELD CLASS # + ################### + + BiodbEntry$methods( getFieldClass = function(field) { + + if ( ! field %in% RBIODB.FIELDS[['name']]) + stop(paste0('Unknown field "', field, '" in BiodEntry.')) + + field.class <- RBIODB.FIELDS[which(field == RBIODB.FIELDS[['name']]), 'class'] + + return(field.class) + }) + + ######################### + # GET FIELD CARDINALITY # + ######################### + + BiodbEntry$methods( getFieldCardinality = function(field) { + + if ( ! field %in% RBIODB.FIELDS[['name']]) + stop(paste0('Unknown field "', field, '" in BiodEntry.')) + + field.card <- RBIODB.FIELDS[which(field == RBIODB.FIELDS[['name']]), 'cardinality'] + + return(field.card) + }) + + ############# + # GET FIELD # + ############# + + BiodbEntry$methods( getField = function(field) { + + if ( ! field %in% RBIODB.FIELDS[['name']]) + stop(paste0('Unknown field "', field, '" in BiodEntry.')) + + if (field %in% names(.self$.fields)) + return(.self$.fields[[field]]) + else if (.self$.compute.field(field)) + return(.self$.fields[[field]]) + + # Return NULL or NA + class = .self$getFieldClass(field) + return(if (class %in% c('character', 'integer', 'double', 'logical')) as.vector(NA, mode = class) else NULL) + }) + + ################# + # COMPUTE FIELD # + ################## + + BiodbEntry$methods( .compute.field = function(field) { + + if ( ! is.null(.self$.factory) && field %in% names(RBIODB.FIELD.COMPUTING)) { + for (db in RBIODB.FIELD.COMPUTING[[field]]) { + db.id <- .self$getField(paste0(db, 'id')) + if ( ! is.na(db.id)) { + db.compound <- .self$.factory$createEntry(db, type = RBIODB.COMPOUND, id = db.id) + if ( ! is.null(db.compound)) { + .self$setField(field, db.compound$getField(field)) + return(TRUE) + } + } + } + } + + return(FALSE) + }) + + ########### + # FACTORY # + ########### + + BiodbEntry$methods( setFactory = function(factory) { + + is.null(factory) || inherits(factory, "BiodbFactory") || stop("The factory instance must inherit from BiodbFactory class.") + .factory <<- factory + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/BiodbFactory.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,183 @@ +if ( ! exists('BiodbFactory')) { # Do not load again if already loaded + + library(methods) + source('ChebiConn.R') + source('KeggConn.R') + source('PubchemConn.R') + source('HmdbConn.R') + source('ChemspiderConn.R') + source('EnzymeConn.R') + source('LipidmapsConn.R') + source('MirbaseConn.R') + source('NcbigeneConn.R') + source('NcbiccdsConn.R') + source('UniprotConn.R') + source('MassbankConn.R') + + ##################### + # CLASS DECLARATION # + ##################### + + BiodbFactory <- setRefClass("BiodbFactory", fields = list(.useragent = "character", .conn = "list", .cache.dir = "character")) + + ############### + # CONSTRUCTOR # + ############### + + BiodbFactory$methods( initialize = function(useragent = NA_character_, cache.dir = NA_character_, ...) { + + ( ! is.null(useragent) && ! is.na(useragent)) || stop("You must provide a user agent string (e.g.: \"myapp ; my.email@address\").") + .useragent <<- useragent + .conn <<- list() + .cache.dir <<- cache.dir + + callSuper(...) # calls super-class initializer with remaining parameters + }) + + ################## + # GET USER AGENT # + ################## + + BiodbFactory$methods( getUserAgent = function() { + return(.self$.useragent) + }) + + ############ + # GET CONN # + ############ + + BiodbFactory$methods( getConn = function(class) { + + if ( ! class %in% names(.self$.conn)) { + + # Create connection instance + conn <- switch(class, + chebi = ChebiConn$new(useragent = .self$.useragent), + kegg = KeggConn$new(useragent = .self$.useragent), + pubchem = PubchemConn$new(useragent = .self$.useragent), + hmdb = HmdbConn$new(useragent = .self$.useragent), + chemspider = ChemspiderConn$new(useragent = .self$.useragent), + enzyme = EnzymeConn$new(useragent = .self$.useragent), + lipidmaps = LipidmapsConn$new(useragent = .self$.useragent), + mirbase = MirbaseConn$new(useragent = .self$.useragent), + ncbigene = NcbigeneConn$new(useragent = .self$.useragent), + ncbiccds = NcbiccdsConn$new(useragent = .self$.useragent), + uniprot = UniprotConn$new(useragent = .self$.useragent), + massbank = MassbankConn$new(useragent = .self$.useragent), + NULL) + + # Unknown class + if (is.null(conn)) + stop(paste0("Unknown r-biodb class \"", class,"\".")) + + .self$.conn[[class]] <- conn + } + + return (.self$.conn[[class]]) + }) + + ################ + # CREATE ENTRY # + ################ + + BiodbFactory$methods( createEntry = function(class, type, id = NULL, content = NULL, drop = TRUE) { + + is.null(id) && is.null(content) && stop("One of id or content must be set.") + ! is.null(id) && ! is.null(content) && stop("id and content cannot be both set.") + + # Get content + if ( ! is.null(id)) + content <- .self$getEntryContent(class, type, id) + + conn <- .self$getConn(class) + entry <- conn$createEntry(type = type, content = content, drop = drop) + + # Set factory + for (e in c(entry)) + e$setFactory(.self) + + return(entry) + }) + + ######################## + # GET CACHE FILE PATHS # + ######################## + + BiodbFactory$methods( .get.cache.file.paths = function(class, type, id) { + + # Get extension + ext <- .self$getConn(class)$getEntryContentType(type) + + # Set filenames + filenames <- vapply(id, function(x) paste0(class, '-', type, '-', x, '.', ext), FUN.VALUE = '') + + # set file paths + file.paths <- vapply(filenames, function(x) file.path(.self$.cache.dir, x), FUN.VALUE = '') + + # Create cache dir if needed + if ( ! is.na(.self$.cache.dir) && ! file.exists(.self$.cache.dir)) + dir.create(.self$.cache.dir) + + return(file.paths) + }) + + ########################### + # LOAD CONTENT FROM CACHE # + ########################### + + BiodbFactory$methods( .load.content.from.cache = function(class, type, id) { + + content <- NULL + + # Read contents from files + file.paths <- .self$.get.cache.file.paths(class, type, id) + content <- lapply(file.paths, function(x) { if (file.exists(x)) paste(readLines(x), collapse = "\n") else NULL }) + + return(content) + }) + + ######################### + # SAVE CONTENT TO CACHE # + ######################### + + BiodbFactory$methods( .save.content.to.cache = function(class, type, id, content) { + + # Write contents into files + file.paths <- .self$.get.cache.file.paths(class, type, id) + mapply(function(c, f) { if ( ! is.null(c)) writeLines(c, f) }, content, file.paths) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + BiodbFactory$methods( getEntryContent = function(class, type, id) { + + content <- NULL + # Load from cache + if ( ! is.na(.self$.cache.dir)) + content <- .self$.load.content.from.cache(class, type, id) + + # Get contents + missing.content.indexes <- vapply(content, is.null, FUN.VALUE = TRUE) + missing.ids <- if (is.null(content)) id else id[missing.content.indexes] + if (length(missing.ids) > 0) { + + # Use connector to get missing contents + conn <- .self$getConn(class) + missing.contents <- conn$getEntryContent(type, missing.ids) + + # Save to cache + if ( ! is.null(missing.contents) && ! is.na(.self$.cache.dir)) + .self$.save.content.to.cache(class, type, missing.ids, missing.contents) + + # Merge content and missing.contents + if (is.null(content)) + content <- missing.contents + else + content[missing.content.indexes] <- missing.contents + } + + return(content) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ChebiCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,61 @@ +if ( ! exists('ChebiCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + ChebiCompound <- setRefClass("ChebiCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createChebiCompoundFromHtml <- function(contents, drop = TRUE) { + + library(XML) + + compounds <- list() + + # Define xpath expressions + xpath.expr <- character() +# xpath.expr[[RBIODB.ACCESSION]] <- "//b[starts-with(., 'CHEBI:')]" + xpath.expr[[RBIODB.INCHI]] <- "//td[starts-with(., 'InChI=')]" + xpath.expr[[RBIODB.INCHIKEY]] <- "//td[text()='InChIKey']/../td[2]" + + for (html in contents) { + + # Create instance + compound <- ChebiCompound$new() + + # Parse HTML + xml <- htmlTreeParse(html, asText = TRUE, useInternalNodes = TRUE) + + # Test generic xpath expressions + for (field in names(xpath.expr)) { + v <- xpathSApply(xml, xpath.expr[[field]], xmlValue) + if (length(v) > 0) + compound$setField(field, v) + } + + # Get accession + accession <- xpathSApply(xml, "//b[starts-with(., 'CHEBI:')]", xmlValue) + if (length(accession) > 0) { + accession <- sub('^CHEBI:([0-9]+)$', '\\1', accession, perl = TRUE) + compound$setField(RBIODB.ACCESSION, accession) + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ChebiConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,48 @@ +if ( ! exists('ChebiConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('ChebiCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + ChebiConn <- setRefClass("ChebiConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + ChebiConn$methods( getEntryContentType = function(type) { + return(RBIODB.HTML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + ChebiConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.CHEBI, x)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + ChebiConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createChebiCompoundFromHtml(content, drop = drop) else NULL) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ChemSpiderConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,60 @@ +if ( ! exists('ChemspiderConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('ChemspiderCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + ChemspiderConn <- setRefClass("ChemspiderConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + ChemspiderConn$methods( getEntryContentType = function(type) { + return(RBIODB.HTML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + ChemspiderConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.CHEMSPIDER, x)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + ChemspiderConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createChemspiderCompoundFromHtml(content, drop = drop) else NULL) + }) + + ############################ + # GET CHEMSPIDER IMAGE URL # + ############################ + + get.chemspider.image.url <- function(id) { + + url <- paste0('http://www.chemspider.com/ImagesHandler.ashx?w=300&h=300&id=', id) + + return(url) + } + +} # end of load safe guard +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ChemspiderCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,59 @@ +if ( ! exists('ChemspiderCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + ChemspiderCompound <- setRefClass("ChemspiderCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createChemspiderCompoundFromHtml <- function(contents, drop = TRUE) { + + library(XML) + + compounds <- list() + + # Define xpath expressions + xpath.expr <- character() + + for (html in contents) { + + # Create instance + compound <- ChemspiderCompound$new() + + # Parse HTML + xml <- htmlTreeParse(html, asText = TRUE, useInternalNodes = TRUE) + + # Test generic xpath expressions + for (field in names(xpath.expr)) { + v <- xpathSApply(xml, xpath.expr[[field]], xmlValue) + if (length(v) > 0) + compound$setField(field, v) + } + + # Get accession + accession <- xpathSApply(xml, "//li[starts-with(., 'ChemSpider ID')]", xmlValue) + if (length(accession) > 0) { + accession <- sub('^ChemSpider ID([0-9]+)$', '\\1', accession, perl = TRUE) + compound$setField(RBIODB.ACCESSION, accession) + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/EnzymeCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,61 @@ +if ( ! exists('EnzymeCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + EnzymeCompound <- setRefClass("EnzymeCompound", contains = 'BiodbEntry') + + ########### + # FACTORY # + ########### + + createEnzymeCompoundFromTxt <- function(contents, drop = TRUE) { + + library(stringr) + + compounds <- list() + + # Define fields regex + regex <- character() + regex[[RBIODB.ACCESSION]] <- "^ID\\s+([0-9.]+)$" + regex[[RBIODB.DESCRIPTION]] <- "^DE\\s+(.+)$" + + for (text in contents) { + + # Create instance + compound <- EnzymeCompound$new() + + lines <- strsplit(text, "\n") + for (s in lines[[1]]) { + + # Test generic regex + parsed <- FALSE + for (field in names(regex)) { + g <- str_match(s, regex[[field]]) + if ( ! is.na(g[1,1])) { + compound$setField(field, g[1,2]) + parsed <- TRUE + break + } + } + if (parsed) + next + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/EnzymeConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,47 @@ +if ( ! exists('EnzymeConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('EnzymeCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + EnzymeConn <- setRefClass("EnzymeConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + EnzymeConn$methods( getEntryContentType = function(type) { + return(RBIODB.TXT) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + EnzymeConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.ENZYME, accession = x, content.type = RBIODB.TXT)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + EnzymeConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createEnzymeCompoundFromTxt(content, drop = drop) else NULL) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/HmdbCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,63 @@ +if ( ! exists('HmdbCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + HmdbCompound <- setRefClass("HmdbCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createHmdbCompoundFromXml <- function(contents, drop = FALSE) { + + library(XML) + + compounds <- list() + + # Define xpath expressions + xpath.expr <- character() + xpath.expr[[RBIODB.ACCESSION]] <- "/metabolite/accession" + xpath.expr[[RBIODB.KEGG.ID]] <- "//kegg_id" + xpath.expr[[RBIODB.NAME]] <- "/metabolite/name" + xpath.expr[[RBIODB.FORMULA]] <- "/metabolite/chemical_formula" + xpath.expr[[RBIODB.SUPER.CLASS]] <- "//super_class" + xpath.expr[[RBIODB.AVERAGE.MASS]] <- "//average_molecular_weight" + xpath.expr[[RBIODB.MONOISOTOPIC.MASS]] <- "//monisotopic_moleculate_weight" + + for (content in contents) { + + # Create instance + compound <- HmdbCompound$new() + + # Parse XML + xml <- xmlInternalTreeParse(content, asText = TRUE) + + # An error occured + if (length(getNodeSet(xml, "//error")) == 0) { + + # Test generic xpath expressions + for (field in names(xpath.expr)) { + v <- xpathSApply(xml, xpath.expr[[field]], xmlValue) + if (length(v) > 0) + compound$setField(field, v) + } + + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/HmdbConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,48 @@ +if ( ! exists('HmdbConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('HmdbCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + HmdbConn <- setRefClass("HmdbConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + HmdbConn$methods( getEntryContentType = function(type) { + return(RBIODB.XML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + HmdbConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.HMDB, x, content.type = RBIODB.XML)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + HmdbConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createHmdbCompoundFromXml(content, drop = drop) else NULL) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/KeggCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,88 @@ +if ( ! exists('KeggCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + KeggCompound <- setRefClass("KeggCompound", contains = 'BiodbEntry') + + ########### + # FACTORY # + ########### + + createKeggCompoundFromTxt <- function(contents, drop = TRUE) { + + library(stringr) + + compounds <- list() + + # Define fields regex + regex <- character() + regex[[RBIODB.NAME]] <- "^NAME\\s+([^,;]+)" + regex[[RBIODB.CHEBI.ID]] <- "^\\s+ChEBI:\\s+(\\S+)" + regex[[RBIODB.LIPIDMAPS.ID]] <- "^\\s+LIPIDMAPS:\\s+(\\S+)" + + for (text in contents) { + + # Create instance + compound <- KeggCompound$new() + + lines <- strsplit(text, "\n") + for (s in lines[[1]]) { + + # Test generic regex + parsed <- FALSE + for (field in names(regex)) { + g <- str_match(s, regex[[field]]) + if ( ! is.na(g[1,1])) { + compound$setField(field, g[1,2]) + parsed <- TRUE + break + } + } + if (parsed) + next + + # ACCESSION + { + # ENZYME ID + g <- str_match(s, "^ENTRY\\s+EC\\s+(\\S+)") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.ACCESSION, paste('ec', g[1,2], sep = ':')) + + # ENTRY ID + else { + g <- str_match(s, "^ENTRY\\s+(\\S+)\\s+Compound") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.ACCESSION, paste('cpd', g[1,2], sep = ':')) + + # OTHER ID + else { + g <- str_match(s, "^ENTRY\\s+(\\S+)") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.ACCESSION, g[1,2]) + } + } + + # ORGANISM + g <- str_match(s, "^ORGANISM\\s+(\\S+)") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.ACCESSION, paste(g[1,2], compound$getField(RBIODB.ACCESSION), sep = ':')) + } + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/KeggConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,48 @@ +if ( ! exists('KeggConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('KeggCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + KeggConn <- setRefClass("KeggConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + KeggConn$methods( getEntryContentType = function(type) { + return(RBIODB.TXT) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + KeggConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.KEGG, x, content.type = RBIODB.TXT)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + KeggConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createKeggCompoundFromTxt(content, drop = drop) else NULL) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/LipidmapsCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,70 @@ +if ( ! exists('LipidmapsCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + source('strhlp.R', chdir = TRUE) + + ##################### + # CLASS DECLARATION # + ##################### + + LipidmapsCompound <- setRefClass("LipidmapsCompound", contains = 'BiodbEntry') + + ########### + # FACTORY # + ########### + + createLipidmapsCompoundFromCsv <- function(contents, drop = TRUE) { + + compounds <- list() + + # Mapping column names + col2field <- list() + col2field[[RBIODB.NAME]] <- 'COMMON_NAME' + col2field[[RBIODB.ACCESSION]] <- 'LM_ID' + col2field[[RBIODB.KEGG.ID]] <- 'KEGG_ID' + col2field[[RBIODB.HMDB.ID]] <- 'HMDBID' + col2field[[RBIODB.MASS]] <- 'MASS' + col2field[[RBIODB.FORMULA]] <- 'FORMULA' + + for (text in contents) { + + # Create instance + compound <- LipidmapsCompound$new() + + # Split text in lines + lines <- split.str(text, sep = "\n", unlist = TRUE) + + # An error occured + if ( ! grepl("No record found", lines[[2]])) { + + # Keys on first line + keys <- split.str(lines[[1]], unlist = TRUE) + + # Values on second line + values <- split.str(lines[[2]], unlist = TRUE) + names(values) <- keys[seq(values)] + + # Get field values + for (field in names(col2field)) + if (values[[col2field[[field]]]] != '-') + compound$setField(field, values[[col2field[[field]]]]) + + # Set names + if (values[['SYNONYMS']] != '-') { + # TODO + } + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/LipidmapsConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,57 @@ +if ( ! exists('LipdmapsConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('LipidmapsCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + LipidmapsConn <- setRefClass("LipidmapsConn", contains = "BiodbConn") + + ############### + # CONSTRUCTOR # + ############### + + LipidmapsConn$methods( initialize = function(...) { + # From http://www.lipidmaps.org/data/structure/programmaticaccess.html: + # If you write a script to automate calls to LMSD, please be kind and do not hit our server more often than once per 20 seconds. We may have to kill scripts that hit our server more frequently. + callSuper(scheduler = UrlRequestScheduler$new(t = 20), ...) + }) + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + LipidmapsConn$methods( getEntryContentType = function(type) { + return(RBIODB.CSV) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + LipidmapsConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.LIPIDMAPS, x, content.type = RBIODB.CSV)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + LipidmapsConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createLipidmapsCompoundFromCsv(content, drop = drop) else NULL) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MassbankCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,66 @@ +if ( ! exists('MassbankCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MassbankCompound <- setRefClass("MassbankCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createMassbankCompoundFromTxt <- function(contents) { + + library(stringr) + + compounds <- list() + + for (text in contents) { + + # Create instance + compound <- MassbankCompound$new() + + # Read text + lines <- strsplit(text, "\n") + for (s in lines[[1]]) { + + # NAME + if (is.na(compound$getField(RBIODB.NAME))) { + g <- str_match(s, "^CH\\$NAME:\\s+(.+)$") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.NAME, g[1,2]) + } + + # CHEBI ID + g <- str_match(s, "^CH\\$LINK: CHEBI\\s+(.+)$") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.CHEBI.ID, g[1,2]) + + # KEGG ID + g <- str_match(s, "^CH\\$LINK: KEGG\\s+(.+)$") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.KEGG.ID, g[1,2]) + + # PUBCHEM ID + g <- str_match(s, "^CH\\$LINK: PUBCHEM\\s+(.+)$") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.PUBCHEM.ID, g[1,2]) + + # INCHI + g <- str_match(s, "^CH\\$IUPAC:\\s+(.+)$") + if ( ! is.na(g[1,1])) + compound$setField(RBIODB.INCHI, g[1,2]) + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.NAME))) NULL else x) + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MassbankConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,59 @@ +if ( ! exists('MassbankConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('MassbankSpectrum.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MassbankConn <- setRefClass("MassbankConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + MassbankConn$methods( getEntryContentType = function(type) { + return(if (type == RBIODB.SPECTRUM) RBIODB.TXT else NULL) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + MassbankConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.SPECTRUM) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + xmlstr <- .self$.scheduler$getUrl(get.entry.url(RBIODB.MASSBANK, id, RBIODB.TXT)) + + # Parse XML and get text + if ( ! is.na(xmlstr)) { + library(XML) + xml <- xmlInternalTreeParse(xmlstr, asText = TRUE) + ns <- c(ax21 = "http://api.massbank/xsd") + returned.ids <- xpathSApply(xml, "//ax21:id", xmlValue, namespaces = ns) + content[match(returned.ids, id)] <- xpathSApply(xml, "//ax21:info", xmlValue, namespaces = ns) + } + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + # Creates a Spectrum instance from file content. + # content A file content, downloaded from the public database. + # RETURN A spectrum instance. + MassbankConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.SPECTRUM) createMassbankSpectrumFromTxt(content, drop = drop) else NULL) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MassbankSpectrum.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,117 @@ +if ( ! exists('MassbankSpectrum')) { # Do not load again if already loaded + + source('BiodbEntry.R') + source('MassbankCompound.R') + + ########################### + # MASSBANK SPECTRUM CLASS # + ########################### + + MassbankSpectrum <- setRefClass("MassbankSpectrum", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createMassbankSpectrumFromTxt <- function(contents, drop = TRUE) { + + library(stringr) + + spectra <- list() + + # Define fields regex + regex <- character() + regex[[RBIODB.ACCESSION]] <- "^ACCESSION: (.+)$" + regex[[RBIODB.MSDEV]] <- "^AC\\$INSTRUMENT: (.+)$" + regex[[RBIODB.MSDEVTYPE]] <- "^AC\\$INSTRUMENT_TYPE: (.+)$" + regex[[RBIODB.MSTYPE]] <- "^AC\\$MASS_SPECTROMETRY: MS_TYPE (.+)$" + regex[[RBIODB.MSPRECMZ]] <- "^MS\\$FOCUSED_ION: PRECURSOR_M/Z (.+)$" + regex[[RBIODB.NB.PEAKS]] <- "^PK\\$NUM_PEAK: ([0-9]+)$" + regex[[RBIODB.MSPRECANNOT]] <- "^MS\\$FOCUSED_ION: PRECURSOR_TYPE (.+)$" + + for (text in contents) { + + # Create instance + spectrum <- MassbankSpectrum$new() + + # Read text + lines <- strsplit(text, "\n") + for (s in lines[[1]]) { + + # Test generic regex + parsed <- FALSE + for (field in names(regex)) { + g <- str_match(s, regex[[field]]) + if ( ! is.na(g[1,1])) { + spectrum$setField(field, g[1,2]) + parsed <- TRUE + break + } + } + if (parsed) + next + + # MS MODE + g <- str_match(s, "^AC\\$MASS_SPECTROMETRY: ION_MODE (.+)$") + if ( ! is.na(g[1,1])) { + spectrum$setField(RBIODB.MSMODE, if (g[1,2] == 'POSITIVE') RBIODB.MSMODE.POS else RBIODB.MSMODE.NEG) + next + } + + # PEAKS + if (.parse.peak.line(spectrum, s)) + next + } + + spectra <- c(spectra, spectrum) + } + + # Replace elements with no accession id by NULL + spectra <- lapply(spectra, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # Set associated compounds + compounds <- createMassbankCompoundFromTxt(contents) + for (i in seq(spectra)) + if ( ! is.null(spectra[[i]])) + spectra[[i]]$setField(RBIODB.COMPOUND, compounds[[i]]) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + spectra <- spectra[[1]] + + return(spectra) + } + + ################### + # PARSE PEAK LINE # + ################### + + .parse.peak.line <- function(spectrum, line) { + + peaks <- RBIODB.PEAK.DF.EXAMPLE + + # Annotation + g <- str_match(line, "^\\s+([0-9][0-9.]*) ([A-Z0-9+-]+) ([0-9]+) ([0-9][0-9.]*) ([0-9][0-9.]*)$") + if ( ! is.na(g[1,1])) + peaks[1, c(RBIODB.PEAK.MZ, RBIODB.PEAK.FORMULA, RBIODB.PEAK.FORMULA.COUNT, RBIODB.PEAK.MASS, RBIODB.PEAK.ERROR.PPM)] <- list(as.double(g[1,2]), g[1,3], as.integer(g[1,4]), as.double(g[1,5]), as.double(g[1,6])) + + # Peak + g <- str_match(line, "^\\s+([0-9][0-9.]*) ([0-9][0-9.]*) ([0-9]+)$") + if ( ! is.na(g[1,1])) + peaks[1, c(RBIODB.PEAK.MZ, RBIODB.PEAK.INTENSITY, RBIODB.PEAK.RELATIVE.INTENSITY)] <- list(as.double(g[1,2]), as.double(g[1,3]), as.integer(g[1,4])) + + if (nrow(peaks) > 0) { + + # Get curent peaks and merge with new peaks + current.peaks <- spectrum$getField(RBIODB.PEAKS) + if ( ! is.null(current.peaks)) + peaks <- rbind(current.peaks, peaks) + + spectrum$setField(RBIODB.PEAKS, peaks) + + return(TRUE) + } + + return(FALSE) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MirbaseCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,54 @@ +if ( ! exists('MirbaseCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MirbaseCompound <- setRefClass("MirbaseCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createMirbaseCompoundFromHtml <- function(contents, drop = TRUE) { + + library(XML) + + compounds <- list() + + # Define fields regex + xpath.expr <- character() + xpath.expr[[RBIODB.ACCESSION]] <- "//td[text()='Accession number']/../td[2]" + xpath.expr[[RBIODB.NAME]] <- "//td[text()='ID']/../td[2]" + xpath.expr[[RBIODB.SEQUENCE]] <- "//td[text()='Sequence']/..//pre" + + for (html in contents) { + + # Create instance + compound <- ChebiCompound$new() + + # Parse HTML + xml <- htmlTreeParse(html, asText = TRUE, useInternalNodes = TRUE) + + # Test generic xpath expressions + for (field in names(xpath.expr)) { + v <- xpathSApply(xml, xpath.expr[[field]], xmlValue) + if (length(v) > 0) + compound$setField(field, v) + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MirbaseConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,66 @@ +if ( ! exists('MirbaseConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('MirbaseCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MirbaseConn <- setRefClass("MirbaseConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + MirbaseConn$methods( getEntryContentType = function(type) { + return(RBIODB.HTML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + MirbaseConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.MIRBASE, x, content.type = RBIODB.HTML)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + MirbaseConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createMirbaseCompoundFromHtml(content, drop = drop) else NULL) + }) + + ################### + # FIND ACCESSIONS # + ################### + + MirbaseConn$methods( + findAccessions = function(name) { + + # Get HTML + htmlstr <- .self$.scheduler$getUrl('http://www.mirbase.org/cgi-bin/query.pl', params = c(terms = name, submit = 'Search')) + + # Parse HTML + xml <- htmlTreeParse(htmlstr, asText = TRUE, useInternalNodes = TRUE) + + # Get accession number + acc <- unlist(xpathSApply(xml, "//a[starts-with(.,'MIMAT')]", xmlValue)) + + return(acc) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Ms4TabSqlDb.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,348 @@ +if ( ! exists('Ms4TabSqlDb')) { # Do not load again if already loaded + + library('methods') + source('msdb-common.R') + source('MsDb.R') + + ##################### + # CLASS DECLARATION # + ##################### + + Ms4TabSqlDb <- setRefClass("Ms4TabSqlDb", contains = "MsDb", fields = list(.host = "character", .port = "integer", .dbname = "character", .user = "character", .password = "character", .drv = "ANY", .conn = "ANY")) + + ############### + # CONSTRUCTOR # + ############### + + Ms4TabSqlDb$methods( initialize = function(host = NA_character_, port = NA_integer_, dbname = NA_character_, user = NA_character_, password = NA_character_, ...) { + + # Initialize members + .host <<- if ( ! is.null(host)) host else NA_character_ + .port <<- if ( ! is.null(port)) port else NA_integer_ + .dbname <<- if ( ! is.null(dbname)) dbname else NA_character_ + .user <<- if ( ! is.null(user)) user else NA_character_ + .password <<- if ( ! is.null(password)) password else NA_character_ + .drv <<- NULL + .conn <<- NULL + + callSuper(...) + }) + + ################## + # GET CONNECTION # + ################## + + Ms4TabSqlDb$methods( .get.connection = function() { + + # Initialize connection + if (is.null(.self$.conn)) { + library('RPostgreSQL') + .drv <<- dbDriver("PostgreSQL") + .conn <<- dbConnect(.self$.drv, host = .self$.host, port = .self$.port, dbname = .self$.dbname, user = .self$.user, password = .self$.password) + } + + return(.self$.conn) + }) + + ############## + # SEND QUERY # + ############## + + Ms4TabSqlDb$methods( .send.query = function(query) { + conn <- .self$.get.connection() # Call it first separately, so library RPostgreSQL is loaded. + rs <- try(dbSendQuery(conn, query)) + return(rs) + }) + + #################### + # GET MOLECULE IDS # + #################### + + Ms4TabSqlDb$methods( getMoleculeIds = function() { + + rs <- .self$.send.query('select pkmol.molecule_id as id from peaklist_name as pkmol;') + ids <- fetch(rs,n=-1) + ids <- ids[['id']] # Get 'id' column + ids <- vapply(ids, function(x) { if (substring(x, 1, 1) == 'N') as.integer(substring(x, 2)) else as.integer(x) } , FUN.VALUE = 1, USE.NAMES = FALSE) + ids <- (sort(ids)) + + return(ids) + }) + + #################### + # GET NB MOLECULES # + #################### + + Ms4TabSqlDb$methods( getNbMolecules = function() { + + rs <- .self$.send.query('select count(*) from peaklist_name;') + df <- fetch(rs,n=-1) + n <- df[[1]] + + return(n) + }) + + ##################### + # GET MOLECULE NAME # + ##################### + + Ms4TabSqlDb$methods( getMoleculeName = function(molid) { + + # Build request + where <- paste0(vapply(molid, function(id) paste0("pkmol.molecule_id = 'N", id, "'"), FUN.VALUE = ''), collapse = ' or ') + request <- paste0('select pkmol.molecule_id as id, pkmol.name from peaklist_name as pkmol where ', where, ';') + + # Run request + rs <- .self$.send.query(request) + df <- fetch(rs,n=-1) + + # Get IDs + ids <- vapply(df[['id']], function(x) as.integer(substring(x, 2)), FUN.VALUE = 1, USE.NAMES = FALSE) + + # Get names in the same order as the input vector + names <- df[['name']][order(ids)[order(molid)]] + + return(if (is.null(names)) NA_character_ else names) + }) + + + ############################### + # GET CHROMATOGRAPHIC COLUMNS # + ############################### + + Ms4TabSqlDb$methods( getChromCol = function(molid = NULL) { + + # Get all columns + if (is.null(molid)) { + request <- 'select name from method;' + + # Get columns of the specified molecules + } else { + where_molids <- paste0(vapply(molid, function(id) paste0("pkmol.molecule_id = 'N", id, "'"), FUN.VALUE = ''), collapse = ' or ') + where <- paste0('pk.name_id = pkmol.id and pk.id = pkret.id_peak and pkret.id_method = method.id and (', where_molids, ')') + request <- paste0('select distinct method.name from method, peaklist as pk, peaklist_name as pkmol, peaklist_ret as pkret where ', where, ';') + } + + # Run request + rs <- .self$.send.query(request) + df <- fetch(rs,n=-1) + + # Gets column list + cols <- df[['name']] + + # Remove FIA + cols <- cols[ cols != 'FIA'] + + # Normalize names + cols <- vapply(cols, .normalize_column_name, FUN.VALUE = '', USE.NAMES = FALSE) + + # Remove duplicates + cols <- cols[ ! duplicated(cols)] + + # Make data frame + cols <- data.frame(id = cols, title = cols, stringsAsFactors = FALSE) + + return(cols) + }) + + ################ + # FIND BY NAME # + ################ + + Ms4TabSqlDb$methods( findByName = function(name) { + + if (is.null(name)) return(NA_integer_) + + # Put names in uppercase + uname <- toupper(name) + + # Build request + where <- paste0(vapply(uname, function(n) paste0("upper(pkmol.name) = '", gsub("'", "''", n, perl = TRUE), "'"), FUN.VALUE = '', USE.NAMES = FALSE), collapse = ' or ') + request <- paste0('select pkmol.molecule_id as id, pkmol.name from peaklist_name as pkmol where ', where, ';') + + # Run request + rs <- .self$.send.query(request) + df <- fetch(rs,n=-1) + + # Adds missing names/IDs + missing_names <- uname[ ! uname %in% toupper(df[['name']])] + df <- rbind(df, data.frame(id = rep(NA_integer_, length(missing_names)), name = missing_names)) + + # Get IDs and names + ids <- vapply(df[['id']], function(x) as.integer(substring(x, 2)), FUN.VALUE = 1, USE.NAMES = FALSE) + names <- toupper(as.character(df[['name']])) + + # Get IDs in the same order as the input vector + ids[order(uname)] <- ids[order(names)] + + return(if (is.null(ids)) NA_integer_ else ids) + }) + + ####################### + # GET RETENTION TIMES # + ####################### + + Ms4TabSqlDb$methods( getRetentionTimes = function(molid, col = NA_character_) { + + if (is.null(molid) || is.na(molid) || length(molid) != 1) + stop("The parameter molid must consist only in a single integer.") + + # Build request + request <- paste0("select distinct method.name as col, (pkret.retention * 60) as ret from peaklist as pk, peaklist_name as pkmol, peaklist_ret as pkret, method where pkret.id_peak = pk.id and pkmol.id = pk.name_id and pkret.id_method = method.id and pkmol.molecule_id = 'N", molid, "'") + if ( ! is.na(col)) { + where_cols <- paste0(vapply(col, function(c) paste0("method.name = '", c, "'"), FUN.VALUE = ''), collapse = ' or ') + request <- paste0(request, ' and (', where_cols, ')') + } + request <- paste0(request, ';') + + # Run request + rs <- .self$.send.query(request) + df <- fetch(rs,n=-1) + + # Remove FIA + df <- df[df[['col']] != 'FIA', ] + + # Normalize names + df[['col']] <- vapply(df[['col']], .normalize_column_name, FUN.VALUE = '', USE.NAMES = FALSE) + + # Build output list + lst <- list() + if (nrow(df) > 0) + for (i in 1:nrow(df)) { + c <- df[i, 'col'] + lst[[c]] <- c(lst[[c]], df[i, 'ret']) + } + + return(lst) + }) + + ################ + # GET NB PEAKS # + ################ + + Ms4TabSqlDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) { + + # Build request + request <- paste0("select count(*) from peaklist as pk, peaklist_name as pkmol where pkmol.id = pk.name_id") + if ( length(molid) > 1 || ! is.na(molid)) { + where_molids <- paste0(vapply(molid, function(id) paste0("pkmol.molecule_id = 'N", id, "'"), FUN.VALUE = ''), collapse = ' or ') + request <- paste0(request, ' and (', where_molids, ')') + } + if ( ! is.na(type)) { + request <- paste0(request, ' and ', if (type == MSDB.TAG.POS) '' else 'not ', 'ion_pos') + } + request <- paste0(request, ';') + + # Run request + rs <- .self$.send.query(request) + df <- fetch(rs,n=-1) + + return(df[1,1]) + }) + + ############################### + # GET CHROMATOGRAPHIC COLUMNS # + ############################### + + Ms4TabSqlDb$methods( .to.dbcols = function(col) { + + # Get all column names + request <- 'select name from method;' + rs <- .self$.send.query(request) + df <- fetch(rs,n=-1) + + # Get database column names + dbcols <- df[['name']] + dbcols <- dbcols[ dbcols != 'FIA'] + + # Get normalize names + normcols <- vapply(dbcols, .normalize_column_name, FUN.VALUE = '', USE.NAMES = FALSE) + + return(dbcols[normcols == tolower(col)]) + }) + + ################# + # GET MZ VALUES # + ################# + + # Returns a numeric vector of all masses stored inside the database. + Ms4TabSqlDb$methods( getMzValues = function(mode = NULL) { + + # Build request + select <- paste0("select distinct pk.mass as ", MSDB.TAG.MZTHEO) + from <- " from peaklist as pk" + where <- "" + if ( ! is.null(mode)) + where <- paste0(" where ", if (mode == MSDB.TAG.POS) '' else 'not ', 'pk.ion_pos') + + # Assemble request + request <- paste0(select, from, where, ';') + + # Run request + rs <- .self$.send.query(request) + df <- fetch(rs, n=-1) + + return(df[[MSDB.TAG.MZTHEO]]) + }) + + ########## + # SEARCH # + ########## + + Ms4TabSqlDb$methods( .do.search.for.mz.rt.bounds = function(mode, mz.low, mz.high, rt.low = NULL, rt.high = NULL, col = NULL, attribs = NULL, molids = NULL) { + + # Build request + select <- paste0("select pkmol.molecule_id as ", MSDB.TAG.MOLID, ", pkmol.name as ", MSDB.TAG.MOLNAMES,", pk.mass as ", MSDB.TAG.MZTHEO, ", pk.composition as ", MSDB.TAG.COMP,", pk.attribution as ", MSDB.TAG.ATTR) + from <- " from peaklist as pk, peaklist_name as pkmol" + where <- paste0(" where pkmol.id = pk.name_id and pk.mass >= ", mz.low, " and pk.mass <= ", mz.high) + where <- paste0(where, ' and ', if (mode == MSDB.TAG.POS) '' else 'not ', 'pk.ion_pos') + + # Insert where clause on attribs + if ( ! is.null(attribs)) { + where.attribs <- paste0(vapply(attribs, function(a) paste0("pk.attribution = '", a, "'"), FUN.VALUE = '', USE.NAMES = FALSE), collapse = " or ") + where <- paste0(where, ' and (', where.attribs, ')') + } + + # Insert where clause on molids + if ( ! is.null(molids)) { + where.molids <- paste0(vapply(molids, function(id) paste0("pkmol.molecule_id = 'N", id, "'"), FUN.VALUE = ''), collapse = ' or ') + where <- paste0(where, ' and (', where.molids, ')') + } + + # Insert where clause on columns + if ( ! is.null(col)) { + dbcols <- .self$.to.dbcols(col) + if ( ! is.null(dbcols)) { + + # Can't find specified columns + if (length(dbcols) == 0 && length(col) > 0) + return(.get.empty.result.df(rt = TRUE)) + + select <- paste0(select, ", (60 * pkret.retention) as ", MSDB.TAG.COLRT, ", method.name as ", MSDB.TAG.COL) + from <- paste0(from, ", method, peaklist_ret as pkret") + where.cols <- if (length(dbcols) == 0) 'TRUE' else paste0(vapply(dbcols, function(c) paste0("method.name = '", c, "'"), FUN.VALUE = '', USE.NAMES = FALSE), collapse = " or ") + where <- paste0(where, " and pk.id = pkret.id_peak and pkret.id_method = method.id and (", where.cols, ")") + if (! is.null(rt.low) && ! is.null(rt.high)) + where <- paste0(where, " and pkret.retention * 60 >= ", rt.low, " and pkret.retention * 60 <= ", rt.high) + } + } + + # Assemble request + request <- paste0(select, from, where, ';') + + # Run request + rs <- .self$.send.query(request) + df <- fetch(rs,n=-1) + + # No results + + # Remove N prefix from IDs + if (nrow(df) > 0) + df[[MSDB.TAG.MOLID]] <- vapply(df[[MSDB.TAG.MOLID]], function(x) substring(x, 2), FUN.VALUE = '', USE.NAMES = FALSE) + else if (nrow(df) == 0) + df <- .get.empty.result.df(rt = ! is.null(col)) + + return(df) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDb.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,467 @@ +if ( ! exists('MsDb')) { # Do not load again if already loaded + + library('methods') + source('msdb-common.R') + source('MsDbObserver.R') + source('MsDbOutputStream.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MsDb <- setRefClass("MsDb", fields = list(.observers = "ANY", .prec = "list", .output.streams = "ANY", .input.stream = "ANY", .mz.tol.unit = "character")) + + ############### + # CONSTRUCTOR # + ############### + + MsDb$methods( initialize = function(...) { + + .observers <<- NULL + .output.streams <<- NULL + .input.stream <<- NULL + .prec <<- MSDB.DFT.PREC + .mz.tol.unit <<- MSDB.DFT.MZTOLUNIT + + callSuper(...) + }) + + #################### + # SET INPUT STREAM # + #################### + + MsDb$methods( setInputStream = function(stream) { + + # Check types of input stream + if ( ! inherits(stream, "MsDbInputStream") && ! is.null(stream)) + stop("Input stream must inherit from MsDbInputStream class.") + + # Save current stream + cur.stream <- .self$.input.stream + + # Set stream + .input.stream <<- stream + + return(cur.stream) + }) + + ###################### + # ADD OUTPUT STREAMS # + ###################### + + MsDb$methods( addOutputStreams = function(stream) { + + # Check types of output streams + if ( ( ! is.list(stream) && ! inherits(stream, "MsDbOutputStream")) || (is.list(stream) && any( ! vapply(stream, function(s) inherits(s, "MsDbOutputStream"), FUN.VALUE = TRUE)))) + stop("Output streams must inherit from MsDbOutputStream class.") + + # Add streams to current list + .output.streams <<- if (is.null(.self$.output.streams)) c(stream) else c(.self$.output.streams, stream) + }) + + ######################### + # REMOVE OUTPUT STREAMS # + ######################### + + MsDb$methods( removeOutputStreams = function(stream) { + + # Check types of output streams + if ( ( ! is.list(stream) && ! inherits(stream, "MsDbOutputStream")) || (is.list(stream) && any( ! vapply(stream, function(s) inherits(s, "MsDbOutputStream"), FUN.VALUE = TRUE)))) + + # Remove streams from current list + .output.streams <<- .self$.output.streams[ ! stream %in% .self$.output.streams] + }) + + ######################## + # RESET OUTPUT STREAMS # + ######################## + + MsDb$methods( resetOutputStreams = function(stream) { + .output.streams <<- NULL + }) + + ################# + # ADD OBSERVERS # + ################# + + MsDb$methods( addObservers = function(obs) { + + # Check types of observers + if ( ( ! is.list(obs) && ! inherits(obs, "MsDbObserver")) || (is.list(obs) && any( ! vapply(obs, function(o) inherits(o, "MsDbObserver"), FUN.VALUE = TRUE)))) + stop("Observers must inherit from MsDbObserver class.") + + # Add observers to current list + .observers <<- if (is.null(.self$.observers)) c(obs) else c(.self$.observers, obs) + }) + + ################## + # SET PRECURSORS # + ################## + + MsDb$methods( setPrecursors = function(prec) { + .prec <<- prec + }) + + ################# + # SET DB FIELDS # + ################# + + MsDb$methods( areDbFieldsSettable = function() { + return(FALSE) + }) + + MsDb$methods( setDbFields = function(fields) { + stop("Method setDbFields() not implemented in concrete class.") + }) + + ################ + # SET MS MODES # + ################ + + MsDb$methods( areDbMsModesSettable = function() { + return(FALSE) + }) + + MsDb$methods( setDbMsModes = function(modes) { + stop("Method setDbMsModes() not implemented in concrete class.") + }) + + MsDb$methods( setMzTolUnit = function(mztolunit) { + + if ( ! mztolunit %in% MSDB.MZTOLUNIT.VALS) + stop(paste0("M/Z tolerance unit must be one of: ", paste(MSDB.MZTOLUNIT.VALS, collapse = ', '), ".")) + + .mz.tol.unit <<- mztolunit + }) + + #################### + # GET MOLECULE IDS # + #################### + + # Returns an integer vector of all molecule IDs stored inside the database. + MsDb$methods( getMoleculeIds = function() { + stop("Method getMoleculeIds() not implemented in concrete class.") + }) + + #################### + # GET NB MOLECULES # + #################### + + # Returns the number of molecules in the database. + MsDb$methods( getNbMolecules = function() { + stop("Method getNbMolecules() not implemented in concrete class.") + }) + + ################# + # GET MZ VALUES # + ################# + + # Returns a numeric vector of all masses stored inside the database. + MsDb$methods( getMzValues = function(mode = NULL) { + stop("Method getMzValues() not implemented in concrete class.") + }) + + ##################### + # GET MOLECULE NAME # + ##################### + + # Get molecule names + # molid An integer vector of molecule IDs. + # Returns a character vector containing the names of the molecule IDs, in the same order as the input vector. + MsDb$methods( getMoleculeName = function(molid) { + stop("Method getMoleculeName() not implemented in concrete class.") + }) + + ############################### + # GET CHROMATOGRAPHIC COLUMNS # + ############################### + + # Get chromatographic columns. + # Returns a vector of character listing the chromatographic column names. The name must be formatted in lowercase as following: uplc(-c8)?(-20min)?. + MsDb$methods( getChromCol = function(molid = NULL) { + stop("Method getChromCol() not implemented in concrete class.") + }) + + ################ + # FIND BY NAME # + ################ + + # Find a molecule by name + # name A vector of molecule names to search for. + # Return an integer vector of the same size as the name input vector, containing the found molecule IDs, in the same order. + MsDb$methods( findByName = function(name) { + stop("Method findByName() not implemented in concrete class.") + }) + + ####################### + # GET RETENTION TIMES # + ####################### + + # Get the retention times of a molecule. + # Returns a list of numeric vectors. The list has for keys/names the columns, and for values vectors of numerics (the retention times). If no retention times are registered for this molecule, then returns an empty list. + MsDb$methods( getRetentionTimes = function(molid, col = NA_character_) { + stop("Method getRetentionTimes() not implemented in concrete class.") + }) + + ################ + # GET NB PEAKS # + ################ + + # Get the total number of MS peaks stored inside the database. + # molid The ID of the molecule. + # type The MS type. + MsDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) { + stop("Method getNbPeaks() not implemented in concrete class.") + }) + + ################## + # GET PEAK TABLE # + ################## + + MsDb$methods( getPeakTable = function(molid = NA_integer_, mode = NA_character_){ + stop("Method getPeakTable() not implemented in concrete class.") + }) + + ########## + # SEARCH # + ########## + + # Find molecule MS peaks whose m/z matches the submitted m/z in the tolerance specified. + # mode The mode to use: either MSDB.TAG.POS or MSDB.TAG.NEG. + # shift The m/z shift to use, in ppm. + # prec The m/z precision to use, in ppm. + # col The chromatographic column used. + # rt.tol Simple retention tolerance parameter: rtinf = rt - rt.tol and rtsup = rt + rt.tol + # rt.tol.x Tolerance parameter for the equations : rtinf = rt - rt.tol.x - rt ^ rt.tol.y and rtsup = rt + rt.tol.x + rt ^ rt.tol.y + # rt.tol.y Tolerance parameter. See rt.tol.x parameter. + # attribs Only search for peaks whose attribution is among this set of attributions. + # molids Only search for peaks whose molecule ID is among this vector of integer molecule IDs. Can also be a data frame with a retention time column x.colnames$rt and a molecule ID column MSDB.TAG.molid. + # molids.rt.tol Retention time tolerance used when molids parameter is a data frame (rt, id) + # precursor.match Remove peaks whose molecule precursor peak has not also been matched. + # precursor.rt.tol + # Returns a data frame, listing m/z values provided in input. Several matches can be found for an m/z value, in which case several lines (the same number as the number of matches found) with the same m/z value repeated will be inserted. The m/z values will be listed in the same order as in the input. The columns of the data.frame are: mz, rt (only if present in the input), id, mztheo, col, colrt, composition, attribution. + MsDb$methods( searchForMzRtList = function(x = NULL, mode, shift = NULL, prec = NULL, col = NULL, rt.tol = NULL, rt.tol.x = NULL, rt.tol.y = NULL, molids = NULL, molids.rt.tol = NULL, attribs = NULL, precursor.match = FALSE, precursor.rt.tol = NULL, same.cols = FALSE, same.rows = FALSE, peak.table = FALSE) { + + # Use provided data frame + old.input <- NULL + tmp.output <- NULL + if ( ! is.null(x)) { + tmp.input <- MsDbInputDataFrameStream$new(df = x) + tmp.output <- MsDbOutputDataFrameStream$new() + old.input <- .self$setInputStream(tmp.input) + .self$addOutputStreams(tmp.output) + } + + if (precursor.match) { + # Get IDs of all molecules whose precursor peak matches one of the mz in the list + precursors.df <- .self$.doSearchForMzRtList(mode = mode, shift = shift, prec = prec, col = col, rt.tol = rt.tol, rt.tol.x = rt.tol.x, rt.tol.y = rt.tol.y, attribs = .self$.prec[[mode]], output.to.stream = FALSE) + cols.to.keep <- if (is.null(col)) MSDB.TAG.MOLID else c(MSDB.TAG.MOLID, MSDB.TAG.COL, MSDB.TAG.COLRT) + precursors.ids <- precursors.df[, cols.to.keep, drop = FALSE] + precursors.ids <- precursors.ids[ ! is.na(precursors.ids[[MSDB.TAG.MOLID]]), , drop = FALSE] + precursors.ids <- precursors.ids[ ! duplicated(precursors.ids), ] + + # Get all matching peaks whose molecule is inside the previously obtained list of molecules + .self$.doSearchForMzRtList(mode = mode, shift = shift, prec = prec, col = col, rt.tol = NULL, rt.tol.x = NULL, rt.tol.y = NULL, molids = precursors.ids, molids.rt.tol = precursor.rt.tol, same.cols = same.cols, same.rows = same.rows, peak.table = peak.table) +# TODO +# +# peaks <- if (peak.table) results[['peaks']] else results +# +# # Merge results with the column/rt found for precursors. +# if ( ! is.null(col) && ! is.null(peaks)) { +# precursors.ids <- precursors.df[, c(MSDB.TAG.MOLID, MSDB.TAG.col, MSDB.TAG.COLRT)] +# precursors.ids <- precursors.ids[ ! is.na(precursors.ids[[MSDB.TAG.MOLID]]), ] +# +# # Get rows where ID is NA +# peaks.na <- peaks[is.na(peaks[[MSDB.TAG.MOLID]]), ] +# +# # Get rows where ID is found (i.e.: not NA) +# peaks <- peaks[, !(colnames(peaks) %in% c(MSDB.TAG.COL, MSDB.TAG.COLRT))] # drop col and colrt columns +# peaks.not.na <- peaks[! is.na(peaks[[MSDB.TAG.MOLID]]), ] +# +# # Add col and colrt values to found peaks +# peaks <- merge(peaks.not.na, precursors.ids, by = MSDB.TAG.MOLID) +# +# # Put back unfound peaks +# peaks <- rbind(peaks, peaks.na) +# +# # Sort +# print(colnames(peaks)) +# print(x.colnames) +# peaks <- peaks[order(peaks[[x.colnames$mz]], peaks[[x.colnames$rt]], peaks[[MSDB.TAG.MOLID]], peaks[[MSDB.TAG.COL]]), ] +# +# # Remove rownames +# rownames(peaks) <- NULL +# +# # Reorder columns +# peaks <- peaks[unlist(.self$.output.fields[names(.PEAK.TABLE.COLS)])] +# } +# +# # Remove duplicates +# if ( ! is.null(peaks)) +# peaks <- peaks[ ! duplicated(peaks), ] +# +# if (peak.table) +# results[['peaks']] <- peaks +# else +# results <- peaks +# +# return(results) + } + else + .self$.doSearchForMzRtList(mode = mode, shift = shift, prec = prec, col = col, rt.tol = rt.tol, rt.tol.x = rt.tol.x, rt.tol.y = rt.tol.y, molids = molids, molids.rt.tol = molids.rt.tol, attribs = attribs, same.cols = same.cols, same.rows = same.rows, peak.table = peak.table) + + if ( ! is.null(x)) { + results <- tmp.output$getDataFrame() + .self$removeOutputStreams(tmp.output) + .self$setInputStream(old.input) + return(results) + } + }) + + MsDb$methods( .doSearchForMzRtList = function(mode, shift = NULL, prec = NULL, col = NULL, rt.tol = NULL, rt.tol.x = NULL, rt.tol.y = NULL, molids = NULL, molids.rt.tol = NULL, attribs = NULL, same.cols = FALSE, same.rows = FALSE, peak.table = FALSE, output.to.stream = TRUE) { + +# # Choose columns to keep from x +# x.cols <- if (same.cols) colnames(x) else intersect(if (is.null(col)) c(x.colnames$mz) else c(x.colnames$mz, x.colnames$rt), colnames(x)) +# +# # Create a peak fake data frame for defining columns +# peaks.fake <- data.frame(stringsAsFactors = FALSE) +# for (field in names(.PEAK.TABLE.COLS)) +# if ( ! is.null(col) || ! field %in% .RT.MATCHING.COLS) +# peaks.fake[.self$.output.fields[[field]]] <- vector(mode = .PEAK.TABLE.COLS[[field]], length = 0) +# +# # Initialize y data frame, so when x contains no rows an empty y data frame is returned with all the columns set with right type. +# if (same.rows) { +# y <- peaks.fake[, if (is.null(col)) c(MSDB.TAG.MZ) else c(MSDB.TAG.MZ, MSDB.TAG.RT), drop = FALSE] +# y[MSDB.TAG.MSMATCHING] <- character() +# } +# else +# y <- peaks.fake +# y <- cbind(y, x[NULL, ! x.cols %in% colnames(y), drop = FALSE]) +# if (peak.table) { +# z <- peaks.fake +# z <- cbind(z, x[NULL, ! x.cols %in% colnames(z), drop = FALSE]) +# } + + # Loop on all lines of input + peaks <- NULL + while (.self$.input.stream$hasNextValues()) { + + .self$.input.stream$nextValues() + + # Search for m/z + results <- .self$searchForMzRtTols(mode = mode, mz = .self$.input.stream$getMz(), shift = shift, prec = prec, rt = .self$.input.stream$getRt(), col = col, rt.tol = rt.tol, rt.tol.x = rt.tol.x, rt.tol.y = rt.tol.y, attribs = attribs, molids = molids, molids.rt.tol = molids.rt.tol) + + # Call output streams + if (output.to.stream && ! is.null(.self$.output.streams)) + for (s in .self$.output.streams) + s$matchedPeaks(mz = .self$.input.stream$getMz(), rt = if (is.null(col)) NULL else .self$.input.stream$getRt(), peaks = results, unused = .self$.input.stream$getAll(but = if (is.null(col)) c(MSDB.TAG.MZ) else c(MSDB.TAG.MZ, MSDB.TAG.RT))) + + # Append to peak list + peaks <- rbind(peaks, results) + +# # Add results to output +# r <- nrow(y) + 1 +# x.lines <- x[i, x.cols, drop = FALSE] +# x.lines <- rename.col(x.lines, unlist(x.colnames), unlist(.self$.output.fields[names(x.colnames)])) +# if (nrow(results) == 0) { +# y[r, colnames(x.lines)] <- x.lines +# } +# else { +# if (same.rows) { +# y[r, colnames(x.lines)] <- x.lines +# ids <- results[[MSDB.TAG.molid]] +# ids <- ids[ ! duplicated(ids)] # Remove duplicated values +# y[r, MSDB.TAG.msmatching] <- paste(ids, collapse = .self$.molids.sep) +# } +# if ( ! same.rows || peak.table) { +# new.rows <- cbind(x.lines, results, row.names = NULL) +# if ( ! same.rows) { +# rows <- r:(r+nrow(results)-1) +# y[rows, colnames(new.rows)] <- new.rows +# } +# if (peak.table) { +# zr <- nrow(z) + 1 +# zrows <- zr:(zr+nrow(results)-1) +# z[zrows, colnames(new.rows)] <- new.rows +# } +# } +# } + } + +# results <- if (peak.table) list(main = y, peaks = z) else y + +# return(results) + return(peaks) + }) + + # rt Retention time in seconds. + # molids An option vector of molecule IDs, used to restrict the search. + MsDb$methods( searchForMzRtTols = function(mode, mz, rt = NULL, shift = NULL, prec = NULL, col = NULL, rt.tol = NULL, rt.tol.x = NULL, rt.tol.y = NULL, attribs = NULL, molids = NULL, molids.rt.tol = NULL, colnames = MSDB.DFT.INPUT.FIELDS) { + + # Set M/Z bounds + if (.self$.mz.tol.unit == MSDB.MZTOLUNIT.PPM) { + mz.low <- mz * (1 + (- shift - prec) * 1e-6) + mz.high <- mz * (1 + (- shift + prec) * 1e-6) + } + else { # PLAIN + mz.low <- mz - shift - prec + mz.high <- mz - shift + prec + } + + # Set retention time bounds + rt.low <- NULL + rt.high <- NULL + if ( ! is.null(rt.tol)) { + low <- rt - rt.tol + high <- rt + rt.tol + rt.low <- if (is.null(rt.low)) low else max(low, rt.low) + rt.high <- if (is.null(rt.high)) high else min(high, rt.high) + } + if ( ! is.null(rt.tol.x)) { + low <- rt - rt.tol.x - rt ^ rt.tol.y + high <- rt + rt.tol.x + rt ^ rt.tol.y + rt.low <- if (is.null(rt.low)) low else max(low, rt.low) + rt.high <- if (is.null(rt.high)) high else min(high, rt.high) + } + + # List molecule IDs + if ( ! is.null(molids.rt.tol) && is.data.frame(molids)) { + ids <- molids[(rt >= molids[[MSDB.TAG.colrt]] - molids.rt.tol) & (rt <= molids[[MSDB.TAG.colrt]] + molids.rt.tol), MSDB.TAG.molid] + if (length(ids) == 0) + # No molecule ID match for this retention time + return(data.frame()) # return empty result set + } else { + ids <- molids + } + + return(.self$searchForMzRtBounds(mode, + mz.low = mz * (1 + (- shift - prec) * 1e-6), + mz.high = mz * (1 + (- shift + prec) * 1e-6), + rt.low = rt.low, + rt.high = rt.high, + col = col, + attribs = attribs, + molids = ids)) + }) + + # rt.low Lower bound of the retention time in seconds. + # rt.high Higher bound of the retention time in seconds. + MsDb$methods( searchForMzRtBounds = function(mode, mz.low, mz.high, rt.low = NULL, rt.high = NULL, col = NULL, attribs = NULL, molids = NULL) { + + results <- .self$.do.search.for.mz.rt.bounds(mode = mode, mz.low = mz.low, mz.high = mz.high, rt.low = rt.low, rt.high = rt.high, col = col, attribs = attribs, molids = molids) + + return(results) + }) + + # TODO Write description of output: data frame with which columns ? + MsDb$methods( .do.search.for.mz.rt.bounds = function(mode, mz.low, mz.high, rt.low = NULL, rt.high = NULL, col = NULL, attribs = NULL, molids = NULL) { + stop("Method .do.search.for.mz.rt.bounds() not implemented in concrete class.") + }) + + # DEPRECATED + MsDb$methods( searchForMz = function(x, mode, tol = 5, col = NULL, rt.tol.x = 5, rt.tol.y = 0.80) { + warning("Method searchForMz() is deprecated. Use searchForMzRtList() instead.") + .self$searchForMzRtList(x = x, mode = mode, prec = tol, col = col, rt.tol.x = rt.tol.x, rt.tol.y = rt.tol.y) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDbChecker.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,44 @@ +if ( ! exists('MsDbChecker')) { # Do not load again if already loaded + + source('MsDbObserver.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MsDbChecker <- setRefClass("MsDbChecker", contains = 'MsDbObserver', fields = list(.fail = 'logical')) + + ############### + # CONSTRUCTOR # + ############### + + # fail If set to TRUE, will fail (i.e.: quit application with a status set to 1) on error. + MsDbChecker$methods( initialize = function(fail = FALSE, ...) { + + .fail <<- if ( ! is.null(fail) && ! is.na(fail)) fail else FALSE + + callSuper(...) # calls super-class initializer with remaining parameters + }) + + ########### + # WARNING # + ########### + + MsDbChecker$methods( warning = function(msg) { + write(paste('WARNING: ', msg), stderr()) + }) + + ######### + # ERROR # + ######### + + MsDbChecker$methods( error = function(msg) { + + write(paste('ERROR:', msg), stderr()) + + # Fail + if (.self$.fail) + quit(status = 1) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDbInputDataFrameStream.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,85 @@ +if ( ! exists('MsDbInputDataFrameStream')) { # Do not load again if already loaded + + library(methods) + source('MsDbInputStream.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MsDbInputDataFrameStream <- setRefClass("MsDbInputDataFrameStream", contains = 'MsDbInputStream', fields = list( .df = "ANY", .i = "integer")) + + ############### + # CONSTRUCTOR # + ############### + + MsDbInputDataFrameStream$methods( initialize = function(df = data.frame(), input.fields = msdb.get.dft.input.fields(), ...) { + + .df <<- df + .i <<- 0L + + callSuper(input.fields = input.fields, ...) + }) + + ########## + # GET MZ # + ########## + + MsDbInputDataFrameStream$methods( getMz = function() { + + if (.self$.i > 0 && .self$.i <= nrow(.self$.df) && ! is.null(.self$.input.fields[[MSDB.TAG.MZ]])) + return(.self$.df[.self$.i, .self$.input.fields[[MSDB.TAG.MZ]]]) + + return(NULL) + }) + + ########## + # GET RT # + ########## + + MsDbInputDataFrameStream$methods( getRt = function() { + + if (.self$.i > 0 && .self$.i <= nrow(.self$.df) && ! is.null(.self$.input.fields[[MSDB.TAG.RT]])) + return(.self$.df[.self$.i, .self$.input.fields[[MSDB.TAG.RT]]]) + + return(NULL) + }) + + ########### + # GET ALL # + ########### + + MsDbInputDataFrameStream$methods( getAll = function(but = NULL) { + + if (.self$.i > 0 && .self$.i <= nrow(.self$.df)) { + + vals <- .self$.df[.self$.i, , drop = FALSE] + + if ( ! is.null(but)) + vals <- vals[, ! colnames(vals) %in% .self$.input.fields[but], drop = FALSE] + + return(vals) + } + + return(NULL) + }) + + ############### + # NEXT VALUES # + ############### + + MsDbInputDataFrameStream$methods( nextValues = function() { + + if (.self$.i <= nrow(.self$.df)) + .i <<- .self$.i + 1L + }) + + ################### + # HAS NEXT VALUES # + ################### + + MsDbInputDataFrameStream$methods( hasNextValues = function() { + return(.self$.i < nrow(.self$.df)) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDbInputStream.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,63 @@ +if ( ! exists('MsDbInputStream')) { # Do not load again if already loaded + + library('methods') + source('msdb-common.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MsDbInputStream <- setRefClass("MsDbInputStream", fields = list(.input.fields = "ANY")) + + ############### + # CONSTRUCTOR # + ############### + + MsDbInputStream$methods( initialize = function(input.fields = msdb.get.dft.input.fields(), ...) { + + .input.fields <<- input.fields + + callSuper(...) + }) + + ########## + # GET MZ # + ########## + + MsDbInputStream$methods( getMz = function() { + stop("Method getMz() not implemented in concrete class.") + }) + + ########## + # GET RT # + ########## + + MsDbInputStream$methods( getRt = function() { + stop("Method getRt() not implemented in concrete class.") + }) + + ########### + # GET ALL # + ########### + + MsDbInputStream$methods( getAll = function(but = NULL) { + stop("Method getUnused() not implemented in concrete class.") + }) + + ############### + # NEXT VALUES # + ############### + + MsDbInputStream$methods( nextValues = function() { + stop("Method nextValues() not implemented in concrete class.") + }) + + ################### + # HAS NEXT VALUES # + ################### + + MsDbInputStream$methods( hasNextValues = function() { + stop("Method hasNextValues() not implemented in concrete class.") + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDbLogger.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,32 @@ +if ( ! exists('MsDbLogger')) { # Do not load again if already loaded + + source('MsDbObserver.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MsDbLogger <- setRefClass("MsDbLogger", contains = 'MsDbObserver', fields = list(.verbose = 'numeric', .file = 'ANY' )) + + ############### + # CONSTRUCTOR # + ############### + + MsDbLogger$methods( initialize = function(verbose = 1, file = NULL, ...) { + + .verbose <<- if ( ! is.null(verbose) && ! is.na(verbose)) verbose else 1 + .file <<- if ( ! is.null(file) && ! is.na(file)) file else stderr() + + callSuper(...) # calls super-class initializer with remaining parameters + }) + + ############ + # PROGRESS # + ############ + + MsDbLogger$methods( progress = function(msg, level = 1) { + if (.self$.verbose >= level) + cat(msg, "\n", sep = '', file = .self$.file) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDbObserver.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,32 @@ +if ( ! exists('MsDbObserver')) { # Do not load again if already loaded + + library('methods') + + ##################### + # CLASS DECLARATION # + ##################### + + MsDbObserver <- setRefClass("MsDbObserver", fields = list()) + + ############ + # PROGRESS # + ############ + + MsDbObserver$methods( progress = function(msg, level = 1) { + }) + + ########### + # WARNING # + ########### + + MsDbObserver$methods( warning = function(msg) { + }) + + ######### + # ERROR # + ######### + + MsDbObserver$methods( error = function(msg) { + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDbOutputDataFrameStream.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,117 @@ +if ( ! exists('MsDbOutputDataFrameStream')) { # Do not load again if already loaded + + library(methods) + library(plyr) + source('MsDbOutputStream.R') + source('dfhlp.R', chdir = TRUE) + + ##################### + # CLASS DECLARATION # + ##################### + + MsDbOutputDataFrameStream <- setRefClass("MsDbOutputDataFrameStream", contains = 'MsDbOutputStream', fields = list( .df = "ANY")) + + ############### + # CONSTRUCTOR # + ############### + + MsDbOutputDataFrameStream$methods( initialize = function(keep.unused = FALSE, one.line = FALSE, match.sep = MSDB.DFT.MATCH.SEP, output.fields = msdb.get.dft.output.fields(), multval.field.sep = MSDB.DFT.OUTPUT.MULTIVAL.FIELD.SEP, first.val = FALSE, ascii = FALSE, noapostrophe = FALSE, noplusminus = FALSE, nogreek = FALSE, ...) { + + .df <<- data.frame() + + callSuper(keep.unused = keep.unused, one.line = one.line, match.sep = match.sep, output.fields = output.fields, multval.field.sep = multval.field.sep, first.val = first.val, ascii = ascii, noapostrophe = noapostrophe, noplusminus = noplusminus, nogreek = nogreek, ...) + }) + + ################## + # GET DATA FRAME # + ################## + + MsDbOutputDataFrameStream$methods( getDataFrame = function(...) { + + # Put at least a column name if empty + if (nrow(.self$.df) == 0) + .self$.df[[.self$.output.fields[[MSDB.TAG.MZ]]]] <- numeric() + + return(.self$.df) + }) + + ################# + # MATCHED PEAKS # + ################# + + MsDbOutputDataFrameStream$methods( matchedPeaks = function(mz, rt = NULL, unused = NULL, peaks = NULL) { + + # Set input values + x <- data.frame(mz = mz) + if ( ! is.null(rt)) + x <- cbind(x, data.frame(rt = rt)) + + # Merge input values with matched peaks + if ( ! is.null(peaks)) { + + # No rows + if (nrow(peaks) == 0) + # Add NA values + peaks[1, ] <- NA + + # Process existing rows + else { + # Process multi-value fields + for (c in colnames(peaks)) + if (c %in% MSDB.MULTIVAL.FIELDS) { + + # Keep only first value in multi-value fields + if (.self$.first.val) + peaks[[c]] <- vapply(peaks[[c]], function(s) split.str(s, sep = MSDB.MULTIVAL.FIELD.SEP, unlist = TRUE)[[1]], FUN.VALUE = '') + + # Change separator + else + peaks[[c]] <- vapply(peaks[[c]], function(s) paste0(split.str(s, sep = MSDB.MULTIVAL.FIELD.SEP, unlist = TRUE), collapse = .self$.multval.field.sep), FUN.VALUE = '') + + } + + # Concatenate results in one line + if (.self$.one.line) { + # For each column, concatenate all values in one string. + for (c in seq(peaks)) + peaks[1, c] <- paste0(peaks[[c]], collapse = .self$.match.sep, FUN.VALUE = '') + peaks <- peaks[1, ] # Keep only first line + } + } + + # Merge + x <- cbind(x, peaks, row.names = NULL) + } + + # Rename columns for output + x <- rename.col(x, names(.self$.output.fields), .self$.output.fields) + + # Add unused columns + if ( .self$.keep.unused && ! is.null(unused)) { + x <- cbind(x, unused, row.names = NULL) + } + + # Convert strings to ASCII + if (.self$.ascii || .self$.noapostrophe || .self$.noplusminus || .self$.nogreek) + for (c in seq(x)) + if (class(x[[c]]) == 'character') { + if (.self$.noapostrophe) + x[[c]] <- gsub("'", 'prime', x[[c]], perl = TRUE) + if (.self$.noplusminus) + x[[c]] <- gsub('±', '+-', x[[c]], perl = TRUE) + if (.self$.nogreek) { + x[[c]] <- gsub('α', 'alpha', x[[c]], perl = TRUE) + x[[c]] <- gsub('β', 'beta', x[[c]], perl = TRUE) + x[[c]] <- gsub('γ', 'gamma', x[[c]], perl = TRUE) + x[[c]] <- gsub('δ', 'delta', x[[c]], perl = TRUE) + } + if (.self$.ascii) { + x[[c]] <- gsub('[^\u0001-\u007F]', '_', x[[c]], perl = TRUE) + } + } + + # Add new rows to data frame + .df <<- rbind.fill(.self$.df, x) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsDbOutputStream.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,47 @@ +if ( ! exists('MsDbOutputStream')) { # Do not load again if already loaded + + library('methods') + source('msdb-common.R') + + ##################### + # CLASS DECLARATION # + ##################### + + MsDbOutputStream <- setRefClass("MsDbOutputStream", fields = list(.keep.unused = "logical", .one.line = "logical", .match.sep = "character", .output.fields = "ANY", .multval.field.sep = "character", .first.val = "logical", .ascii = "logical", .noapostrophe = "logical", .noplusminus = "logical", .nogreek = "logical")) + + ############### + # CONSTRUCTOR # + ############### + + #' Constructor. + #' + #' @param keep.unused Set to \code{TRUE} if you want to keep in the output, unused columns of the input. + #' @param one.line Set to \code{TRUE} if you want to output only one line for each input line. + #' @return + #' @examples + #' stream <- MsDbOutputDataFrameStream$new(one.line = TRUE) + MsDbOutputStream$methods( initialize = function(keep.unused = FALSE, one.line = FALSE, match.sep = MSDB.DFT.MATCH.SEP, output.fields = msdb.get.dft.output.fields(), multval.field.sep = MSDB.DFT.OUTPUT.MULTIVAL.FIELD.SEP, first.val = FALSE, ascii = FALSE, noapostrophe = FALSE, noplusminus = FALSE, nogreek = FALSE, ...) { + + .keep.unused <<- keep.unused + .one.line <<- one.line + .match.sep <<- match.sep + .output.fields <<- output.fields + .multval.field.sep <<- multval.field.sep + .first.val <<- first.val + .ascii <<- ascii + .noapostrophe <<- noapostrophe + .noplusminus <<- noplusminus + .nogreek <<- nogreek + + callSuper(...) + }) + + ################# + # MATCHED PEAKS # + ################# + + MsDbOutputStream$methods( matchedPeaks = function(mz, rt = NULL, unused = NULL, peaks = NULL) { + stop("Method matchedPeaks() not implemented in concrete class.") + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsFileDb.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,475 @@ +if ( ! exists('MsFileDb')) { # Do not load again if already loaded + + library('methods') + source('MsDb.R') + source('msdb-common.R') + source('search.R', chdir = TRUE) + + ##################### + # CLASS DECLARATION # + ##################### + + MsFileDb <- setRefClass("MsFileDb", contains = "MsDb", fields = list(.file = "character", .db = "ANY", .fields = "list", .modes = "list", .name.to.id = "ANY")) + + ############### + # CONSTRUCTOR # + ############### + + MsFileDb$methods( initialize = function(file = NA_character_, ...) { + + # Initialize members + .file <<- if ( ! is.null(file)) file else NA_character_ + .db <<- NULL + .fields <<- msdb.get.dft.db.fields() + .modes <<- MSDB.DFT.MODES + .name.to.id <<- NULL + + callSuper(...) + }) + + ################# + # SET DB FIELDS # + ################# + + MsFileDb$methods( areDbFieldsSettable = function() { + return(TRUE) + }) + + MsFileDb$methods( setDbFields = function(fields) { + .fields <<- as.list(fields) + }) + + ################ + # CHECK FIELDS # + ################ + + MsFileDb$methods( .check.fields = function(fields) { + + if (is.null(fields)) + stop("No fields specified for .check.fields()") + + # Check that fields are defined in the fields list + unknown <- fields[ ! fields %in% names(.self$.fields)] + if (length(unknown) > 0) + stop(paste0("Database field", if (length(unknown) == 1) "" else "s", " \"", paste(unkown, collapse = ", "), "\" ", if (length(unknown) == 1) "is" else "are", " not defined.")) + + # Check that field values are real columns inside the database + .self$.init.db() + db.col.names <- fields #vapply(fields, function(s) .self$.fields[[s]], FUN.VALUE = '') + unknown.cols <- db.col.names[ ! db.col.names %in% colnames(.self$.db)] + if (length(unknown.cols) > 0) + stop(paste0("Column", if (length(unknown.cols) == 1) "" else "s", " \"", paste(unknown.cols, collapse = ", "), "\" ", if (length(unknown.cols) == 1) "is" else "are", " not defined inside the database \"", .self$.file, "\".")) + }) + + ################ + # SET MS MODES # + ################ + + MsFileDb$methods( areDbMsModesSettable = function() { + return(TRUE) + }) + + MsFileDb$methods( setDbMsModes = function(modes) { + .modes <<- as.list(modes) + }) + + ########### + # INIT DB # + ########### + + MsFileDb$methods( .init.db = function() { + + if (is.null(.self$.db)) { + + # Load database + .db <<- read.table(.self$.file, sep = "\t", quote = "\"", header = TRUE, stringsAsFactors = FALSE, row.names = NULL) + + # Rename columns + colnames(.self$.db) <- vapply(colnames(.self$.db), function(c) if (c %in% .self$.fields) names(.self$.fields)[.self$.fields %in% c] else c, FUN.VALUE = '') + } + }) + + ############ + # GET DATA # + ############ + + MsFileDb$methods( .get = function(db = NULL, col = NULL) { + + # Init db + if (is.null(db)) { + .self$.init.db() + db <- .self$.db + } + + # Check fields + .self$.check.fields(col) + + # Get database columns +# db.cols <- unlist(.self$.fields[col]) + + return(db[, col]) + }) + + ########### + # GET ROW # + ########### + + MsFileDb$methods( .get.row = function(row, cols = NULL) { + + # Init db + .self$.init.db() + + # Check fields + if ( ! is.null(cols)) + .self$.check.fields(cols) + + if ( ! is.null(cols)) { + #cols <- vapply(cols, function(c) .self$.fields[[c]], FUN.VALUE = '') + return(.self$.db[row, cols]) + } + + return(.self$.db[row, ]) + }) + + ########### + # GET COL # + ########### + + MsFileDb$methods( .get.col = function(col) { + + # Init db + .self$.init.db() + + # Check fields + .self$.check.fields(col) + + #return(.self$.db[[.self$.fields[[col]]]]) + return(.self$.db[[col]]) + }) + + #################### + # GET MOLECULE IDS # + #################### + + MsFileDb$methods( getMoleculeIds = function() { + + # Init db + .self$.init.db() + + # Get IDs + mol.ids <- as.character(.self$.get.col(MSDB.TAG.MOLID)) + mol.ids <- mol.ids[ ! duplicated(mol.ids)] + mol.ids <- sort(mol.ids) + + return(mol.ids) + }) + + #################### + # GET NB MOLECULES # + #################### + + # Returns the number of molecules in the database. + MsFileDb$methods( getNbMolecules = function() { + + # Init db + .self$.init.db() + + # Get IDs + mol.ids <- .self$.get.col(MSDB.TAG.MOLID) + mol.ids <- mol.ids[ ! duplicated(mol.ids)] + + return(length(mol.ids)) + }) + + ##################### + # GET MOLECULE NAME # + ##################### + + MsFileDb$methods( .get.name.from.id = function(db, id) { + + if(is.na(id)) + return(NA_character_) + + # Get names + names <- db[db[[MSDB.TAG.MOLID]] %in% id, MSDB.TAG.MOLNAMES] + if (length(names) == 0) + return(NA_character_) + + # Each molecule has potentially several names. Since we must return only one name for each molecule, we choose the first one. + name <- strsplit(names, ';')[[1]][[1]] + + return(name) + }) + + # Get molecule names + # molid An integer vector of molecule IDs. + # Returns a character vector containing the names of the molecule IDs, in the same order as the input vector. + MsFileDb$methods( getMoleculeName = function(molid) { + + if (is.null(molid)) + return(NA_character_) + + # Init db + .self$.init.db() + + # Get database + db <- .self$.db[, c(MSDB.TAG.MOLID, MSDB.TAG.MOLNAMES)] + + # Remove duplicates + db <- db[! duplicated(db[[MSDB.TAG.MOLID]]), ] + + # Look for ids + names <- vapply(molid, function(i) .self$.get.name.from.id(db, i), FUN.VALUE = '') + + return(names) + }) + + ################### + # INIT NAME TO ID # + ################### + + MsFileDb$methods( .init.name.to.id = function() { + + if (is.null(.self$.name.to.id)) { + + # Create data frame + .name.to.id <<- data.frame(name = character(), id = character(), stringsAsFactors = FALSE) + + # Init db + .self$.init.db() + + # Get database subset (columns name and id only). + db <- .self$.db[, c(MSDB.TAG.MOLID, MSDB.TAG.MOLNAMES)] + + # Remove duplicate IDs + db <- db[! duplicated(db[[MSDB.TAG.MOLID]]), ] + + # Loop on all + for(i in seq(db[[MSDB.TAG.MOLID]])) { + i.id <- db[i, MSDB.TAG.MOLID] + i.names <- split.str(db[i, MSDB.TAG.MOLNAMES], ';', unlist = TRUE) + .name.to.id <<- rbind(.self$.name.to.id, data.frame(name = toupper(i.names), id = rep(i.id, length(i.names)), stringsAsFactors = FALSE)) + } + + # Order by name + .name.to.id <<- .self$.name.to.id[order(.self$.name.to.id[['name']]), ] + } + }) + + #################### + # GET ID FROM NAME # + #################### + + MsFileDb$methods( .get.id.from.name = function(name) { + + # Initialize name.to.id search tree + .self$.init.name.to.id() + + # Search for name + i <- binary.search(toupper(name), .self$.name.to.id[['name']]) + + # Get ID + id <- if (is.na(i)) NA_character_ else as.character(.self$.name.to.id[i, 'id']) + + return(id) + }) + + ################ + # FIND BY NAME # + ################ + + # Find a molecule by name + # name A vector of molecule names to search for. + # Return a vector of the same size as the name input vector, containing the found molecule IDs, in the same order. + MsFileDb$methods( findByName = function(name) { + + if (is.null(name)) + return(NA_character_) + + # Look for molecules with this name + ids <- list() + for (n in name) + ids <- c(ids, list(.self$.get.id.from.name(n))) + + return(ids) + }) + + ############################### + # GET CHROMATOGRAPHIC COLUMNS # + ############################### + + MsFileDb$methods( getChromCol = function(molid = NULL) { + + # Init db + .self$.init.db() + + # Get database + db <- .self$.db[, c(MSDB.TAG.MOLID, MSDB.TAG.COL)] + + # Filter on molecule IDs + if ( ! is.null(molid)) + db <- db[db[[MSDB.TAG.MOLID]] %in% molid,] + + # Get column names + cols <- db[[MSDB.TAG.COL]] + + # Remove duplicates + cols <- cols[ ! duplicated(cols)] + + # Make data frame + cols <- data.frame(id = cols, title = cols, stringsAsFactors = FALSE) + + return(cols) + }) + + ################ + # GET NB PEAKS # + ################ + + # Get the total number of MS peaks stored inside the database. + # molid The ID of the molecule. + # type The MS type. + MsFileDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) { + + # Init db + .self$.init.db() + + # Get database + db <- .self$.db[, c(MSDB.TAG.MOLID, MSDB.TAG.MODE, MSDB.TAG.MZTHEO)] + + # Filter on mode + if ( ! is.null(type) && ! is.na(type)) + db <- db[db[[MSDB.TAG.MODE]] == (if (type == MSDB.TAG.POS) .self$.modes$pos else .self$.modes$neg), ] + + # Filter on molecule IDs + if ( ! is.null(molid) && ! is.na(molid)) + db <- db[db[[MSDB.TAG.MOLID]] %in% molid,] + + # Get mz values + mz <- db[[MSDB.TAG.MZTHEO]] + + # Count number of unique values + n <- sum(as.integer(! duplicated(mz))) + + return(n) + }) + + ########## + # SEARCH # + ########## + + MsFileDb$methods( .do.search.for.mz.rt.bounds = function(mode, mz.low, mz.high, rt.low = NULL, rt.high = NULL, col = NULL, attribs = NULL, molids = NULL) { + + # Init db + .self$.init.db() + db <- .self$.db + + # Filter on mode + if ( ! is.null(mode) && ! is.na(mode)) + db <- db[db[[MSDB.TAG.MODE]] == (if (mode == MSDB.TAG.POS) .self$.modes$pos else .self$.modes$neg), ] + + # Filter on molecule IDs + if ( ! is.null(molids)) + db <- db[db[[MSDB.TAG.MOLID]] %in% molids,] + + # Filter on attributions + if ( ! is.null(attribs) && ! is.na(attribs)) + db <- db[db[[MSDB.TAG.ATTR]] %in% attribs,] + + # Filter on columns + if ( ! is.null(col) && ! is.na(col)) + db <- db[db[[MSDB.TAG.COL]] %in% col,] + + # Filter on retention time + if ( ! is.null(rt.low) && ! is.na(rt.low) && ! is.null(rt.high) && ! is.na(rt.high)) + db <- db[db[[MSDB.TAG.COLRT]] >= rt.low & db[[MSDB.TAG.COLRT]] <= rt.high, ] + + # Remove retention times and column information + if (is.null(col) || is.na(col) || is.null(rt.low) || is.na(rt.low) || is.null(rt.high) || is.na(rt.high)) { + db <- db[, ! (colnames(db) %in% c(MSDB.TAG.COL, MSDB.TAG.COLRT))] + + # Remove duplicates + db <- db[ ! duplicated(db), ] + } + + # Filter on mz + db <- db[db[[MSDB.TAG.MZTHEO]] >= mz.low & db[[MSDB.TAG.MZTHEO]] <= mz.high, ] + + # Rename database fields +# conv <- c( mz = 'mztheo', rt = 'colrt') # solving mismatch of field names between database and output +# cols <- colnames(db) +# for (db.field in names(.self$.fields)) { +# output.field <- if (db.field %in% names(conv)) conv[[db.field]] else db.field +# if (.self$.fields[[db.field]] %in% cols && output.field %in% names(.self$.output.fields)) +# cols[cols %in% .self$.fields[[db.field]]] <- .self$.output.fields[[output.field]] +# } +# colnames(db) <- cols + + # Remove unwanted columns +# db <- db[, colnames(db) %in% .self$.output.fields] + + return(db) + }) + + ################# + # GET MZ VALUES # + ################# + + # Returns a numeric vector of all masses stored inside the database. + MsFileDb$methods( getMzValues = function(mode = NULL) { + + # Init db + .self$.init.db() + db <- .self$.db + + # Filter on mode + if ( ! is.null(mode) && ! is.na(mode)) { + mode.tag <- if (mode == MSDB.TAG.POS) .self$.modes$pos else .self$.modes$neg + selected.lines <- (.self$.get(db, col = MSDB.TAG.MODE) == mode.tag) + db <- db[selected.lines, ] + } + + # Get masses + mz <- .self$.get(db, col = MSDB.TAG.MZTHEO) + + # Remove duplicates + mz <- mz[ ! duplicated(mz)] + + return(mz) + }) + + ####################### + # GET RETENTION TIMES # + ####################### + + # Get the retention times of a molecule. + # Returns a list of numeric vectors. The list has for keys/names the columns, and for values vectors of numerics (the retention times). If no retention times are registered for this molecule, then returns an empty list. + MsFileDb$methods( getRetentionTimes = function(molid, col = NA_character_) { + + if (is.null(molid) || is.na(molid)) + return(list()) + + # Init db + .self$.init.db() + db <- .self$.db[, c(MSDB.TAG.MOLID, MSDB.TAG.COL, MSDB.TAG.COLRT)] + + # Filter on molecule ID + if ( ! is.null(molid) && ! is.na(molid)) + db <- db[db[[MSDB.TAG.MOLID]] %in% molid,] + + # Remove duplicates + db <- db[! duplicated(db), ] + + # Build retention time list + rt <- list() + cols <- db[[MSDB.TAG.COL]] + cols <- cols[ ! duplicated(cols)] + for (col in cols) { + colrts <- db[db[[MSDB.TAG.COL]] %in% col, MSDB.TAG.COLRT] + rt[col] <- list(colrts) + } + + return(rt) + }) + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsPeakForestDb.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,293 @@ +if ( ! exists('MsPeakForestDb')) { # Do not load again if already loaded + + library(methods) + source('MsDb.R') + source(file.path('UrlRequestScheduler.R')) + + ##################### + # CLASS DECLARATION # + ##################### + + MsPeakForestDb <- setRefClass("MsPeakForestDb", contains = "MsDb", fields = list(.url = "character", .url.scheduler = "ANY")) + + ############### + # CONSTRUCTOR # + ############### + + MsPeakForestDb$methods( initialize = function(url = NA_character_, useragent = NA_character_, ...) { + + # Check URL + if (is.null(url) || is.na(url)) + stop("No URL defined for new MsPeakForestDb instance.") + + .url <<- url + .url.scheduler <<- UrlRequestScheduler$new(n = 3, useragent = useragent) + .self$.url.scheduler$setVerbose(1L) + + callSuper(...) + }) + + ########### + # GET URL # + ########### + + MsPeakForestDb$methods( .get.url = function(url, params = NULL, ret.type = 'json') { + + res <- NULL + + content <- .self$.url.scheduler$getUrl(url = url, params = params) + + if (ret.type == 'json') { + + library(RJSONIO) + + res <- fromJSON(content, nullValue = NA) + + if (class(res) == 'list' && 'success' %in% names(res) && res$success == FALSE) { + param.str <- if (is.null(params)) '' else paste('?', vapply(names(params), function(p) paste(p, params[[p]], sep = '='), FUN.VALUE = ''), collapse = '&', sep = '') + stop(paste0("Failed to run web service. URL was \"", url, param.str, "\".")) + } + } else { + if (ret.type == 'integer') { + if (grepl('^[0-9]+$', content, perl = TRUE)) + res <- as.integer(content) + else { + library(RJSONIO) + res <- fromJSON(content, nullValue = NA) + } + } + } + + return(res) + }) + + #################### + # GET MOLECULE IDS # + #################### + + MsPeakForestDb$methods( getMoleculeIds = function() { + + ids <- as.character(.self$.get.url(url = paste0(.self$.url, 'compounds/all/ids'))) + + return(ids) + }) + + #################### + # GET NB MOLECULES # + #################### + + MsPeakForestDb$methods( getNbMolecules = function() { + + n <- .self$.get.url(url = paste0(.self$.url, 'compounds/all/count'), ret.type = 'integer') + + return(n) + }) + + ############################### + # GET CHROMATOGRAPHIC COLUMNS # + ############################### + + MsPeakForestDb$methods( getChromCol = function(molid = NULL) { + + # Set URL + url <- paste0(.self$.url, 'metadata/lc/list-code-columns') + params <- NULL + if ( ! is.null(molid)) + params <- list(molids = paste(molid, collapse = ',')) + + # Call webservice + wscols <- .self$.get.url(url = url, params = params) + + # Build data frame + cols <- data.frame(id = character(), title = character()) + for(id in names(wscols)) + cols <- rbind(cols, data.frame(id = id, title = wscols[[id]]$name, stringsAsFactors = FALSE)) + + return(cols) + }) + + ####################### + # GET RETENTION TIMES # + ####################### + + MsPeakForestDb$methods( getRetentionTimes = function(molid, col = NA_character_) { + + if (is.null(molid) || is.na(molid) || length(molid) != 1) + stop("The parameter molid must consist only in a single value.") + + rt <- list() + + # Set URL + url <- paste0(.self$.url, 'spectra/lcms/search') + params <- NULL + if ( ! is.null(molid)) + params <- list(molids = paste(molid, collapse = ',')) + + # Call webservice + spectra <- .self$.get.url(url = url, params = params) + if (class(spectra) == 'list' && length(spectra) > 0) { + for (s in spectra) + if (is.na(col) || s$liquidChromatography$columnCode %in% col) { + ret.time <- (s$RTmin + s$RTmax) / 2 + c <- s$liquidChromatography$columnCode + if (c %in% names(rt)) { + if ( ! ret.time %in% rt[[c]]) + rt[[c]] <- c(rt[[c]], ret.time) + } else + rt[[c]] <- ret.time + } + } + + return(rt) + }) + + ##################### + # GET MOLECULE NAME # + ##################### + + MsPeakForestDb$methods( getMoleculeName = function(molid) { + + library(RJSONIO) + + if (is.null(molid)) + return(NA_character_) + + # Initialize names + names <- as.character(molid) + + # Get non NA values + non.na.molid <- molid[ ! is.na(molid)] + + if (length(non.na.molid) > 0) { + # Set URL + url <- paste0(.self$.url, 'compounds/all/names') + params <- c(molids = paste(non.na.molid, collapse = ',')) + + # Call webservice + names[ ! is.na(molid)] <- .self$.get.url(url = url, params = params) + } + + return(names) + }) + + ################ + # FIND BY NAME # + ################ + + MsPeakForestDb$methods( findByName = function(name) { + + if (is.null(name)) + return(NA_character_) + + ids <- list() + + for (n in name) { + + if (is.na(n)) + ids <- c(ids, NA_character_) + + else { + url <- paste0(.self$.url, 'search/compounds/name/', curlEscape(n)) + compounds <- .self$.get.url(url = url)$compoundNames + ids <- c(ids, list(vapply(compounds, function(c) as.character(c$compound$id), FUN.VALUE = ''))) + } + } + + return(ids) + }) + + ################# + # GET NB PEAKS # + ################# + + MsPeakForestDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) { + + # Build URL + url <- paste0(.self$.url, 'spectra/lcms/count-peaks') + params <- NULL + if ( ! is.na(type)) + params <- c(params, mode = if (type == MSDB.TAG.POS) 'pos' else 'neg') + if ( ! is.null(molid) && (length(molid) > 1 || ! is.na(molid))) + params <- c(params, molids = paste(molid, collapse = ',')) + + # Run request + n <- .self$.get.url(url = url, params = params, ret.type = 'integer') + + return(sum(n)) + }) + + ################# + # GET MZ VALUES # + ################# + + MsPeakForestDb$methods( getMzValues = function(mode = NULL) { + + # Build URL + url <- paste0(.self$.url, 'spectra/lcms/peaks/list-mz') + + # Query params + params <- NULL + if ( ! is.null(mode)) + params <- c(params, mode = if (mode == MSDB.TAG.POS) 'positive' else 'negative') + + # Get MZ valuels + mz <- .self$.get.url(url = url, params = params) + + return(mz) + }) + + ############################## + # DO SEARCH FOR MZ RT BOUNDS # + ############################## + + MsPeakForestDb$methods( .do.search.for.mz.rt.bounds = function(mode, mz.low, mz.high, rt.low = NULL, rt.high = NULL, col = NULL, attribs = NULL, molids = NULL) { + + # Build URL for mz search + url <- paste0(.self$.url, 'spectra/lcms/peaks/get-range/', mz.low, '/', mz.high) + + # Get spectra + spectra <- .self$.get.url(url = url) + + # Build result data frame + results <- data.frame(MSDB.TAG.MOLID = character(), MSDB.TAG.MOLNAMES = character(), MSDB.TAG.MZTHEO = numeric(), MSDB.TAG.COMP = character(), MSDB.TAG.ATTR = character()) + for (x in spectra) + results <- rbind(results, data.frame(MSDB.TAG.MOLID = vapply(x$source$listOfCompounds, function(c) as.character(c$id), FUN.VALUE = ''), + MSDB.TAG.MOLNAMES = vapply(x$source$listOfCompounds, function(c) paste(c$names, collapse = MSDB.MULTIVAL.FIELD.SEP), FUN.VALUE = ''), + MSDB.TAG.MZTHEO = as.numeric(x$theoricalMass), + MSDB.TAG.COMP = as.character(x$composition), + MSDB.TAG.ATTR = as.character(x$attribution), + stringsAsFactors = FALSE)) + + # RT search + if ( ! is.null(rt.low) && ! is.null(rt.high)) { + + rt.res <- data.frame(MSDB.TAG.MOLID = character(), MSDB.TAG.COL = character(), MSDB.TAG.COLRT = numeric()) + + if (nrow(results) > 0) { + # Build URL for rt search + url <- paste0(.self$.url, 'spectra/lcms/range-rt-min/', rt.low, '/', rt.high) + params <- NULL + if ( ! is.null(col)) + params <- c(columns = paste(col, collapse = ',')) + + # Run query + rtspectra <- .self$.get.url(url = url, params = params) + + # Get compound/molecule IDs + for (x in spectra) + rt.res <- rbind(rt.res, data.frame(MSDB.TAG.MOLID = vapply(x$listOfCompounds, function(c) as.character(c$id), FUN.VALUE = ''), + MSDB.TAG.COL = as.character(x$liquidChromatography$columnCode), + MSDB.TAG.COLRT = (as.numeric(x$RTmin) + as.numeric(x$RTmax)) / 2, + stringsAsFactors = FALSE)) + } + + # Add retention times and column info + results <- merge(results, rt.res) + } + + # Rename columns with proper names + colnames(results) <- vapply(colnames(results), function(s) eval(parse(text=s)), FUN.VALUE = '') + + return(results) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MsXlsDb.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,842 @@ +if ( ! exists('MsXlsDb')) { # Do not load again if already loaded + + library('methods') + library('stringr') + source('msdb-common.R') + source('MsDb.R') + source('strhlp.R', chdir = TRUE) + source('dfhlp.R', chdir = TRUE) + source('search.R', chdir = TRUE) + source('excelhlp.R', chdir = TRUE) + + ############# + # CONSTANTS # + ############# + + .THIS.FILE.PATH <- getwd() # We suppose that the file has been sourced with the option chdir = TRUE + + .XLS_PEAKS_ROW_OFFSET <- 8 + .XLS_PEAKS_RT_COL_START <- 11 + .XLS_MSPOS_TAB <- 'MS_POS' + .XLS_MSNEG_TAB <- 'MS_NEG' + .XLS_MZ_COL <- 1 + .XLS_INTENSITY_COL <- 2 + .XLS_RELATIVE_COL <- 3 + .XLS_THEORETICAL_MZ_COL <- 5 + .XLS_COMPOSITION_COL <- 8 + .XLS_ATTRIBUTION_COL <- 9 + + ##################### + # CLASS DECLARATION # + ##################### + + MsXlsDb <- setRefClass("MsXlsDb", contains = "MsDb", fields = list(.mz.index = "ANY", .name_index = "ANY", .db_dir = "character", .limit = "numeric", .files = "ANY", .cache_dir = "character", .db = "ANY")) + + ############### + # CONSTRUCTOR # + ############### + + MsXlsDb$methods( initialize = function(db_dir = NA_character_, limit = NA_integer_, cache_dir = NA_character_, cache = FALSE, ...) { + + # Initialize members + .db_dir <<- if ( ! is.null(db_dir)) db_dir else NA_character_ + .limit <<- if ( ! is.null(limit) && ! is.na(limit) && limit > 0) limit else NA_integer_ + cache_dir <- if (cache && is.na(cache_dir) && ! is.na(db_dir)) file.path(db_dir, 'cache') else cache_dir + .cache_dir <<- if ( cache || ! is.null(cache_dir)) cache_dir else NA_character_ + .files <<- NULL + .db <<- NULL + .mz.index <<- NULL + .name_index <<- NULL + + callSuper(...) + }) + + #################### + # GET MOLECULE IDS # + #################### + + MsXlsDb$methods( getMoleculeIds = function() { + + # Init file list + .self$.init.file.list() + + # Get IDs + mol.ids <- as.integer(which( ! is.na(.self$.files))) + + return(mol.ids) + }) + + #################### + # GET NB MOLECULES # + #################### + + # Returns a list of all molecule names + MsXlsDb$methods( getNbMolecules = function() { + return(length(.self$getMoleculeIds())) + }) + + ##################### + # GET MOLECULE NAME # + ##################### + + MsXlsDb$methods( getMoleculeName = function(molid) { + return(vapply(molid, function(m) .self$.get.mol.name(m), FUN.VALUE = "")) + }) + + ############################### + # GET CHROMATOGRAPHIC COLUMNS # + ############################### + + # Returns a list of all chromatographic columns used + MsXlsDb$methods( getChromCol = function(molid = NULL) { + + cn <- character() + + # If no molecule IDs provided, then look at all molecules + if (is.null(molid)) + molid <- .self$getMoleculeIds() + + # Loop on molecules + for (mid in molid) { + + rt <- .self$getRetentionTimes(mid) + + if ( ! is.null(rt)) + cn <- c(cn, names(rt)) + } + + # Remove duplicates + cn <- cn[ ! duplicated(cn)] + + # Make data frame + cn <- data.frame(id = cn, title = cn, stringsAsFactors = FALSE) + + return(cn) + }) + + ################ + # FIND BY NAME # + ################ + + MsXlsDb$methods( findByName = function(name) { + + # NULL entry + if (is.null(name)) + return(NA_integer_) + + # Initialize output list + ids <- NULL + + for (n in name) { + + id <- NA_integer_ + + if ( ! is.na(n)) { + + # Get index + index <- .self$.get.name.index() + + # Search for name in index + i <- binary.search(toupper(n), index[['name']]) + + id <- if (is.na(i)) NA_integer_ else index[i, 'id'] + } + + ids <- c(ids, id) + } + + return(ids) + }) + + ####################### + # GET RETENTION TIMES # + ####################### + + MsXlsDb$methods( getRetentionTimes = function(molid, col = NA_character_) { + + if (is.null(molid) || is.na(molid)) + return(NULL) + + # Find it in memory + rt <- .self$.mem.get(molid, 'rt') + + if (is.null(rt)) { + + # Call observers + if ( ! is.null(.self$.observers)) + for (obs in .self$.observers) + obs$progress(paste0("Loading retention times of file", .self$.get.file(molid), "."), level = 2) + + rt <- NULL + + # Load from cache file + cache_file <- NA_character_ + if ( ! is.na(.self$.get.cache.dir())) { + cache_file <- file.path(.self$.get.cache.dir(), paste0('rt-', molid, '.bin')) + if (file.exists(cache_file)) + load(file = cache_file) # load rt + } + + if (is.null(rt)) { + + # Get retention times of both positive and negative mode tabs + mspos_rt <- .self$.parse_retention_times(molid, .XLS_MSPOS_TAB) + msneg_rt <- .self$.parse_retention_times(molid, .XLS_MSNEG_TAB) + + # Retention times stored in negative and positive modes + if ( ! is.null(mspos_rt) && ! is.null(msneg_rt)) { + + # Warn observers when both retention time lists are not identical + if ( ! identical(mspos_rt, msneg_rt)) + for (obs in .self$.observers) + obs$warning(paste0("Retention times in negative and positive modes are different in file ", .self$.get.file(molid), ".")) + + # Merge both lists + rt <- mspos_rt + for (c in names(msneg_rt)) + if (c %in% names(rt)) { + v <- c(rt[[c]], msneg_rt[[c]]) + rt[[c]] <- v[ ! duplicated(v)] + } + else + rt[[c]] <- msneg_rt[[c]] + } + else + # Set retention times + rt <- if (is.null(mspos_rt)) msneg_rt else mspos_rt + + if (is.null(rt)) rt <- list() + + # Write in cache + if ( ! is.na(cache_file)) { + + # Call observers + if ( ! is.null(.self$.observers)) + for (obs in .self$.observers) + obs$progress(paste0("Caching retention times of file ", .self$.get.file(molid), ".")) + + save(rt, file = cache_file) + } + } + + # Store in memory + .self$.mem.set(rt, molid, 'rt') + } + + # Select only one column if asked + if ( ! is.na(col)) rt <- rt[[col]] + + return(rt) + }) + + ################# + # GET NB PEAKS # + ################# + + MsXlsDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) { + + # Initialize parameters + if (is.null(molid) || (length(molid) == 1 && is.na(molid))) + molid <- .self$getMoleculeIds() + if (is.na(type)) + type <- c(MSDB.TAG.POS, MSDB.TAG.NEG) + + return(sum(vapply(molid, function(m) { if (is.na(m)) 0 else sum(vapply(type, function(t) { peaks <- .self$.get.peaks(m, t) ; if (is.null(peaks)) 0 else nrow(peaks) }, FUN.VALUE = 1)) }, FUN.VALUE = 1))) + }) + + ################## + # GET PEAK TABLE # + ################## + + MsXlsDb$methods( getPeakTable = function(molid = NA_integer_, mode = NA_character_) { + + peaks <- NULL + + # Set default molecule IDs + if (is.null(molid) || (length(molid) == 1 && is.na(molid))) + molid <- .self$getMoleculeIds() + + # Set default modes + if (is.null(mode) || (length(mode) == 1 && is.na(mode))) + mode <- c(MSDB.TAG.POS, MSDB.TAG.NEG) + + # Loop on all molecules + for (mol in molid) { + + # Loop on all modes + for (mod in mode) { + m.peaks <- .self$.get.peaks(mol, mod) + if ( ! is.null(m.peaks) && nrow(m.peaks) > 0) { + m.peaks[[MSDB.TAG.MOLID]] <- mol + m.peaks[[MSDB.TAG.MODE]] <- mod + peaks <- if (is.null(peaks)) m.peaks else rbind(peaks, m.peaks) + peaks <- df.move.col.first(peaks, c(MSDB.TAG.MOLID, MSDB.TAG.MODE)) + } + } + } + + return(peaks) + }) + + ################# + # GET MZ VALUES # + ################# + + # Returns a numeric vector of all masses stored inside the database. + MsXlsDb$methods( getMzValues = function(mode = NULL) { + + mz <- numeric() + + # Get all mz values of all molecules + for(molid in .self$getMoleculeIds()) + for (m in (if (is.null(mode) || is.na(mode)) c(MSDB.TAG.POS, MSDB.TAG.NEG) else mode)) + mz <- c(mz, .self$.get.peaks(molid, m)[[MSDB.TAG.MZTHEO]]) + + # Remove duplicated + mz <- mz[ ! duplicated(mz)] + + return(mz) + }) + + ############# + # GET PEAKS # + ############# + + MsXlsDb$methods( .get.peaks = function(molid, mode) { + + tab <- if (mode == MSDB.TAG.POS) .XLS_MSPOS_TAB else .XLS_MSNEG_TAB + + # Find it in memory + peak_df <- .self$.mem.get(molid, 'peaks', mode) + + if (is.null(peak_df)) { + # Call observers + if ( ! is.null(.self$.observers)) + for (obs in .self$.observers) + obs$progress(paste0("Loading peaks of tab ", tab, " of file ", .self$.get.file(molid), "."), level = 2) + + peak_df <- NULL + + # Load from cache file + cache_file <- NA_character_ + if ( ! is.na(.self$.get.cache.dir())) { + cache_file <- file.path(.self$.get.cache.dir(), paste0('peaks-', molid, '-', tab, '.csv')) + if (file.exists(cache_file)) + peak_df <- read.csv(cache_file, header = TRUE, stringsAsFactors = FALSE) + } + + # Read from XLS file, if not in cache + if (is.null(peak_df)) { + + # Load tab (peaks start at row 8) + if (.self$.tab.exists(.self$.get.file(molid), tab)) { + + peaks <- read.excel(.self$.get.file(molid), tab, start.row = .XLS_PEAKS_ROW_OFFSET, stringsAsFactors = FALSE) + if ( ! is.null(peaks)) + peaks <- peaks[ ! is.na(peaks[.XLS_MZ_COL]), , drop = FALSE] # Remove rows where m/z is not defined. TODO maybe call observer for notify a line with non NA values but without m/z value. + + # Instantiate peaks + if ( ! is.null(peaks) && nrow(peaks) > 0) { + peak_df <- peaks[1:length(peaks[[.XLS_MZ_COL]]), c(.XLS_MZ_COL, .XLS_THEORETICAL_MZ_COL, .XLS_INTENSITY_COL, .XLS_RELATIVE_COL, .XLS_COMPOSITION_COL, .XLS_ATTRIBUTION_COL), drop = FALSE] + colnames(peak_df) <- c(MSDB.TAG.MZEXP, MSDB.TAG.MZTHEO, MSDB.TAG.INT, MSDB.TAG.REL, MSDB.TAG.COMP, MSDB.TAG.ATTR) + } + + # Set default data frame (important for cache file writing, because we need a correct header to be written in order for loading) + else { + peak_df <- data.frame(stringsAsFactors = FALSE) + peak_df[MSDB.TAG.MZEXP] <- numeric() + peak_df[MSDB.TAG.MZTHEO] <- numeric() + peak_df[MSDB.TAG.INT] <- numeric() + peak_df[MSDB.TAG.REL] <- numeric() + peak_df[MSDB.TAG.COMP] <- character() + peak_df[MSDB.TAG.ATTR] <- character() + } + + if (is.null(peak_df)) peak_df <- data.frame() + + # Write in cache + if ( ! is.na(cache_file)) { + + # Call observers + if ( ! is.null(.self$.observers)) + for (obs in .self$.observers) + obs$progress(paste0("Caching peaks of tab ", tab, " of file ", .self$.get.file(molid), ".")) + + write.csv(peak_df, cache_file, row.names = FALSE) + } + } + } + + # Store in memory + .self$.mem.set(peak_df, molid, 'peaks', mode) + } + + return(peak_df) + }) + + ############################## + # GET FULL MS PEAK M/Z INDEX # + ############################## + + # Get mz index for full ions, creating it if necessary. + MsXlsDb$methods( .get.mz.index = function(mode) { + + if (is.null(.self$.mz.index[[mode]])) { + + # Initialize data frame + mzi <- data.frame(stringsAsFactors = FALSE) + mzi[MSDB.TAG.MZTHEO] <- numeric() + mzi[MSDB.TAG.MOLID] <- character() + mzi[MSDB.TAG.COMP] <- character() + mzi[MSDB.TAG.ATTR] <- character() + + # Loop on all molecules + for(molid in .self$getMoleculeIds()) { + + # Get all peaks of this molecule + peaks <- .self$.get.peaks(molid, mode) + + # Remove rows whose mz is NA. + peaks <- peaks[ ! is.na(peaks[[MSDB.TAG.MZTHEO]]), ] + + if (nrow(peaks) > 0) { + + # Add id column + peaks[MSDB.TAG.MOLID] <- molid + + # Append peaks + r <- nrow(mzi) + 1 + rows <- r:(r+nrow(peaks)-1) + mzi[rows, ] <- peaks[colnames(mzi)] + } + } + + # Sort by M/Z + sorted_indices <- order(mzi[[MSDB.TAG.MZTHEO]]) + + # Group in a data frame + .self$.mz.index[[mode]] <- mzi[sorted_indices, ] + } + + return(.self$.mz.index[[mode]]) + }) + + ###################### + # SEARCH FOR MZ & RT # + ###################### + + MsXlsDb$methods( .do.search.for.mz.rt.bounds = function(mode, mz.low, mz.high, rt.low = NULL, rt.high = NULL, col = NULL, attribs = NULL, molids = NULL) { + + # Search for m/z + results <- .self$.do.search.for.mz(mode, mz.low, mz.high) + + # Filter on attributions + if ( ! is.null(attribs)) { + results <- results[results[[MSDB.TAG.ATTR]] %in% attribs, ] + } + + # Filer on molecule IDs + if ( ! is.null(molids)) { + results <- results[results[[MSDB.TAG.MOLID]] %in% molids, ] + } + + # Use retention time + if ( ! is.null(col) && ! is.null(rt.low) && ! is.null(rt.high)) { + + # Get list of unique IDs + ids <- results[[MSDB.TAG.MOLID]] + ids <- ids[ ! duplicated(ids)] + rt <- .self$.search.for.rt(mols = ids, rt.low = rt.low, rt.high = rt.high, col = col) + results <- results[results[[MSDB.TAG.MOLID]] %in% rt[[MSDB.TAG.MOLID]], ] + results <- merge(results, rt) + } + + return(results) + }) + + ############################## + # SEARCH FOR M/Z IN MS PEAKS # + ############################## + + MsXlsDb$methods( .do.search.for.mz = function(mode, mz.low, mz.high) { + + results <- data.frame(stringsAsFactors = FALSE) + results[MSDB.TAG.MZTHEO] <- numeric() + results[MSDB.TAG.MOLID] <- character() + results[MSDB.TAG.MOLNAMES] <- character() + results[MSDB.TAG.COMP] <- character() + results[MSDB.TAG.ATTR] <- character() + + # Create m/z index + mz_index <- .self$.get.mz.index(mode) + + # Find molecules + low_bound <- binary.search(mz.low, mz_index[[MSDB.TAG.MZTHEO]], lower = FALSE) + high_bound <- binary.search(mz.high, mz_index[[MSDB.TAG.MZTHEO]], lower = TRUE) + + # Get results + if ( ! is.na(high_bound) && ! is.na(low_bound) && low_bound <= high_bound) + results <- mz_index[low_bound:high_bound,] + + # Remove row names + rownames(results) <- NULL + + return(results) + }) + + ################ + # GET MOL NAME # + ################ + + MsXlsDb$methods( .get.mol.name = function(molid) { + + if (is.na(molid)) + return(NA_character_) + + # Find it in memory + name <- .self$.mem.get(molid, 'name') + + if (is.null(name)) { + + # Load molecule + mol <- .self$.load.molecule(molid) + + # Look for name in tabs + for (tab in c(.XLS_MSPOS_TAB, .XLS_MSNEG_TAB)) { + hdr <- mol[[tab]][['header']] + if ( ! is.null(hdr)) + name <- hdr[[1]] + if ( ! is.null(name) && ! is.na(name)) break + } + + # Store in memory + if (is.null(name)) name <- NA_character_ + .self$.mem.set(name, molid, 'name') + } + + return(name) + }) + + ################## + # GET NAME INDEX # + ################## + + # Get name index. + MsXlsDb$methods( .get.name.index = function() { + + if (is.null(.self$.name_index)) { + + # Get names + names <- vapply(.self$getMoleculeIds(), function(id) toupper(.self$getMoleculeName(id)), FUN.VALUE = "") + + # Get molecule IDs + id <- .self$getMoleculeIds() + + # Sort by names + sorted_indices <- order(names) + + # Group in a data frame + .self$.name_index <- data.frame(name = rbind(names)[, sorted_indices], + id = rbind(id)[, sorted_indices], + stringsAsFactors = FALSE) + } + + return(.self$.name_index) + }) + + ################## + # INIT FILE LIST # + ################## + + MsXlsDb$methods( .init.file.list = function() { + + if (is.null(.self$.files)) { + + # List all files + files <- Sys.glob(file.path(.self$.db_dir, '*.xls')) + + # Limit the size of the database + if ( ! is.na(.self$.limit)) + files <- head(files, .self$.limit) + + # Get IDs + ids <- vapply(files, function(f) .extract_molecule_id_from_filename(f), FUN.VALUE = 1) + + # Use ids as indices to build the vector of files + .files <<- rep(NA_character_, max(ids)) + .files[ids] <<- files + } + }) + + ################# + # GET CACHE DIR # + ################# + + MsXlsDb$methods( .get.cache.dir = function() { + + if ( ! is.na(.self$.cache_dir) && ! file.exists(.self$.cache_dir)) + dir.create(.self$.cache_dir) + + return(.self$.cache_dir) + }) + + ################# + # LOAD MOLECULE # + ################# + + MsXlsDb$methods( .load.molecule = function(molid) { + + # Init local variables + mol <- NULL + cache_file <- NA_character_ + excel_file <- .self$.get.file(molid) + + # Call observers + if ( ! is.null(.self$.observers)) + for (obs in .self$.observers) + obs$progress(paste0("Loading molecule ", molid, "."), level = 2) + + # Load from cache + if ( ! is.na(.self$.get.cache.dir())) { + cache_file <- file.path(.self$.get.cache.dir(), paste0(molid, '.bin')) + if (file.exists(cache_file)) + load(file = cache_file) # load mol variable + } + + # Load from Excel file & write to cache + if (is.null(mol) && ! is.na(excel_file)) { + + source(file.path(.THIS.FILE.PATH, 'excelhlp.R'), chdir = TRUE) # we use the path set when sourcing the file, since when calling this method, the current path could be different. + + # Load from Excel file + for(tab in c(.XLS_MSPOS_TAB, .XLS_MSNEG_TAB)) { + + # Test that tab exists + if (.self$.tab.exists(excel_file, tab)) { + header <- read.excel(excel_file, tab, start.row = 1, end.row = .XLS_PEAKS_ROW_OFFSET - 1, header = FALSE, stringsAsFactors = FALSE, trim.values = TRUE, col.index = c(1))[[1]] + peaks <- read.excel(excel_file, tab, start.row = .XLS_PEAKS_ROW_OFFSET) + mol[[tab]] <- list(header = header, peaks = peaks) + } + + # Missing tab + else { + for (obs in .self$.observers) + obs$warning(paste0("No excel tab ", tab, " in file ", excel_file, ".")) + } + } + + # Write in cache + if ( ! is.na(cache_file)) { + + # Call observers + if ( ! is.null(.self$.observers)) + for (obs in .self$.observers) + obs$progress(paste0("Caching file ", excel_file, ".")) + + save(mol, file = cache_file) + } + } + + return(mol) + }) + + ######################## + # DOES EXCEL TAB EXIST # + ######################## + + MsXlsDb$methods( .tab.exists = function(file, tab) { + + source(file.path(.THIS.FILE.PATH, 'excelhlp.R'), chdir = TRUE) # we use the path set when sourcing the file, since when calling this method, the current path could be different. + + if ( ! tab.exists(file, tab)) { + + # Warn observers + for (obs in .self$.observers) + obs$warning(paste0("No excel tab ", tab, " in file ", file, ".")) + + return(FALSE) + } + + return(TRUE) + }) + + ######################### + # PARSE RETENTION TIMES # + ######################### + + MsXlsDb$methods( .parse_retention_times = function(id, tab) { + + rt <- NULL + + if (.self$.tab.exists(.self$.get.file(id), tab)) { + peaks <- read.excel(.self$.get.file(id), tab, start.row = .XLS_PEAKS_ROW_OFFSET) + + # Get retention times + if ( ! is.null(peaks) && length(peaks) > 0 && ! is.na(peaks[[1]][[1]])) + for (c in .XLS_PEAKS_RT_COL_START:length(names(peaks))) + if ( ! is.na(peaks[[c]][[1]])) { + + # Check retention times of all different m/z peaks for the same column. + .self$.check_retention_times(id, tab, names(peaks)[[c]], peaks[[c]], sum( ! is.na(peaks[[1]]))) + + # Add retention time + # TODO The column names are transformed through the read.xlsx call. For instance: + # HPLC (C18) 25mn QTOF (Bis) --> HPLC..C18..25mn.QTOF..Bis. + # ZICpHILIC 150*5*2.1 Shimadzu-Exactive-42mn --> ZICpHILIC.150.5.2.1.Shimadzu.Exactive.42mn + # This can be an issue, since we loose the formating. + col_id <- names(peaks)[[c]] + time <- peaks[[c]][[1]] * 60 # Read and convert retention time in seconds. + if (is.null(rt) || ! col_id %in% names(rt)) + rt[[col_id]] <- list(time) + else + rt[[col_id]] <- c(rt[[col_id]], time) + } + } + + return(rt) + }) + + ######################### + # CHECK RETENTION TIMES # + ######################### + + MsXlsDb$methods( .check_retention_times = function(id, tab_name, column_name, rt, n) { + + if (n >= 1 && ! is.null(.self$.observers) && length(.self$.observers) > 0) + + # Check column only if there is at least one value inside + if (sum( ! is.na(rt)) > 0) + + # Loop on all values + for(i in 1:n) { + + # Check that it's defined + if (i > 1 && is.na(rt[[i]])) + for (obs in .self$.observers) + obs$warning(paste0("Retention times undefined for column ", column_name, " at row ", i + .XLS_PEAKS_ROW_OFFSET, " of tab ", tab_name, " in file ", .self$.get.file(id), ".")) + + else if (i > 1) + # Check the value (it must be constant) + if (rt[[i-1]] != rt[[i]]) + for (obs in .self$.observers) + obs$error(paste0("Retention times not constant for column ", column_name, " between row ", i - 1 + .XLS_PEAKS_ROW_OFFSET, " and row ", i + .XLS_PEAKS_ROW_OFFSET, "o tab", tab_name, "in file", .self$.get.file(id))) + } + }) + + #################### + # GET FILE FROM ID # + #################### + + MsXlsDb$methods( .get.file = function(id) { + + # List files + .self$.init.file.list() + + return( if (id > 0 && id <= length(.self$.files)) .self$.files[id] else NA_character_) + }) + + ########### + # MEM GET # + ########### + + # Get database data from memory + MsXlsDb$methods( .mem.get = function(molid, field, second.field = NA_character_) { + + data <- .self$.db[[as.character(molid)]][[field]] + + if ( ! is.na(second.field)) + data <- data[[second.field]] + + return(data) + }) + + ########### + # MEM SET # + ########### + + # Set database data into memory + MsXlsDb$methods( .mem.set = function(data, molid, field, second.field = NA_character_) { + + id <- as.character(molid) + + # Create db + if (is.null(.self$.db)) + .db <<- list() + + # Create first level + if (is.null(.self$.db[[id]])) + .self$.db[[id]] <- list() + + # Create second level + if ( ! is.na(second.field) && is.null(.self$.db[[id]][[field]])) + .self$.db[[id]][[field]] <- list() + + # Store data + if (is.na(second.field)) { + .self$.db[[id]][[field]] <- data + } else { + .self$.db[[id]][[field]][[second.field]] <- data + } + }) + + ################# + # SEARCH FOR RT # + ################# + + # Find molecules matching a certain retention time. + # col A list of chromatographic columns to use. + # rt.low The lower bound of the rt value. + # rt.high The higher bound of the rt value. + # mols A list of molecule IDs to process. If unset, then take all molecules. + # Return a data frame with the following columns: id, col, colrt. + MsXlsDb$methods( .search.for.rt = function(col, rt.low, rt.high, mols = NULL) { + + # Use all molecules if no list is provided + if (is.null(mols)) + mols <- .self$getMoleculeIds() + + results <- data.frame(id = integer(), col = character(), colrt = double(), stringsAsFactors = FALSE) + + # Loop on all molecules + for (molid in mols) { + no.col <- TRUE + for (c in col) { + molrts <- .self$getRetentionTimes(molid, c) + if ( ! is.null(molrts)) { + no.col <- FALSE + for (molrt in molrts) { + if (molrt >= rt.low && molrt <= rt.high) { + r <- nrow(results) + 1 + results[r, ] <- c(id = molid, col = c, colrt = molrt) + } + } + } + } + + if (no.col) { + r <- nrow(results) + 1 + results[r, c(MSDB.TAG.MOLID)] <- c(id = molid) + } + } + + return(results) + }) + + ############################ + # EXTRACT ID FROM FILENAME # + ############################ + + .extract_molecule_id_from_filename <- function(filename) { + + id <- NA_integer_ + + if ( ! is.na(filename)) { + g <- str_match(filename, "N(\\d+)[._-]") + if ( ! is.na(g[1,1])) + id <- as.numeric(g[1,2]) + } + + return(id) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/NcbiCcdsCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,46 @@ +if ( ! exists('NcbiccdsCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + NcbiccdsCompound <- setRefClass("NcbiccdsCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createNcbiccdsCompoundFromHtml <- function(contents, drop = TRUE) { + + library(XML) + + compounds <- list() + + for (html in contents) { + + # Create instance + compound <- NcbiccdsCompound$new() + + # Parse HTML + xml <- htmlTreeParse(html, asText = TRUE, useInternalNodes = TRUE) + + if (length(getNodeSet(xml, "//*[starts-with(.,'No results found for CCDS ID ')]")) == 0) { + compound$setField(RBIODB.ACCESSION, xpathSApply(xml, "//input[@id='DATA']", xmlGetAttr, "value")) + compound$setField(RBIODB.SEQUENCE, xpathSApply(xml, "//b[starts-with(.,'Nucleotide Sequence')]/../tt", xmlValue)) + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/NcbiCcdsConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,56 @@ +if ( ! exists('NcbiccdsConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('NcbiccdsCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + NcbiccdsConn <- setRefClass("NcbiccdsConn", contains = "BiodbConn") + + ############### + # CONSTRUCTOR # + ############### + + NcbiccdsConn$methods( initialize = function(...) { + # From NCBI E-Utility manual: "In order not to overload the E-utility servers, NCBI recommends that users post no more than three URL requests per second and limit large jobs to either weekends or between 9:00 PM and 5:00 AM Eastern time during weekdays". + callSuper(scheduler = UrlRequestScheduler$new(n = 3), ...) + }) + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + NcbiccdsConn$methods( getEntryContentType = function(type) { + return(RBIODB.HTML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + NcbiccdsConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.NCBICCDS, x)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + NcbiccdsConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createNcbiccdsCompoundFromHtml(content, drop = drop) else NULL) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/NcbiGeneCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,118 @@ +if ( ! exists('NcbigeneCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + source(file.path('strhlp.R'), chdir = TRUE) + + ##################### + # CLASS DECLARATION # + ##################### + + NcbigeneCompound <- setRefClass("NcbigeneCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createNcbigeneCompoundFromXml <- function(contents, drop = TRUE) { + + library(XML) + + compounds <- list() + + # Define xpath expressions + xpath.expr <- character() + xpath.expr[[RBIODB.ACCESSION]] <- "//Gene-track_geneid" + xpath.expr[[RBIODB.KEGG.ID]] <- "/Dbtag_db[text()='KEGG']/..//Object-id_str" + xpath.expr[[RBIODB.UNIPROT.ID]] <- "//Gene-commentary_heading[text()='UniProtKB']/..//Dbtag_db[text()='UniProtKB/Swiss-Prot']/..//Object-id_str" + xpath.expr[[RBIODB.LOCATION]] <- "//Gene-ref_maploc" + xpath.expr[[RBIODB.PROTEIN.DESCRIPTION]] <- "//Gene-ref_desc" + xpath.expr[[RBIODB.SYMBOL]] <- "//Gene-ref_locus" + xpath.expr[[RBIODB.SYNONYMS]] <- "//Gene-ref_syn_E" + + for (content in contents) { + + # Create instance + compound <- NcbigeneCompound$new() + + # Parse HTML + xml <- xmlInternalTreeParse(content, asText = TRUE) + + # An error occured + if (length(getNodeSet(xml, "//Error")) == 0 && length(getNodeSet(xml, "//ERROR")) == 0) { + + # Test generic xpath expressions + for (field in names(xpath.expr)) { + v <- xpathSApply(xml, xpath.expr[[field]], xmlValue) + if (length(v) > 0) { + + # Eliminate duplicates + v <- v[ ! duplicated(v)] + + # Set field + compound$setField(field, v) + } + } + + # CCDS ID + ccdsid <- .find.ccds.id(xml) + if ( ! is.na(ccdsid)) + compound$setField(RBIODB.NCBI.CCDS.ID, ccdsid) + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + + # Get data + + } + + ################ + # FIND CCDS ID # + ################ + + .find.ccds.id <- function(xml) { + + # 1) Get all CCDS tags. + ccds_elements <- getNodeSet(xml, "//Dbtag_db[text()='CCDS']/..//Object-id_str") + + # 2) If all CCDS are the same, go to point 4. + ccds <- NA_character_ + for (e in ccds_elements) { + current_ccds <- xmlValue(e) + if (is.na(ccds)) + ccds <- current_ccds + else { + if (current_ccds != ccds) { + ccds <- NA_character_ + break + } + } + } + + # 3) There are several CCDS values, we need to find the best one (i.e.: the most current one). + if (is.na(ccds)) { + # For each CCDS, look for the parent Gene-commentary tag. Then look for the text content of the Gene-commentary_label which is situed under. Ignore CCDS that have no Gene-commentary_label associated. Choose the CCDS that has the smallest Gene-commentary_label in alphabetical order. + version <- NA_character_ + for (e in ccds_elements) { + versions <- xpathSApply(e, "ancestor::Gene-commentary/Gene-commentary_label", xmlValue) + if (length(versions) < 1) next + current_version <- versions[[length(versions)]] + if (is.na(version) || current_version < version) { + version <- current_version + ccds <- xmlValue(e) + } + } + } + + return(ccds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/NcbiGeneConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,56 @@ +if ( ! exists('NcbigeneConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('NcbigeneCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + NcbigeneConn <- setRefClass("NcbigeneConn", contains = "BiodbConn") + + ############### + # CONSTRUCTOR # + ############### + + NcbigeneConn$methods( initialize = function(...) { + # From NCBI E-Utility manual: "In order not to overload the E-utility servers, NCBI recommends that users post no more than three URL requests per second and limit large jobs to either weekends or between 9:00 PM and 5:00 AM Eastern time during weekdays". + callSuper(scheduler = UrlRequestScheduler$new(n = 3), ...) + }) + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + NcbigeneConn$methods( getEntryContentType = function(type) { + return(RBIODB.XML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + NcbigeneConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.NCBIGENE, x)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + NcbigeneConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createNcbigeneCompoundFromXml(content, drop = drop) else NULL) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/PubchemCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,71 @@ +if ( ! exists('PubchemCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + PubchemCompound <- setRefClass("PubchemCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createPubchemCompoundFromXml <- function(contents, drop = TRUE) { + + library(XML) + + compounds <- list() + + # Set XML namespace + ns <- c(pubchem = "http://pubchem.ncbi.nlm.nih.gov/pug_view") + + # Define xpath expressions + xpath.expr <- character() + xpath.expr[[RBIODB.ACCESSION]] <- "//pubchem:RecordType[text()='CID']/../pubchem:RecordNumber" + xpath.expr[[RBIODB.INCHI]] <- "//pubchem:Name[text()='InChI']/../pubchem:StringValue" + xpath.expr[[RBIODB.INCHIKEY]] <- "//pubchem:Name[text()='InChI Key']/../pubchem:StringValue" + + for (content in contents) { + + # Create instance + compound <- PubchemCompound$new() + + # Parse XML + xml <- xmlInternalTreeParse(content, asText = TRUE) + + # Unknown compound + fault <- xpathSApply(xml, "/pubchem:Fault", xmlValue, namespaces = ns) + if (length(fault) == 0) { + + # Test generic xpath expressions + for (field in names(xpath.expr)) { + v <- xpathSApply(xml, xpath.expr[[field]], xmlValue, namespaces = ns) + if (length(v) > 0) + compound$setField(field, v) + } + + # Get name + name <- NA_character_ + tryCatch( { name <- xpathSApply(xml, "//pubchem:Name[text()='IUPAC Name']/../pubchem:StringValue", xmlValue, namespaces = ns) }, warning = function(w) {}) + if (is.na(name)) + tryCatch( { name <- xpathSApply(xml, "//pubchem:Name[text()='Record Title']/../pubchem:StringValue", xmlValue, namespaces = ns) }, warning = function(w) {}) + if ( ! is.na(name)) + compound$setField(RBIODB.NAME, name) + + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/PubchemConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,59 @@ +if ( ! exists('get.pubchem.compound.url')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('PubchemCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + PubchemConn <- setRefClass("PubchemConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + PubchemConn$methods( getEntryContentType = function(type) { + return(RBIODB.XML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + PubchemConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.PUBCHEM, x, content.type = RBIODB.XML)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + PubchemConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createPubchemCompoundFromXml(content, drop = drop) else NULL) + }) + + ######################### + # GET PUBCHEM IMAGE URL # + ######################### + + get.pubchem.image.url <- function(id) { + + url <- paste0('http://pubchem.ncbi.nlm.nih.gov/image/imgsrv.fcgi?cid=', id, '&t=l') + + return(url) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/UniProtCompound.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,81 @@ +if ( ! exists('UniprotCompound')) { # Do not load again if already loaded + + source('BiodbEntry.R') + + ##################### + # CLASS DECLARATION # + ##################### + + UniprotCompound <- setRefClass("UniprotCompound", contains = "BiodbEntry") + + ########### + # FACTORY # + ########### + + createUniprotCompoundFromXml <- function(contents, drop = FALSE) { + + library(XML) + + # Set XML namespace + ns <- c(uniprot = "http://uniprot.org/uniprot") + + compounds <- list() + + # Define xpath expressions + xpath.values <- character() + xpath.values[[RBIODB.NAME]] <- "/uniprot:uniprot/uniprot:compound/uniprot:name" + xpath.values[[RBIODB.GENE.SYMBOLS]] <- "//uniprot:gene/uniprot:name" + xpath.values[[RBIODB.FULLNAMES]] <- "//uniprot:protein//uniprot:fullName" + xpath.values[[RBIODB.SEQUENCE]] <- "//uniprot:entry/uniprot:sequence" + xpath.values[[RBIODB.ACCESSION]] <- "//uniprot:accession[1]" + xpath.attr <- list() + xpath.attr[[RBIODB.KEGG.ID]] <- list(path = "//uniprot:dbReference[@type='KEGG']", attr = 'id') + xpath.attr[[RBIODB.NCBI.GENE.ID]] <- list(path = "//uniprot:dbReference[@type='GeneID']", attr = 'id') + xpath.attr[[RBIODB.ENZYME.ID]] <- list(path = "//uniprot:dbReference[@type='EC']", attr = 'id') + xpath.attr[[RBIODB.MASS]] <- list(path = "//uniprot:entry/uniprot:sequence", attr = 'mass') + xpath.attr[[RBIODB.LENGTH]] <- list(path = "//uniprot:entry/uniprot:sequence", attr = 'length') + + for (content in contents) { + + # Create instance + compound <- HmdbCompound$new() + + # If the entity doesn't exist (i.e.: no <id>.xml page), then it returns an HTML page + if ( ! grepl("^<!DOCTYPE html ", content, perl = TRUE)) { + + # Parse XML + xml <- xmlInternalTreeParse(content, asText = TRUE) + + # Test value xpath + for (field in names(xpath.values)) { + v <- xpathSApply(xml, xpath.values[[field]], xmlValue, namespaces = ns) + if (length(v) > 0) + compound$setField(field, v) + } + + # Test attribute xpath + for (field in names(xpath.attr)) { + v <- xpathSApply(xml, xpath.attr[[field]]$path, xmlGetAttr, xpath.attr[[field]]$attr, namespaces = ns) + if (length(v) > 0) + compound$setField(field, v) + } + + # Remove new lines from sequence string + seq <- compound$getField(RBIODB.SEQUENCE) + if ( ! is.na(seq)) + compound$setField(RBIODB.SEQUENCE, gsub("\\n", "", seq)) + } + + compounds <- c(compounds, compound) + } + + # Replace elements with no accession id by NULL + compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) + + # If the input was a single element, then output a single object + if (drop && length(contents) == 1) + compounds <- compounds[[1]] + + return(compounds) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/UniProtConn.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,47 @@ +if ( ! exists('UniprotConn')) { # Do not load again if already loaded + + source('BiodbConn.R') + source('UniprotCompound.R') + + ##################### + # CLASS DECLARATION # + ##################### + + UniprotConn <- setRefClass("UniprotConn", contains = "BiodbConn") + + ########################## + # GET ENTRY CONTENT TYPE # + ########################## + + UniprotConn$methods( getEntryContentType = function(type) { + return(RBIODB.XML) + }) + + ##################### + # GET ENTRY CONTENT # + ##################### + + UniprotConn$methods( getEntryContent = function(type, id) { + + if (type == RBIODB.COMPOUND) { + + # Initialize return values + content <- rep(NA_character_, length(id)) + + # Request + content <- vapply(id, function(x) .self$.scheduler$getUrl(get.entry.url(RBIODB.UNIPROT, x, content.type = RBIODB.XML)), FUN.VALUE = '') + + return(content) + } + + return(NULL) + }) + + ################ + # CREATE ENTRY # + ################ + + UniprotConn$methods( createEntry = function(type, content, drop = TRUE) { + return(if (type == RBIODB.COMPOUND) createUniprotCompoundFromXml(content, drop = drop) else NULL) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/UrlRequestScheduler.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,126 @@ +if ( ! exists('UrlRequestScheduler')) { # Do not load again if already loaded + + ############# + # CONSTANTS # + ############# + + RLIB.GET <- 'GET' + RLIB.POST <- 'POST' + + ##################### + # CLASS DECLARATION # + ##################### + + UrlRequestScheduler <- setRefClass("UrlRequestScheduler", fields = list(.n = "numeric", .t = "numeric", .time.of.last.request = "ANY", .useragent = "character", .ssl.verifypeer = "logical", .nb.max.tries = "integer", .verbose = "integer")) + + # n: number of connections + # t: time (in seconds) + + # The scheduler restrict the number of connections at n per t seconds. + + ############### + # CONSTRUCTOR # + ############### + + UrlRequestScheduler$methods( initialize = function(n = 1, t = 1, useragent = NA_character_, ssl.verifypeer = TRUE, ...) { + .n <<- n + .t <<- t + .time.of.last.request <<- -1 + .useragent <<- useragent + .nb.max.tries <<- 10L + .ssl.verifypeer <<- ssl.verifypeer + .verbose <<- 0L + callSuper(...) # calls super-class initializer with remaining parameters + }) + + ################## + # SET USER AGENT # + ################## + + UrlRequestScheduler$methods( setUserAgent = function(useragent) { + .useragent <<- useragent + }) + + ############### + # SET VERBOSE # + ############### + + UrlRequestScheduler$methods( setVerbose = function(verbose) { + .verbose <<- verbose + }) + + ################## + # WAIT AS NEEDED # + ################## + + # Wait the specified between two requests. + UrlRequestScheduler$methods( .wait.as.needed = function() { + + # Compute minimum waiting time between two URL requests + waiting_time <- .self$.t / .self$.n + + # Wait, if needed, before previous URL request and this new URL request. + if (.self$.time.of.last.request > 0) { + spent_time <- Sys.time() - .self$.time.of.last.request + if (spent_time < waiting_time) + Sys.sleep(waiting_time - spent_time) + } + + # Store current time + .time.of.last.request <<- Sys.time() + }) + + #################### + # GET CURL OPTIONS # + #################### + + UrlRequestScheduler$methods( .get_curl_opts = function(url) { + opts <- curlOptions(useragent = .self$.useragent, timeout.ms = 60000, verbose = FALSE) + return(opts) + }) + + ########### + # GET URL # + ########### + + UrlRequestScheduler$methods( .doGetUrl = function(url, params = NULL, method = RLIB.GET) { + + content <- NA_character_ + + # Use form to send URL request + if ( ! is.null(params) && ! is.na(params)) + switch(method, + GET = { content <- getForm(url, .opts = .self$.get_curl_opts(), .params = params) }, + POST = { content <- postForm(url, .opts = .self$.get_curl_opts(), .params = params) }, + stop(paste('Unknown method "', method, '".')) + ) + + # Get URL normally + else + content <- getURL(url, .opts = .self$.get_curl_opts(), ssl.verifypeer = .self$.ssl.verifypeer) + + return(content) + }) + + UrlRequestScheduler$methods( getUrl = function(url, params = NULL, method = RLIB.GET) { + + # Load library here and not inside .doGetUrl() since it is called from inside a try/catch clause, hence if library is missing the error will be ignored. + library(bitops) + library(RCurl) + + content <- NA_character_ + + # Wait required time between two requests + .self$.wait.as.needed() + + # Run query + for (i in seq(.self$.nb.max.tries)) { + tryCatch({ content <- .self$.doGetUrl(url, params = params, method = method) }, + error = function(e) { if (.self$.verbose > 0) print("Retry connection to server...") } ) + if ( ! is.na(content)) + break + } + + return(content) + }) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/biodb-common.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,181 @@ +if ( ! exists('RBIODB.COMPOUND')) { # Do not load again if already loaded + + ############# + # CONSTANTS # + ############# + + # Entry types + RBIODB.COMPOUND <- 'compound' + RBIODB.SPECTRUM <- 'spectrum' + + # Entry content types + RBIODB.HTML <- 'html' + RBIODB.TXT <- 'txt' + RBIODB.XML <- 'xml' + RBIODB.CSV <- 'csv' + RBIODB.ANY <- 'any' + + # Class names + RBIODB.CHEBI <- 'chebi' + RBIODB.KEGG <- 'kegg' + RBIODB.PUBCHEM <- 'pubchem' + RBIODB.HMDB <- 'hmdb' + RBIODB.CHEMSPIDER <- 'chemspider' + RBIODB.ENZYME <- 'enzyme' + RBIODB.LIPIDMAPS <- 'lipidmaps' + RBIODB.MIRBASE <- 'mirbase' + RBIODB.NCBIGENE <- 'ncbigene' + RBIODB.NCBICCDS <- 'ncbiccds' + RBIODB.UNIPROT <- 'uniprot' + RBIODB.MASSBANK <- 'massbank' + + # Fields + RBIODB.COMPOUND <- 'compound' + RBIODB.ACCESSION <- 'accession' + RBIODB.DESCRIPTION <- 'description' + RBIODB.PROTEIN.DESCRIPTION <- 'protdesc' + RBIODB.NAME <- 'name' + RBIODB.FULLNAMES <- 'fullnames' + RBIODB.SYNONYMS <- 'synonyms' + RBIODB.SYMBOL <- 'symbol' + RBIODB.GENE.SYMBOLS <- 'genesymbols' + RBIODB.CHEBI.ID <- 'chebiid' + RBIODB.LIPIDMAPS.ID <- 'lipidmapsid' + RBIODB.KEGG.ID <- 'keggid' + RBIODB.HMDB.ID <- 'hmdbid' + RBIODB.ENZYME.ID <- 'enzymeid' + RBIODB.NCBI.CCDS.ID <- 'ncbiccdsid' + RBIODB.NCBI.GENE.ID <- 'ncbigeneid' + RBIODB.PUBCHEM.ID <- 'pubchemid' + RBIODB.UNIPROT.ID <- 'uniprotid' + RBIODB.INCHI <- 'inchi' + RBIODB.INCHIKEY <- 'inchikey' + RBIODB.MSDEV <- 'msdev' + RBIODB.MSDEVTYPE <- 'msdevtype' + RBIODB.MSTYPE <- 'mstype' + RBIODB.MSMODE <- 'msmode' + RBIODB.MSPRECMZ <- 'msprecmz' # numeric + RBIODB.MSPRECANNOT <- 'msprecannot' + RBIODB.FORMULA <- 'formula' + RBIODB.SUPER.CLASS <- 'superclass' + RBIODB.MASS <- 'mass' + RBIODB.AVERAGE.MASS <- 'averagemass' + RBIODB.MONOISOTOPIC.MASS <- 'monoisotopicmass' + RBIODB.SEQUENCE <- 'sequence' + RBIODB.LOCATION <- 'location' + RBIODB.LENGTH <- 'length' + RBIODB.NB.PEAKS <- 'nbpeaks' + RBIODB.NB.PEAKS <- 'nbpeaks' + RBIODB.PEAKS <- 'peaks' + + # Mode values + RBIODB.MSMODE.NEG <- 'neg' + RBIODB.MSMODE.POS <- 'pos' + + # Cardinalities + RBIODB.CARD.ONE <- '1' + RBIODB.CARD.MANY <- '*' + + # Field attributes + RBIODB.FIELDS <- data.frame(matrix(c( + # FIELD NAME CLASS CARDINALITY + RBIODB.COMPOUND, 'BiodEntry', RBIODB.CARD.ONE, + RBIODB.ACCESSION, 'character', RBIODB.CARD.ONE, + RBIODB.DESCRIPTION, 'character', RBIODB.CARD.ONE, + RBIODB.NAME, 'character', RBIODB.CARD.ONE, + RBIODB.FULLNAMES, 'character', RBIODB.CARD.MANY, + RBIODB.SYNONYMS, 'character', RBIODB.CARD.MANY, + RBIODB.PROTEIN.DESCRIPTION, 'character', RBIODB.CARD.ONE, + RBIODB.SYMBOL, 'character', RBIODB.CARD.ONE, + RBIODB.GENE.SYMBOLS, 'character', RBIODB.CARD.MANY, + RBIODB.CHEBI.ID, 'character', RBIODB.CARD.ONE, + RBIODB.LIPIDMAPS.ID, 'character', RBIODB.CARD.ONE, + RBIODB.KEGG.ID, 'character', RBIODB.CARD.ONE, + RBIODB.HMDB.ID, 'character', RBIODB.CARD.ONE, + RBIODB.ENZYME.ID, 'character', RBIODB.CARD.ONE, + RBIODB.PUBCHEM.ID, 'character', RBIODB.CARD.ONE, + RBIODB.UNIPROT.ID, 'character', RBIODB.CARD.ONE, + RBIODB.NCBI.CCDS.ID, 'character', RBIODB.CARD.ONE, + RBIODB.NCBI.GENE.ID, 'character', RBIODB.CARD.ONE, + RBIODB.INCHI, 'character', RBIODB.CARD.ONE, + RBIODB.INCHIKEY, 'character', RBIODB.CARD.ONE, + RBIODB.MSDEV, 'character', RBIODB.CARD.ONE, + RBIODB.MSDEVTYPE, 'character', RBIODB.CARD.ONE, + RBIODB.MSTYPE, 'character', RBIODB.CARD.ONE, + RBIODB.MSMODE, 'character', RBIODB.CARD.ONE, + RBIODB.MSPRECMZ, 'double', RBIODB.CARD.ONE, + RBIODB.MSPRECANNOT, 'character', RBIODB.CARD.ONE, + RBIODB.FORMULA, 'character', RBIODB.CARD.ONE, + RBIODB.SUPER.CLASS, 'character', RBIODB.CARD.ONE, + RBIODB.MASS, 'double', RBIODB.CARD.ONE, + RBIODB.AVERAGE.MASS, 'double', RBIODB.CARD.ONE, + RBIODB.MONOISOTOPIC.MASS, 'double', RBIODB.CARD.ONE, + RBIODB.SEQUENCE, 'character', RBIODB.CARD.ONE, + RBIODB.LENGTH, 'integer', RBIODB.CARD.ONE, + RBIODB.LOCATION, 'character', RBIODB.CARD.ONE, + RBIODB.NB.PEAKS, 'integer', RBIODB.CARD.ONE, + RBIODB.PEAKS, 'data.frame', RBIODB.CARD.ONE + ), byrow = TRUE, ncol = 3), stringsAsFactors = FALSE) + colnames(RBIODB.FIELDS) <- c('name', 'class', 'cardinality') + + # How to compute a missing field ? + RBIODB.FIELD.COMPUTING <- list() + RBIODB.FIELD.COMPUTING[[RBIODB.INCHI]] <- c(RBIODB.CHEBI) + RBIODB.FIELD.COMPUTING[[RBIODB.INCHIKEY]] <- c(RBIODB.CHEBI) + RBIODB.FIELD.COMPUTING[[RBIODB.SEQUENCE]] <- c(RBIODB.NCBICCDS) + + # Peaks data frame columns + RBIODB.PEAK.MZ <- 'mz' + RBIODB.PEAK.FORMULA <- 'formula' + RBIODB.PEAK.FORMULA.COUNT <- 'formula.count' + RBIODB.PEAK.MASS <- 'mass' + RBIODB.PEAK.ERROR.PPM <- 'error.ppm' + RBIODB.PEAK.INTENSITY <- 'intensity' + RBIODB.PEAK.RELATIVE.INTENSITY <- 'relative.intensity' + RBIODB.PEAK.DF.EXAMPLE <- data.frame(mz = double(), int = double(), rel.int = integer(), formula = character(), formula.count <- integer(), mass = double(), error = double(), stringsAsFactors = FALSE) + colnames(RBIODB.PEAK.DF.EXAMPLE) <- c(RBIODB.PEAK.MZ, RBIODB.PEAK.INTENSITY, RBIODB.PEAK.RELATIVE.INTENSITY, RBIODB.PEAK.FORMULA, RBIODB.PEAK.FORMULA.COUNT, RBIODB.PEAK.MASS, RBIODB.PEAK.ERROR.PPM) + + ################# + # GET ENTRY URL # + ################# + + # TODO Let the choice to use either jp or eu + RBIODB.MASSBANK.JP.WS.URL <- "http://www.massbank.jp/api/services/MassBankAPI/getRecordInfo" + RBIODB.MASSBANK.EU.WS.URL <- "http://massbank.eu/api/services/MassBankAPI/getRecordInfo" + + get.entry.url <- function(class, accession, content.type = RBIODB.ANY) { + + url <- switch(class, + chebi = if (content.type %in% c(RBIODB.ANY, RBIODB.HTML)) paste0('https://www.ebi.ac.uk/chebi/searchId.do?chebiId=', accession) else NULL, + chemspider = if (content.type %in% c(RBIODB.ANY, RBIODB.HTML)) paste0('http://www.chemspider.com/Chemical-Structure.', accession, '.html') else NULL, + enzyme = if (content.type %in% c(RBIODB.ANY, RBIODB.TXT)) paste0('http://enzyme.expasy.org/EC/', accession, '.txt') else NULL, + hmdb = switch(content.type, + xml = paste0('http://www.hmdb.ca/metabolites/', accession, '.xml'), + html = paste0('http://www.hmdb.ca/metabolites/', accession), + any = paste0('http://www.hmdb.ca/metabolites/', accession), + NULL), + kegg = switch(content.type, + txt = paste0('http://rest.kegg.jp/get/', accession), + html = paste0('http://www.genome.jp/dbget-bin/www_bget?cpd:', accession), + any = paste0('http://www.genome.jp/dbget-bin/www_bget?cpd:', accession), + NULL), + lipidmaps = if (content.type %in% c(RBIODB.ANY, RBIODB.CSV)) paste0('http://www.lipidmaps.org/data/LMSDRecord.php?Mode=File&LMID=', accession, '&OutputType=CSV&OutputQuote=No') else NULL, + massbank = if (content.type %in% c(RBIODB.ANY, RBIODB.TXT)) paste0(RBIODB.MASSBANK.EU.WS.URL, '?ids=', paste(accession, collapse = ',')) else NULL, + mirbase = if (content.type %in% c(RBIODB.ANY, RBIODB.HTML)) paste0('http://www.mirbase.org/cgi-bin/mature.pl?mature_acc=', accession) else NULL, + pubchem = { + accession <- gsub(' ', '', accession, perl = TRUE) + accession <- gsub('^CID', '', accession, perl = TRUE) + switch(content.type, + xml = paste0('http://pubchem.ncbi.nlm.nih.gov/rest/pug_view/data/compound/', accession, '/XML/?response_type=save&response_basename=CID_', accession), + html = paste0('http://pubchem.ncbi.nlm.nih.gov/compound/', accession), + NULL) + }, + ncbigene = if (content.type %in% c(RBIODB.ANY, RBIODB.XML)) paste0('http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=gene&id=', accession, '&rettype=xml&retmode=text') else NULL, + ncbiccds = if (content.type %in% c(RBIODB.ANY, RBIODB.HTML)) paste0('https://www.ncbi.nlm.nih.gov/CCDS/CcdsBrowse.cgi?REQUEST=CCDS&GO=MainBrowse&DATA=', accession), + uniprot = if (content.type %in% c(RBIODB.ANY, RBIODB.XML)) paste0('http://www.uniprot.org/uniprot/', accession, '.xml'), + NULL + ) + + return(url) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/chem.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,119 @@ +if ( ! exists('load.sdf')) { # Do not load again if already loaded + + ############# + # CONSTANTS # + ############# + + R.LIB.CHEM.FILE.PATH <- parent.frame(2)$ofile + + CARBOXYL.GROUP <- "carboxyl" + + ################## + # LOAD JAVA CHEM # + ################## + + load.java.chem <- function() { + library(rJava) + .jinit() + .jcall('java/lang/System', 'S', 'setProperty', "rJava.debug", "1") # DEBUG/VERBOSE mode --> TODO does not work + cmd <- c("mvn", "-f", file.path(dirname(R.LIB.CHEM.FILE.PATH), '..', 'java-chem'), "org.apache.maven.plugins:maven-dependency-plugin:2.10:build-classpath") + classpath <- system(paste(cmd, collapse = " "), intern = TRUE) + classpath <- grep("^\\[INFO]", classpath, invert = TRUE, value = TRUE) + classpath <- strsplit(classpath, split = ':')[[1]] # TODO make it portable (classpath under Windows use ';' instead of ':') + .jaddClassPath(classpath) + .jaddClassPath(file.path(dirname(R.LIB.CHEM.FILE.PATH), '..', 'java-chem', 'target', 'java-chem-1.0.jar')) + } + + ############# + # GET INCHI # + ############# + + get.inchi <- function(mol) { + load.java.chem() + cdkhlp <- .jnew('org/openscience/chem/CdkHelper') + inchi <- .jcall(cdkhlp, 'S', 'getInchi', mol) + return(inchi) + } + + ######################### + # CONTAINS SUBSTRUCTURE # + ######################### + + contains.substructure <- function(inchi, group) { + + load.java.chem() + cdkhlp <- .jnew('org/openscience/chem/CdkHelper') + + # Search for substructure + contains <- .jcall(cdkhlp, '[Z', 'containFunctionalGroup', inchi, toupper(group)) + + return(contains) + } + + ############ + # LOAD SDF # + ############ + + load.sdf <- function(file, silent = FALSE) { + + library(stringr) + + # Valid file ? + if ( ! file.exists(file)) { + if ( ! silent) + warning(paste0("SDF File \"", file, "\" does not exist.")) + return(NULL) + } + + info <- data.frame() + + # Read file line by line + con <- file(file) + open(con) + imol <- 1 # Index of molecule inside the file + field.name <- NA_character_ + while (TRUE) { + + # Read one line + line <- readLines(con, n = 1) + if (length(line) == 0) + break + + # Field value + if ( ! is.na(field.name)) { + info[imol, field.name] <- line + field.name <- NA_character_ + next + } + + # Empty line + if (line == "") { + field.name <- NA_character_ + next + } + + # End of molecule + if (substring(line, 1, 4) == "$$$$") { + field.name <- NA_character_ + imol <- imol + 1 + next + } + + # Metadata field + g <- str_match(line, "^> <(.*)>$") + if ( ! is.na(g[1,2])) { + field.name <- g[1,2] + next + } + } + close(con) + + # Load molecule structures + load.java.chem() + cdkhlp <- .jnew('org/openscience/chem/CdkHelper') + struct <- .jcall(cdkhlp, '[Lorg/openscience/cdk/interfaces/IAtomContainer;', 'loadSdf', file) + + return(list(struct = struct, info = info)) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/dfhlp.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,116 @@ +if ( ! exists('remove.na.rows')) { # Do not load again if already loaded + + source('strhlp.R') + + ################# + # RENAME COLUMN # + ################# + + rename.col <- function(df, cur, new) { + + for (k in seq(cur)) { + i <- which(cur[k] == colnames(df)) + if (length(i) == 1) + colnames(df)[i] <- new[k] + } + + return(df) + } + + ################## + # REMOVE NA ROWS # + ################## + + remove.na.rows <- function(df) { + na.rows <- apply(is.na(df), MARGIN = 1, all) + return(df[ ! na.rows, , drop = FALSE]) + } + + ###################### + # MOVE COLUMNS FIRST # + ###################### + + df.move.col.first <- function(df, cols) { + not.cols <- setdiff(names(df), cols) + df[c(cols, not.cols)] + } + + ##################### + # MOVE COLUMNS LAST # + ##################### + + df.move.col.last <- function(df, cols) { + not.cols <- setdiff(names(df), cols) + df[c(not.cols, cols)] + } + + ############## + # READ TABLE # + ############## + + df.read.table <- function(file, sep = "", header = TRUE, remove.na.rows = TRUE, check.names = TRUE, stringsAsFactors = TRUE, trim.header = FALSE, trim.values = FALSE, fileEncoding = "") { + + # Call built-in read.table() + df <- read.table(file, sep = sep, header = header, check.names = check.names, stringsAsFactors = stringsAsFactors, fileEncoding = fileEncoding) + + # Clean data frame + df <- df.clean(df, trim.colnames = trim.header, trim.values = trim.values, remove.na.rows = remove.na.rows) + + return(df) + } + + ################# + # READ CSV FILE # + ################# + + # Read CSV file and return a data.frame. + # file The path to the CSV file. + # header If TRUE, use first line as header line. + # check.names If TRUE, correct header (column) names in the data frame, by replacing non-ASCII characters by dot. + # stringsAsFactors If TRUE, replace string values by factors. + # trim.header If TRUE, remove whitespaces at beginning and of header titles. + # trim.values If TRUE, remove whitespaces at beginning and of string values. + # remove.na.rows If TRUE, remove all lines that contain only NA values. + df.read.csv <- function(file, header = TRUE, remove.na.rows = TRUE, check.names = TRUE, stringsAsFactors = TRUE, trim.header = FALSE, trim.values = FALSE) { + + # Call built-in read.csv() + df <- read.csv(file, header = header, check.names = check.names, stringsAsFactors = stringsAsFactors) + + # Clean data frame + df <- df.clean(df, trim.colnames = trim.header, trim.values = trim.values, remove.na.rows = remove.na.rows) + + return(df) + } + + ################## + # WRITE TSV FILE # + ################## + + df.write.tsv <- function(df, file, row.names = FALSE, col.names = TRUE) { + write.table(df, file = file, row.names = row.names, col.names = col.names, sep = "\t") + } + + #################### + # CLEAN DATA FRAME # + #################### + + df.clean <- function(df, trim.colnames = FALSE, trim.values = FALSE, remove.na.rows = FALSE) { + + # Remove NA lines + if (remove.na.rows) + df <- remove.na.rows(df) + + # Trim header + if (trim.colnames) + colnames(df) <- trim(colnames(df)) + + # Trim values + if (trim.values) + for (c in 1:ncol(df)) + if (typeof(df[[c]]) == 'character') + df[[c]] <- trim(df[[c]]) + + return(df) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/excelhlp.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,83 @@ +if ( ! exists('read.excel')) { # Do not load again if already loaded + + source('strhlp.R') + source('dfhlp.R') + + ############### + # GET NB ROWS # + ############### + + get.nbrows <- function(file, tab) { + + library(rJava) + library(xlsxjars) + library(xlsx, quietly = TRUE) + + df <- read.xlsx(file, tab) + na_rows <- apply(is.na(df), MARGIN = 1, FUN = all) # look for rows that contain only NA values. + last_row <- tail(which(! na_rows), n = 1) + return(last_row) + } + + ############## + # READ EXCEL # + ############## + + # Read Excel xlsx file + # file The path to the Excel file. + # sheet + # start.row + # end.row + # header If TRUE, use first line as header line. + # check.names If TRUE, correct header (column) names in the data frame, by replacing non-ASCII characters by dot. + # stringsAsFactors If TRUE, replace string values by factors. + # trim.header If TRUE, remove whitespaces at beginning and of header titles. + # trim.values If TRUE, remove whitespaces at beginning and of string values. + # remove.na.rows If TRUE, remove all lines that contain only NA values. + read.excel <- function(file, sheet, start.row = NULL, end.row = NULL, header = TRUE, remove.na.rows = TRUE, check.names = TRUE, stringsAsFactors = TRUE, trim.header = FALSE, trim.values = FALSE, col.index = NULL) { + + library(rJava) + library(xlsxjars) + library(xlsx, quietly = TRUE) + + # Check that start row and end row exist + if ( ! is.null(start.row) || ! is.null(end.row)) { + nb_rows <- get.nbrows(file, sheet) + if ( ! is.null(start.row) && start.row > nb_rows) + return(NULL) + if ( ! is.null(end.row) && end.row > nb_rows) + return(NULL) + } + + # Call xlsx package + df <- read.xlsx(file, sheet, startRow = start.row, endRow = end.row, header = header, check.names = check.names, stringsAsFactors = stringsAsFactors, colIndex = col.index) + + # Remove column default names if header was set to false + if ( ! header) + colnames(df) <- NULL + + # Clean data frame + df <- df.clean(df, trim.colnames = trim.header, trim.values = trim.values, remove.na.rows = remove.na.rows) + + return(df) + } + + ####################### + # CHECK IF TAB EXISTS # + ####################### + + tab.exists <- function(file, tab) { + + if (is.null(file) || is.na(file) || is.null(tab) || is.na(tab)) + return(FALSE) + + library(rJava) + library(xlsxjars) + library(xlsx, quietly = TRUE) + + wb <- loadWorkbook(file) + sheets <- getSheets(wb) + return(tab %in% names(sheets)) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/fshlp.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,20 @@ +if ( ! exists('extname')) { # Do not load again if already loaded + + source('strhlp.R') + + ########### + # EXTNAME # + ########### + + extname <- function(path) { + return(sub('^.*\\.([^.]*)$', '\\1', path, perl = TRUE)) + } + + ############## + # REMOVE EXT # + ############## + + remove.ext <- function(path) { + return(sub('\\.[^.]*$', '', path)) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hshhlp.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,20 @@ +# Function for testing if a key exists inside a list/hashmap +hHasKey <- function(h, k) { + return(length(which(names(h) == k)) > 0) +} + +# Function for getting a boolean value from a list/hashmap +hGetBool <- function(h, k) { + if (hHasKey(h, k)) return(h[[k]]) else return(FALSE) +} + +# keys A list of keys. +# values A list of values. +# RETURN A hash using keys as keys and values as values. +hCreate <- function(keys, values) { + h <- list() + sz <- min(length(keys), length(values)) + for(i in 1:sz) + h[ keys[[i]] ] <- values[i] + return(h) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/htmlhlp.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,111 @@ +if ( ! exists('HtmlWriter')) { # Do not load again if already loaded + + library(methods) + + ##################### + # CLASS DECLARATION # + ##################### + + HtmlWriter <- setRefClass("HtmlWriter", fields = list(.file = "character", .auto.indent = "numeric")) + + + ############### + # CONSTRUCTOR # + ############### + + HtmlWriter$methods( initialize = function(file = NA_character_, auto.indent = TRUE, ...) { + + .file <<- file + .auto.indent <<- if (auto.indent) 0 else NA_integer_ + + # Create empty file + cat('', file = .self$.file, append = FALSE) + + callSuper(...) # calls super-class initializer with remaining parameters + }) + + ######### + # WRITE # + ######### + + HtmlWriter$methods( write = function(text, indent = NA_integer_, newline = TRUE, escape = FALSE) { + + # Compute indentation + if (is.na(indent)) + indent <- if (is.na(.self$.auto.indent)) 0 else .self$.auto.indent + + cat(rep("\t", indent), text, if (newline) "\n" else "", sep = '', file = .self$.file, append = TRUE) + }) + + ############# + # WRITE TAG # + ############# + + HtmlWriter$methods( writeTag = function(tag, text = NA_character_, indent = NA_integer_, newline = TRUE) { + + if (is.na(text)) + .self$write(paste0("<", tag, "/>"), indent = indent, newline = newline, escape = FALSE) + else { + .self$writeBegTag(tag, indent = indent, newline = FALSE) + .self$write(text, escape = TRUE , indent = 0, newline = FALSE) + .self$writeEndTag(tag, indent = 0, newline = newline) + } + }) + + ################### + # WRITE BEGIN TAG # + ################### + + HtmlWriter$methods( writeBegTag = function(tag, indent = NA_integer_, newline = TRUE) { + + # Write opening tag + .self$write(paste0("<", tag, ">"), indent = indent, newline = newline, escape = FALSE) + + # Increment auto-indent + if ( ! is.na(.self$.auto.indent)) + .auto.indent <<- .self$.auto.indent + 1 + }) + + ################# + # WRITE END TAG # + ################# + + HtmlWriter$methods( writeEndTag = function(tag, indent = NA_integer_, newline = TRUE) { + + # Decrement auto-indent + if ( ! is.na(.self$.auto.indent)) + .auto.indent <<- .self$.auto.indent - 1 + + # Write closing tag + .self$write(paste0("</", tag, ">"), indent = indent, newline = newline, escape = FALSE) + }) + + ############### + # WRITE TABLE # + ############### + + HtmlWriter$methods( writeTable = function(x, indent = NA_integer_, newline = TRUE) { + + .self$writeBegTag('table', indent = indent, newline = newline) + + # Write table header + if ( ! is.null(colnames(x))) { + .self$writeBegTag('tr', indent = indent + 1, newline = newline) + for (field in colnames(x)) + .self$writeTag('th', field, indent = indent + 2, newline = newline) + .self$writeEndTag('tr', indent = indent + 1, newline = newline) + } + + # Write values + if (nrow(x) > 0 && ncol(x) > 0) + for (i in 1:nrow(x)) { + .self$writeBegTag('tr', indent = indent + 1, newline = newline) + for (j in 1:ncol(x)) + .self$writeTag('td', x[i, j], indent = indent + 2, newline = newline) + .self$writeEndTag('tr', indent = indent + 1, newline = newline) + } + .self$writeEndTag('table', indent = indent, newline = newline) + }) + + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lcmsmatching.xml Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,521 @@ +<tool id="lcmsmatching" name="LC/MS matching" version="2.1.3"> + + <description>Matching of mz/rt values onto local reference compound database.</description> + + <requirements> + <requirement type="package" version="3.2.2">R</requirement> + <requirement type="package" version="1.20.0">r-getopt</requirement> + <requirement type="package" version="1.0.0">r-stringr</requirement> + <requirement type="package" version="1.8.3">r-plyr</requirement> + <requirement type="package" version="3.98">r-xml</requirement> + </requirements> + + <!--~~~~~~~ + ~ COMMAND ~ + ~~~~~~~~--> + + <command><![CDATA[ + $__tool_directory__/search-mz -i "$mzrtinput" + + ## Database + -d file --url "$dbfile" + + ## M/Z matching + -m $mzmode -p $mzprec -s $mzshift + + ## Precursor matching + #if $prec.match == "true" + --precursor-match --pos-prec "$prec.pos" --neg-prec "$prec.neg" + #end if + #if $prec.match == "true" and $rt.match == "true" + --precursor-rt-tol $rt.tolz + #end if + + ## Chromatographic columns options and retention matching + #if $rt.match == "true" and $rt.cols.all == "true" + --all-cols --rttolx $rt.tolx --rttoly $rt.toly + #end if + #if $rt.match == "true" and $rt.cols.all == "false" and $rt.cols.list != "" + -c "$rt.cols.list" --check-cols --rttolx $rt.tolx --rttoly $rt.toly + #end if + + ## Table outputs + -o "$mainoutput" --peak-output-file "$peaksoutput" --same-rows --same-cols + + ## HTML output + --html-output-file "$htmloutput" --no-main-table-in-html-output + + ## Fields + --input-col-names "$inputfields" + --db-fields "$dbfields" + --db-ms-modes "$dbmsmodes" + + ## Ouput setting + #if $out.enabled == "true" + --output-col-names "$out.outputfields" + --molids-sep "$out.molidssep" + #else + --molids-sep "|" + #end if + + ]]></command> + + <!--~~~~~~ + ~ INPUTS ~ + ~~~~~~~--> + + <inputs> + + <!-- DATABASE --> + + <!-- Database file --> + <param name="dbfile" label="Database file" type="data" format="tabular" help="Decimal: '.', missing: NA, mode: character and numerical, sep: tabular. Retention time values must be in seconds."/> + + <!-- File database field names --> + <param name="dbfields" label="File database column names" type="text" size="256" value="mztheo=mztheo,colrt=colrt,molid=molid,col=col,mode=mode,attr=attr,comp=comp,molnames=molnames,molcomp=molcomp,molmass=molmass,inchi=inchi,inchikey=inchikey,pubchem=pubchem,chebi=chebi,hmdb=hmdb,kegg=kegg" help=""/> + + <!-- File database MS modes --> + <param name="dbmsmodes" label="File database MS modes" type="text" size="32" value="pos=POS,neg=NEG" help=""/> + + <!-- INPUT --> + + <!-- Input file --> + <param name="mzrtinput" label="Input file - MZ(/RT) values" type="data" format="tabular" help="Decimal: '.', missing: NA, mode: character and numerical, sep: tabular. RT values must be in seconds."/> + + <!-- Input field names --> + <param name="inputfields" label="Input file column names" type="text" size="32" value="mz=mzmed,rt=rtmed" help=""/> + + <!-- M/Z MATCHING --> +<!-- <conditional name="mz"> + + <param name="enabled" label="M/Z matching" type="select"> + <option value="true">Show</option> + <option value="false">Hide</option> + </param> + + <when value="true">--> + <!-- Mode --> + <param name="mzmode" label="MS mode" type="select" display="radio" multiple="false" help=""> + <option value="pos">Positive</option> + <option value="neg">Negative</option> + </param> + + <!-- MZ matching parameters --> + <param name="mzprec" label="M/Z precision (in ppm)" type="float" help="" value="5"/> + <param name="mzshift" label="M/Z shift (in ppm)" type="float" help="" value="0"/> + <!--</when> + <when value="false"></when> + </conditional>--> + + <!-- RETENTION TIME PARAMETERS --> + <conditional name="rt"> + + <param name="match" label="Retention time match" type="select"> + <option value="false">Off</option> + <option value="true">On</option> + </param> + + <when value="false"></when> + <when value="true"> + <!-- Columns --> + <conditional name="cols"> + <param name="all" label="All chromatographic columns" type="select"> + <option value="true">Yes</option> + <option value="false">No</option> + </param> + <when value="true"></when> + <when value="false"> + <param name="list" label="Chromatographic columns" type="text" size="64" value="" help="Set here the list of chromatographic columns against which the retention time matching will be run. This is a comma separated list of the column names as used instead the database file."/> + </when> + </conditional> + + <!-- Tolerances --> + <param name="tolx" label="RTX retention time tolerance, parameter x (in seconds)" type="float" help="" value="5"/> + <param name="toly" label="RTY retention time tolerance, parameter y" type="float" help="" value="0.8"/> + <param name="tolz" label="RTZ retention time tolerance, used when precursor matching is enabled." type="float" help="" value="5"/> + </when> + </conditional> + + <!-- PRECURSOR MATCH --> + <conditional name="prec"> + + <param name="match" label="Precursor match" type="select"> + <option value="false">Off</option> + <option value="true">On</option> + </param> + + <when value="false"></when> + <when value="true"> + <!-- Negative precursors --> + <param name="neg" label="List of negative precursors" type="text" size="128" value="[(M-H)]-,[M-H]-,[(M+Cl)]-,[M+Cl]-" help=""> + <sanitizer> + <valid initial="string.printable"> + <remove value='"'/> + </valid> + <mapping initial="none"> + <add source='"' target='\"'/> + </mapping> + </sanitizer> + </param> + + <!-- Positive precursors --> + <param name="pos" label="List of positive precursors" type="text" size="128" value="[(M+H)]+,[M+H]+,[(M+Na)]+,[M+Na]+,[(M+K)]+,[M+K]+" help=""> + <sanitizer> + <valid initial="string.printable"> + <remove value='"'/> + </valid> + <mapping initial="none"> + <add source='"' target='\"'/> + </mapping> + </sanitizer> + </param> + </when> + </conditional> + + <!-- OUTPUT --> + <conditional name="out"> + + <param name="enabled" label="Output settings" type="select"> + <option value="false">Off</option> + <option value="true">On</option> + </param> + + <when value="false"></when> + <when value="true"> + + <!-- Output field names --> + <param name="outputfields" label="Output column names" type="text" size="256" value="mz=mz,rt=rt,col=col,colrt=colrt,molid=molid,attr=attr,comp=comp,int=int,rel=rel,mzexp=mzexp,mztheo=mztheo,molnames=molnames,molcomp=molcomp,molmass=molmass,inchi=inchi,inchikey=inchikey,pubchem=pubchem,chebi=chebi,hmdb=hmdb,kegg=kegg" help=""/> + + <!-- Molecule IDs separator character --> + <param name="molidssep" label="Molecule IDs separator character" type="text" size="3" value="|" help=""> + <sanitizer> + <valid initial="string.printable"> + <remove value='"'/> + </valid> + <mapping initial="none"> + <add source='"' target='\"'/> + </mapping> + </sanitizer> + </param> + </when> + </conditional> + + </inputs> + + <!--~~~~~~~ + ~ OUTPUTS ~ + ~~~~~~~~--> + + <outputs> + + <!-- Output file --> + <data name="mainoutput" label="lcmsmatch_${mzrtinput.name}" format="tabular"/> + <data name="peaksoutput" label="lcmsmatch_${mzrtinput.name}_peaks" format="tabular"/> + <data name="htmloutput" label="lcmsmatch_${mzrtinput.name}.html" format="html"/> + + </outputs> + + <!--~~~~~ + ~ TESTS ~ + ~~~~~~--> + + <tests> + + <!-- Simple quick test --> + <test> + <param name="dbfile" value="filedb.tsv"/> + <param name="mzrtinput" value="mz-input-small.tsv"/> + <param name="inputfields" value=""/> + <param name="dbfields" value=""/> + <param name="dbmsmodes" value=""/> + <param name="mzmode" value="pos"/> + <output name="mainoutput" file="filedb-small-mz-match-output.tsv"/> + <output name="peaksoutput" file="filedb-small-mz-match-peaks-output.tsv"/> + <output name="htmloutput" file="filedb-small-mz-match-html-output.html"/> + </test> + </tests> + + <!--~~~~ + ~ HELP ~ + ~~~~~--> + + <help> +<!-- @@@BEGIN_RST@@@ --> + +============== +LC/MS matching +============== + +This tool performs LC/MS matching on an input list of MZ/RT values, using a provided single file database. + +----------- +Input files +----------- + +Be careful to always provide UTF-8 encoded files, unless you do not use special characters at all. For instance, greek letters in molecule names give errors if the file is in latin1 (ISO 8859-1) or Windows 1252 (not distinguishable from latin1) encoding. + +Single file database +==================== + +The database used is provided as a single file, in tabular format, through the *Database file* field. This file contains a list of MS peaks, with retention times. +Peaks are "duplicated" as much as necessary. For instance if 3 retention times are available on a compound with 10 peaks in positive mode, then there will be 30 lines for this compounds in positive mode. + +The file must contain a header with the column names. The names are free, but must be provided through the *File database column names* field. +In this field, each column is identified with a tag, and the columns names are listed as a comma separated list of tag/name couples (separated by character `=`). The allowed tags are the following ones: + ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| Column tag | Compulsory | Values | ++==============+============+============================================================================================================+ +| mztheo | Yes | The m/z values. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| mode | Yes | The MS mode. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| molid | Yes | This is the identifier of your compound. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| colrt | No | The retention time values in seconds. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| col | No | The chromatographic column associated with the retention time. Compulsory if retention times are provided. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| attr | No | The attribution of the peak (e.g.: ``[(M+H)-(H2O)-(NH3)]+``). | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| comp | No | The composition of the peak (e.g.: ``C6 H10 N O``). | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| molcomp | No | The composition of the molecule. (e.g.: ``C6H14N2O2``). | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| molmass | No | The mass of the molecule. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| molnames | No | The names of the molecule, as a semicolon separated list. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| inchi | No | The InChI of the molecule. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| inchikey | No | The InChI key of the molecule. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| pubchem | No | The PubChem ID of the molecule. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| chebi | No | The ChEBI ID of the molecule. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| hmdb | No | The HMDB ID of the molecule. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ +| kegg | No | The KEGG ID of the molecule. | ++--------------+------------+------------------------------------------------------------------------------------------------------------+ + +The field *File database MS modes* allows you to personalize the MS mode identifiers. The value of the field is a comma separated list of mode/name couples (separated by character `=`).. +For instance, if in your database file you use characters '+' and '-' to identify the modes, then you must set the field to `pos=+,neg=-`. + +Example of database file (totally fake, no meaning): + ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| molid | mode | mz | composition | attribution | col | rt | molcomp | molmass | molnames | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 112.07569 | "P9Z6W410 O" | "[(M+H)-(H2O)-(NH3)]+" | "colzz" | 5.69 | "J114L6M62O2" | 146.10553 | "Blablaine'" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 112.07569 | "P9Z6W410 O" | "[(M+H)-(H2O)-(NH3)]+" | "col12" | 0.8 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 112.07569 | "P9Z6W410 O" | "[(M+H)-(H2O)-(NH3)]+" | "somecol" | 8.97 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 191.076694 | "P92Z6W413 Na2 O2" | "[(M-H+2Na)]+" | "colAA" | 1.58 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 191.076694 | "P92Z6W413 Na2 O2" | "[(M-H+2Na)]+" | "colzz2" | 4.08 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 294.221687 | "U1113P94ZW429 O4" | "[(2M+H)]+ (13C)" | "somecol" | 8.97 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 72.080775 | "P9Z4W410 O0" | "[(M+H)-(J15L2M6O2)]+" | "hcoltt" | 0.8 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 112.07569 | "P9Z6W410 O" | "[(M+H)-(H2O)-(NH3)]+" | "colzz3" | 4.54 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 72.080775 | "P9Z4W410 O0" | "[(M+H)-(J15L2M6O2)]+" | "colzz3" | 4.54 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 72.080775 | "P9Z4W410 O0" | "[(M+H)-(J15L2M6O2)]+" | "colpp" | 0.89 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ +| A10 | "POS" | 145.097154 | "P92Z6W413 O2" | "[(M+H)-(H2)]+" | "hcoltt" | 0.8 | "J114L6M62O2" | 146.10553 | "Blablaine" | ++-------+-------+------------+--------------------+-------------------------+-----------+-------+---------------+-----------+--------------+ + +MZ/RT input file +================ + +The input to provide is a file, in a tabular format (or TSV: Tab Seperated Values), containing the list of MZ/RT values. + +The following columns will be used: + ++--------------+------------+---------------------------------------+ +| Column tag | Compulsory | Values | ++==============+============+=======================================+ +| mz | Yes | The m/z values. | ++--------------+------------+---------------------------------------+ +| rt | No | The retention time values in seconds. | ++--------------+------------+---------------------------------------+ + +The file may contain a header line, in which case you have to provide the column names through the *Input file column names* field, which consists in a comma separated list of tag/name couples (separated by character `=`). If your file does not contain a header line, then you must provide the column numbers. Examples: + + * With a header line having name MASS for mz column and RET for rt column: `mz=MASS,rt=RET`. + * With no header line: `mz=1,rt=2`. + +Since the MS spectrum mode can not be known from the file, an *MS mode* radio button field is provided for setting the mode. + +Example of file input: + ++-------------+-------------+ +| mz | rt | ++-------------+-------------+ +| 75.02080998 | 49.38210915 | ++-------------+-------------+ +| 75.05547146 | 0.658528069 | ++-------------+-------------+ +| 75.08059797 | 1743.94267 | ++-------------+-------------+ +| 76.03942694 | 51.23158899 | ++-------------+-------------+ +| 76.07584477 | 50.51249853 | ++-------------+-------------+ +| 76.07593168 | 0.149308136 | ++-------------+-------------+ + +------------ +M/Z matching +------------ + +In the simplest form of the algorithm only the *m/z* values are matched against the database peaks. This happens if both *Retention time match* and *Precursor match* are off. + +The first parameter is the MS mode, specified through the *MS mode* parameter. + +The parameters *M/Z precision* and *M/Z shift* are used by the algorithm in the following formula in order to match an *m/z* value: + + mz (1 + (- shift - precision) / 10^6) < mztheo < mz (1 + (- shift - precision) / 10^6) + +Where *mztheo* is the theoretical mass of the database peak that is tested. If this double inequality is true, then the *m/z* value is matched with this peak. + +-------------------- +Retention time match +-------------------- + +If at least one column is checked inside the *Columns* parameter section, then retention time is also matched, in addition to the *m/z* value, according to the following formula: + + rt - x - rt^y < colrt < rt + x + rt^y + +Where *x* is the value of the parameter *RTX* and *y* the value of the parameter *RTY*. + +If for a reference compound the database does not contain retention time for at least one of the specified columns, then only the *m/z* value is matched against the peaks of the reference compound. This means that in the results you can find compounds that do no match the provided retention time value. + +The *RTZ* parameter is used in the *Precursor match* algorithm (see below). + +--------------- +Precursor match +--------------- + +If the "Precursor match" option is enabled inside the parameters section, then a more sophisticated version of the algorithm, which is executed in two steps, is used. + +This algorithm takes two more parameters, one for each MS mode. These are the lists of precursors. Since the matching is run for one MS mode only, only one of the two parameters is used. Inside the single file database, all the peaks whose **attr** column value is equal to one of the precursor listed in *List of negative precursors* or *List of positive precursors*, depending on the mode, are considered as precursor peaks. + +M/Z matching using precursor matching +===================================== + + 1. Using the normal M/Z matching algorithm described above, we first look only for precursor peaks ([(M+H)]+, [(M+Na)]+, [(M+Cl)]-, ...). + 2. From step 1, we construct a list of matched molecules. + 3. We look at all peaks inside the molecule list obtained in step 2, using the normal M/Z matching algorithm described above. + +MZ/RT matching using precursor matching +======================================= + + 1. Using the normal MZ/RT matching algorithm described above, we first look only for precursor peaks ([(M+H)]+, [(M+Na)]+, [(M+Cl)]-, ...). + 2. From step 1, we construct a list of matched molecules, retaining the matched retention time of each molecule. + 3. For each input couple (m/z,rt), we look at all peaks inside the molecules taken from step 2, whose matched retention time between *rt - z* and *rt + z*, where *z* is the value of parameter *RTZ*. + +--------------- +Output settings +--------------- + +The *Output column names* parameter is used to customize the columns of the output files. As with the *File database column names* parameter, each column is identified with a tag, and the columns names are listed as a comma separated list of tag/name couples (separated by character `=`). The allowed tags are the following ones: + ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| Column tag | Values | ++==============+=================================================================================================================================+ +| mz | The m/z values from the input file. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| mztheo | The m/z values from the database. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| molid | This is the identifier of your compound. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| rt | The retention time values in seconds from the input file. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| col | The chromatographic column associated with the retention time. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| colrt | The retention time associated with the matched chromatographic column. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| msmatching | The list IDs of matched molecules. IDs are separated by the character specified in the *Molecule IDs separator character* field | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| attr | The attribution of the peak (e.g.: ``[(M+H)-(H2O)-(NH3)]+``). | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| comp | The composition of the peak (e.g.: ``C6 H10 N O``). | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| molcomp | The composition of the molecule. (e.g.: ``C6H14N2O2``). | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| molmass | The mass of the molecule. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| molnames | The names of the molecule, as a semicolon separated list. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| inchi | The InChI of the molecule. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| inchikey | The InChI key of the molecule. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| pubchem | The PubChem ID of the molecule. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| chebi | The ChEBI ID of the molecule. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| hmdb | The HMDB ID of the molecule. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ +| kegg | The KEGG ID of the molecule. | ++--------------+---------------------------------------------------------------------------------------------------------------------------------+ + +The *Molecule IDs separator character* is used to customize the character used to separate the molecule IDs of the **molid** column inside the *main* output file. + +Output files +============ + +Three files are output by the tool. + ++-------------+--------------------------------------+--------------------------------------------------------+ +| Outputs | File name | Description | ++-------------+--------------------------------------+--------------------------------------------------------+ +| Main output | lcmsmatching_{input_file_name} | Contains the list of compounds that have been matched. | ++-------------+--------------------------------------+--------------------------------------------------------+ +| Peak list | lcmsmatching_peaks_{input_file_name} | Contains all matched database peaks. | ++-------------+--------------------------------------+--------------------------------------------------------+ +| HTML output | lcmsmatching_{input_file_name}.html | Contains the two tables on one page. | ++-------------+--------------------------------------+--------------------------------------------------------+ + +The **main** output is identical to the input file, to which is added an *msmatching* column. This column contains a list of IDs of the compounds that have been matched for this couple of (m/z, rt) values. + +The **peak list** output contains all database peaks that have been matched, for each (m/z, rt) input couple. Thus for each (m/z, rt) couple, there will be zero, one or more matched peaks output. The columns output are *mz*, *rt*, *id*, *mztheo*, *col*, *colrt*, *attribution* and *composition*, where *id* is the compound ID, *mztheo* is the theoretical mass of the fragment, *col* is the matched column and *colrt* is the retention time measured on the column for the reference compound. + +The **HTML** output contains the peak table with links toward HMDB, KEGG, ChEBI and PubChem public databases, when IDs are available. + +===== +About +===== + +.. class:: infomark + +**Author** + Pierrick Roger (pierrick.roger@cea.fr) wrote this MS matching method. + MetaboHUB: The French National Infrastructure for Metabolomics and Fluxomics (http://www.metabohub.fr/en). + +.. class:: infomark + +**Acknowledgement** + Data and algorithms have been kindly provided by Christophe Junot at *DSV/IBITEC-S/SPI* (*CEA/Saclay*), from a former application developped by Cyrille Petat and Arnaud Martel at *DSV/IBITEC-S/DIR* (*CEA/Saclay*). + +.. class:: infomark + +**Please cite** + R Core Team (2013). R: A language and Environment for Statistical Computing. http://www.r-project.org + +<!-- @@@END_RST@@@ --> + </help> + + <!--~~~~~~~~~ + ~ CITATIONS ~ + ~~~~~~~~~~--> + + <citations/> + +</tool>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/msdb-common.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,220 @@ +if ( ! exists('.parse_chrom_col_desc')) { # Do not load again if already loaded + + library('stringr') + source('strhlp.R', chdir = TRUE) + + ############# + # CONSTANTS # + ############# + + # Field tags + MSDB.TAG.MZ <- 'mz' + MSDB.TAG.MZEXP <- 'mzexp' + MSDB.TAG.MZTHEO <- 'mztheo' + MSDB.TAG.RT <- 'rt' + MSDB.TAG.MODE <- 'mode' + MSDB.TAG.MOLID <- 'molid' + MSDB.TAG.COL <- 'col' + MSDB.TAG.COLRT <- 'colrt' + MSDB.TAG.ATTR <- 'attr' + MSDB.TAG.INT <- 'int' # Absolute intensity + MSDB.TAG.REL <- 'rel' # Relative intensity + MSDB.TAG.COMP <- 'comp' + MSDB.TAG.MOLNAMES <- 'molnames' + MSDB.TAG.MOLCOMP <- 'molcomp' + MSDB.TAG.MOLATTR <- 'molattr' + MSDB.TAG.MOLMASS <- 'molmass' + MSDB.TAG.INCHI <- 'inchi' + MSDB.TAG.INCHIKEY <- 'inchikey' + MSDB.TAG.PUBCHEM <- 'pubchem' + MSDB.TAG.CHEBI <- 'chebi' + MSDB.TAG.HMDB <- 'hmdb' + MSDB.TAG.KEGG <- 'kegg' + + # Mode tags + MSDB.TAG.POS <- 'ms.pos' + MSDB.TAG.NEG <- 'ms.neg' + + # Fields containing multiple values + MSDB.MULTIVAL.FIELDS <- c(MSDB.TAG.MOLNAMES) + MSDB.MULTIVAL.FIELD.SEP <- ';' + + # Authorized mz tolerance unit values + MSDB.MZTOLUNIT.PPM <- 'ppm' + MSDB.MZTOLUNIT.PLAIN <- 'plain' # same as mz: mass-to-charge ratio + MSDB.MZTOLUNIT.VALS <- c(MSDB.MZTOLUNIT.PPM, MSDB.MZTOLUNIT.PLAIN) + + # Default values + MSDB.DFT.PREC <- list() + MSDB.DFT.PREC[[MSDB.TAG.POS]] <- c("[(M+H)]+", "[M+H]+", "[(M+Na)]+", "[M+Na]+", "[(M+K)]+", "[M+K]+") + MSDB.DFT.PREC[[MSDB.TAG.NEG]] <- c("[(M-H)]-", "[M-H]-", "[(M+Cl)]-", "[M+Cl]-") + MSDB.DFT.OUTPUT.FIELDS <- list( mz = 'mz', rt = 'rt', col = 'col', colrt = 'colrt', molid = 'id', attr = 'attribution', comp = 'composition', int = 'intensity', rel = 'relative', mzexp = 'mzexp', mztheo = 'mztheo', msmatching = 'msmatching', molnames = 'molnames', molcomp = 'molcomp', molmass = 'molmass', inchi = 'inchi', inchikey = 'inchikey', pubchem = 'pubchem', chebi = 'chebi', hmdb = 'hmdb', kegg = 'kegg') + MSDB.DFT.OUTPUT.MULTIVAL.FIELD.SEP <- MSDB.MULTIVAL.FIELD.SEP + MSDB.DFT.MATCH.FIELDS <- list( molids = 'molid', molnames = 'molnames') + MSDB.DFT.MATCH.SEP <- ',' + MSDB.DFT.MODES <- list( pos = 'POS', neg = 'NEG') + MSDB.DFT.MZTOLUNIT <- MSDB.MZTOLUNIT.PPM + + ############################ + # GET DEFAULT INPUT FIELDS # + ############################ + + msdb.get.dft.input.fields <- function () { + + dft.fields <- list() + + for(f in c(MSDB.TAG.MZ, MSDB.TAG.RT)) + dft.fields[[f]] <- f + + return(dft.fields) + } + + ############################# + # GET DEFAULT OUTPUT FIELDS # + ############################# + + msdb.get.dft.output.fields <- function () { + + dft.fields <- list() + + for(f in c(MSDB.TAG.MZ, MSDB.TAG.RT, MSDB.TAG.COL, MSDB.TAG.COLRT, MSDB.TAG.MOLID, MSDB.TAG.ATTR, MSDB.TAG.COMP, MSDB.TAG.INT, MSDB.TAG.REL, MSDB.TAG.MZEXP, MSDB.TAG.MZTHEO, MSDB.TAG.MOLNAMES, MSDB.TAG.MOLCOMP, MSDB.TAG.MOLMASS, MSDB.TAG.INCHI, MSDB.TAG.INCHIKEY, MSDB.TAG.PUBCHEM, MSDB.TAG.CHEBI, MSDB.TAG.HMDB, MSDB.TAG.KEGG)) + dft.fields[[f]] <- f + + return(dft.fields) + } + + ######################### + # GET DEFAULT DB FIELDS # + ######################### + + msdb.get.dft.db.fields <- function () { + + dft.fields <- list() + + for (f in c(MSDB.TAG.MZTHEO, MSDB.TAG.COLRT, MSDB.TAG.MOLID, MSDB.TAG.COL, MSDB.TAG.MODE, MSDB.TAG.ATTR, MSDB.TAG.COMP, MSDB.TAG.MOLNAMES, MSDB.TAG.MOLCOMP, MSDB.TAG.MOLMASS, MSDB.TAG.INCHI, MSDB.TAG.INCHIKEY, MSDB.TAG.PUBCHEM, MSDB.TAG.CHEBI, MSDB.TAG.HMDB, MSDB.TAG.KEGG)) + dft.fields[[f]] <- f + + return(dft.fields) + } + + ################## + # MAKE DB FIELDS # + ################## + + msdb.make.db.fields <- function(fields) { + + # Merge with default fields + dft.fields <- msdb.get.dft.db.fields() + absent <- ! names(dft.fields) %in% names(fields) + if (length(absent) > 0) + fields <- c(fields, dft.fields[absent]) + + return(fields) + } + + ######################### + # MAKE INPUT DATA FRAME # + ######################### + + msdb.make.input.df <- function(mz, rt = NULL) { + + field <- msdb.get.dft.input.fields() + + x <- data.frame() + + # Set mz + if (length(mz) > 1) + x[seq(mz), field[[MSDB.TAG.MZ]]] <- mz + else if (length(mz) == 1) + x[1, field[[MSDB.TAG.MZ]]] <- mz + else + x[, field[[MSDB.TAG.MZ]]] <- numeric() + + # Set rt + if ( ! is.null(rt)) { + if (length(rt) > 1) + x[seq(rt), field[[MSDB.TAG.RT]]] <- rt + else if (length(rt) == 1) + x[1, field[[MSDB.TAG.RT]]] <- rt + else + x[, field[[MSDB.TAG.RT]]] <- numeric() + } + + return(x) + } + + ############################### + # GET EMPTY RESULT DATA FRAME # + ############################### + + .get.empty.result.df <- function(rt = FALSE) { + + df <- data.frame(stringsAsFactors = FALSE) + df[MSDB.TAG.MOLID] <- character() + df[MSDB.TAG.MOLNAMES] <- character() + df[MSDB.TAG.MZ] <- numeric() + df[MSDB.TAG.MZTHEO] <- numeric() + df[MSDB.TAG.ATTR] <- character() + df[MSDB.TAG.COMP] <- character() + if (rt) { + df[MSDB.TAG.RT] <- numeric() + df[MSDB.TAG.COL] <- character() + df[MSDB.TAG.COLRT] <- numeric() + } + + return(df) + } + + ############################ + # PARSE COLUMN DESCRIPTION # + ############################ + + .parse_chrom_col_desc <- function(desc) { + + # Clean string + s <- desc + s <- gsub('\\.+', ' ', s, perl = TRUE) # Replace '.' characters by spaces + s <- gsub('[*-]', ' ', s, perl = TRUE) # Replace dashes and asterisks by spaces + s <- gsub('[)(]', '', s, perl = TRUE) # Remove paranthesis + s <- trim(s) + s <- tolower(s) # put in lowercase + + # Match 2 3 4 5 6 7 8 9 10 1112 13 + pattern <- "^(uplc|hsf5|hplc|zicphilic)( (c8|c18|150 5 2 1))?( (\\d+)mn)?( (orbitrap|exactive|qtof|shimadzu exactive))?( (\\d+)mn)?( (bis|ter))?( 1)?$" + g <- str_match(s, pattern) + if (is.na(g[1, 1])) + stop(paste0("Impossible to parse column description \"", desc, "\".")) + + type <- g[1, 2] + stationary_phase <- if ( ! is.na(g[1, 4]) && nchar(g[1, 4]) > 0) g[1, 4] else NA_character_ + msdevice <- if ( ! is.na(g[1, 8]) && nchar(g[1, 8]) > 0) g[1, 8] else NA_character_ + time <- if ( ! is.na(g[1,6]) && nchar(g[1, 6]) > 0) as.integer(g[1, 6]) else ( if ( ! is.na(g[1, 10]) && nchar(g[1, 10]) > 0) as.integer(g[1, 10]) else NA_integer_ ) + + # Correct values + if ( ! is.na(stationary_phase) && stationary_phase == '150 5 2 1') stationary_phase <- '150*5*2.1' + if ( ! is.na(msdevice)) msdevice <- gsub(' ', '', msdevice) # remove spaces + + return(list( type = type, stationary_phase = stationary_phase, time = time, msdevice = msdevice)) + + } + + ######################### + # NORMALIZE COLUMN NAME # + ######################### + + .normalize_column_name <- function(desc) { + + lst <- .parse_chrom_col_desc(desc) + + v <- c(lst$type) + if ( ! is.na(lst$stationary_phase)) + v <- c(v, lst$stationary_phase) + if ( ! is.na(lst$time)) + v <- c(v, paste0(lst$time, "min")) + if ( ! is.na(lst$msdevice)) + v <- c(v, lst$msdevice) + + return(paste(v, collapse = '-')) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/mysql.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,207 @@ +library(RMySQL, quietly = TRUE) + +############# +# RUN QUERY # +############# + +# conn The connection to the database. +# queries A query or a list of queries. +# close Close query with a ';' if not already done. +# RETURN The last query result. +run_query <- function(conn, queries, close = TRUE) { + + for (query in queries) { + + # Append ';' + if (close) { + n <- nchar(query) + if (substr(query, n, n) != ';') + query <- paste0(query, ';') + } + + # Send query + result <- dbSendQuery(conn, query) + + # Test that everything went right +# if ( ! dbHasCompleted(result)) +# stop("Can't run the following query : ", query) + } + + # Return result + return(invisible(result)) +} + +################ +# RUN SQL FILE # +################ + +# conn The connection to the DBMS. +# file The path to the SQL file. +run_sql_file <- function(conn, file) { + + # Split SQL into single queries and put them into a list + queries <- character() + query <- "" + for (line in readLines(file)) { + line <- sub('^(.*)\\s*--.*$', '\\1', line, perl = TRUE) # remove one line comment + if (grepl("^\\s*$", line)) next # empty line + query <- paste(query, line) + if (grepl(";\\s*$", line, perl = TRUE)) { + query <- gsub("\t", " ", query, perl = TRUE) # replace tabulation by spaces + query <- gsub("/\\*.*\\*/", "", query, perl = TRUE) # remove multiline comments + queries <- c(queries, query) + query <- "" + } + } + + # Run queries + invisible(run_query(conn, queries)) +} + +################# +# DROP DATABASE # +################# + +# conn The connection to the DBMS. +# db The name of the database to drop. +# fail_if_doesnt_exist Fails if database doesn't exist. +drop_database <- function(conn, db, fail_if_doesnt_exist = FALSE) { + invisible(run_query(conn, paste("drop database", if (fail_if_doesnt_exist) "" else "if exists", db))) +} + +################### +# CREATE DATABASE # +################### + +# conn The connection to the DBMS. +# db The name of the database to create. +# drop Drop/erase existing database. +# encoding Set the character set encoding to use as default for the database. +# use If true, switch to the newly created database. +create_database <- function(conn, db, drop = FALSE, encoding = 'utf8', use = TRUE) { + + # Drop database + if (drop) drop_database(conn, db) + + # Create database + enc <- if (is.null(encoding) || is.na(encoding)) "" else paste("character set", encoding) + run_query(conn, paste("create database", db, enc)) + + # Switch to database + invisible(run_query(conn, paste("use", db))) +} + +############################## +# CONVERT VALUE TO SQL VALUE # +############################## + +to_sql_value <- function(x) { + + # NA or NULL + if (length(x) == 0 || is.na(x) || is.null(x)) + return('null') + + # String + if (is.character(x)) + return(paste0('"', as.character(x), '"')) + + return(x) +} + +#################### +# MAKE INSERT LINE # +#################### + +make_insert_line <- function(values) { + values <- lapply(values, to_sql_value) + return(paste0("(", paste(values, collapse=','), ")")) +} + +########## +# INSERT # +########## + +# Run a insert query on a MySQL database. +# conn Connection to a database. +# table Table name. +# fields List of field names. +# values List of list of values. NA values will be translated as NULL. +insert <- function(conn, table, fields, values) { + + # Do nothing if no values + if (length(values) == 0 ) return + + # Build header + h <- paste("insert into", table) + h <- paste0(h, "(", paste(fields, collapse = ','), ")") + h <- paste(h, "values") + + qr <- paste(h, paste0(lapply(values, make_insert_line), collapse=','), ';') + + # Send query + run_query(conn, qr) +} + +######## +# JOIN # +######## + +Join <- setRefClass("Join", fields = list(table = "character", left_field = "character", right_field = "character", outer = "character")) + +Join$methods( initialize = function(table, left_field, right_field, outer = NA_character_) { + table <<- table + left_field <<- left_field + right_field <<- right_field + outer <<- outer +}) + +Join$methods( getStatement = function() { + type <- 'INNER JOIN' + if ( ! is.na(outer)) + switch(tolower(outer), + left = type <- 'LEFT OUTER JOIN', + right = type <- 'RIGHT OUTER JOIN', + stop('Error in join outer type. "', outer ,'" is unknown. You must choose between "LEFT" and "RIGHT".') + ) + + return(paste(type, .self$table, 'ON', .self$left_field, '=', .self$right_field)) +}) + +########## +# SELECT # +########## + +# Run a select query on a MySQL database. Returns the dataframe of results. +# conn Connection to a database. +select <- function(conn, fields, from, joins = NULL , where = NULL, orderby = NULL) { + + # Select/from + rq <- paste("SELECT ", paste(fields, collapse = ', '), 'FROM', from) + + # Joins + if ( ! is.null(joins) && length(joins) > 0) + rq <- paste(rq, paste(lapply(joins, function (x) x$getStatement() ), collapse = ' ')) + + # Where + if ( ! is.null(where)) rq <- paste(rq, 'WHERE', where) + + # Order by + if ( ! is.null(orderby)) rq <- paste(rq, 'ORDER BY', orderby) + + # End request, send it and get results + rq <- paste0(rq, ';') + res <- try(dbSendQuery(conn, rq)) + data <- fetch(res, n=-1) + + return(data) +} + +####################### +# SELECT SINGLE FIELD # +####################### + +select_single_field <- function(conn, field, from, where = NULL) { + values <- select(conn, fields = field, from = from, where = where) + val <- if (field %in% colnames(values) && length(values[field][[1]]) > 0) values[field][[1]] else NA_character_ + return(val) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nethlp.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,24 @@ +if ( ! exists('extract.address')) { + + ################### + # EXTRACT ADDRESS # + ################### + + extract.address <- function(url) { + + addr <- sub('^([0-9A-Za-z.]+).*$', '\\1', url, perl = TRUE) + + return(addr) + } + + ################ + # EXTRACT PORT # + ################ + + extract.port <- function(url) { + + port <- sub('^.*:([0-9]+)$', '\\1', url, perl = TRUE) + + return(as.integer(port)) + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/search-mz Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,542 @@ +#!/usr/bin/env Rscript +# vi: ft=R +args <- commandArgs(trailingOnly = F) +script.path <- sub("--file=","",args[grep("--file=",args)]) +library(getopt) +source(file.path(dirname(script.path), 'msdb-common.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'MsFileDb.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'MsPeakForestDb.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'MsXlsDb.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'Ms4TabSqlDb.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'MsDbLogger.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'MsDbInputDataFrameStream.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'MsDbOutputDataFrameStream.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'htmlhlp.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'strhlp.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'fshlp.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'biodb-common.R'), chdir = TRUE) +source(file.path(dirname(script.path), 'nethlp.R'), chdir = TRUE) + +############# +# CONSTANTS # +############# + +PROG <- sub('^.*/([^/]+)$', '\\1', commandArgs()[4], perl = TRUE) + +# Authorized database types +MSDB.XLS <- 'xls' +MSDB.4TABSQL <- '4tabsql' +MSDB.FILE <- 'file' +MSDB.PEAKFOREST <- 'peakforest' +MSDB.VALS <- c(MSDB.XLS, MSDB.4TABSQL, MSDB.FILE, MSDB.PEAKFOREST) + +# Authorized mode values +POS_MODE <- 'pos' +NEG_MODE <- 'neg' +MSDB.MODE.VALS <- c(POS_MODE, NEG_MODE) + +# Default +MSDB.DFT <- list() +MSDB.DFT[['mzshift']] <- 0 # in ppm +MSDB.DFT[['mzprec']] <- 5 # in ppm +MSDB.DFT[['mztolunit']] <- MSDB.DFT.MZTOLUNIT +MSDB.DFT[['precursor-rt-tol']] <- 5 +MSDB.DFT[['molids-sep']] <- MSDB.DFT.MATCH.SEP +MSDB.DFT[['db-fields']] <- concat.kv.list(msdb.get.dft.db.fields()) +MSDB.DFT[['db-ms-modes']] <- concat.kv.list(MSDB.DFT.MODES) +MSDB.DFT[['input-col-names']] <- concat.kv.list(msdb.get.dft.input.fields()) +MSDB.DFT[['output-col-names']] <- concat.kv.list(msdb.get.dft.output.fields()) +MSDB.DFT[['pos-prec']] <- paste(MSDB.DFT.PREC[[MSDB.TAG.POS]], collapse = ',') +MSDB.DFT[['neg-prec']] <- paste(MSDB.DFT.PREC[[MSDB.TAG.NEG]], collapse = ',') + +############## +# PRINT HELP # +############## + +print.help <- function(spec, status = 0) { + cat(getopt(spec, usage = TRUE, command = PROG)) + q(status = status) +} + +############################### +# SET DEFAULT ARGUMENT VALUES # +############################### + +set.dft.arg.val <-function(opt) { + + for (f in names(MSDB.DFT)) + if (is.null(opt[[f]])) + opt[[f]] <- MSDB.DFT[[f]] + + # Set default values + if ( opt$database == MSDB.XLS && ! is.null(opt$url) && is.null(opt[['cache-dir']])) + opt[['cache-dir']] <- file.path(opt$url, 'cache') + + if ( ! is.null(opt$rtcol) && opt$rtcol == '') + opt$rtcol <- NULL + + return(opt) +} + +######################### +# PARSE ARGUMENT VALUES # +######################### + +parse.arg.val <- function(opt) { + + # Parse input column names + if ( ! is.null(opt[['db-fields']])) { + cust <- split.kv.list(opt[['db-fields']]) + opt[['db-fields']] <- split.kv.list(MSDB.DFT[['db-fields']]) + opt[['db-fields']][names(cust)] <- cust + } + + # Parse MS modes + if ( ! is.null(opt[['db-ms-modes']])) { + cust <- split.kv.list(opt[['db-ms-modes']]) + opt[['db-ms-modes']] <- split.kv.list(MSDB.DFT[['db-ms-modes']]) + opt[['db-ms-modes']][names(cust)] <- cust + } + + # Parse retention time columns + if ( ! is.null(opt$rtcol)) + opt$rtcol <- strsplit(opt$rtcol, ',')[[1]] + + # Parse input column names + if ( ! is.null(opt[['input-col-names']])) { + custcols <- split.kv.list(opt[['input-col-names']]) + dftcols <- split.kv.list(MSDB.DFT[['input-col-names']]) + opt[['input-col-names']] <- c(custcols, dftcols[ ! names(dftcols) %in% names(custcols)]) + } + + # Parse output column names + if ( ! is.null(opt[['output-col-names']])) { + custcols <- split.kv.list(opt[['output-col-names']]) + dftcols <- split.kv.list(MSDB.DFT[['output-col-names']]) + opt[['output-col-names']] <- c(custcols, dftcols[ ! names(dftcols) %in% names(custcols)]) + } + + # Parse lists of precursors + if ( ! is.null(opt[['pos-prec']])) + opt[['pos-prec']] <- split.str(opt[['pos-prec']], unlist = TRUE) + if ( ! is.null(opt[['neg-prec']])) + opt[['neg-prec']] <- split.str(opt[['neg-prec']], unlist = TRUE) + + return(opt) +} + +################################# +# PRINT DEFAULT ARGUMENT VALUES # +################################# + +print.dft.arg.val <- function(opt) { + + print.flags <- MSDB.DFT + names(print.flags) <- vapply(names(print.flags), function(x) paste0('print-', x), FUN.VALUE = '') + for (f in names(print.flags)) + if ( ! is.null(opt[[f]])) { + cat(print.flags[[f]]) + q(status = 0) + } +} + +make.getopt.spec.print.dft <- function() { + + spec <- character() + + for (f in names(MSDB.DFT)) + spec <- c(spec, paste0('print-', f), NA_character_, 0, 'logical', paste0('Print default value of --', f)) + + return(spec) +} + +############################## +# MAKE GETOPT SPECIFICATIONS # +############################## + +make.getopt.spec <- function() { + spec = c( + 'help', 'h', 0, 'logical', 'Print this help.', + 'mode', 'm', 1, 'character', paste0('MS mode. Possible values are:', paste(MSDB.MODE.VALS, collapse = ", "), '.'), + 'mzshift', 's', 1, 'numeric', paste0('Shift on m/z, in ppm. Default is ', MSDB.DFT$mzshift,'.'), + 'mzprec', 'p', 1, 'numeric', paste0('Tolerance on m/z, in ppm. Default is ', MSDB.DFT$mzprec,'.'), + 'mztolunit', NA_character_, 1, 'character', paste0('Tolerance on m/z, in ppm. Default is ', MSDB.DFT$mztolunit,'.'), + 'rttol', 'r', 1, 'numeric', paste0('Tolerance on retention times. Unset by default.'), + 'rttolx', 'x', 1, 'numeric', paste0('Tolerance on retention times. Unset by default.'), + 'rttoly', 'y', 1, 'numeric', paste0('Tolerance on retention times. Unset by default.'), + 'rtcol', 'c', 1, 'character', paste0('Chromatographic column to use. Unset by default. If set, use the corresponding column to filter on retention times, if retention times are provided.'), + 'all-cols', NA_character_, 0, 'logical', 'Use all available chromatographic columns to match retention times.', + 'check-cols', NA_character_, 0, 'logical', 'Check that the chromatographic column names specified with option -c really exist.', + 'list-cols', NA_character_, 0, 'logical', 'List all chromatographic columns present in the database. Write list inside the file specified by -o option.', + 'same-rows', 'a', 0, 'logical', 'If set, output exactly the same number of rows as the input. This means that in case of multiple matches for one mz, then only one line is output (i.e.: the mz value is not duplicated on several lines). In the main output file, an "ms.matching" column is output with inside, for each mz, a comma separated list of matched component/molecule IDs. If unset, then only the main output file is used, and one single is written to it with one line per peak match, and eventual mz line duplicated if there are multiple matches for this mz.', + 'same-cols', 'b', 0, 'logical', 'If set, output the same columns as inside the input. All input columns are copied to the output.', + 'input-file', 'i', 1, 'character', 'Set input file.', + 'output-file', 'o', 1, 'character', 'Set file to use for the main output.', + 'peak-output-file', NA_character_, 1, 'character', 'If set and if --same-rows is set, then output all matches inside the specified file, with one mz match per line. The output columns are: mz, rt, id, col, colrt, composition, attribution. This means that if an mz value is matched several times, then it will repeated on several lines, with one match description per line.', + 'html-output-file', NA_character_, 1, 'character', 'Set file to use for the HTML output.', + 'no-main-table-in-html-output', NA_character_, 0, 'logical', 'Do not display main table in HTML output.', + 'precursor-match', NA_character_, 0, 'logical', 'Remove peaks whose molecule precursor peak has not been matched. Unset by default.', + 'precursor-rt-tol', NA_character_, 1, 'numeric', paste0('Precursor retention time tolerance. Only used when precursor-match is enabled. Default is ', MSDB.DFT[['precursor-rt-tol']], '.'), + 'pos-prec', NA_character_, 1, 'character', paste0('Set the list of precursors to use in positive mode. Default is "', MSDB.DFT[['pos-prec']], '".'), + 'neg-prec', NA_character_, 1, 'character', paste0('Set the list of precursors to use in negative mode. Default is "', MSDB.DFT[['neg-prec']], '".'), + 'input-col-names', NA_character_, 1, 'character', paste0('Set the input column names. Default is "', MSDB.DFT[['input-col-names']], '".'), + 'output-col-names', NA_character_, 1, 'character', paste0('Set the output column names. Default is "', MSDB.DFT[['output-col-names']], '".'), + 'molids-sep', NA_character_, 1, 'character', paste0('Set character separator used to when concatenating molecule IDs in output. Default is "', MSDB.DFT[['molids-sep']] , '".'), + 'first-val', NA_character_, 0, 'logical', 'Keep only the first value in multi-value fields. Unset by default.', + 'excel2011comp', NA_character_, 0, 'logical', 'Excel 2011 compatiblity mode. Output ASCII text files instead of UTF-8 files, where greek letters are replaced with their latin names, plusminus sign is replaced with +- and apostrophe is replaced with \"prime\". All other non-ASCII characters are repladed with underscore.', + 'database', 'd', 1, 'character', paste0('Set database to use: "xls" for an Excel database, "file" for a single file database, "4tabsql" for a 4Tab SQL database, and "peakforest" for a connection to PeakForest database.'), + 'url', NA_character_, 1, 'character', 'URL of database. For "peakforest" database it is the HTTP URL, for the "xls" database it is the path to the directory containing the Excel files, for the "file" database it is the path to the file database and for the "4tabsql" database it is the IP address of the server.', + 'cache-dir', NA_character_, 1, 'character', 'Path to directory where to store cache files. Only used when database flag is set to "xls".', + 'useragent', NA_character_, 1, 'character', 'User agent. Used by the "Peakforest" database.', + 'db-name', NA_character_, 1, 'character', 'Name of the database. Used by the "4tabsql" database.', + 'db-user', NA_character_, 1, 'character', 'Name of the database. Used by the "4tabsql" database.', + 'db-password', NA_character_, 1, 'character', 'Name of the database. Used by the "4tabsql" database.', + 'db-fields', NA_character_, 1, 'character', paste0('Comma separated key/value list giving the field names to be used in the single file database (option --db-file). Default is "', MSDB.DFT[['db-fields']], '".'), + 'db-ms-modes', NA_character_, 1, 'character', paste0('Comma separated key/value list giving the MS modes to be used in the single file database (option --db-file). Default is "', MSDB.DFT[['db-ms-modes']], '".'), + 'debug', NA_character_, 0, 'logical', 'Set debug mode.' + ) + + spec <- c(spec, make.getopt.spec.print.dft()) + + if ( ! is.null(spec)) + spec <- matrix(spec, byrow = TRUE, ncol = 5) + + return(spec) +} + +############# +# READ ARGS # +############# + +read_args <- function() { + + # options + spec <- make.getopt.spec() + opt <- getopt(spec) + + # help + if ( ! is.null(opt$help)) + print.help(spec) + + print.dft.arg.val(opt) # Print default values + opt <- set.dft.arg.val(opt) # Set default values + opt <- parse.arg.val(opt) # Parse list values + + # Check values + error <- .check.db.conn.opts(opt) + if (is.null(opt[['output-file']])) { + warning("You must set a path for the output file.") + error <- TRUE + } + if (is.null(opt[['list-cols']])) { + if (is.null(opt[['input-file']])) { + warning("You must provide an input file.") + error <- TRUE + } + if (is.null(opt$mode) || ( ! opt$mode %in% MSDB.MODE.VALS)) { + warning("You must specify a mode through the --mode option.") + error <- TRUE + } + if (is.null(opt$mzprec)) { + warning("You must set a precision in MZ with the --mzprec option.") + error <- TRUE + } + if ( ( ! is.null(opt$rtcol) || ! is.null(opt[['all-cols']])) && (is.null(opt$rttolx) || is.null(opt$rttoly))) { + warning("When chromatographic columns are set, you must provide values for --rttolx and -rttoly.") + error <- TRUE + } + if (is.null(opt$mztolunit) || ( ! opt$mztolunit %in% MSDB.MZTOLUNIT.VALS)) { + warning("You must specify an M/Z tolerance unit through the --mztolunit option.") + error <- TRUE + } + } + + # help + if (error) + print.help(spec, status = 1) + + return(opt) +} + + ##################################### + # CHECK DATABASE CONNECTION OPTIONS # + ##################################### + + .check.db.conn.opts <- function(opt) { + + # Print default values + if ( ! is.null(opt[['print-db-fields']])) { + cat(MSDB.DFT[['db-fields']]) + q(status = 0) + } + if ( ! is.null(opt[['print-db-ms-modes']])) { + cat(MSDB.DFT[['db-ms-modes']]) + q(status = 0) + } + + # Check values + error <- FALSE + if (is.null(opt$database)) { + warning("You must provide a database type through --database option.") + error <- TRUE + } + if ( ! opt$database %in% MSDB.VALS) { + warning(paste0("Invalid value \"", opt$database, "\" for --database option.")) + error <- TRUE + } + if (opt$database == MSDB.FILE) { + if (is.null(opt$url)) { + warning("When using single file database, you must specify the location of the database file with option --url.") + error <- TRUE + } + if ( ! file.exists(opt$url)) { + warning(paste0("The file path \"", opt$url,"\" specified with --db-file option is not valid.")) + error <- TRUE + } + } + if (opt$database == MSDB.XLS) { + if (is.null(opt$url)) { + warning("When using Excel database, you must specify the location of the Excel files directory with option --url.") + error <- TRUE + } + if ( ! file.exists(opt$url)) { + warning(paste0("The directory path \"", opt$url,"\" specified with --xls-dir option is not valid.")) + error <- TRUE + } + } + if (opt$database == MSDB.4TABSQL) { + if (is.null(opt$url)) { + warning("When using 4Tab SQL database, you must specify the URL of the SQL server with option --url.") + error <- TRUE + } + if (is.null(opt[['db-name']])) { + warning("When using 4Tab SQL database, you must specify the database name through the --db-name option.") + error <- TRUE + } + if (is.null(opt[['db-user']])) { + warning("When using 4Tab SQL database, you must specify the database user through the --db-user option.") + error <- TRUE + } + if (is.null(opt[['db-password']])) { + warning("When using 4Tab SQL database, you must specify the database user password through the --db-password option.") + error <- TRUE + } + } + if (opt$database == MSDB.PEAKFOREST) { + if (is.null(opt$url)) { + warning("When using PeakForest database, you must specify the URL of the PeakForest server with option --url.") + error <- TRUE + } + if (is.null(opt$useragent)) { + warning("When using PeakForest database, you must specify a user agent with option --useragent.") + error <- TRUE + } + } + + return(error) + } + + ############################# + # DISPLAY COMMAND LINE HELP # + ############################# + + .disp.cmd.line.help <- function(optspec, opt, prog, error = FALSE) { + + if ( ! is.null(opt$help) || error ) { + cat(getopt(optspec, usage = TRUE, command = prog)) + q(status = 1) + } + } + + ################# + # LOAD DATABASE # + ################# + + .load.db <- function(opt) { + + if (is.null(opt[['pos-prec']]) && is.null(opt[['neg-prec']])) { + precursors <- NULL + } else { + precursors <- list() + precursors[[MSDB.TAG.POS]] <- opt[['pos-prec']] + precursors[[MSDB.TAG.NEG]] <- opt[['neg-prec']] + } + + db <- switch(opt$database, + peakforest = MsPeakForestDb$new(url = opt$url, useragent = opt$useragent), + xls = MsXlsDb(db_dir = opt$url, cache_dir = opt[['cache-dir']]), + '4tabsql' = Ms4TabSqlDb(host = extract.address(opt$url), port = extract.port(opt$url), dbname = opt[['db-name']], user = opt[['db-user']], password = opt[['db-password']]), + file = MsFileDb(file = opt$url), + NULL) + db$setPrecursors(precursors) + if (db$areDbFieldsSettable()) + db$setDbFields(opt[['db-fields']]) + if (db$areDbMsModesSettable()) + db$setDbMsModes(opt[['db-ms-modes']]) + db$addObservers(MsDbLogger$new()) + + return(db) + } + +############### +# OUTPUT HTML # +############### + +output.html <- function(db, main, peaks, file, opt, output.fields) { + + # Replace public database IDs by URLs + if ( ! is.null(peaks)) + for (extdb in c(MSDB.TAG.KEGG, MSDB.TAG.HMDB, MSDB.TAG.CHEBI, MSDB.TAG.PUBCHEM)) { + field <- output.fields[[extdb]] + if (field %in% colnames(peaks)) + peaks[[field]] <- vapply(peaks[[field]], function(id) paste0('<a href="', get.entry.url(class = extdb, accession = id, content.type = RBIODB.HTML), '">', id, '</a>'), FUN.VALUE = '') + } + + # Write HTML + html <- HtmlWriter(file = file) + html$writeBegTag('html') + html$writeBegTag('header') + html$writeTag('title', text = "LC/MS matching results") + html$writeBegTag('style') + html$write('table, th, td { border-collapse: collapse; }') + html$write('table, th { border: 1px solid black; }') + html$write('td { border-left: 1px solid black; border-right: 1px solid black; }') + html$write('th, td { padding: 5px; }') + html$write('th { background-color: LightBlue; }') + html$write('tr:nth-child(even) { background-color: LemonChiffon; }') + html$write('tr:nth-child(odd) { background-color: LightGreen; }') + html$writeEndTag('style') + html$writeEndTag('header') + html$writeBegTag('body') + html$writeTag('h1', text = "LC/MS matching") + + # Write parameters + html$writeTag('h2', text = "Parameters") + html$writeBegTag('ul') + html$writeTag('li', paste0("Mode = ", opt$mode, ".")) + html$writeTag('li', paste0("M/Z precision = ", opt$mzprec, ".")) + html$writeTag('li', paste0("M/Z shift = ", opt$mzshift, ".")) + html$writeTag('li', paste0("Precursor match = ", (if (is.null(opt[['precursor-match']])) "no" else "yes"), ".")) + if ( ! is.null(opt[['precursor-match']])) { + html$writeTag('li', paste0("Positive precursors = ", paste0(opt[['pos-prec']], collapse = ', '), ".")) + html$writeTag('li', paste0("Negative precursors = ", paste0(opt[['neg-prec']], collapse = ', '), ".")) + } + if ( ! is.null(opt$rtcol)) { + html$writeTag('li', paste0("Columns = ", paste(opt$rtcol, collapse = ", "), ".")) + html$writeTag('li', paste0("RTX = ", opt$rttolx, ".")) + html$writeTag('li', paste0("RTY = ", opt$rttoly, ".")) + if ( ! is.null(opt[['precursor-match']])) + html$writeTag('li', paste0("RTZ = ", opt[['precursor-rt-tol']], ".")) + } + html$writeEndTag('ul') + + # Write results + html$writeTag('h2', text = "Results") + results <- FALSE + if ( ! is.null(main) && nrow(main) > 0 && is.null(opt[['no-main-table-in-html-output']])) { + html$writeTag('h3', text = "Main output") + html$writeTable(main) + results <- TRUE + } + if ( ! is.null(peaks) && nrow(peaks) > 0) { + html$writeTag('h3', text = "Matched peaks") + html$writeTable(peaks) + results <- TRUE + } + if ( ! results) + html$writeTag('p', 'None.') + + html$writeEndTag('body') + html$writeEndTag('html') +} + +######## +# MAIN # +######## + +options(error = function() { traceback(2) ; quit(status = 1) }, warn = 2 ) + +# Read command line arguments +opt <- read_args() + +if (is.null(opt$debug)) { + options(error = function() { quit(status = 1) }, warn = 0 ) +} + +# Load database +db <- .load.db(opt) + +# Print columns +if ( ! is.null(opt[['list-cols']])) { + cols <- db$getChromCol() + df.write.tsv(cols, file = opt[['output-file']]) + q(status = 0) +} + +# Read input +if ( ! is.null(opt[['input-file']]) && ! file.exists(opt[['input-file']])) + stop(paste0("Input file \"", opt[['input-file']], "\" does not exist.")) +if (file.info(opt[['input-file']])$size > 0) { + + # Load file into data frame + input <- read.table(file = opt[['input-file']], header = TRUE, sep = "\t") + + # Convert each column that is identified by a number into a name + for (field in names(opt[['input-col-names']])) { + if ( ! opt[['input-col-names']][[field]] %in% colnames(input) && length(grep('^[0-9]+$', opt[['input-col-names']][[field]])) > 0) { + col.index <- as.integer(opt[['input-col-names']][[field]]) + if (col.index < 1 || col.index > length(colnames(input))) + stop(paste0("No column n°", col.index, " for input field ", field, ".")) + opt[['input-col-names']][[field]] <- colnames(input)[[col.index]] + } + } +} else { + input <- data.frame() + input[[opt[['input-col-names']][['mz']]]] <- double() + input[[opt[['input-col-names']][['rt']]]] <- double() +} + +# Check mz column +if ( ! opt[['input-col-names']][['mz']] %in% colnames(input)) + stop(paste0('No column named "', opt[['input-col-names']][['mz']], '" in input file.')) + +# Set columns 'all-cols' specified +if ( ! is.null(opt[['all-cols']])) + opt$rtcol <- db$getChromCol() + +# Check chrom columns +if ( ! is.null(opt[['check-cols']]) && ! is.null(opt$rtcol)) { + dbcols <- db$getChromCol() + unknown.cols <- opt$rtcol[ ! opt$rtcol %in% dbcols] + if (length(unknown.cols) > 0) { + stop(paste0("Unknown chromatographic column", (if (length(unknown.cols) > 1) 's' else ''), ': ', paste(unknown.cols, collapse = ', '), ".\nAllowed chromatographic column names are:\n", paste(dbcols, collapse = "\n"))) + } +} + +# Check that an RT column exists when using MZ/RT matching +if ( ! is.null(opt$rtcol) && ! opt[['input-col-names']][['rt']] %in% colnames(input)) + stop(paste0("You are running an MZ/RT match run on your input data, but no retention time column named '", opt[['input-col-names']][['rt']],"' can be found inside your input file.")) + +# Set streams +input.stream <- MsDbInputDataFrameStream$new(df = input, input.fields = opt[['input-col-names']]) +main.output <- MsDbOutputDataFrameStream$new(keep.unused = ! is.null(opt[['same-cols']]), output.fields = opt[['output-col-names']], one.line = ! is.null(opt[['same-rows']]), match.sep = opt[['molids-sep']], first.val = ! is.null(opt[['first-val']]), ascii = ! is.null(opt[['excel2011comp']]), nogreek = ! is.null(opt[['excel2011comp']]), noapostrophe = ! is.null(opt[['excel2011comp']]), noplusminus = ! is.null(opt[['excel2011comp']])) +peaks.output <- MsDbOutputDataFrameStream$new(keep.unused = ! is.null(opt[['same-cols']]), output.fields = opt[['output-col-names']], first.val = ! is.null(opt[['first-val']]), ascii = ! is.null(opt[['excel2011comp']]), nogreek = ! is.null(opt[['excel2011comp']]), noapostrophe = ! is.null(opt[['excel2011comp']]), noplusminus = ! is.null(opt[['excel2011comp']])) +invisible(db$setInputStream(input.stream)) +db$addOutputStreams(c(main.output, peaks.output)) + +# Set M/Z tolerance unit +db$setMzTolUnit(opt$mztolunit) + +# Search database +mode <- if (opt$mode == POS_MODE) MSDB.TAG.POS else MSDB.TAG.NEG +db$searchForMzRtList(mode = mode, shift = opt$mzshift, prec = opt$mzprec, rt.tol = opt$rttol, rt.tol.x = opt$rttolx, rt.tol.y = opt$rttoly, col = opt$rtcol, precursor.match = ! is.null(opt[['precursor-match']]), precursor.rt.tol = opt[['precursor-rt-tol']]) + +# Write output +# TODO Create a class MsDbOutputCsvFileStream +df.write.tsv(main.output$getDataFrame(), file = opt[['output-file']], row.names = FALSE) +if ( ! is.null(opt[['peak-output-file']])) + # TODO Create a class MsDbOutputCsvFileStream + df.write.tsv(peaks.output$getDataFrame(), file = opt[['peak-output-file']], row.names = FALSE) +if ( ! is.null(opt[['html-output-file']])) + # TODO Create a class MsDbOutputHtmlFileStream + output.html(db = db, main = main.output$getDataFrame(), peaks = peaks.output$getDataFrame(), file = opt[['html-output-file']], opt = opt, output.fields = opt[['output-col-names']])
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/search.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,64 @@ +if ( ! exists('binary.search')) { # Do not load again if already loaded + + # Run a binary search on a sorted array. + # val The value to search. + # tab The array of values, sorted in ascending order. + # lower If set to NA, then search for the first value found by the binary search. If set to TRUE, find the value with the lowest index in the array. If set to FALSE, find the value with the highest index in the array. + # first The index of the array from which to start (1 by default). + # last The index of the array where to stop searching (end of the array by default). + # Returns the index of the found value, or NA. + binary.search <- function(val, tab, lower = NA, first = 1L, last = length(tab)) + { + # Check array & value + if (is.null(tab)) + stop('Argument "tab" is NULL.') + if (is.null(val)) + stop('Argument "val" is NULL.') + + # Wrong arguments + if (is.na(val) || last < first || length(tab) == 0) + return(NA_integer_) + + # Find value + l <- first + h <- last + while (h >= l) { + + # Take middle point + m <- (h + l) %/% 2 + # Found value + if (tab[m] == val) { + if (is.na(lower)) + return(m) + if (lower && m > first) { + for (i in (m-1):first) + if (tab[i] != val) + return(i+1) + } + else if ( ! lower && m < last) + for (i in (m+1):last) + if (tab[i] != val) + return(i-1) + return(m) + } + + # Decrease higher bound + else if (tab[m] > val) h <- m - 1 + + # Increase lower bound + else l <- m + 1 + } + + # Value not found + if ( ! is.na(lower)) { + # Look for lower or higher bound + if (lower) + return(if (h < first) NA_integer_ else h) + else + return(if (l > last) NA_integer_ else l) + } + + return(NA_integer_) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/strhlp.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,72 @@ +if ( ! exists('trim')) { # Do not load again if already loaded + + ####################### + # WHITESPACE TRIMMING # + ####################### + + # Trim leading whitespaces + trim.leading <- function (x) sub("^\\s+", "", x) + + # Trim trailing whitespaces + trim.trailing <- function (x) sub("\\s+$", "", x) + + # Trim leading and trailing whitespaces + trim <- function (x) gsub("^\\s+|\\s+$", "", x) + + ############# + # SPLITTING # + ############# + + # s The string to split. + # sep The separator on which to split. + # trim Trim whitespaces for the resulting elements. + # unlist Unlist the result, So that for a single string (i.e.: s has length 1), it returns a vector of strings instead of a list of vectors of strings. + # RETURN A list of strings. + split.str <- function(s, sep = ',', trim = TRUE, unlist = FALSE) { + v <- strsplit(s, sep) + if (trim) v <- lapply(v, trim) + if (unlist) v <- unlist(v) + return(v) + } + + ######################## + # SPLIT KEY/VALUE LIST # + ######################## + + split.kv.list <- function(s, sep = ',', kvsep = '=') { + + # Split + kvs <- strsplit(strsplit(s, sep)[[1]], kvsep) + + # Get keys + k <- vapply(kvs, function(x) x[[1]], FUN.VALUE = '') + v <- vapply(kvs, function(x) x[[2]], FUN.VALUE = '') + + # Set names + names(v) <- k + + return(v) + } + + ######################### + # CONCAT KEY/VALUE LIST # + ######################### + + concat.kv.list <- function(x, sep = ',', kvsep = '=') { + + k <- names(x) + + s = paste(paste(names(x), x, sep = kvsep), collapse = sep) + + return(s) + } + + ################# + # REMOVE QUOTES # + ################# + + remove.quotes <- function(s) { + return(sub('^["\']?([^\'"]*)["\']?$', '\\1', s, perl = TRUE)) + } + +} # end of load safe guard
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test-data/filedb-small-mz-match-html-output.html Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,369 @@ +<html> + <header> + <title>LC/MS matching results</title> + <style> + table, th, td { border-collapse: collapse; } + table, th { border: 1px solid black; } + td { border-left: 1px solid black; border-right: 1px solid black; } + th, td { padding: 5px; } + th { background-color: LightBlue; } + tr:nth-child(even) { background-color: LemonChiffon; } + tr:nth-child(odd) { background-color: LightGreen; } + </style> + </header> + <body> + <h1>LC/MS matching</h1> + <h2>Parameters</h2> + <ul> + <li>Mode = pos.</li> + <li>M/Z precision = 5.</li> + <li>M/Z shift = 0.</li> + <li>Precursor match = no.</li> + </ul> + <h2>Results</h2> + <h3>Matched peaks</h3> + <table> + <tr> + <th>mz</th> + <th>molid</th> + <th>mode</th> + <th>mztheo</th> + <th>comp</th> + <th>attr</th> + <th>molcomp</th> + <th>molmass</th> + <th>molnames</th> + </tr> + <tr> + <td>80.04959</td> + <td>U761</td> + <td>POS</td> + <td>80.04948</td> + <td>P9Z5W46 O0</td> + <td>[(M+H)-(NHCO)]+</td> + <td>J16L6M62O</td> + <td>122.048</td> + <td>Coquelicol;Paquerettol</td> + </tr> + <tr> + <td>82.04819</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>83.01344</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>84.05585</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>87.05536</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>89.50682</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>90.97681</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>92.98093</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>94.57331</td> + <td>A10</td> + <td>POS</td> + <td>94.57331</td> + <td>P93Z8W419 O2</td> + <td>[(M+2H)+(CH3CN)]++</td> + <td>J114L6M62O2</td> + <td>146.1055</td> + <td>Blablaine</td> + </tr> + <tr> + <td>97.07603</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>99.54296</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>101.0709</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>102.0663</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>102.2845</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>104.0034</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>104.5318</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>105.4461</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>105.7271</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>106.0231</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>106.24</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>106.5116</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>106.763</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>106.9815</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>107.2424</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>107.4569</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>107.6885</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>107.9273</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>108.1576</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>109.0777</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + <tr> + <td>110.0599</td> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + <td/> + </tr> + </table> + </body> +</html>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test-data/filedb-small-mz-match-output.tsv Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,31 @@ +"mz" "molid" "mode" "mztheo" "comp" "attr" "molcomp" "molmass" "molnames" +80.04959021 "U761" "POS" "80.049475" "P9Z5W46 O0" "[(M+H)-(NHCO)]+" "J16L6M62O" "122.04801" "Coquelicol;Paquerettol" +82.04819461 NA NA NA NA NA NA NA NA +83.01343941 NA NA NA NA NA NA NA NA +84.05585475 NA NA NA NA NA NA NA NA +87.05536392 NA NA NA NA NA NA NA NA +89.50682004 NA NA NA NA NA NA NA NA +90.97680734 NA NA NA NA NA NA NA NA +92.98092987 NA NA NA NA NA NA NA NA +94.57331384 "A10" "POS" "94.5733145" "P93Z8W419 O2" "[(M+2H)+(CH3CN)]++" "J114L6M62O2" "146.10553" "Blablaine" +97.07602789 NA NA NA NA NA NA NA NA +99.5429594 NA NA NA NA NA NA NA NA +101.0708987 NA NA NA NA NA NA NA NA +102.066292 NA NA NA NA NA NA NA NA +102.2845376 NA NA NA NA NA NA NA NA +104.0034256 NA NA NA NA NA NA NA NA +104.5317528 NA NA NA NA NA NA NA NA +105.4460999 NA NA NA NA NA NA NA NA +105.7271343 NA NA NA NA NA NA NA NA +106.0231437 NA NA NA NA NA NA NA NA +106.2399954 NA NA NA NA NA NA NA NA +106.5116177 NA NA NA NA NA NA NA NA +106.7629705 NA NA NA NA NA NA NA NA +106.9814579 NA NA NA NA NA NA NA NA +107.2424051 NA NA NA NA NA NA NA NA +107.4569385 NA NA NA NA NA NA NA NA +107.6884734 NA NA NA NA NA NA NA NA +107.9272908 NA NA NA NA NA NA NA NA +108.1575604 NA NA NA NA NA NA NA NA +109.0777249 NA NA NA NA NA NA NA NA +110.0599023 NA NA NA NA NA NA NA NA
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test-data/filedb-small-mz-match-peaks-output.tsv Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,31 @@ +"mz" "molid" "mode" "mztheo" "comp" "attr" "molcomp" "molmass" "molnames" +80.04959021 "U761" "POS" 80.049475 "P9Z5W46 O0" "[(M+H)-(NHCO)]+" "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +82.04819461 NA NA NA NA NA NA NA NA +83.01343941 NA NA NA NA NA NA NA NA +84.05585475 NA NA NA NA NA NA NA NA +87.05536392 NA NA NA NA NA NA NA NA +89.50682004 NA NA NA NA NA NA NA NA +90.97680734 NA NA NA NA NA NA NA NA +92.98092987 NA NA NA NA NA NA NA NA +94.57331384 "A10" "POS" 94.5733145 "P93Z8W419 O2" "[(M+2H)+(CH3CN)]++" "J114L6M62O2" 146.10553 "Blablaine" +97.07602789 NA NA NA NA NA NA NA NA +99.5429594 NA NA NA NA NA NA NA NA +101.0708987 NA NA NA NA NA NA NA NA +102.066292 NA NA NA NA NA NA NA NA +102.2845376 NA NA NA NA NA NA NA NA +104.0034256 NA NA NA NA NA NA NA NA +104.5317528 NA NA NA NA NA NA NA NA +105.4460999 NA NA NA NA NA NA NA NA +105.7271343 NA NA NA NA NA NA NA NA +106.0231437 NA NA NA NA NA NA NA NA +106.2399954 NA NA NA NA NA NA NA NA +106.5116177 NA NA NA NA NA NA NA NA +106.7629705 NA NA NA NA NA NA NA NA +106.9814579 NA NA NA NA NA NA NA NA +107.2424051 NA NA NA NA NA NA NA NA +107.4569385 NA NA NA NA NA NA NA NA +107.6884734 NA NA NA NA NA NA NA NA +107.9272908 NA NA NA NA NA NA NA NA +108.1575604 NA NA NA NA NA NA NA NA +109.0777249 NA NA NA NA NA NA NA NA +110.0599023 NA NA NA NA NA NA NA NA
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test-data/filedb.tsv Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,1551 @@ +"molid" "mode" "mztheo" "comp" "attr" "col" "colrt" "molcomp" "molmass" "molnames" +A10 "POS" 112.07569 "P9Z6W410 O" "[(M+H)-(H2O)-(NH3)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 Blablaine' +A10 "POS" 112.07569 "P9Z6W410 O" "[(M+H)-(H2O)-(NH3)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 112.07569 "P9Z6W410 O" "[(M+H)-(H2O)-(NH3)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 191.076694 "P92Z6W413 Na2 O2" "[(M-H+2Na)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 191.076694 "P92Z6W413 Na2 O2" "[(M-H+2Na)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 294.221687 "U1113P94ZW429 O4" "[(2M+H)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 72.080775 "P9Z4W410 O0" "[(M+H)-(J15L2M6O2)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 112.07569 "P9Z6W410 O" "[(M+H)-(H2O)-(NH3)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 72.080775 "P9Z4W410 O0" "[(M+H)-(J15L2M6O2)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 72.080775 "P9Z4W410 O0" "[(M+H)-(J15L2M6O2)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 145.097154 "P92Z6W413 O2" "[(M+H)-(H2)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 145.097154 "P92Z6W413 O2" "[(M+H)-(H2)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 112.07569 "P9Z6W410 O" "[(M+H)-(H2O)-(NH3)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 72.080775 "P9Z4W410 O0" "[(M+H)-(J15L2M6O2)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(NH3)-(HCOOH)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(NH3)-(HCOOH)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(NH3)-(HCOOH)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(NH3)-(HCOOH)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.116159 "U513P92ZW415 O2" "[(M+H)]+ (13C)" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.116159 "U513P92ZW415 O2" "[(M+H)]+ (13C)" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 145.097154 "P92Z6W413 O2" "[(M+H)-(H2)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.116159 "U513P92ZW415 O2" "[(M+H)]+ (13C)" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 70.065125 "P9Z4W48 O0" "[(M+H)-(J17L2M6O2)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 70.065125 "P9Z4W48 O0" "[(M+H)-(J17L2M6O2)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 70.065125 "P9Z4W48 O0" "[(M+H)-(J17L2M6O2)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 70.065125 "P9Z4W48 O0" "[(M+H)-(J17L2M6O2)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(C3H7O2N)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(C3H7O2N)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(C3H7O2N)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(C3H7O2N)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(J17L2M6)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(J17L2M6)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(J17L2M6)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(J17L2M6)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 101.107324 "P92Z5W413 O0" "[(M+H)-(HCOOH)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 101.107324 "P92Z5W413 O0" "[(M+H)-(HCOOH)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 101.107324 "P92Z5W413 O0" "[(M+H)-(HCOOH)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 101.107324 "P92Z5W413 O0" "[(M+H)-(HCOOH)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 360.167522 "U1113P94ZW426 Na3 O4" "[(2M-2H+3Na)]+ (13C)" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 360.167522 "U1113P94ZW426 Na3 O4" "[(2M-2H+3Na)]+ (13C)" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.116159 "U513P92ZW415 O2" "[(M+H)]+ (13C)" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 360.167522 "U1113P94ZW426 Na3 O4" "[(2M-2H+3Na)]+ (13C)" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 294.221687 "U1113P94ZW429 O4" "[(2M+H)]+ (13C)" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 294.221687 "U1113P94ZW429 O4" "[(2M+H)]+ (13C)" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 294.221687 "U1113P94ZW429 O4" "[(2M+H)]+ (13C)" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 294.221687 "U1113P94ZW429 O4" "[(2M+H)]+ (13C)" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.063395 "U413P92Z2W416 O2" "[(M+2H)]++ (13C2)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.063395 "U413P92Z2W416 O2" "[(M+2H)]++ (13C2)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.063395 "U413P92Z2W416 O2" "[(M+2H)]++ (13C2)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.063395 "U413P92Z2W416 O2" "[(M+2H)]++ (13C2)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 149.117048 "P92Z6W415 O 18O" "[(M+H)]+ (18O)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 149.117048 "P92Z6W415 O 18O" "[(M+H)]+ (18O)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 149.117048 "P92Z6W415 O 18O" "[(M+H)]+ (18O)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 149.117048 "P92Z6W415 O 18O" "[(M+H)]+ (18O)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 337.182222 "P94Z12W427 Na2 O4" "[(2M-H+2Na)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 337.182222 "P94Z12W427 Na2 O4" "[(2M-H+2Na)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 337.182222 "P94Z12W427 Na2 O4" "[(2M-H+2Na)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 337.182222 "P94Z12W427 Na2 O4" "[(2M-H+2Na)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.0573 "P92Z5W414 O0" "[(M+2H)-(HCOOH)]++" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.0573 "P92Z5W414 O0" "[(M+2H)-(HCOOH)]++" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 360.167522 "U1113P94ZW426 Na3 O4" "[(2M-2H+3Na)]+ (13C)" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.0573 "P92Z5W414 O0" "[(M+2H)-(HCOOH)]++" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 251.032367 "U6H13 Cl0 37Cl N2 Na3 O2" "[(M-H+2Na)+(NaCl)]+ (37Cl)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 251.032367 "U6H13 Cl0 37Cl N2 Na3 O2" "[(M-H+2Na)+(NaCl)]+ (37Cl)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 251.032367 "U6H13 Cl0 37Cl N2 Na3 O2" "[(M-H+2Na)+(NaCl)]+ (37Cl)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 251.032367 "U6H13 Cl0 37Cl N2 Na3 O2" "[(M-H+2Na)+(NaCl)]+ (37Cl)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.105594 "U513P92ZW413 O" "[(M+H)-(H2O)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.105594 "U513P92ZW413 O" "[(M+H)-(H2O)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.105594 "U513P92ZW413 O" "[(M+H)-(H2O)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.105594 "U513P92ZW413 O" "[(M+H)-(H2O)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 73.08413 "U313P9ZW410 O0" "[(M+H)-(J15L2M6O2)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 73.08413 "U313P9ZW410 O0" "[(M+H)-(J15L2M6O2)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 73.08413 "U313P9ZW410 O0" "[(M+H)-(J15L2M6O2)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 73.08413 "U313P9ZW410 O0" "[(M+H)-(J15L2M6O2)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 316.203632 "U1113P94ZW428 Na O4" "[(2M+Na)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 316.203632 "U1113P94ZW428 Na O4" "[(2M+Na)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 316.203632 "U1113P94ZW428 Na O4" "[(2M+Na)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 316.203632 "U1113P94ZW428 Na O4" "[(2M+Na)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 113.059706 "P90Z6W49 O2" "[(M+H)-2(NH3)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 113.059706 "P90Z6W49 O2" "[(M+H)-2(NH3)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 113.059706 "P90Z6W49 O2" "[(M+H)-2(NH3)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 113.059706 "P90Z6W49 O2" "[(M+H)-2(NH3)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)-(NH3)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)-(NH3)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)-(NH3)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)-(NH3)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5617175 "U513P92ZW416 O2" "[(M+2H)]++ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5617175 "U513P92ZW416 O2" "[(M+2H)]++ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5617175 "U513P92ZW416 O2" "[(M+2H)]++ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5617175 "U513P92ZW416 O2" "[(M+2H)]++ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 104.070605 "P9Z4W410 O2" "[(M+H)-(J15L2M6)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 104.070605 "P9Z4W410 O2" "[(M+H)-(J15L2M6)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 104.070605 "P9Z4W410 O2" "[(M+H)-(J15L2M6)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 104.070605 "P9Z4W410 O2" "[(M+H)-(J15L2M6)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 293.218332 "P94Z12W429 O4" "[(2M+H)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 293.218332 "P94Z12W429 O4" "[(2M+H)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 293.218332 "P94Z12W429 O4" "[(2M+H)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 293.218332 "P94Z12W429 O4" "[(2M+H)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 94.5733145 "P93Z8W419 O2" "[(M+2H)+(CH3CN)]++" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 360.167522 "U1113P94ZW426 Na3 O4" "[(2M-2H+3Na)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 94.5733145 "P93Z8W419 O2" "[(M+2H)+(CH3CN)]++" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 94.5733145 "P93Z8W419 O2" "[(M+2H)+(CH3CN)]++" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 171.098993 "P92Z6W414 Na O 18O" "[(M+Na)]+ (18O)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 171.098993 "P92Z6W414 Na O 18O" "[(M+Na)]+ (18O)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 171.098993 "P92Z6W414 Na O 18O" "[(M+Na)]+ (18O)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 171.098993 "P92Z6W414 Na O 18O" "[(M+Na)]+ (18O)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 338.185577 "U1113P94ZW427 Na2 O4" "[(2M-H+2Na)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 338.185577 "U1113P94ZW427 Na2 O4" "[(2M-H+2Na)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 338.185577 "U1113P94ZW427 Na2 O4" "[(2M-H+2Na)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 338.185577 "U1113P94ZW427 Na2 O4" "[(2M-H+2Na)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 418.126145 "U1113C H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 418.126145 "U1113C H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 418.126145 "U1113C H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 418.126145 "U1113C H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5558175 "P9Z5W414 15N O0" "[(M+2H)-(HCOOH)]++ (15N)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5558175 "P9Z5W414 15N O0" "[(M+2H)-(HCOOH)]++ (15N)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5558175 "P9Z5W414 15N O0" "[(M+2H)-(HCOOH)]++ (15N)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5558175 "P9Z5W414 15N O0" "[(M+2H)-(HCOOH)]++ (15N)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 169.094749 "P92Z6W414 Na O2" "[(M+Na)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 169.094749 "P92Z6W414 Na O2" "[(M+Na)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 169.094749 "P92Z6W414 Na O2" "[(M+Na)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 169.094749 "P92Z6W414 Na O2" "[(M+Na)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 359.164167 "P94Z12W426 Na3 O4" "[(2M-2H+3Na)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 359.164167 "P94Z12W426 Na3 O4" "[(2M-2H+3Na)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 359.164167 "P94Z12W426 Na3 O4" "[(2M-2H+3Na)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 359.164167 "P94Z12W426 Na3 O4" "[(2M-2H+3Na)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 315.200277 "P94Z12W428 Na O4" "[(2M+Na)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 315.200277 "P94Z12W428 Na O4" "[(2M+Na)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 315.200277 "P94Z12W428 Na O4" "[(2M+Na)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 315.200277 "P94Z12W428 Na O4" "[(2M+Na)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 107.08961 "U313P9ZW412 O2" "[(M+H)-(J13L2M6)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 107.08961 "U313P9ZW412 O2" "[(M+H)-(J13L2M6)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 107.08961 "U313P9ZW412 O2" "[(M+H)-(J13L2M6)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 107.08961 "U313P9ZW412 O2" "[(M+H)-(J13L2M6)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 95.074992 "U713P93ZW419 O2" "[(M+2H)+(CH3CN)]++ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 95.074992 "U713P93ZW419 O2" "[(M+2H)+(CH3CN)]++ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 95.074992 "U713P93ZW419 O2" "[(M+2H)+(CH3CN)]++ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 95.074992 "U713P93ZW419 O2" "[(M+2H)+(CH3CN)]++ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.091784 "P9Z6W414 15N Na O2" "[(M+Na)]+ (15N)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.091784 "P9Z6W414 15N Na O2" "[(M+Na)]+ (15N)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.091784 "P9Z6W414 15N Na O2" "[(M+Na)]+ (15N)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.091784 "P9Z6W414 15N Na O2" "[(M+Na)]+ (15N)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 106.086255 "P9Z4W412 O2" "[(M+H)-(J13L2M6)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 106.086255 "P9Z4W412 O2" "[(M+H)-(J13L2M6)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 106.086255 "P9Z4W412 O2" "[(M+H)-(J13L2M6)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 106.086255 "P9Z4W412 O2" "[(M+H)-(J13L2M6)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5585575 "P9Z6W416 15N O2" "[(M+2H)]++ (15N)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5585575 "P9Z6W416 15N O2" "[(M+2H)]++ (15N)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5585575 "P9Z6W416 15N O2" "[(M+2H)]++ (15N)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.5585575 "P9Z6W416 15N O2" "[(M+2H)]++ (15N)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.098104 "U513P92ZW414 Na O2" "[(M+Na)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.098104 "U513P92ZW414 Na O2" "[(M+Na)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.098104 "U513P92ZW414 Na O2" "[(M+Na)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 170.098104 "U513P92ZW414 Na O2" "[(M+Na)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.06004 "P92Z6W416 O2" "[(M+2H)]++" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.06004 "P92Z6W416 O2" "[(M+2H)]++" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.06004 "P92Z6W416 O2" "[(M+2H)]++" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.06004 "P92Z6W416 O2" "[(M+2H)]++" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.096425 "P9Z4W412 O0" "[(M+H)-(J13L2M6O2)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.096425 "P9Z4W412 O0" "[(M+H)-(J13L2M6O2)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.096425 "P9Z4W412 O0" "[(M+H)-(J13L2M6O2)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.096425 "P9Z4W412 O0" "[(M+H)-(J13L2M6O2)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.062162 "P92Z6W416 O 18O" "[(M+2H)]++ (18O)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.062162 "P92Z6W416 O 18O" "[(M+2H)]++ (18O)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.062162 "P92Z6W416 O 18O" "[(M+2H)]++ (18O)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 75.062162 "P92Z6W416 O 18O" "[(M+2H)]++ (18O)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 129.102239 "P92Z6W413 O" "[(M+H)-(H2O)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5589775 "U413P92ZW414 O0" "[(M+2H)-(HCOOH)]++ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 192.080049 "U513P92ZW413 Na2 O2" "[(M-H+2Na)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 192.080049 "U513P92ZW413 Na2 O2" "[(M-H+2Na)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 192.080049 "U513P92ZW413 Na2 O2" "[(M-H+2Na)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 192.080049 "U513P92ZW413 Na2 O2" "[(M-H+2Na)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 116.070605 "P9Z5W410 O2" "[(M+H)-(J15LM6)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 116.070605 "P9Z5W410 O2" "[(M+H)-(J15LM6)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 116.070605 "P9Z5W410 O2" "[(M+H)-(J15LM6)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 191.076694 "P92Z6W413 Na2 O2" "[(M-H+2Na)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 118.086255 "P9Z5W412 O2" "[(M+H)-(J13LM6)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 118.086255 "P9Z5W412 O2" "[(M+H)-(J13LM6)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 118.086255 "P9Z5W412 O2" "[(M+H)-(J13LM6)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 118.086255 "P9Z5W412 O2" "[(M+H)-(J13LM6)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 147.112804 "P92Z6W415 O2" "[(M+H)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 147.112804 "P92Z6W415 O2" "[(M+H)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 147.112804 "P92Z6W415 O2" "[(M+H)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 147.112804 "P92Z6W415 O2" "[(M+H)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5589775 "U413P92ZW414 O0" "[(M+2H)-(HCOOH)]++ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5589775 "U413P92ZW414 O0" "[(M+2H)-(HCOOH)]++ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.5589775 "U413P92ZW414 O0" "[(M+2H)-(HCOOH)]++ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.109839 "P9Z6W415 15N O2" "[(M+H)]+ (15N)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)-(NH3)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)-(NH3)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)-(NH3)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)-(NH3)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 249.035317 "U6H13 Cl N2 Na3 O2" "[(M-H+2Na)+(NaCl)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 249.035317 "U6H13 Cl N2 Na3 O2" "[(M-H+2Na)+(NaCl)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 249.035317 "U6H13 Cl N2 Na3 O2" "[(M-H+2Na)+(NaCl)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 116.070605 "P9Z5W410 O2" "[(M+H)-(J15LM6)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 126.05255 "P9Z4W49 Na O2" "[(M+Na)-(J15L2M6)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 126.05255 "P9Z4W49 Na O2" "[(M+Na)-(J15L2M6)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 126.05255 "P9Z4W49 Na O2" "[(M+Na)-(J15L2M6)]+" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 126.05255 "P9Z4W49 Na O2" "[(M+Na)-(J15L2M6)]+" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(NH3)-(HCOOH)]+ (13C)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(NH3)-(HCOOH)]+ (13C)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(NH3)-(HCOOH)]+ (13C)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(NH3)-(HCOOH)]+ (13C)" "somecol" 8.97 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.109839 "P9Z6W415 15N O2" "[(M+H)]+ (15N)" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.109839 "P9Z6W415 15N O2" "[(M+H)]+ (15N)" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 148.109839 "P9Z6W415 15N O2" "[(M+H)]+ (15N)" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 74.096425 "P9Z4W412 O0" "[(M+H)-(J13L2M6O2)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 417.12279 "U12H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+" "colzz2" 4.08 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 111.091674 "P92Z6W411 O0" "[(M+H)-2(H2O)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 111.091674 "P92Z6W411 O0" "[(M+H)-2(H2O)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 111.091674 "P92Z6W411 O0" "[(M+H)-2(H2O)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 111.091674 "P92Z6W411 O0" "[(M+H)-2(H2O)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 417.12279 "U12H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 417.12279 "U12H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+" "colpp" 0.89 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 417.12279 "U12H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+" "colzz3" 4.54 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 129.102239 "P92Z6W413 O" "[(M+H)-(H2O)]+" "colzz" 5.69 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 129.102239 "P92Z6W413 O" "[(M+H)-(H2O)]+" "hcoltt" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 51.0573 "P92Z5W414 O0" "[(M+2H)-(HCOOH)]++" "col12" 0.8 "J114L6M62O2" 146.10553 "Blablaine" +A10 "POS" 417.12279 "U12H26 Cl N4 Na4 O4" "[(2M-2H+3Na)+(NaCl)]+" "colAA" 1.58 "J114L6M62O2" 146.10553 "Blablaine" +K12 "POS" 53.06848 "U313P92Z2W416" "[(M+2H)]++ (13C2)" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 104.120009 "P9Z5W415 15N" "[(M+H)]+ (15N)" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.5636425 "P9Z5W416 15N" "[(M+2H)]++ (15N)" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.5636425 "P9Z5W416 15N" "[(M+2H)]++ (15N)" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.065125 "P92Z5W416" "[(M+2H)]++" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.5636425 "P9Z5W416 15N" "[(M+2H)]++ (15N)" "colpp" 0.88 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 53.06848 "U313P92Z2W416" "[(M+2H)]++ (13C2)" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.5668025 "U413P92ZW416" "[(M+2H)]++ (13C)" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.5668025 "U413P92ZW416" "[(M+2H)]++ (13C)" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.5636425 "P9Z5W416 15N" "[(M+2H)]++ (15N)" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 72.080775 "P9Z4W410" "[(M+H)-(J15LM6)]+" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.065125 "P92Z5W416" "[(M+2H)]++" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 103.122974 "P92Z5W415" "[(M+H)]+" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 103.122974 "P92Z5W415" "[(M+H)]+" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 105.129684 "U313P92Z2W415" "[(M+H)]+ (13C2)" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 105.129684 "U313P92Z2W415" "[(M+H)]+ (13C2)" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 105.129684 "U313P92Z2W415" "[(M+H)]+ (13C2)" "colpp" 0.88 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 102.110679 "U413P92ZW413" "[(M+H)-(H2)]+ (13C)" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 103.122974 "P92Z5W415" "[(M+H)]+" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 87.09978 "U413P9ZW412" "[(M+H)-(NH3)]+ (13C)" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 87.09978 "U413P9ZW412" "[(M+H)-(NH3)]+ (13C)" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 87.09978 "U413P9ZW412" "[(M+H)-(NH3)]+ (13C)" "colpp" 0.88 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 70.073231 "U413P90ZW49" "[(M+H)-2(NH3)]+ (13C)" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 70.073231 "U413P90ZW49" "[(M+H)-2(NH3)]+ (13C)" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 52.065125 "P92Z5W416" "[(M+2H)]++" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 74.096425 "P9Z4W412" "[(M+H)-(J13LM6)]+" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 101.107324 "P92Z5W413" "[(M+H)-(H2)]+" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 101.107324 "P92Z5W413" "[(M+H)-(H2)]+" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 101.107324 "P92Z5W413" "[(M+H)-(H2)]+" "colpp" 0.88 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 104.126329 "U413P92ZW415" "[(M+H)]+ (13C)" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 104.126329 "U413P92ZW415" "[(M+H)]+ (13C)" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 58.065125 "P9Z3W48" "[(M+H)-(J17L2M6)]+" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 58.065125 "P9Z3W48" "[(M+H)-(J17L2M6)]+" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 104.120009 "P9Z5W415 15N" "[(M+H)]+ (15N)" "colpp" 0.88 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 85.08413 "U413P9ZW410" "[(M+H)-(H2)-(NH3)]+ (13C)" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 85.08413 "U413P9ZW410" "[(M+H)-(H2)-(NH3)]+ (13C)" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 69.069876 "P90Z5W49" "[(M+H)-2(NH3)]+" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 69.069876 "P90Z5W49" "[(M+H)-2(NH3)]+" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 102.110679 "U413P92ZW413" "[(M+H)-(H2)]+ (13C)" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 86.096425 "P9Z5W412" "[(M+H)-(NH3)]+" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 86.096425 "P9Z5W412" "[(M+H)-(NH3)]+" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 84.080775 "P9Z5W410" "[(M+H)-(H2)-(NH3)]+" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 84.080775 "P9Z5W410" "[(M+H)-(H2)-(NH3)]+" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 84.080775 "P9Z5W410" "[(M+H)-(H2)-(NH3)]+" "colpp" 0.88 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 74.096425 "P9Z4W412" "[(M+H)-(J13LM6)]+" "colAA" 1.75 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 87.09346 "P90Z5W412 15N" "[(M+H)-(NH3)]+ (15N)" "hcoltt" 0.8 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 58.065125 "P9Z3W48" "[(M+H)-(J17L2M6)]+" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 87.09346 "P90Z5W412 15N" "[(M+H)-(NH3)]+ (15N)" "colpp" 0.88 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 87.09346 "P90Z5W412 15N" "[(M+H)-(NH3)]+ (15N)" "colzz" 9.14 "J114L5M62" 102.1157 "Pompomine" +K12 "POS" 105.129684 "U313P92Z2W415" "[(M+H)]+ (13C2)" "col12" 0.77 "J114L5M62" 102.1157 "Pompomine" +P5 "NEG" 366.058797 "U813P92ZW416 Na3 O9" "[(M-H)+3(HCOONa)]- (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.104754 "P9Z6W415 15N O3" "[(M+H)]+ (15N)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.0585 "U413C2 H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C2)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.104754 "P9Z6W415 15N O3" "[(M+H)]+ (15N)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.104754 "P9Z6W415 15N O3" "[(M+H)]+ (15N)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.0585 "U413C2 H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C2)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 366.058797 "U813P92ZW416 Na3 O9" "[(M-H)+3(HCOONa)]- (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 366.058797 "U813P92ZW416 Na3 O9" "[(M-H)+3(HCOONa)]- (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 366.058797 "U813P92ZW416 Na3 O9" "[(M-H)+3(HCOONa)]- (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 366.058797 "U813P92ZW416 Na3 O9" "[(M-H)+3(HCOONa)]- (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.0585 "U413C2 H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C2)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.0585 "U413C2 H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C2)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 50.049475 "P92Z5W412 O0" "[(M+2H)-(H2O)-(HCOOH)]++" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.04884 "U6H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (37Cl)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.04884 "U6H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (37Cl)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.04884 "U6H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (37Cl)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.04884 "U6H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (37Cl)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 50.049475 "P92Z5W412 O0" "[(M+2H)-(H2O)-(HCOOH)]++" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.100509 "U513P92ZW413 O2" "[(M+H)-(H2O)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.100509 "U513P92ZW413 O2" "[(M+H)-(H2O)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.100509 "U513P92ZW413 O2" "[(M+H)-(H2O)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.100509 "U513P92ZW413 O2" "[(M+H)-(H2O)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.08117 "P9Z6W412 O3" "[(M+H)-(NH3)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 221.04884 "U6H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (37Cl)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.100509 "U513P92ZW413 O2" "[(M+H)-(H2O)]+ (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.08117 "P9Z6W412 O3" "[(M+H)-(NH3)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.08117 "P9Z6W412 O3" "[(M+H)-(NH3)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 348.193462 "U1113P94ZW428 Na O6" "[(2M+Na)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 348.193462 "U1113P94ZW428 Na O6" "[(2M+Na)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 348.193462 "U1113P94ZW428 Na O6" "[(2M+Na)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 348.193462 "U1113P94ZW428 Na O6" "[(2M+Na)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 298.071372 "U713P92ZW415 Na2 O7" "[(M-H)+2(HCOONa)]- (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 298.071372 "U713P92ZW415 Na2 O7" "[(M-H)+2(HCOONa)]- (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 298.071372 "U713P92ZW415 Na2 O7" "[(M-H)+2(HCOONa)]- (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 298.071372 "U713P92ZW415 Na2 O7" "[(M-H)+2(HCOONa)]- (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 298.071372 "U713P92ZW415 Na2 O7" "[(M-H)+2(HCOONa)]- (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 186.093019 "U513P92ZW414 Na O3" "[(M+Na)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 186.093019 "U513P92ZW414 Na O3" "[(M+Na)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 186.093019 "U513P92ZW414 Na O3" "[(M+Na)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 186.093019 "U513P92ZW414 Na O3" "[(M+Na)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 183.075112 "P92Z6W412 Na O3" "[(M-2H+Na)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 183.075112 "P92Z6W412 Na O3" "[(M-2H+Na)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 183.075112 "P92Z6W412 Na O3" "[(M-2H+Na)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.08117 "P9Z6W412 O3" "[(M+H)-(NH3)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 183.075112 "P92Z6W412 Na O3" "[(M-2H+Na)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 404.137533 "U1113C H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 404.137533 "U1113C H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 404.137533 "U1113C H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 404.137533 "U1113C H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 347.190107 "P94Z12W428 Na O6" "[(2M+Na)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 347.190107 "P94Z12W428 Na O6" "[(2M+Na)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 347.190107 "P94Z12W428 Na O6" "[(2M+Na)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 347.190107 "P94Z12W428 Na O6" "[(2M+Na)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 347.190107 "P94Z12W428 Na O6" "[(2M+Na)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 345.175555 "P94Z12W426 Na O6" "[(2M-2H+Na)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 345.175555 "P94Z12W426 Na O6" "[(2M-2H+Na)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 345.175555 "P94Z12W426 Na O6" "[(2M-2H+Na)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 345.175555 "P94Z12W426 Na O6" "[(2M-2H+Na)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 199.066895 "U6H14 Cl0 37Cl N2 O3" "[(M+Cl)]- (37Cl)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 199.066895 "U6H14 Cl0 37Cl N2 O3" "[(M+Cl)]- (37Cl)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 199.066895 "U6H14 Cl0 37Cl N2 O3" "[(M+Cl)]- (37Cl)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 199.066895 "U6H14 Cl0 37Cl N2 O3" "[(M+Cl)]- (37Cl)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 199.066895 "U6H14 Cl0 37Cl N2 O3" "[(M+Cl)]- (37Cl)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 183.075112 "P92Z6W412 Na O3" "[(M-2H+Na)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 163.097411 "P92Z6W413 O2 18O" "[(M-H)]- (18O)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 163.097411 "P92Z6W413 O2 18O" "[(M-H)]- (18O)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 163.097411 "P92Z6W413 O2 18O" "[(M-H)]- (18O)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 403.134178 "U12H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 403.134178 "U12H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 403.134178 "U12H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 403.134178 "U12H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 403.134178 "U12H26 Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 145.097154 "P92Z6W413 O2" "[(M+H)-(H2O)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 145.097154 "P92Z6W413 O2" "[(M+H)-(H2O)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 145.097154 "P92Z6W413 O2" "[(M+H)-(H2O)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 145.097154 "P92Z6W413 O2" "[(M+H)-(H2O)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 297.068017 "P92Z8W415 Na2 O7" "[(M-H)+2(HCOONa)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 297.068017 "P92Z8W415 Na2 O7" "[(M-H)+2(HCOONa)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 297.068017 "P92Z8W415 Na2 O7" "[(M-H)+2(HCOONa)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 297.068017 "P92Z8W415 Na2 O7" "[(M-H)+2(HCOONa)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 297.068017 "P92Z8W415 Na2 O7" "[(M-H)+2(HCOONa)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 219.05179 "U6H13 Cl N2 Na O3" "[(M-H)+(NaCl)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 219.05179 "U6H13 Cl N2 Na O3" "[(M-H)+(NaCl)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 219.05179 "U6H13 Cl N2 Na O3" "[(M-H)+(NaCl)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 219.05179 "U6H13 Cl N2 Na O3" "[(M-H)+(NaCl)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 391.153997 "P94Z12W426 Na3 O6" "[(2M-2H+3Na)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 391.153997 "P94Z12W426 Na3 O6" "[(2M-2H+3Na)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 391.153997 "P94Z12W426 Na3 O6" "[(2M-2H+3Na)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 391.153997 "P94Z12W426 Na3 O6" "[(2M-2H+3Na)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 391.153997 "P94Z12W426 Na3 O6" "[(2M-2H+3Na)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 392.157352 "U1113P94ZW426 Na3 O6" "[(2M-2H+3Na)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 392.157352 "U1113P94ZW426 Na3 O6" "[(2M-2H+3Na)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 392.157352 "U1113P94ZW426 Na3 O6" "[(2M-2H+3Na)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 392.157352 "U1113P94ZW426 Na3 O6" "[(2M-2H+3Na)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 73.052215 "P92Z6W414 O2" "[(M+2H)-(H2O)]++" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 73.052215 "P92Z6W414 O2" "[(M+2H)-(H2O)]++" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 73.052215 "P92Z6W414 O2" "[(M+2H)-(H2O)]++" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 73.052215 "P92Z6W414 O2" "[(M+2H)-(H2O)]++" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 73.052215 "P92Z6W414 O2" "[(M+2H)-(H2O)]++" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 359.170288 "U12H28 Cl N4 O6" "[(2M+Cl)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 359.170288 "U12H28 Cl N4 O6" "[(2M+Cl)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 359.170288 "U12H28 Cl N4 O6" "[(2M+Cl)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 359.170288 "U12H28 Cl N4 O6" "[(2M+Cl)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 413.16298 "P94Z13W427 Na2 O8" "[(2M-2H+Na)+(HCOONa)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 413.16298 "P94Z13W427 Na2 O8" "[(2M-2H+Na)+(HCOONa)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 413.16298 "P94Z13W427 Na2 O8" "[(2M-2H+Na)+(HCOONa)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 413.16298 "P94Z13W427 Na2 O8" "[(2M-2H+Na)+(HCOONa)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 413.16298 "P94Z13W427 Na2 O8" "[(2M-2H+Na)+(HCOONa)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 165.111963 "P92Z6W415 O2 18O" "[(M+H)]+ (18O)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 165.111963 "P92Z6W415 O2 18O" "[(M+H)]+ (18O)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 165.111963 "P92Z6W415 O2 18O" "[(M+H)]+ (18O)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 165.111963 "P92Z6W415 O2 18O" "[(M+H)]+ (18O)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 163.107719 "P92Z6W415 O3" "[(M+H)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 163.107719 "P92Z6W415 O3" "[(M+H)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 163.107719 "P92Z6W415 O3" "[(M+H)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 163.107719 "P92Z6W415 O3" "[(M+H)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 163.107719 "P92Z6W415 O3" "[(M+H)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 207.071609 "P92Z6W413 Na2 O3" "[(M-H+2Na)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 207.071609 "P92Z6W413 Na2 O3" "[(M-H+2Na)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 207.071609 "P92Z6W413 Na2 O3" "[(M-H+2Na)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 207.071609 "P92Z6W413 Na2 O3" "[(M-H+2Na)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 222.052195 "U513C H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C+37Cl)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 222.052195 "U513C H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C+37Cl)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 222.052195 "U513C H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C+37Cl)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 222.052195 "U513C H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C+37Cl)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 222.052195 "U513C H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C+37Cl)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 134.08117 "P9Z5W412 O3" "[(M+H)-(J13LM6)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 134.08117 "P9Z5W412 O3" "[(M+H)-(J13LM6)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 134.08117 "P9Z5W412 O3" "[(M+H)-(J13LM6)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 134.08117 "P9Z5W412 O3" "[(M+H)-(J13LM6)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 549.13783 "P94Z15W429 Na4 O12" "[(2M-2H+Na)+3(HCOONa)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 549.13783 "P94Z15W429 Na4 O12" "[(2M-2H+Na)+3(HCOONa)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 549.13783 "P94Z15W429 Na4 O12" "[(2M-2H+Na)+3(HCOONa)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 549.13783 "P94Z15W429 Na4 O12" "[(2M-2H+Na)+3(HCOONa)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 549.13783 "P94Z15W429 Na4 O12" "[(2M-2H+Na)+3(HCOONa)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 231.084836 "P92Z7W414 Na O4 18O" "[(M-H)+(HCOONa)]- (18O)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 231.084836 "P92Z7W414 Na O4 18O" "[(M-H)+(HCOONa)]- (18O)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 231.084836 "P92Z7W414 Na O4 18O" "[(M-H)+(HCOONa)]- (18O)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 231.084836 "P92Z7W414 Na O4 18O" "[(M-H)+(HCOONa)]- (18O)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.104754 "P9Z6W415 15N O3" "[(M+H)]+ (15N)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.104754 "P9Z6W415 15N O3" "[(M+H)]+ (15N)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 230.083947 "U613P92ZW414 Na O5" "[(M-H)+(HCOONa)]- (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 230.083947 "U613P92ZW414 Na O5" "[(M-H)+(HCOONa)]- (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 230.083947 "U613P92ZW414 Na O5" "[(M-H)+(HCOONa)]- (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 230.083947 "U613P92ZW414 Na O5" "[(M-H)+(HCOONa)]- (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 230.083947 "U613P92ZW414 Na O5" "[(M-H)+(HCOONa)]- (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 433.042867 "P92Z10W417 Na4 O11" "[(M-H)+4(HCOONa)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 433.042867 "P92Z10W417 Na4 O11" "[(M-H)+4(HCOONa)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 433.042867 "P92Z10W417 Na4 O11" "[(M-H)+4(HCOONa)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 433.042867 "P92Z10W417 Na4 O11" "[(M-H)+4(HCOONa)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 324.196965 "U1113P94ZW427 O6" "[(2M-H)]- (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 324.196965 "U1113P94ZW427 O6" "[(2M-H)]- (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 324.196965 "U1113P94ZW427 O6" "[(2M-H)]- (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 324.196965 "U1113P94ZW427 O6" "[(2M-H)]- (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 324.196965 "U1113P94ZW427 O6" "[(2M-H)]- (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 132.06552 "P9Z5W410 O3" "[(M+H)-(J15LM6)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 132.06552 "P9Z5W410 O3" "[(M+H)-(J15LM6)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 132.06552 "P9Z5W410 O3" "[(M+H)-(J15LM6)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 132.06552 "P9Z5W410 O3" "[(M+H)-(J15LM6)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 229.080592 "P92Z7W414 Na O5" "[(M-H)+(HCOONa)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 229.080592 "P92Z7W414 Na O5" "[(M-H)+(HCOONa)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 229.080592 "P92Z7W414 Na O5" "[(M-H)+(HCOONa)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 229.080592 "P92Z7W414 Na O5" "[(M-H)+(HCOONa)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 229.080592 "P92Z7W414 Na O5" "[(M-H)+(HCOONa)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 323.19361 "P94Z12W427 O6" "[(2M-H)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 323.19361 "P94Z12W427 O6" "[(2M-H)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 323.19361 "P94Z12W427 O6" "[(2M-H)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 323.19361 "P94Z12W427 O6" "[(2M-H)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 346.17891 "U1113P94ZW426 Na O6" "[(2M-2H+Na)]- (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 346.17891 "U1113P94ZW426 Na O6" "[(2M-2H+Na)]- (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 346.17891 "U1113P94ZW426 Na O6" "[(2M-2H+Na)]- (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 346.17891 "U1113P94ZW426 Na O6" "[(2M-2H+Na)]- (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 346.17891 "U1113P94ZW426 Na O6" "[(2M-2H+Na)]- (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 74.06004 "P9Z3W48 O" "[(M+H)-(C3H7O2N)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 74.06004 "P9Z3W48 O" "[(M+H)-(C3H7O2N)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 74.06004 "P9Z3W48 O" "[(M+H)-(C3H7O2N)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 74.06004 "P9Z3W48 O" "[(M+H)-(C3H7O2N)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 365.055442 "P92Z9W416 Na3 O9" "[(M-H)+3(HCOONa)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 365.055442 "P92Z9W416 Na3 O9" "[(M-H)+3(HCOONa)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 365.055442 "P92Z9W416 Na3 O9" "[(M-H)+3(HCOONa)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 365.055442 "P92Z9W416 Na3 O9" "[(M-H)+3(HCOONa)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 365.055442 "P92Z9W416 Na3 O9" "[(M-H)+3(HCOONa)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 531.272495 "P96Z18W441 Na2 O9" "[(3M-H+2Na)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 531.272495 "P96Z18W441 Na2 O9" "[(3M-H+2Na)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 222.052195 "U513C H13 Cl0 37Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C+37Cl)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 531.272495 "P96Z18W441 Na2 O9" "[(3M-H+2Na)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 154.047465 "P9Z5W49 Na O3" "[(M+Na)-(J15LM6)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 154.047465 "P9Z5W49 Na O3" "[(M+Na)-(J15LM6)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 154.047465 "P9Z5W49 Na O3" "[(M+Na)-(J15LM6)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 154.047465 "P9Z5W49 Na O3" "[(M+Na)-(J15LM6)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 154.047465 "P9Z5W49 Na O3" "[(M+Na)-(J15LM6)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 50.049475 "P92Z5W412 O0" "[(M+2H)-(H2O)-(HCOOH)]++" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 198.0732 "U513C H14 Cl N2 O3" "[(M+Cl)]- (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 370.175407 "U1113P94ZW427 Na2 O6" "[(2M-H+2Na)]+ (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 370.175407 "U1113P94ZW427 Na2 O6" "[(2M-H+2Na)]+ (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 370.175407 "U1113P94ZW427 Na2 O6" "[(2M-H+2Na)]+ (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 370.175407 "U1113P94ZW427 Na2 O6" "[(2M-H+2Na)]+ (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 370.175407 "U1113P94ZW427 Na2 O6" "[(2M-H+2Na)]+ (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 145.086846 "P92Z6W411 O 18O" "[(M-H)-(H2O)]- (18O)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 145.086846 "P92Z6W411 O 18O" "[(M-H)-(H2O)]- (18O)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 145.086846 "P92Z6W411 O 18O" "[(M-H)-(H2O)]- (18O)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 145.086846 "P92Z6W411 O 18O" "[(M-H)-(H2O)]- (18O)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 527.128847 "P94Z14W428 Na5 O10" "[(2M-2H+3Na)+2(HCOONa)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 527.128847 "P94Z14W428 Na5 O10" "[(2M-2H+3Na)+2(HCOONa)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 527.128847 "P94Z14W428 Na5 O10" "[(2M-2H+3Na)+2(HCOONa)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 527.128847 "P94Z14W428 Na5 O10" "[(2M-2H+3Na)+2(HCOONa)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 146.08117 "P9Z6W412 O3" "[(M+H)-(NH3)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 117.102239 "P92Z5W413 O" "[(M+H)-(HCOOH)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 117.102239 "P92Z5W413 O" "[(M+H)-(HCOOH)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 117.102239 "P92Z5W413 O" "[(M+H)-(HCOOH)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 117.102239 "P92Z5W413 O" "[(M+H)-(HCOOH)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.0574975 "P92Z6W416 O3" "[(M+2H)]++" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.0574975 "P92Z6W416 O3" "[(M+2H)]++" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.0574975 "P92Z6W416 O3" "[(M+2H)]++" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.0574975 "P92Z6W416 O3" "[(M+2H)]++" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.0574975 "P92Z6W416 O3" "[(M+2H)]++" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 553.25444 "P96Z18W440 Na3 O9" "[(3M-2H+3Na)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 553.25444 "P96Z18W440 Na3 O9" "[(3M-2H+3Na)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 553.25444 "P96Z18W440 Na3 O9" "[(3M-2H+3Na)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 553.25444 "P96Z18W440 Na3 O9" "[(3M-2H+3Na)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 575.236385 "P96Z18W439 Na4 O9" "[(3M-3H+4Na)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 575.236385 "P96Z18W439 Na4 O9" "[(3M-3H+4Na)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 575.236385 "P96Z18W439 Na4 O9" "[(3M-3H+4Na)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 575.236385 "P96Z18W439 Na4 O9" "[(3M-3H+4Na)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 575.236385 "P96Z18W439 Na4 O9" "[(3M-3H+4Na)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 168.063115 "P9Z6W411 Na O3" "[(M+Na)-(NH3)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 168.063115 "P9Z6W411 Na O3" "[(M+Na)-(NH3)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 168.063115 "P9Z6W411 Na O3" "[(M+Na)-(NH3)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 168.063115 "P9Z6W411 Na O3" "[(M+Na)-(NH3)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 144.085957 "U513P92ZW411 O2" "[(M-H)-(H2O)]- (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 144.085957 "U513P92ZW411 O2" "[(M-H)-(H2O)]- (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 144.085957 "U513P92ZW411 O2" "[(M-H)-(H2O)]- (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 144.085957 "U513P92ZW411 O2" "[(M-H)-(H2O)]- (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 144.085957 "U513P92ZW411 O2" "[(M-H)-(H2O)]- (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 161.093167 "P92Z6W413 O3" "[(M-H)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 161.093167 "P92Z6W413 O3" "[(M-H)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 161.093167 "P92Z6W413 O3" "[(M-H)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 161.093167 "P92Z6W413 O3" "[(M-H)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 143.082602 "P92Z6W411 O2" "[(M-H)-(H2O)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 143.082602 "P92Z6W411 O2" "[(M-H)-(H2O)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 143.082602 "P92Z6W411 O2" "[(M-H)-(H2O)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 143.082602 "P92Z6W411 O2" "[(M-H)-(H2O)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 143.082602 "P92Z6W411 O2" "[(M-H)-(H2O)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 220.055145 "U513C H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 220.055145 "U513C H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 220.055145 "U513C H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 220.055145 "U513C H13 Cl N2 Na O3" "[(M-H)+(NaCl)]- (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 459.141422 "P94Z13W427 Na4 O8" "[(2M-2H+3Na)+(HCOONa)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 459.141422 "P94Z13W427 Na4 O8" "[(2M-2H+3Na)+(HCOONa)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 459.141422 "P94Z13W427 Na4 O8" "[(2M-2H+3Na)+(HCOONa)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 459.141422 "P94Z13W427 Na4 O8" "[(2M-2H+3Na)+(HCOONa)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 459.141422 "P94Z13W427 Na4 O8" "[(2M-2H+3Na)+(HCOONa)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 275.059034 "P92Z7W414 Na3 O5" "[(M-H+2Na)+(HCOONa)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 275.059034 "P92Z7W414 Na3 O5" "[(M-H+2Na)+(HCOONa)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 275.059034 "P92Z7W414 Na3 O5" "[(M-H+2Na)+(HCOONa)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 275.059034 "P92Z7W414 Na3 O5" "[(M-H+2Na)+(HCOONa)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 325.208162 "P94Z12W429 O6" "[(2M+H)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 325.208162 "P94Z12W429 O6" "[(2M+H)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 325.208162 "P94Z12W429 O6" "[(2M+H)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 325.208162 "P94Z12W429 O6" "[(2M+H)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 325.208162 "P94Z12W429 O6" "[(2M+H)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.096522 "U513P92ZW413 O3" "[(M-H)]- (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.096522 "U513P92ZW413 O3" "[(M-H)]- (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.096522 "U513P92ZW413 O3" "[(M-H)]- (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.096522 "U513P92ZW413 O3" "[(M-H)]- (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.559175 "U513P92ZW416 O3" "[(M+2H)]++ (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.559175 "U513P92ZW416 O3" "[(M+2H)]++ (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.559175 "U513P92ZW416 O3" "[(M+2H)]++ (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.559175 "U513P92ZW416 O3" "[(M+2H)]++ (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.559175 "U513P92ZW416 O3" "[(M+2H)]++ (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(J15L3M6O2)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(J15L3M6O2)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(J15L3M6O2)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(J15L3M6O2)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 89.079045 "U313P9ZW410 O" "[(M+H)-(J15L2M6O2)]+ (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 89.079045 "U313P9ZW410 O" "[(M+H)-(J15L2M6O2)]+ (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 89.079045 "U313P9ZW410 O" "[(M+H)-(J15L2M6O2)]+ (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 89.079045 "U313P9ZW410 O" "[(M+H)-(J15L2M6O2)]+ (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 89.079045 "U313P9ZW410 O" "[(M+H)-(J15L2M6O2)]+ (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.111074 "U513P92ZW415 O3" "[(M+H)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.111074 "U513P92ZW415 O3" "[(M+H)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.111074 "U513P92ZW415 O3" "[(M+H)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 164.111074 "U513P92ZW415 O3" "[(M+H)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.556015 "P9Z6W416 15N O3" "[(M+2H)]++ (15N)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.556015 "P9Z6W416 15N O3" "[(M+2H)]++ (15N)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.556015 "P9Z6W416 15N O3" "[(M+2H)]++ (15N)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.556015 "P9Z6W416 15N O3" "[(M+2H)]++ (15N)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 82.556015 "P9Z6W416 15N O3" "[(M+2H)]++ (15N)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 88.07569 "P9Z4W410 O" "[(M+H)-(J15L2M6O2)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 88.07569 "P9Z4W410 O" "[(M+H)-(J15L2M6O2)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 88.07569 "P9Z4W410 O" "[(M+H)-(J15L2M6O2)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 88.07569 "P9Z4W410 O" "[(M+H)-(J15L2M6O2)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 100.07569 "P9Z5W410 O" "[(M+H)-(NH3)-(HCOOH)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 100.07569 "P9Z5W410 O" "[(M+H)-(NH3)-(HCOOH)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 100.07569 "P9Z5W410 O" "[(M+H)-(NH3)-(HCOOH)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 100.07569 "P9Z5W410 O" "[(M+H)-(NH3)-(HCOOH)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 100.07569 "P9Z5W410 O" "[(M+H)-(NH3)-(HCOOH)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 326.211517 "U1113P94ZW429 O6" "[(2M+H)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 326.211517 "U1113P94ZW429 O6" "[(2M+H)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 326.211517 "U1113P94ZW429 O6" "[(2M+H)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 326.211517 "U1113P94ZW429 O6" "[(2M+H)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 99.091674 "P92Z5W411 O0" "[(M+H)-(H2O)-(HCOOH)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 99.091674 "P92Z5W411 O0" "[(M+H)-(H2O)-(HCOOH)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 99.091674 "P92Z5W411 O0" "[(M+H)-(H2O)-(HCOOH)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 99.091674 "P92Z5W411 O0" "[(M+H)-(H2O)-(HCOOH)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 99.091674 "P92Z5W411 O0" "[(M+H)-(H2O)-(HCOOH)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 127.086589 "P92Z6W411 O" "[(M+H)-2(H2O)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 127.086589 "P92Z6W411 O" "[(M+H)-2(H2O)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 127.086589 "P92Z6W411 O" "[(M+H)-2(H2O)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 127.086589 "P92Z6W411 O" "[(M+H)-2(H2O)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 481.150405 "P94Z14W428 Na3 O10" "[(2M-2H+Na)+2(HCOONa)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 481.150405 "P94Z14W428 Na3 O10" "[(2M-2H+Na)+2(HCOONa)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 481.150405 "P94Z14W428 Na3 O10" "[(2M-2H+Na)+2(HCOONa)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 481.150405 "P94Z14W428 Na3 O10" "[(2M-2H+Na)+2(HCOONa)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 481.150405 "P94Z14W428 Na3 O10" "[(2M-2H+Na)+2(HCOONa)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 434.046222 "U913P92ZW417 Na4 O11" "[(M-H)+4(HCOONa)]- (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 434.046222 "U913P92ZW417 Na4 O11" "[(M-H)+4(HCOONa)]- (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 434.046222 "U913P92ZW417 Na4 O11" "[(M-H)+4(HCOONa)]- (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 434.046222 "U913P92ZW417 Na4 O11" "[(M-H)+4(HCOONa)]- (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.556435 "U413P92ZW414 O" "[(M+2H)-(HCOOH)]++ (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.556435 "U413P92ZW414 O" "[(M+2H)-(HCOOH)]++ (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.556435 "U413P92ZW414 O" "[(M+2H)-(HCOOH)]++ (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.556435 "U413P92ZW414 O" "[(M+2H)-(HCOOH)]++ (13C)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.556435 "U413P92ZW414 O" "[(M+2H)-(HCOOH)]++ (13C)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.0547575 "P92Z5W414 O" "[(M+2H)-(HCOOH)]++" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.0547575 "P92Z5W414 O" "[(M+2H)-(HCOOH)]++" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.0547575 "P92Z5W414 O" "[(M+2H)-(HCOOH)]++" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 59.0547575 "P92Z5W414 O" "[(M+2H)-(HCOOH)]++" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 265.030232 "U6H13 Cl N2 Na3 O3" "[(M-H+2Na)+(NaCl)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 265.030232 "U6H13 Cl N2 Na3 O3" "[(M-H+2Na)+(NaCl)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 265.030232 "U6H13 Cl N2 Na3 O3" "[(M-H+2Na)+(NaCl)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 265.030232 "U6H13 Cl N2 Na3 O3" "[(M-H+2Na)+(NaCl)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 265.030232 "U6H13 Cl N2 Na3 O3" "[(M-H+2Na)+(NaCl)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 369.172052 "P94Z12W427 Na2 O6" "[(2M-H+2Na)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 369.172052 "P94Z12W427 Na2 O6" "[(2M-H+2Na)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 369.172052 "P94Z12W427 Na2 O6" "[(2M-H+2Na)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 369.172052 "P94Z12W427 Na2 O6" "[(2M-H+2Na)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 501.030292 "P92Z11W418 Na5 O13" "[(M-H)+5(HCOONa)]-" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 501.030292 "P92Z11W418 Na5 O13" "[(M-H)+5(HCOONa)]-" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 501.030292 "P92Z11W418 Na5 O13" "[(M-H)+5(HCOONa)]-" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 501.030292 "P92Z11W418 Na5 O13" "[(M-H)+5(HCOONa)]-" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 501.030292 "P92Z11W418 Na5 O13" "[(M-H)+5(HCOONa)]-" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 569.017717 "P92Z12W419 Na6 O15" "[(M-H)+6(HCOONa)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 569.017717 "P92Z12W419 Na6 O15" "[(M-H)+6(HCOONa)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 569.017717 "P92Z12W419 Na6 O15" "[(M-H)+6(HCOONa)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 569.017717 "P92Z12W419 Na6 O15" "[(M-H)+6(HCOONa)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 405.131228 "U12H26 Cl0 37Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 405.131228 "U12H26 Cl0 37Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 405.131228 "U12H26 Cl0 37Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 405.131228 "U12H26 Cl0 37Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 405.131228 "U12H26 Cl0 37Cl N4 Na2 O6" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 208.074964 "U513P92ZW413 Na2 O3" "[(M-H+2Na)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 208.074964 "U513P92ZW413 Na2 O3" "[(M-H+2Na)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 208.074964 "U513P92ZW413 Na2 O3" "[(M-H+2Na)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 208.074964 "U513P92ZW413 Na2 O3" "[(M-H+2Na)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 197.1014315 "P94Z13W431 Na O8" "[(2M+2H)+(HCOONa)]++" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 197.1014315 "P94Z13W431 Na O8" "[(2M+2H)+(HCOONa)]++" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 197.1014315 "P94Z13W431 Na O8" "[(2M+2H)+(HCOONa)]++" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 197.1014315 "P94Z13W431 Na O8" "[(2M+2H)+(HCOONa)]++" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 197.069845 "U6H14 Cl N2 O3" "[(M+Cl)]-" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 197.069845 "U6H14 Cl N2 O3" "[(M+Cl)]-" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 197.069845 "U6H14 Cl N2 O3" "[(M+Cl)]-" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 197.069845 "U6H14 Cl N2 O3" "[(M+Cl)]-" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 189.061044 "P92Z6W411 Na2 O2" "[(M-H+2Na)-(H2O)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 189.061044 "P92Z6W411 Na2 O2" "[(M-H+2Na)-(H2O)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 189.061044 "P92Z6W411 Na2 O2" "[(M-H+2Na)-(H2O)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 189.061044 "P92Z6W411 Na2 O2" "[(M-H+2Na)-(H2O)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 189.061044 "P92Z6W411 Na2 O2" "[(M-H+2Na)-(H2O)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 129.07396 "U513P9ZW410 O2" "[(M+H)-(H2O)-(NH3)]+ (13C)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 129.07396 "U513P9ZW410 O2" "[(M+H)-(H2O)-(NH3)]+ (13C)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 129.07396 "U513P9ZW410 O2" "[(M+H)-(H2O)-(NH3)]+ (13C)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 129.07396 "U513P9ZW410 O2" "[(M+H)-(H2O)-(NH3)]+ (13C)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 198.0732 "U513C H14 Cl N2 O3" "[(M+Cl)]- (13C)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 198.0732 "U513C H14 Cl N2 O3" "[(M+Cl)]- (13C)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 198.0732 "U513C H14 Cl N2 O3" "[(M+Cl)]- (13C)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 387.010349 "P92Z8W413 Na6 O7" "[(M-3H+4Na)+2(HCOONa)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 387.010349 "P92Z8W413 Na6 O7" "[(M-3H+4Na)+2(HCOONa)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 343.046459 "P92Z8W415 Na4 O7" "[(M-H+2Na)+2(HCOONa)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 343.046459 "P92Z8W415 Na4 O7" "[(M-H+2Na)+2(HCOONa)]+" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 343.046459 "P92Z8W415 Na4 O7" "[(M-H+2Na)+2(HCOONa)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 343.046459 "P92Z8W415 Na4 O7" "[(M-H+2Na)+2(HCOONa)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 343.046459 "P92Z8W415 Na4 O7" "[(M-H+2Na)+2(HCOONa)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 185.089664 "P92Z6W414 Na O3" "[(M+Na)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 185.089664 "P92Z6W414 Na O3" "[(M+Na)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.090202 "P9Z6W413 15N O3" "[(M-H)]- (15N)" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.090202 "P9Z6W413 15N O3" "[(M-H)]- (15N)" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.090202 "P9Z6W413 15N O3" "[(M-H)]- (15N)" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "NEG" 162.090202 "P9Z6W413 15N O3" "[(M-H)]- (15N)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 128.070605 "P9Z6W410 O2" "[(M+H)-(H2O)-(NH3)]+" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 527.128847 "P94Z14W428 Na5 O10" "[(2M-2H+3Na)+2(HCOONa)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 128.070605 "P9Z6W410 O2" "[(M+H)-(H2O)-(NH3)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 128.070605 "P9Z6W410 O2" "[(M+H)-(H2O)-(NH3)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 128.070605 "P9Z6W410 O2" "[(M+H)-(H2O)-(NH3)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 387.010349 "P92Z8W413 Na6 O7" "[(M-3H+4Na)+2(HCOONa)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 387.010349 "P92Z8W413 Na6 O7" "[(M-3H+4Na)+2(HCOONa)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 197.1014315 "P94Z13W431 Na O8" "[(2M+2H)+(HCOONa)]++" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 167.079099 "P92Z6W412 Na O2" "[(M+Na)-(H2O)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 185.089664 "P92Z6W414 Na O3" "[(M+Na)]+" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 185.089664 "P92Z6W414 Na O3" "[(M+Na)]+" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 185.089664 "P92Z6W414 Na O3" "[(M+Na)]+" "somecol" 8.335 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 167.079099 "P92Z6W412 Na O2" "[(M+Na)-(H2O)]+" "colAA" 1.56 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 167.079099 "P92Z6W412 Na O2" "[(M+Na)-(H2O)]+" "colzz2" 3.83 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 167.079099 "P92Z6W412 Na O2" "[(M+Na)-(H2O)]+" "colzz3" 4.64 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 83.0608525 "U413P92Z2W416 O3" "[(M+2H)]++ (13C2)" "colzz" 3.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 83.0608525 "U413P92Z2W416 O3" "[(M+2H)]++ (13C2)" "hcoltt" 0.9 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 83.0608525 "U413P92Z2W416 O3" "[(M+2H)]++ (13C2)" "col12" 0.8 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 83.0608525 "U413P92Z2W416 O3" "[(M+2H)]++ (13C2)" "colzz3" 4.21 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 83.0608525 "U413P92Z2W416 O3" "[(M+2H)]++ (13C2)" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +P5 "POS" 189.061044 "P92Z6W411 Na2 O2" "[(M-H+2Na)-(H2O)]+" "colpp" 0.79 "J114L6M62O3" 162.10044 "Abracadabrine" +A103 "POS" 78.079934 "P9Z3W410 O0 18O" "[(M+H)]+ (18O)" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 104.10699 "P9Z5W414 O" "[(2M+H)-(J15LM6O)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 104.10699 "P9Z5W414 O" "[(2M+H)-(J15LM6O)]+" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 59.07295 "P9Z3W49 O0" "[(M+H)-(OH•)]+" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 104.10699 "P9Z5W414 O" "[(2M+H)-(J15LM6O)]+" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 78.079934 "P9Z3W410 O0 18O" "[(M+H)]+ (18O)" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 78.079934 "P9Z3W410 O0 18O" "[(M+H)]+ (18O)" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 153.148348 "P92Z6W419 O 18O" "[(2M+H)]+ (18O)" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 153.148348 "P92Z6W419 O 18O" "[(2M+H)]+ (18O)" "colzz3" 5.14 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 153.148348 "P92Z6W419 O 18O" "[(2M+H)]+ (18O)" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 173.126049 "P92Z6W418 Na O2" "[(2M+Na)]+" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 78.079934 "P9Z3W410 O0 18O" "[(M+H)]+ (18O)" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 173.126049 "P92Z6W418 Na O2" "[(2M+Na)]+" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 77.079045 "U213P9ZW410 O" "[(M+H)]+ (13C)" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 77.079045 "U213P9ZW410 O" "[(M+H)]+ (13C)" "colzz3" 5.14 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 153.148348 "P92Z6W419 O 18O" "[(2M+H)]+ (18O)" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 59.06848 "U213P9ZW48 O0" "[(M+H)-(H2O)]+ (13C)" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 173.126049 "P92Z6W418 Na O2" "[(2M+Na)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 59.06848 "U213P9ZW48 O0" "[(M+H)-(H2O)]+ (13C)" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 75.063395 "U213P9ZW48 O" "[(2M+H)-(J19L3M6)-(H2O)]+ (13C)" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 75.063395 "U213P9ZW48 O" "[(2M+H)-(J19L3M6)-(H2O)]+ (13C)" "colzz3" 5.14 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 75.063395 "U213P9ZW48 O" "[(2M+H)-(J19L3M6)-(H2O)]+ (13C)" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 59.07295 "P9Z3W49 O0" "[(M+H)-(OH•)]+" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 152.147459 "U513P92ZW419 O2" "[(2M+H)]+ (13C)" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 152.147459 "U513P92ZW419 O2" "[(2M+H)]+ (13C)" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 152.147459 "U513P92ZW419 O2" "[(2M+H)]+ (13C)" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 60.04439 "P9Z2W46 O" "[(M+H)-(CH4)]+" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 60.04439 "P9Z2W46 O" "[(M+H)-(CH4)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 60.04439 "P9Z2W46 O" "[(M+H)-(CH4)]+" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 76.07569 "P9Z3W410 O" "[(M+H)]+" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 76.07569 "P9Z3W410 O" "[(M+H)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 76.07569 "P9Z3W410 O" "[(M+H)]+" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 174.129404 "U513P92ZW418 Na O2" "[(2M+Na)]+ (13C)" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 174.129404 "U513P92ZW418 Na O2" "[(2M+Na)]+ (13C)" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 77.072725 "P90Z3W410 15N O" "[(M+H)]+ (15N)" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 77.072725 "P90Z3W410 15N O" "[(M+H)]+ (15N)" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 77.072725 "P90Z3W410 15N O" "[(M+H)]+ (15N)" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 59.06848 "U213P9ZW48 O0" "[(M+H)-(H2O)]+ (13C)" "colzz3" 5.14 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 74.06004 "P9Z3W48 O" "[(2M+H)-(J19L3M6)-(H2O)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 74.06004 "P9Z3W48 O" "[(2M+H)-(J19L3M6)-(H2O)]+" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 98.057635 "P9Z3W49 Na O" "[(M+Na)]+" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 98.057635 "P9Z3W49 Na O" "[(M+Na)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 98.057635 "P9Z3W49 Na O" "[(M+Na)]+" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 151.144104 "P92Z6W419 O2" "[(2M+H)]+" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 92.070605 "P9Z3W410 O2" "[(2M+H)-(J19L3M6)]+" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 92.070605 "P9Z3W410 O2" "[(2M+H)-(J19L3M6)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 92.070605 "P9Z3W410 O2" "[(2M+H)-(J19L3M6)]+" "col12" 0.89 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 99.05467 "P90Z3W49 15N Na O" "[(M+Na)]+ (15N)" "colzz3" 5.14 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 99.05467 "P90Z3W49 15N Na O" "[(M+Na)]+ (15N)" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(H2O)]+" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(H2O)]+" "colzz3" 5.14 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(H2O)]+" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 99.05467 "P90Z3W49 15N Na O" "[(M+Na)]+ (15N)" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 99.05467 "P90Z3W49 15N Na O" "[(M+Na)]+ (15N)" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 115.122974 "P92Z6W415 O0" "[(2M+H)-2(H2O)]+" "colpp" 1.13 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 151.144104 "P92Z6W419 O2" "[(2M+H)]+" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 151.144104 "P92Z6W419 O2" "[(2M+H)]+" "colzz3" 5.14 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 115.122974 "P92Z6W415 O0" "[(2M+H)-2(H2O)]+" "colzz2" 5.03 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 115.122974 "P92Z6W415 O0" "[(2M+H)-2(H2O)]+" "hcoltt" 1 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +A103 "POS" 74.06004 "P9Z3W48 O" "[(2M+H)-(J19L3M6)-(H2O)]+" "colzz" 8.75 "J19L3M6O" 75.06841 "6-α-jusdecarotine" +T1078 "NEG" 250.129613 "P9Z10W420 O6" "[(M-H)+(HCOOH)]-" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 250.129613 "P9Z10W420 O6" "[(M-H)+(HCOOH)]-" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 435.256283 "P92Z18W438 Na O7 18O" "[(2M+Na)]+ (18O)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 435.256283 "P92Z18W438 Na O7 18O" "[(2M+Na)]+ (18O)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 435.256283 "P92Z18W438 Na O7 18O" "[(2M+Na)]+ (18O)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 205.127488 "U813P9ZW418 O4" "[(M-H)]- (13C)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 229.123985 "U813P9ZW419 Na O4" "[(M+Na)]+ (13C)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 435.256283 "P92Z18W438 Na O7 18O" "[(2M+Na)]+ (18O)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 250.129613 "P9Z10W420 O6" "[(M-H)+(HCOOH)]-" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 250.129613 "P9Z10W420 O6" "[(M-H)+(HCOOH)]-" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 250.129613 "P9Z10W420 O6" "[(M-H)+(HCOOH)]-" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 251.132968 "U913P9ZW420 O6" "[(M-H)+(HCOOH)]- (13C)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 251.132968 "U913P9ZW420 O6" "[(M-H)+(HCOOH)]- (13C)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 251.132968 "U913P9ZW420 O6" "[(M-H)+(HCOOH)]- (13C)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 250.129613 "P9Z10W420 O6" "[(M-H)+(HCOOH)]-" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 251.132968 "U913P9ZW420 O6" "[(M-H)+(HCOOH)]- (13C)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 204.124133 "P9Z9W418 O4" "[(M-H)]-" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 204.124133 "P9Z9W418 O4" "[(M-H)]-" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 204.124133 "P9Z9W418 O4" "[(M-H)]-" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 204.124133 "P9Z9W418 O4" "[(M-H)]-" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.14204 "U813P9ZW420 O4" "[(M+H)]+ (13C)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.14204 "U813P9ZW420 O4" "[(M+H)]+ (13C)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.14204 "U813P9ZW420 O4" "[(M+H)]+ (13C)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.14204 "U813P9ZW420 O4" "[(M+H)]+ (13C)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.14204 "U813P9ZW420 O4" "[(M+H)]+ (13C)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 436.259638 "U1713P92ZW438 Na O7 18O" "[(2M+Na)]+ (13C) (18O)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 436.259638 "U1713P92ZW438 Na O7 18O" "[(2M+Na)]+ (13C) (18O)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 436.259638 "U1713P92ZW438 Na O7 18O" "[(2M+Na)]+ (13C) (18O)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 436.259638 "U1713P92ZW438 Na O7 18O" "[(2M+Na)]+ (13C) (18O)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 209.146284 "U813P9ZW420 O3 18O" "[(M+H)]+ (13C) (18O)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 209.146284 "U813P9ZW420 O3 18O" "[(M+H)]+ (13C) (18O)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 209.146284 "U813P9ZW420 O3 18O" "[(M+H)]+ (13C) (18O)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 209.146284 "U813P9ZW420 O3 18O" "[(M+H)]+ (13C) (18O)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 209.146284 "U813P9ZW420 O3 18O" "[(M+H)]+ (13C) (18O)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 206.138685 "P9Z9W420 O4" "[(M+H)]+" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 206.138685 "P9Z9W420 O4" "[(M+H)]+" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 206.138685 "P9Z9W420 O4" "[(M+H)]+" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 206.138685 "P9Z9W420 O4" "[(M+H)]+" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 253.137212 "U913P9ZW420 O5 18O" "[(M-H)+(HCOOH)]- (13C) (18O)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 253.137212 "U913P9ZW420 O5 18O" "[(M-H)+(HCOOH)]- (13C) (18O)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 253.137212 "U913P9ZW420 O5 18O" "[(M-H)+(HCOOH)]- (13C) (18O)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 253.137212 "U913P9ZW420 O5 18O" "[(M-H)+(HCOOH)]- (13C) (18O)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 253.137212 "U913P9ZW420 O5 18O" "[(M-H)+(HCOOH)]- (13C) (18O)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 243.101216 "U813C H19 Cl0 37Cl N O4" "[(M+Cl)]- (13C) (37Cl)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 243.101216 "U813C H19 Cl0 37Cl N O4" "[(M+Cl)]- (13C) (37Cl)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 243.101216 "U813C H19 Cl0 37Cl N O4" "[(M+Cl)]- (13C) (37Cl)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 243.101216 "U813C H19 Cl0 37Cl N O4" "[(M+Cl)]- (13C) (37Cl)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 242.097861 "U9H19 Cl0 37Cl N O4" "[(M+Cl)]- (37Cl)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 242.097861 "U9H19 Cl0 37Cl N O4" "[(M+Cl)]- (37Cl)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 242.097861 "U9H19 Cl0 37Cl N O4" "[(M+Cl)]- (37Cl)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 242.097861 "U9H19 Cl0 37Cl N O4" "[(M+Cl)]- (37Cl)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 242.097861 "U9H19 Cl0 37Cl N O4" "[(M+Cl)]- (37Cl)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 240.100811 "U9H19 Cl N O4" "[(M+Cl)]-" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 240.100811 "U9H19 Cl N O4" "[(M+Cl)]-" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 240.100811 "U9H19 Cl N O4" "[(M+Cl)]-" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 240.100811 "U9H19 Cl N O4" "[(M+Cl)]-" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 229.123985 "U813P9ZW419 Na O4" "[(M+Na)]+ (13C)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 229.123985 "U813P9ZW419 Na O4" "[(M+Na)]+ (13C)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 229.123985 "U813P9ZW419 Na O4" "[(M+Na)]+ (13C)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 229.123985 "U813P9ZW419 Na O4" "[(M+Na)]+ (13C)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 252.133857 "P9Z10W420 O5 18O" "[(M-H)+(HCOOH)]- (18O)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 252.133857 "P9Z10W420 O5 18O" "[(M-H)+(HCOOH)]- (18O)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 252.133857 "P9Z10W420 O5 18O" "[(M-H)+(HCOOH)]- (18O)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 205.12639 "U813P9ZW418 O4" "[(M+H)-(H2)]+ (13C)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 205.12639 "U813P9ZW418 O4" "[(M+H)-(H2)]+ (13C)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 205.12639 "U813P9ZW418 O4" "[(M+H)-(H2)]+ (13C)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 205.12639 "U813P9ZW418 O4" "[(M+H)-(H2)]+ (13C)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 205.12639 "U813P9ZW418 O4" "[(M+H)-(H2)]+ (13C)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 204.123035 "P9Z9W418 O4" "[(M+H)-(H2)]+" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 204.123035 "P9Z9W418 O4" "[(M+H)-(H2)]+" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 204.123035 "P9Z9W418 O4" "[(M+H)-(H2)]+" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 204.123035 "P9Z9W418 O4" "[(M+H)-(H2)]+" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(C5H12O2)]+" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(C5H12O2)]+" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 251.132968 "U913P9ZW420 O6" "[(M-H)+(HCOOH)]- (13C)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(C5H12O2)]+" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(C5H12O2)]+" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 77.079045 "U213P9ZW410 O" "[(M+H)-(C6H10O3)]+ (13C)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 77.079045 "U213P9ZW410 O" "[(M+H)-(C6H10O3)]+ (13C)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 77.079045 "U213P9ZW410 O" "[(M+H)-(C6H10O3)]+ (13C)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 77.079045 "U213P9ZW410 O" "[(M+H)-(C6H10O3)]+ (13C)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 188.12812 "P9Z9W418 O3" "[(M+H)-(H2O)]+" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 188.12812 "P9Z9W418 O3" "[(M+H)-(H2O)]+" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 188.12812 "P9Z9W418 O3" "[(M+H)-(H2O)]+" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 188.12812 "P9Z9W418 O3" "[(M+H)-(H2O)]+" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 188.12812 "P9Z9W418 O3" "[(M+H)-(H2O)]+" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 241.104166 "U813C H19 Cl N O4" "[(M+Cl)]- (13C)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 241.104166 "U813C H19 Cl N O4" "[(M+Cl)]- (13C)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 241.104166 "U813C H19 Cl N O4" "[(M+Cl)]- (13C)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 433.252039 "P92Z18W438 Na O8" "[(2M+Na)]+" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 433.252039 "P92Z18W438 Na O8" "[(2M+Na)]+" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 433.252039 "P92Z18W438 Na O8" "[(2M+Na)]+" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 433.252039 "P92Z18W438 Na O8" "[(2M+Na)]+" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 433.252039 "P92Z18W438 Na O8" "[(2M+Na)]+" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.13572 "P90Z9W420 15N O4" "[(M+H)]+ (15N)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.13572 "P90Z9W420 15N O4" "[(M+H)]+ (15N)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.13572 "P90Z9W420 15N O4" "[(M+H)]+ (15N)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 207.13572 "P90Z9W420 15N O4" "[(M+H)]+ (15N)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(C6H10O3)]+" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(C6H10O3)]+" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(C6H10O3)]+" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(C6H10O3)]+" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(C6H10O3)]+" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 170.117555 "P9Z9W416 O2" "[(M+H)-2(H2O)]+" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 170.117555 "P9Z9W416 O2" "[(M+H)-2(H2O)]+" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 170.117555 "P9Z9W416 O2" "[(M+H)-2(H2O)]+" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 170.117555 "P9Z9W416 O2" "[(M+H)-2(H2O)]+" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 176.12812 "P9Z8W418 O3" "[(M+H)-(CH2O)]+" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 176.12812 "P9Z8W418 O3" "[(M+H)-(CH2O)]+" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 176.12812 "P9Z8W418 O3" "[(M+H)-(CH2O)]+" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 176.12812 "P9Z8W418 O3" "[(M+H)-(CH2O)]+" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 176.12812 "P9Z8W418 O3" "[(M+H)-(CH2O)]+" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.142929 "P9Z9W420 O3 18O" "[(M+H)]+ (18O)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 240.100811 "U9H19 Cl N O4" "[(M+Cl)]-" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.142929 "P9Z9W420 O3 18O" "[(M+H)]+ (18O)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.142929 "P9Z9W420 O3 18O" "[(M+H)]+ (18O)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.145395 "U713P9Z2W420 O4" "[(M+H)]+ (13C2)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.145395 "U713P9Z2W420 O4" "[(M+H)]+ (13C2)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.145395 "U713P9Z2W420 O4" "[(M+H)]+ (13C2)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.145395 "U713P9Z2W420 O4" "[(M+H)]+ (13C2)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.145395 "U713P9Z2W420 O4" "[(M+H)]+ (13C2)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 252.133857 "P9Z10W420 O5 18O" "[(M-H)+(HCOOH)]- (18O)" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 230.124874 "P9Z9W419 Na O3 18O" "[(M+Na)]+ (18O)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 230.124874 "P9Z9W419 Na O3 18O" "[(M+Na)]+ (18O)" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 230.124874 "P9Z9W419 Na O3 18O" "[(M+Na)]+ (18O)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 241.104166 "U813C H19 Cl N O4" "[(M+Cl)]- (13C)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 228.12063 "P9Z9W419 Na O4" "[(M+Na)]+" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 228.12063 "P9Z9W419 Na O4" "[(M+Na)]+" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 228.12063 "P9Z9W419 Na O4" "[(M+Na)]+" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 228.12063 "P9Z9W419 Na O4" "[(M+Na)]+" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 205.127488 "U813P9ZW418 O4" "[(M-H)]- (13C)" "col12" 4.72 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "NEG" 205.127488 "U813P9ZW418 O4" "[(M-H)]- (13C)" "somecol" 2.56 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 228.12063 "P9Z9W419 Na O4" "[(M+Na)]+" "colAA" 10.94 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 434.255394 "U1713P92ZW438 Na O8" "[(2M+Na)]+ (13C)" "colpp" 2.47 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 230.124874 "P9Z9W419 Na O3 18O" "[(M+Na)]+ (18O)" "hcoltt" 5 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 230.124874 "P9Z9W419 Na O3 18O" "[(M+Na)]+ (18O)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 434.255394 "U1713P92ZW438 Na O8" "[(2M+Na)]+ (13C)" "colzz3" 2.29 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 434.255394 "U1713P92ZW438 Na O8" "[(2M+Na)]+ (13C)" "colzz" 11.02 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(C5H12O2)]+" "colzz3" 3.92 "J119L9M6O4" 205.13141 "Canapenol" +T1078 "POS" 208.142929 "P9Z9W420 O3 18O" "[(M+H)]+ (18O)" "colzz2" 4.34 "J119L9M6O4" 205.13141 "Canapenol" +J89 "NEG" 279.132627 "P92Z12W420 Na O4" "[(2M-2H+Na)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 279.132627 "P92Z12W420 Na O4" "[(2M-2H+Na)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 279.132627 "P92Z12W420 Na O4" "[(2M-2H+Na)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 490.149224 "U18H30 Cl0 37Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]- (37Cl)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 279.132627 "P92Z12W420 Na O4" "[(2M-2H+Na)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 490.149224 "U18H30 Cl0 37Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]- (37Cl)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 259.165234 "P92Z12W423 O4" "[(2M+H)]+" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 259.165234 "P92Z12W423 O4" "[(2M+H)]+" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 259.165234 "P92Z12W423 O4" "[(2M+H)]+" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 490.149224 "U18H30 Cl0 37Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]- (37Cl)" "colzz2" 3.59 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 490.149224 "U18H30 Cl0 37Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]- (37Cl)" "colzz3" 3.76 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 415.107477 "P92Z14W422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 415.107477 "P92Z14W422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 415.107477 "P92Z14W422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 415.107477 "P92Z14W422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 415.107477 "P92Z14W422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 339.0883 "U12H20 Cl0 37Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 415.107477 "P92Z14W422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]-" "hcoltt" 1.4 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 339.0883 "U12H20 Cl0 37Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 339.0883 "U12H20 Cl0 37Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 339.0883 "U12H20 Cl0 37Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 133.093854 "U513P9ZW412 O 18O" "[(M+H)]+ (13C) (18O)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 133.093854 "U513P9ZW412 O 18O" "[(M+H)]+ (13C) (18O)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 133.093854 "U513P9ZW412 O 18O" "[(M+H)]+ (13C) (18O)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 133.093854 "U513P9ZW412 O 18O" "[(M+H)]+ (13C) (18O)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 133.093854 "U513P9ZW412 O 18O" "[(M+H)]+ (13C) (18O)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 175.080538 "U613P9ZW412 O4" "[(M-H)+(HCOOH)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 175.080538 "U613P9ZW412 O4" "[(M-H)+(HCOOH)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 175.080538 "U613P9ZW412 O4" "[(M-H)+(HCOOH)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 175.080538 "U613P9ZW412 O4" "[(M-H)+(HCOOH)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 175.080538 "U613P9ZW412 O4" "[(M-H)+(HCOOH)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 430.193551 "P93Z18W430 Na2 O6" "[(3M-3H+2Na)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 430.193551 "P93Z18W430 Na2 O6" "[(3M-3H+2Na)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 430.193551 "P93Z18W430 Na2 O6" "[(3M-3H+2Na)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 430.193551 "P93Z18W430 Na2 O6" "[(3M-3H+2Na)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 430.193551 "P93Z18W430 Na2 O6" "[(3M-3H+2Na)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 278.120332 "U1113P92ZW418 Na O4" "[(2M-2H+Na)-(H2)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 278.120332 "U1113P92ZW418 Na O4" "[(2M-2H+Na)-(H2)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 278.120332 "U1113P92ZW418 Na O4" "[(2M-2H+Na)-(H2)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 278.120332 "U1113P92ZW418 Na O4" "[(2M-2H+Na)-(H2)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 278.120332 "U1113P92ZW418 Na O4" "[(2M-2H+Na)-(H2)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 499.184331 "U1813P93ZW431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 499.184331 "U1813P93ZW431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 499.184331 "U1813P93ZW431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 499.184331 "U1813P93ZW431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 499.184331 "U1813P93ZW431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(HCOOH)]+ (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(HCOOH)]+ (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(HCOOH)]+ (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(HCOOH)]+ (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(HCOOH)]+ (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 411.229513 "U1713P93ZW433 Na O6" "[(3M+Na)]+ (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 411.229513 "U1713P93ZW433 Na O6" "[(3M+Na)]+ (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 411.229513 "U1713P93ZW433 Na O6" "[(3M+Na)]+ (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 411.229513 "U1713P93ZW433 Na O6" "[(3M+Na)]+ (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 411.229513 "U1713P93ZW433 Na O6" "[(3M+Na)]+ (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 410.226158 "P93Z18W433 Na O6" "[(3M+Na)]+" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 410.226158 "P93Z18W433 Na O6" "[(3M+Na)]+" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 410.226158 "P93Z18W433 Na O6" "[(3M+Na)]+" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 410.226158 "P93Z18W433 Na O6" "[(3M+Na)]+" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 410.226158 "P93Z18W433 Na O6" "[(3M+Na)]+" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 337.09125 "U12H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 337.09125 "U12H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 337.09125 "U12H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 337.09125 "U12H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 337.09125 "U12H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 197.062483 "U613P9ZW411 Na O4" "[(M-H)+(HCOONa)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 197.062483 "U613P9ZW411 Na O4" "[(M-H)+(HCOONa)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 197.062483 "U613P9ZW411 Na O4" "[(M-H)+(HCOONa)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 197.062483 "U613P9ZW411 Na O4" "[(M-H)+(HCOONa)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 197.062483 "U613P9ZW411 Na O4" "[(M-H)+(HCOONa)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 488.152174 "U18H30 Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 488.152174 "U18H30 Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 488.152174 "U18H30 Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 488.152174 "U18H30 Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 488.152174 "U18H30 Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 198.063372 "P9Z7W411 Na O3 18O" "[(M-H)+(HCOONa)]- (18O)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 198.063372 "P9Z7W411 Na O3 18O" "[(M-H)+(HCOONa)]- (18O)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 198.063372 "P9Z7W411 Na O3 18O" "[(M-H)+(HCOONa)]- (18O)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 198.063372 "P9Z7W411 Na O3 18O" "[(M-H)+(HCOONa)]- (18O)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 198.063372 "P9Z7W411 Na O3 18O" "[(M-H)+(HCOONa)]- (18O)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 259.154926 "P92Z12W421 O3 18O" "[(2M-H)]- (18O)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 259.154926 "P92Z12W421 O3 18O" "[(2M-H)]- (18O)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 259.154926 "P92Z12W421 O3 18O" "[(2M-H)]- (18O)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 259.154926 "P92Z12W421 O3 18O" "[(2M-H)]- (18O)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 259.154926 "P92Z12W421 O3 18O" "[(2M-H)]- (18O)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.068738 "P90Z6W410 15N O2" "[(M-H)]- (15N)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.068738 "P90Z6W410 15N O2" "[(M-H)]- (15N)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.068738 "P90Z6W410 15N O2" "[(M-H)]- (15N)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.068738 "P90Z6W410 15N O2" "[(M-H)]- (15N)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.068738 "P90Z6W410 15N O2" "[(M-H)]- (15N)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 196.059128 "P9Z7W411 Na O4" "[(M-H)+(HCOONa)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 196.059128 "P9Z7W411 Na O4" "[(M-H)+(HCOONa)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 196.059128 "P9Z7W411 Na O4" "[(M-H)+(HCOONa)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 196.059128 "P9Z7W411 Na O4" "[(M-H)+(HCOONa)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 196.059128 "P9Z7W411 Na O4" "[(M-H)+(HCOONa)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.033681 "U513C H10 Cl N Na O2" "[(M-H)+(NaCl)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.033681 "U513C H10 Cl N Na O2" "[(M-H)+(NaCl)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.033681 "U513C H10 Cl N Na O2" "[(M-H)+(NaCl)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.033681 "U513C H10 Cl N Na O2" "[(M-H)+(NaCl)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.033681 "U513C H10 Cl N Na O2" "[(M-H)+(NaCl)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 277.116977 "P92Z12W418 Na O4" "[(2M-2H+Na)-(H2)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 277.116977 "P92Z12W418 Na O4" "[(2M-2H+Na)-(H2)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 277.116977 "P92Z12W418 Na O4" "[(2M-2H+Na)-(H2)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 277.116977 "P92Z12W418 Na O4" "[(2M-2H+Na)-(H2)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 277.116977 "P92Z12W418 Na O4" "[(2M-2H+Na)-(H2)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 484.098257 "U1413P92ZW423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 484.098257 "U1413P92ZW423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 484.098257 "U1413P92ZW423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 484.098257 "U1413P92ZW423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 484.098257 "U1413P92ZW423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 264.046553 "P9Z8W412 Na2 O6" "[(M-H)+2(HCOONa)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 264.046553 "P9Z8W412 Na2 O6" "[(M-H)+2(HCOONa)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 264.046553 "P9Z8W412 Na2 O6" "[(M-H)+2(HCOONa)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 264.046553 "P9Z8W412 Na2 O6" "[(M-H)+2(HCOONa)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 264.046553 "P9Z8W412 Na2 O6" "[(M-H)+2(HCOONa)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 410.226158 "P93Z18W433 Na O6" "[(3M+Na)]+" "hcoltt" 1.4 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08329 "P90Z6W412 15N O2" "[(M+H)]+ (15N)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08329 "P90Z6W412 15N O2" "[(M+H)]+ (15N)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08329 "P90Z6W412 15N O2" "[(M+H)]+ (15N)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08329 "P90Z6W412 15N O2" "[(M+H)]+ (15N)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 128.071703 "P9Z6W410 O2" "[(M-H)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 128.071703 "P9Z6W410 O2" "[(M-H)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 128.071703 "P9Z6W410 O2" "[(M-H)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 128.071703 "P9Z6W410 O2" "[(M-H)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 128.071703 "P9Z6W410 O2" "[(M-H)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 258.154037 "U1113P92ZW421 O4" "[(2M-H)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 258.154037 "U1113P92ZW421 O4" "[(2M-H)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 258.154037 "U1113P92ZW421 O4" "[(2M-H)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 258.154037 "U1113P92ZW421 O4" "[(2M-H)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 258.154037 "U1113P92ZW421 O4" "[(2M-H)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 483.094902 "P92Z15W423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 279.132627 "P92Z12W420 Na O4" "[(2M-2H+Na)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 498.180976 "P93Z19W431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 498.180976 "P93Z19W431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 498.180976 "P93Z19W431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 498.180976 "P93Z19W431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 498.180976 "P93Z19W431 Na3 O8" "[(3M-3H+2Na)+(HCOONa)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 347.120052 "P92Z13W421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 347.120052 "P92Z13W421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 347.120052 "P92Z13W421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 347.120052 "P92Z13W421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 347.120052 "P92Z13W421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 431.196906 "U1713P93ZW430 Na2 O6" "[(3M-3H+2Na)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 431.196906 "U1713P93ZW430 Na2 O6" "[(3M-3H+2Na)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 431.196906 "U1713P93ZW430 Na2 O6" "[(3M-3H+2Na)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 431.196906 "U1713P93ZW430 Na2 O6" "[(3M-3H+2Na)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 431.196906 "U1713P93ZW430 Na2 O6" "[(3M-3H+2Na)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 333.037333 "U813P9ZW413 Na3 O8" "[(M-H)+3(HCOONa)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 333.037333 "U813P9ZW413 Na3 O8" "[(M-H)+3(HCOONa)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 333.037333 "U813P9ZW413 Na3 O8" "[(M-H)+3(HCOONa)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 333.037333 "U813P9ZW413 Na3 O8" "[(M-H)+3(HCOONa)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 333.037333 "U813P9ZW413 Na3 O8" "[(M-H)+3(HCOONa)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 130.075947 "P9Z6W410 O 18O" "[(M-H)]- (18O)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 130.075947 "P9Z6W410 O 18O" "[(M-H)]- (18O)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 130.075947 "P9Z6W410 O 18O" "[(M-H)]- (18O)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 130.075947 "P9Z6W410 O 18O" "[(M-H)]- (18O)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 130.075947 "P9Z6W410 O 18O" "[(M-H)]- (18O)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.092965 "U413P9Z2W412 O2" "[(M+H)]+ (13C2)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.092965 "U413P9Z2W412 O2" "[(M+H)]+ (13C2)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.092965 "U413P9Z2W412 O2" "[(M+H)]+ (13C2)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.092965 "U413P9Z2W412 O2" "[(M+H)]+ (13C2)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.092965 "U413P9Z2W412 O2" "[(M+H)]+ (13C2)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 260.168589 "U1113P92ZW423 O4" "[(2M+H)]+ (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 260.168589 "U1113P92ZW423 O4" "[(2M+H)]+ (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 260.168589 "U1113P92ZW423 O4" "[(2M+H)]+ (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 260.168589 "U1113P92ZW423 O4" "[(2M+H)]+ (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 260.168589 "U1113P92ZW423 O4" "[(2M+H)]+ (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 416.110832 "U1313P92ZW422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 416.110832 "U1313P92ZW422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 416.110832 "U1313P92ZW422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 416.110832 "U1313P92ZW422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 416.110832 "U1313P92ZW422 Na3 O8" "[(2M-2H+Na)+2(HCOONa)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.027361 "U6H10 Cl N0 15N Na O2" "[(M-H)+(NaCl)]- (15N)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.027361 "U6H10 Cl N0 15N Na O2" "[(M-H)+(NaCl)]- (15N)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.027361 "U6H10 Cl N0 15N Na O2" "[(M-H)+(NaCl)]- (15N)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.027361 "U6H10 Cl N0 15N Na O2" "[(M-H)+(NaCl)]- (15N)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.027361 "U6H10 Cl N0 15N Na O2" "[(M-H)+(NaCl)]- (15N)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 174.077183 "P9Z7W412 O4" "[(M-H)+(HCOOH)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 174.077183 "P9Z7W412 O4" "[(M-H)+(HCOOH)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 174.077183 "P9Z7W412 O4" "[(M-H)+(HCOOH)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 174.077183 "P9Z7W412 O4" "[(M-H)+(HCOOH)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 174.077183 "P9Z7W412 O4" "[(M-H)+(HCOOH)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 490.149224 "U18H30 Cl0 37Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]- (37Cl)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 490.149224 "U18H30 Cl0 37Cl N3 Na3 O6" "[(3M-3H+2Na)+(NaCl)]- (37Cl)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 257.150682 "P92Z12W421 O4" "[(2M-H)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 186.030326 "U6H10 Cl N Na O2" "[(M-H)+(NaCl)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 186.030326 "U6H10 Cl N Na O2" "[(M-H)+(NaCl)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 186.030326 "U6H10 Cl N Na O2" "[(M-H)+(NaCl)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 186.030326 "U6H10 Cl N Na O2" "[(M-H)+(NaCl)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 186.030326 "U6H10 Cl N Na O2" "[(M-H)+(NaCl)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 280.135982 "U1113P92ZW420 Na O4" "[(2M-2H+Na)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 280.135982 "U1113P92ZW420 Na O4" "[(2M-2H+Na)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 280.135982 "U1113P92ZW420 Na O4" "[(2M-2H+Na)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 280.135982 "U1113P92ZW420 Na O4" "[(2M-2H+Na)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 280.135982 "U1113P92ZW420 Na O4" "[(2M-2H+Na)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 266.050797 "P9Z8W412 Na2 O5 18O" "[(M-H)+2(HCOONa)]- (18O)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 266.050797 "P9Z8W412 Na2 O5 18O" "[(M-H)+2(HCOONa)]- (18O)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 266.050797 "P9Z8W412 Na2 O5 18O" "[(M-H)+2(HCOONa)]- (18O)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 339.0883 "U12H20 Cl0 37Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (37Cl)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 266.050797 "P9Z8W412 Na2 O5 18O" "[(M-H)+2(HCOONa)]- (18O)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 188.027376 "U6H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (37Cl)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 188.027376 "U6H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (37Cl)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 188.027376 "U6H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (37Cl)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 188.027376 "U6H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (37Cl)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 188.027376 "U6H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (37Cl)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 265.049908 "U713P9ZW412 Na2 O6" "[(M-H)+2(HCOONa)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 265.049908 "U713P9ZW412 Na2 O6" "[(M-H)+2(HCOONa)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 265.049908 "U713P9ZW412 Na2 O6" "[(M-H)+2(HCOONa)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 265.049908 "U713P9ZW412 Na2 O6" "[(M-H)+2(HCOONa)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 265.049908 "U713P9ZW412 Na2 O6" "[(M-H)+2(HCOONa)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.075058 "U513P9ZW410 O2" "[(M-H)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.075058 "U513P9ZW410 O2" "[(M-H)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.075058 "U513P9ZW410 O2" "[(M-H)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.075058 "U513P9ZW410 O2" "[(M-H)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 129.075058 "U513P9ZW410 O2" "[(M-H)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 348.123407 "U1213P92ZW421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 348.123407 "U1213P92ZW421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 348.123407 "U1213P92ZW421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 348.123407 "U1213P92ZW421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 348.123407 "U1213P92ZW421 Na2 O6" "[(2M-2H+Na)+(HCOONa)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 189.030731 "U513C H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (13C) (37Cl)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 189.030731 "U513C H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (13C) (37Cl)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 189.030731 "U513C H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (13C) (37Cl)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 189.030731 "U513C H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (13C) (37Cl)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 189.030731 "U513C H10 Cl0 37Cl N Na O2" "[(M-H)+(NaCl)]- (13C) (37Cl)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 338.094605 "U1113C H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 338.094605 "U1113C H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)]+" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)]+" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)]+" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)]+" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)]+" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(HCOOH)]+" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(HCOOH)]+" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(HCOOH)]+" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(HCOOH)]+" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(HCOOH)]+" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 187.027361 "U6H10 Cl N0 15N Na O2" "[(M-H)+(NaCl)]- (15N)" "colpp" 0.93 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.090499 "P9Z6W412 O 18O" "[(M+H)]+ (18O)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.090499 "P9Z6W412 O 18O" "[(M+H)]+ (18O)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.090499 "P9Z6W412 O 18O" "[(M+H)]+ (18O)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.090499 "P9Z6W412 O 18O" "[(M+H)]+ (18O)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 257.150682 "P92Z12W421 O4" "[(2M-H)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 257.150682 "P92Z12W421 O4" "[(2M-H)]-" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 257.150682 "P92Z12W421 O4" "[(2M-H)]-" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 257.150682 "P92Z12W421 O4" "[(2M-H)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 349.124296 "P92Z13W421 Na2 O5 18O" "[(2M-2H+Na)+(HCOONa)]- (18O)" "colpp" 0.93 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)]+ (13C)" "hcoltt" 1.4 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)]+ (13C)" "colzz" 5.26 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)]+ (13C)" "colzz2" 3.59 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)]+ (13C)" "colzz3" 3.76 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)]+ (13C)" "colpp" 0.93 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 256.138387 "U1113P92ZW419 O4" "[(2M-H)-(H2)]- (13C)" "hcoltt" 1.4 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 256.138387 "U1113P92ZW419 O4" "[(2M-H)-(H2)]- (13C)" "colzz" 5.26 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 483.094902 "P92Z15W423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]-" "colzz2" 3.59 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 483.094902 "P92Z15W423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]-" "colzz3" 3.76 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 483.094902 "P92Z15W423 Na4 O10" "[(2M-2H+Na)+3(HCOONa)]-" "colpp" 0.93 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 332.033978 "P9Z9W413 Na3 O8" "[(M-H)+3(HCOONa)]-" "hcoltt" 1.4 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 332.033978 "P9Z9W413 Na3 O8" "[(M-H)+3(HCOONa)]-" "colzz" 5.26 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 332.033978 "P9Z9W413 Na3 O8" "[(M-H)+3(HCOONa)]-" "colzz2" 3.59 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 332.033978 "P9Z9W413 Na3 O8" "[(M-H)+3(HCOONa)]-" "colzz3" 3.76 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 332.033978 "P9Z9W413 Na3 O8" "[(M-H)+3(HCOONa)]-" "colpp" 0.93 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 349.124296 "P92Z13W421 Na2 O5 18O" "[(2M-2H+Na)+(HCOONa)]- (18O)" "hcoltt" 1.4 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 349.124296 "P92Z13W421 Na2 O5 18O" "[(2M-2H+Na)+(HCOONa)]- (18O)" "colzz" 5.26 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 349.124296 "P92Z13W421 Na2 O5 18O" "[(2M-2H+Na)+(HCOONa)]- (18O)" "colzz2" 3.59 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 349.124296 "P92Z13W421 Na2 O5 18O" "[(2M-2H+Na)+(HCOONa)]- (18O)" "colzz3" 3.76 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 255.135032 "P92Z12W419 O4" "[(2M-H)-(H2)]-" "colzz2" 3.59 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 256.138387 "U1113P92ZW419 O4" "[(2M-H)-(H2)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 256.138387 "U1113P92ZW419 O4" "[(2M-H)-(H2)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 256.138387 "U1113P92ZW419 O4" "[(2M-H)-(H2)]- (13C)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 256.138387 "U1113P92ZW419 O4" "[(2M-H)-(H2)]- (13C)" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 255.135032 "P92Z12W419 O4" "[(2M-H)-(H2)]-" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "POS" 132.090499 "P9Z6W412 O 18O" "[(M+H)]+ (18O)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 255.135032 "P92Z12W419 O4" "[(2M-H)-(H2)]-" "somecol" 5.745 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 255.135032 "P92Z12W419 O4" "[(2M-H)-(H2)]-" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 338.094605 "U1113C H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (13C)" "colzz2" 2.64 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 338.094605 "U1113C H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (13C)" "colAA" 2.6 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 266.050797 "P9Z8W412 Na2 O5 18O" "[(M-H)+2(HCOONa)]- (18O)" "col12" 1.06 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +J89 "NEG" 338.094605 "U1113C H20 Cl N2 Na2 O4" "[(2M-2H+Na)+(NaCl)]- (13C)" "colzz3" 2.83 "J111L6M6O2" 129.07898 "Zopic acid;Chababacid" +76R "POS" 57.05283 "U213P9ZW46 O0" "[(M+H)-(H2O)-(HCOOH)]+ (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 57.05283 "U213P9ZW46 O0" "[(M+H)-(H2O)-(HCOOH)]+ (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 57.033491 "P90Z3W45 O" "[(M+H)-(NH3)-(HCOOH)]+" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 57.05283 "U213P9ZW46 O0" "[(M+H)-(H2O)-(HCOOH)]+ (13C)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 57.033491 "P90Z3W45 O" "[(M+H)-(NH3)-(HCOOH)]+" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 103.05831 "U313P9ZW48 O2" "[(M+H)-(H2O)]+ (13C)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 103.05831 "U313P9ZW48 O2" "[(M+H)-(H2O)]+ (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 103.05831 "U313P9ZW48 O2" "[(M+H)-(H2O)]+ (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 57.033491 "P90Z3W45 O" "[(M+H)-(NH3)-(HCOOH)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 57.033491 "P90Z3W45 O" "[(M+H)-(NH3)-(HCOOH)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(H2O)]+" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(H2O)]+" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 75.063395 "U213P9ZW48 O" "[(M+H)-(HCOOH)]+ (13C)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 75.063395 "U213P9ZW48 O" "[(M+H)-(HCOOH)]+ (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 75.063395 "U213P9ZW48 O" "[(M+H)-(HCOOH)]+ (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 75.063395 "U213P9ZW48 O" "[(M+H)-(HCOOH)]+ (13C)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(H2O)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 74.06004 "P9Z3W48 O" "[(M+H)-(HCOOH)]+" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 74.06004 "P9Z3W48 O" "[(M+H)-(HCOOH)]+" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 239.115922 "U613P92Z2W417 O6" "[(2M-H)]- (13C2)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 239.115922 "U613P92Z2W417 O6" "[(2M-H)]- (13C2)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 239.115922 "U613P92Z2W417 O6" "[(2M-H)]- (13C2)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 239.115922 "U613P92Z2W417 O6" "[(2M-H)]- (13C2)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 124.0369 "P9Z4W47 Na O2" "[(M+Na)-(H2O)]+" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 124.0369 "P9Z4W47 Na O2" "[(M+Na)-(H2O)]+" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 124.0369 "P9Z4W47 Na O2" "[(M+Na)-(H2O)]+" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.039305 "P9Z2W46 O2" "[(M+H)-(C2H4O)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.039305 "P9Z2W46 O2" "[(M+H)-(C2H4O)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.039305 "P9Z2W46 O2" "[(M+H)-(C2H4O)]+" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.039305 "P9Z2W46 O2" "[(M+H)-(C2H4O)]+" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 122.069764 "P9Z4W410 O2 18O" "[(M+H)]+ (18O)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 122.069764 "P9Z4W410 O2 18O" "[(M+H)]+ (18O)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 122.069764 "P9Z4W410 O2 18O" "[(M+H)]+ (18O)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 238.112567 "U713P92ZW417 O6" "[(2M-H)]- (13C)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 238.112567 "U713P92ZW417 O6" "[(2M-H)]- (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 238.112567 "U713P92ZW417 O6" "[(2M-H)]- (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 238.112567 "U713P92ZW417 O6" "[(2M-H)]- (13C)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 104.059199 "P9Z4W48 O 18O" "[(M+H)-(H2O)]+ (18O)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 104.059199 "P9Z4W48 O 18O" "[(M+H)-(H2O)]+ (18O)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 104.059199 "P9Z4W48 O 18O" "[(M+H)-(H2O)]+ (18O)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 120.06552 "P9Z4W410 O3" "[(M+H)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 120.06552 "P9Z4W410 O3" "[(M+H)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 120.06552 "P9Z4W410 O3" "[(M+H)]+" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 120.06552 "P9Z4W410 O3" "[(M+H)]+" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 121.062555 "P90Z4W410 15N O3" "[(M+H)]+ (15N)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 121.062555 "P90Z4W410 15N O3" "[(M+H)]+ (15N)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 121.062555 "P90Z4W410 15N O3" "[(M+H)]+ (15N)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 143.05082 "U313P9ZW49 Na O3" "[(M+Na)]+ (13C)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 143.05082 "U313P9ZW49 Na O3" "[(M+Na)]+ (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 143.05082 "U313P9ZW49 Na O3" "[(M+Na)]+ (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 143.05082 "U313P9ZW49 Na O3" "[(M+Na)]+ (13C)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 261.095401 "P92Z8W416 Na O5 18O" "[(2M-2H+Na)]- (18O)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 261.095401 "P92Z8W416 Na O5 18O" "[(2M-2H+Na)]- (18O)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 261.095401 "P92Z8W416 Na O5 18O" "[(2M-2H+Na)]- (18O)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(CO2)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(CO2)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(CO2)]+" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(CO2)]+" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 156.024696 "U4H9 Cl0 37Cl N O3" "[(M+Cl)]- (37Cl)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 156.024696 "U4H9 Cl0 37Cl N O3" "[(M+Cl)]- (37Cl)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 156.024696 "U4H9 Cl0 37Cl N O3" "[(M+Cl)]- (37Cl)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 237.109212 "P92Z8W417 O6" "[(2M-H)]-" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 237.109212 "P92Z8W417 O6" "[(2M-H)]-" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 237.109212 "P92Z8W417 O6" "[(2M-H)]-" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 237.109212 "P92Z8W417 O6" "[(2M-H)]-" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 120.055212 "P9Z4W48 O2 18O" "[(M-H)]- (18O)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 120.055212 "P9Z4W48 O2 18O" "[(M-H)]- (18O)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 120.055212 "P9Z4W48 O2 18O" "[(M-H)]- (18O)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.048003 "P90Z4W48 15N O3" "[(M-H)]- (15N)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.048003 "P90Z4W48 15N O3" "[(M-H)]- (15N)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.048003 "P90Z4W48 15N O3" "[(M-H)]- (15N)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.048003 "P90Z4W48 15N O3" "[(M-H)]- (15N)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 78.054955 "P9Z2W48 O2" "[(M+H)-(C2H2O)]+" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 78.054955 "P9Z2W48 O2" "[(M+H)-(C2H2O)]+" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 78.054955 "P9Z2W48 O2" "[(M+H)-(C2H2O)]+" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 142.047465 "P9Z4W49 Na O3" "[(M+Na)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 142.047465 "P9Z4W49 Na O3" "[(M+Na)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 142.047465 "P9Z4W49 Na O3" "[(M+Na)]+" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 142.047465 "P9Z4W49 Na O3" "[(M+Na)]+" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 154.027646 "U4H9 Cl N O3" "[(M+Cl)]-" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 154.027646 "U4H9 Cl N O3" "[(M+Cl)]-" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 154.027646 "U4H9 Cl N O3" "[(M+Cl)]-" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 56.049475 "P9Z3W46 O0" "[(M+H)-(H2O)-(HCOOH)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 56.049475 "P9Z3W46 O0" "[(M+H)-(H2O)-(HCOOH)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 56.049475 "P9Z3W46 O0" "[(M+H)-(H2O)-(HCOOH)]+" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 56.049475 "P9Z3W46 O0" "[(M+H)-(H2O)-(HCOOH)]+" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(H2O)-(CO2)]+" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(H2O)-(CO2)]+" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 58.065125 "P9Z3W48 O0" "[(M+H)-(H2O)-(CO2)]+" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 260.094512 "U713P92ZW416 Na O6" "[(2M-2H+Na)]- (13C)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 260.094512 "U713P92ZW416 Na O6" "[(2M-2H+Na)]- (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 260.094512 "U713P92ZW416 Na O6" "[(2M-2H+Na)]- (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 260.094512 "U713P92ZW416 Na O6" "[(2M-2H+Na)]- (13C)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 121.068875 "U313P9ZW410 O3" "[(M+H)]+ (13C)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 121.068875 "U313P9ZW410 O3" "[(M+H)]+ (13C)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 121.068875 "U313P9ZW410 O3" "[(M+H)]+ (13C)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 187.041748 "U413P9ZW49 Na O5" "[(M-H)+(HCOONa)]- (13C)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 187.041748 "U413P9ZW49 Na O5" "[(M-H)+(HCOONa)]- (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 187.041748 "U413P9ZW49 Na O5" "[(M-H)+(HCOONa)]- (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 187.041748 "U413P9ZW49 Na O5" "[(M-H)+(HCOONa)]- (13C)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 123.073119 "U313P9ZW410 O2 18O" "[(M+H)]+ (13C) (18O)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 123.073119 "U313P9ZW410 O2 18O" "[(M+H)]+ (13C) (18O)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 123.073119 "U313P9ZW410 O2 18O" "[(M+H)]+ (13C) (18O)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.054323 "U313P9ZW48 O3" "[(M-H)]- (13C)" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.054323 "U313P9ZW48 O3" "[(M-H)]- (13C)" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.054323 "U313P9ZW48 O3" "[(M-H)]- (13C)" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 119.054323 "U313P9ZW48 O3" "[(M-H)]- (13C)" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 118.050968 "P9Z4W48 O3" "[(M-H)]-" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 118.050968 "P9Z4W48 O3" "[(M-H)]-" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 118.050968 "P9Z4W48 O3" "[(M-H)]-" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 176.009591 "U4H8 Cl N Na O3" "[(M-H)+(NaCl)]-" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 176.009591 "U4H8 Cl N Na O3" "[(M-H)+(NaCl)]-" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 176.009591 "U4H8 Cl N Na O3" "[(M-H)+(NaCl)]-" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 176.009591 "U4H8 Cl N Na O3" "[(M-H)+(NaCl)]-" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 186.038393 "P9Z5W49 Na O5" "[(M-H)+(HCOONa)]-" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 76.07569 "P9Z3W410 O" "[(M+H)-(CO2)]+" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 186.038393 "P9Z5W49 Na O5" "[(M-H)+(HCOONa)]-" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 92.070605 "P9Z3W410 O2" "[(M+H)-(CO)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 92.070605 "P9Z3W410 O2" "[(M+H)-(CO)]+" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 92.070605 "P9Z3W410 O2" "[(M+H)-(CO)]+" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 92.070605 "P9Z3W410 O2" "[(M+H)-(CO)]+" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 165.059803 "U413P9ZW410 O5" "[(M-H)+(HCOOH)]- (13C)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 165.059803 "U413P9ZW410 O5" "[(M-H)+(HCOOH)]- (13C)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 165.059803 "U413P9ZW410 O5" "[(M-H)+(HCOOH)]- (13C)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 74.024753 "P9Z2W44 O2" "[(M-H)-(C2H4O)]-" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 74.024753 "P9Z2W44 O2" "[(M-H)-(C2H4O)]-" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 74.024753 "P9Z2W44 O2" "[(M-H)-(C2H4O)]-" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 74.024753 "P9Z2W44 O2" "[(M-H)-(C2H4O)]-" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 259.091157 "P92Z8W416 Na O6" "[(2M-2H+Na)]-" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 259.091157 "P92Z8W416 Na O6" "[(2M-2H+Na)]-" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 259.091157 "P92Z8W416 Na O6" "[(2M-2H+Na)]-" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 164.056448 "P9Z5W410 O5" "[(M-H)+(HCOOH)]-" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 164.056448 "P9Z5W410 O5" "[(M-H)+(HCOOH)]-" "colzz2" 2.16 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 164.056448 "P9Z5W410 O5" "[(M-H)+(HCOOH)]-" "col12" 0.82 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 164.056448 "P9Z5W410 O5" "[(M-H)+(HCOOH)]-" "somecol" 6.13 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 178.006641 "U4H8 Cl0 37Cl N Na O3" "[(M-H)+(NaCl)]- (37Cl)" "colzz" 4.12 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 178.006641 "U4H8 Cl0 37Cl N Na O3" "[(M-H)+(NaCl)]- (37Cl)" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 178.006641 "U4H8 Cl0 37Cl N Na O3" "[(M-H)+(NaCl)]- (37Cl)" "colpp" 0.84 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "POS" 74.06004 "P9Z3W48 O" "[(M+H)-(HCOOH)]+" "hcoltt" 1.11 "J19L4M6O3" 119.05824 "L-vroomumil" +76R "NEG" 186.038393 "P9Z5W49 Na O5" "[(M-H)+(HCOONa)]-" "colzz3" 2.18 "J19L4M6O3" 119.05824 "L-vroomumil" +U761 "NEG" 168.049572 "U613P92ZW47 O3" "[(M-H)+(HCOOH)]- (13C)" "colzz3" 3.66 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 168.049572 "U613P92ZW47 O3" "[(M-H)+(HCOOH)]- (13C)" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 168.049572 "U613P92ZW47 O3" "[(M-H)+(HCOOH)]- (13C)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 123.055289 "P92Z6W47 O" "[(M+H)]+" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 123.055289 "P92Z6W47 O" "[(M+H)]+" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 123.055289 "P92Z6W47 O" "[(M+H)]+" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 123.055289 "P92Z6W47 O" "[(M+H)]+" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 123.055289 "P92Z6W47 O" "[(M+H)]+" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 170.064124 "U613P92ZW49 O3" "[(M+H)+(HCOOH)]+ (13C)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 170.064124 "U613P92ZW49 O3" "[(M+H)+(HCOOH)]+ (13C)" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 170.064124 "U613P92ZW49 O3" "[(M+H)+(HCOOH)]+ (13C)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 123.055289 "P92Z6W47 O" "[(M+H)]+" "colzz3" 3.66 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 170.064124 "U613P92ZW49 O3" "[(M+H)+(HCOOH)]+ (13C)" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 167.046217 "P92Z7W47 O3" "[(M-H)+(HCOOH)]-" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 167.046217 "P92Z7W47 O3" "[(M-H)+(HCOOH)]-" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 170.064124 "U613P92ZW49 O3" "[(M+H)+(HCOOH)]+ (13C)" "colzz" 11.06 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 167.046217 "P92Z7W47 O3" "[(M-H)+(HCOOH)]-" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 167.046217 "P92Z7W47 O3" "[(M-H)+(HCOOH)]-" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 168.049572 "U613P92ZW47 O3" "[(M-H)+(HCOOH)]- (13C)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 122.044092 "U513P92ZW45 O" "[(M-H)]- (13C)" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 122.044092 "U513P92ZW45 O" "[(M-H)]- (13C)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 122.044092 "U513P92ZW45 O" "[(M-H)]- (13C)" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 122.044092 "U513P92ZW45 O" "[(M-H)]- (13C)" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 80.049475 "P9Z5W46 O0" "[(M+H)-(NHCO)]+" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 80.049475 "P9Z5W46 O0" "[(M+H)-(NHCO)]+" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 80.049475 "P9Z5W46 O0" "[(M+H)-(NHCO)]+" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 80.049475 "P9Z5W46 O0" "[(M+H)-(NHCO)]+" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 80.049475 "P9Z5W46 O0" "[(M+H)-(NHCO)]+" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 78.033825 "P9Z5W44 O0" "[(M+H)-(NH3CO)]+" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 78.033825 "P9Z5W44 O0" "[(M+H)-(NH3CO)]+" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 78.033825 "P9Z5W44 O0" "[(M+H)-(NH3CO)]+" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 78.033825 "P9Z5W44 O0" "[(M+H)-(NH3CO)]+" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 78.033825 "P9Z5W44 O0" "[(M+H)-(NH3CO)]+" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 169.060769 "P92Z7W49 O3" "[(M+H)+(HCOOH)]+" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 169.060769 "P92Z7W49 O3" "[(M+H)+(HCOOH)]+" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 169.060769 "P92Z7W49 O3" "[(M+H)+(HCOOH)]+" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 169.060769 "P92Z7W49 O3" "[(M+H)+(HCOOH)]+" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 169.060769 "P92Z7W49 O3" "[(M+H)+(HCOOH)]+" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 122.044092 "U513P92ZW45 O" "[(M-H)]- (13C)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 106.02874 "P9Z6W44 O" "[(M+H)-(NH3)]+" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 106.02874 "P9Z6W44 O" "[(M+H)-(NH3)]+" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 106.02874 "P9Z6W44 O" "[(M+H)-(NH3)]+" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 106.02874 "P9Z6W44 O" "[(M+H)-(NH3)]+" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 96.04439 "P9Z5W46 O" "[(M+H)-(HCN)]+" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 96.04439 "P9Z5W46 O" "[(M+H)-(HCN)]+" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 96.04439 "P9Z5W46 O" "[(M+H)-(HCN)]+" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 96.04439 "P9Z5W46 O" "[(M+H)-(HCN)]+" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 96.04439 "P9Z5W46 O" "[(M+H)-(HCN)]+" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.059533 "P92Z6W47 O0 18O" "[(M+H)]+ (18O)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.059533 "P92Z6W47 O0 18O" "[(M+H)]+ (18O)" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.059533 "P92Z6W47 O0 18O" "[(M+H)]+ (18O)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.059533 "P92Z6W47 O0 18O" "[(M+H)]+ (18O)" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.059533 "P92Z6W47 O0 18O" "[(M+H)]+ (18O)" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.052324 "P9Z6W47 15N O" "[(M+H)]+ (15N)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.052324 "P9Z6W47 15N O" "[(M+H)]+ (15N)" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.052324 "P9Z6W47 15N O" "[(M+H)]+ (15N)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.052324 "P9Z6W47 15N O" "[(M+H)]+ (15N)" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.052324 "P9Z6W47 15N O" "[(M+H)]+ (15N)" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 119.025087 "P92Z6W43 O" "[(M-H)-(H2)]-" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 119.025087 "P92Z6W43 O" "[(M-H)-(H2)]-" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 119.025087 "P92Z6W43 O" "[(M-H)-(H2)]-" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 119.025087 "P92Z6W43 O" "[(M-H)-(H2)]-" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 119.025087 "P92Z6W43 O" "[(M-H)-(H2)]-" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 121.040737 "P92Z6W45 O" "[(M-H)]-" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 121.040737 "P92Z6W45 O" "[(M-H)]-" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 121.040737 "P92Z6W45 O" "[(M-H)]-" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 121.040737 "P92Z6W45 O" "[(M-H)]-" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "NEG" 121.040737 "P92Z6W45 O" "[(M-H)]-" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 126.065354 "U313P92Z3W47 O" "[(M+H)]+ (13C3)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 126.065354 "U313P92Z3W47 O" "[(M+H)]+ (13C3)" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 126.065354 "U313P92Z3W47 O" "[(M+H)]+ (13C3)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 126.065354 "U313P92Z3W47 O" "[(M+H)]+ (13C3)" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 126.065354 "U313P92Z3W47 O" "[(M+H)]+ (13C3)" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.058644 "U513P92ZW47 O" "[(M+H)]+ (13C)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.058644 "U513P92ZW47 O" "[(M+H)]+ (13C)" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.058644 "U513P92ZW47 O" "[(M+H)]+ (13C)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.058644 "U513P92ZW47 O" "[(M+H)]+ (13C)" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.058644 "U513P92ZW47 O" "[(M+H)]+ (13C)" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.061999 "U413P92Z2W47 O" "[(M+H)]+ (13C2)" "hcoltt" 2.5 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.061999 "U413P92Z2W47 O" "[(M+H)]+ (13C2)" "colzz2" 4.24 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.061999 "U413P92Z2W47 O" "[(M+H)]+ (13C2)" "colzz3" 4.3 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.061999 "U413P92Z2W47 O" "[(M+H)]+ (13C2)" "col12" 1.32 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 125.061999 "U413P92Z2W47 O" "[(M+H)]+ (13C2)" "colpp" 0.95 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 124.058644 "U513P92ZW47 O" "[(M+H)]+ (13C)" "col12" 1.05 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +U761 "POS" 169.060769 "P92Z7W49 O3" "[(M+H)+(HCOOH)]+" "somecol" 2.67 "J16L6M62O" 122.04801 "Coquelicol;Paquerettol" +34 "POS" 190.163109 "U813P92ZW421 O2" "[(M+H)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 190.163109 "U813P92ZW421 O2" "[(M+H)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 96.085637 "P92Z9W422 O 18O" "[(M+2H)]++ (18O)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 96.085637 "P92Z9W422 O 18O" "[(M+2H)]++ (18O)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)-(NC3H9)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 172.133205 "P9Z9W418 O2" "[(M+H)-(NH3)]+" "col12" 0.78 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 172.133205 "P9Z9W418 O2" "[(M+H)-(NH3)]+" "somecol" 8.615 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 118.086255 "P92Z10W424 O4" "[(M+2H)+(HCOOH)]++" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 95.5851925 "U813P92ZW422 O2" "[(M+2H)]++ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 95.5851925 "U813P92ZW422 O2" "[(M+2H)]++ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 95.5820325 "P9Z9W422 15N O2" "[(M+2H)]++ (15N)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 95.5820325 "P9Z9W422 15N O2" "[(M+2H)]++ (15N)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 131.08961 "U513P9ZW412 O2" "[(M+H)-(NC3H9)]+ (13C)" "somecol" 8.615 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(NC3H9)-(HCOOH)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 188.147459 "U813P92ZW419 O2" "[(M+H)-(H2)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 188.147459 "U813P92ZW419 O2" "[(M+H)-(H2)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 118.5879325 "U913P92ZW424 O4" "[(M+2H)+(HCOOH)]++ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 118.5879325 "U913P92ZW424 O4" "[(M+2H)+(HCOOH)]++ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 187.144104 "P92Z9W419 O2" "[(M+H)-(H2)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 187.144104 "P92Z9W419 O2" "[(M+H)-(H2)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 102.127725 "P9Z6W416 O0" "[(M+H)-(J15L3M6O2)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 102.127725 "P9Z6W416 O0" "[(M+H)-(J15L3M6O2)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 212.145054 "U813P92ZW420 Na O2" "[(M+Na)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 212.145054 "U813P92ZW420 Na O2" "[(M+Na)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 192.167353 "U813P92ZW421 O 18O" "[(M+H)]+ (13C) (18O)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 192.167353 "U813P92ZW421 O 18O" "[(M+H)]+ (13C) (18O)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(NC3H9)-(HCOOH)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(NC3H9)-(HCOOH)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 112.07569 "P9Z6W410 O" "[(M+H)-(NC3H9)-(H2O)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 112.07569 "P9Z6W410 O" "[(M+H)-(NC3H9)-(H2O)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 100.112075 "P9Z6W414 O0" "[(M+H)-(C3H7O2N)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 100.112075 "P9Z6W414 O0" "[(M+H)-(C3H7O2N)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 247.118377 "U9H21 Cl N2 Na O2" "[(M+H)+(NaCl)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 247.118377 "U9H21 Cl N2 Na O2" "[(M+H)+(NaCl)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 191.166464 "U713P92Z2W421 O2" "[(M+H)]+ (13C2)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 191.166464 "U713P92Z2W421 O2" "[(M+H)]+ (13C2)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 269.100322 "U9H20 Cl N2 Na2 O2" "[(M+Na)+(NaCl)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 269.100322 "U9H20 Cl N2 Na2 O2" "[(M+Na)+(NaCl)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 72.080775 "P92Z8W420 O0" "[(M+2H)-(HCOOH)]++" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 72.080775 "P92Z8W420 O0" "[(M+2H)-(HCOOH)]++" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 211.141699 "P92Z9W420 Na O2" "[(M+Na)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 211.141699 "P92Z9W420 Na O2" "[(M+Na)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 189.159754 "P92Z9W421 O2" "[(M+H)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 189.159754 "P92Z9W421 O2" "[(M+H)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 171.149189 "P92Z9W419 O" "[(M+H)-(H2O)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 171.149189 "P92Z9W419 O" "[(M+H)-(H2O)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 270.103677 "U813C H20 Cl N2 Na2 O2" "[(M+Na)+(NaCl)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 270.103677 "U813C H20 Cl N2 Na2 O2" "[(M+Na)+(NaCl)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 191.163998 "P92Z9W421 O 18O" "[(M+H)]+ (18O)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 191.163998 "P92Z9W421 O 18O" "[(M+H)]+ (18O)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)-(NC3H9)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 130.086255 "P9Z6W412 O2" "[(M+H)-(NC3H9)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 95.083515 "P92Z9W422 O2" "[(M+2H)]++" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 95.083515 "P92Z9W422 O2" "[(M+2H)]++" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 152.0682 "P9Z6W411 Na O2" "[(M+Na)-(NC3H9)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 152.0682 "P9Z6W411 Na O2" "[(M+Na)-(NC3H9)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 378.315587 "U1713P94ZW441 O4" "[(2M+H)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 378.315587 "U1713P94ZW441 O4" "[(2M+H)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 377.312232 "P94Z18W441 O4" "[(2M+H)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 377.312232 "P94Z18W441 O4" "[(2M+H)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 72.5792925 "P9Z8W420 15N O0" "[(M+2H)-(HCOOH)]++ (15N)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 72.5792925 "P9Z8W420 15N O0" "[(M+2H)-(HCOOH)]++ (15N)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 271.097372 "U9H20 Cl0 37Cl N2 Na2 O2" "[(M+Na)+(NaCl)]+ (37Cl)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 271.097372 "U9H20 Cl0 37Cl N2 Na2 O2" "[(M+Na)+(NaCl)]+ (37Cl)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 73.08413 "U613P92Z2W420 O0" "[(M+2H)-(HCOOH)]++ (13C2)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 73.08413 "U613P92Z2W420 O0" "[(M+2H)-(HCOOH)]++ (13C2)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 190.156789 "P9Z9W421 15N O2" "[(M+H)]+ (15N)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 190.156789 "P9Z9W421 15N O2" "[(M+H)]+ (15N)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 379.318942 "U1613P94Z2W441 O4" "[(2M+H)]+ (13C2)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 379.318942 "U1613P94Z2W441 O4" "[(2M+H)]+ (13C2)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 143.154274 "P92Z8W419 O0" "[(M+H)-(HCOOH)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 143.154274 "P92Z8W419 O0" "[(M+H)-(HCOOH)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 72.5824525 "U713P92ZW420 O0" "[(M+2H)-(HCOOH)]++ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 72.5824525 "U713P92ZW420 O0" "[(M+2H)-(HCOOH)]++ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 249.115427 "U9H21 Cl0 37Cl N2 Na O2" "[(M+H)+(NaCl)]+ (37Cl)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 249.115427 "U9H21 Cl0 37Cl N2 Na O2" "[(M+H)+(NaCl)]+ (37Cl)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 172.152544 "U813P92ZW419 O" "[(M+H)-(H2O)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 172.152544 "U813P92ZW419 O" "[(M+H)-(H2O)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 248.121732 "U813C H21 Cl N2 Na O2" "[(M+H)+(NaCl)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 248.121732 "U813C H21 Cl N2 Na O2" "[(M+H)+(NaCl)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 400.297532 "U1713P94ZW440 Na O4" "[(2M+Na)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 400.297532 "U1713P94ZW440 Na O4" "[(2M+Na)]+ (13C)" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 399.294177 "P94Z18W440 Na O4" "[(2M+Na)]+" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 399.294177 "P94Z18W440 Na O4" "[(2M+Na)]+" "colpp" 0.77 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(NC3H9)-(HCOOH)]+ (13C)" "colzz" 9.46 "J120L9M62O2" 188.15248 "Chazamine" +34 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(NC3H9)-(HCOOH)]+ (13C)" "col12" 0.78 "J120L9M62O2" 188.15248 "Chazamine" +L17 "POS" 84.063729 "U313P92ZW47" "[(M+H)-(J15L2M6)]+ (13C)" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 83.060374 "P92Z4W47" "[(M+H)-(J15L2M6)]+" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.063729 "U313P92ZW47" "[(M+H)-(J15L2M6)]+ (13C)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.080775 "P9Z5W410" "[(M+H)-(J12LM62)]+" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.080775 "P9Z5W410" "[(M+H)-(J12LM62)]+" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 63.5549245 "P93Z6W413" "[(M+2H)]++" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 63.5549245 "P93Z6W413" "[(M+2H)]++" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 81.044724 "P92Z4W45" "[(M+H)-(J17L2M6)]+" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 148.084518 "P93Z6W411 Na" "[(M+Na)]+" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 148.084518 "P93Z6W411 Na" "[(M+Na)]+" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.068199 "P94Z8W416" "[(M+2H)+(CH3CN)]++" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.5698765 "U713P94ZW416" "[(M+2H)+(CH3CN)]++ (13C)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.5698765 "U713P94ZW416" "[(M+2H)+(CH3CN)]++ (13C)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.5667165 "P93Z8W416 15N" "[(M+2H)+(CH3CN)]++ (15N)" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.057409 "P9Z4W47 15N" "[(M+H)-(J15L2M6)]+ (15N)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 84.057409 "P9Z4W47 15N" "[(M+H)-(J15L2M6)]+ (15N)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 251.19787 "P96Z12W423" "[(2M+H)]+" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 252.201225 "U1113P96ZW423" "[(2M+H)]+ (13C)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 252.201225 "U1113P96ZW423" "[(2M+H)]+ (13C)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 206.043141 "U6H11 Cl N3 Na2" "[(M+Na)+(NaCl)]+" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 85.08413 "U413P9ZW410" "[(M+H)-(J12LM62)]+ (13C)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 85.08413 "U413P9ZW410" "[(M+H)-(J12LM62)]+ (13C)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 64.5582795 "U413P93Z2W413" "[(M+2H)]++ (13C2)" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 64.053442 "P92Z6W413 15N" "[(M+2H)]++ (15N)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 64.053442 "P92Z6W413 15N" "[(M+2H)]++ (15N)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 110.079379 "U513P92ZW49" "[(M+H)-(NH3)]+ (13C)" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 64.056602 "U513P93ZW413" "[(M+2H)]++ (13C)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 64.056602 "U513P93ZW413" "[(M+2H)]++ (13C)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 106.045674 "U313P92ZW46 Na" "[(M+Na)-(J15L2M6)]+ (13C)" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 208.040191 "U6H11 Cl0 37Cl N3 Na2" "[(M+Na)+(NaCl)]+ (37Cl)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 208.040191 "U6H11 Cl0 37Cl N3 Na2" "[(M+Na)+(NaCl)]+ (37Cl)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 127.099608 "P92Z6W412 15N" "[(M+H)]+ (15N)" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 105.042319 "P92Z4W46 Na" "[(M+Na)-(J15L2M6)]+" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 105.042319 "P92Z4W46 Na" "[(M+Na)-(J15L2M6)]+" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 126.102573 "P93Z6W412" "[(M+H)]+" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 127.105928 "U513P93ZW412" "[(M+H)]+ (13C)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 127.105928 "U513P93ZW412" "[(M+H)]+ (13C)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 109.076024 "P92Z6W49" "[(M+H)-(NH3)]+" "colpp" 0.77 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 128.109283 "U413P93Z2W412" "[(M+H)]+ (13C2)" "col12" 0.75 "J111L6M63" 125.0953 "Clafamine" +L17 "POS" 128.109283 "U413P93Z2W412" "[(M+H)]+ (13C2)" "somecol" 6.195 "J111L6M63" 125.0953 "Clafamine" +V101 "POS" 309.178479 "P92Z14W426 Na O4" "[(2M+Na)]+" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 309.178479 "P92Z14W426 Na O4" "[(2M+Na)]+" "colpp" 0.89 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 287.196534 "P92Z14W427 O4" "[(2M+H)]+" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 287.196534 "P92Z14W427 O4" "[(2M+H)]+" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 287.196534 "P92Z14W427 O4" "[(2M+H)]+" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 146.108615 "U513P9Z2W414 O2" "[(M+H)]+ (13C2)" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 309.178479 "P92Z14W426 Na O4" "[(2M+Na)]+" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 289.200778 "P92Z14W427 O3 18O" "[(2M+H)]+ (18O)" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 289.200778 "P92Z14W427 O3 18O" "[(2M+H)]+ (18O)" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 289.200778 "P92Z14W427 O3 18O" "[(2M+H)]+ (18O)" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(C3H6)]+" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 102.054955 "P9Z4W48 O2" "[(M+H)-(C3H6)]+" "colpp" 0.89 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 310.181834 "U1313P92ZW426 Na O4" "[(2M+Na)]+ (13C)" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 310.181834 "U1313P92ZW426 Na O4" "[(2M+Na)]+ (13C)" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 310.181834 "U1313P92ZW426 Na O4" "[(2M+Na)]+ (13C)" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 288.199889 "U1313P92ZW427 O4" "[(2M+H)]+ (13C)" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 288.199889 "U1313P92ZW427 O4" "[(2M+H)]+ (13C)" "colpp" 0.89 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 145.10526 "U613P9ZW414 O2" "[(M+H)]+ (13C)" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 145.10526 "U613P9ZW414 O2" "[(M+H)]+ (13C)" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 145.10526 "U613P9ZW414 O2" "[(M+H)]+ (13C)" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 167.087205 "U613P9ZW413 Na O2" "[(M+Na)]+ (13C)" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 167.087205 "U613P9ZW413 Na O2" "[(M+Na)]+ (13C)" "colpp" 0.89 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 98.096425 "P9Z6W412 O0" "[(M+H)-(HCOOH)]+" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 98.096425 "P9Z6W412 O0" "[(M+H)-(HCOOH)]+" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 98.096425 "P9Z6W412 O0" "[(M+H)-(HCOOH)]+" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(C2H4O2)]+" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 84.080775 "P9Z5W410 O0" "[(M+H)-(C2H4O2)]+" "colpp" 0.89 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 166.08385 "P9Z7W413 Na O2" "[(M+Na)]+" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 166.08385 "P9Z7W413 Na O2" "[(M+Na)]+" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 166.08385 "P9Z7W413 Na O2" "[(M+Na)]+" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(C2H4O2)]+ (13C)" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 85.08413 "U413P9ZW410 O0" "[(M+H)-(C2H4O2)]+ (13C)" "colpp" 0.89 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 168.088094 "P9Z7W413 Na O 18O" "[(M+Na)]+ (18O)" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 168.088094 "P9Z7W413 Na O 18O" "[(M+Na)]+ (18O)" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 168.088094 "P9Z7W413 Na O 18O" "[(M+Na)]+ (18O)" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 146.106149 "P9Z7W414 O 18O" "[(M+H)]+ (18O)" "colzz3" 2.49 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 146.106149 "P9Z7W414 O 18O" "[(M+H)]+ (18O)" "colpp" 0.89 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 144.101905 "P9Z7W414 O2" "[(M+H)]+" "colzz3" 2.19 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 144.101905 "P9Z7W414 O2" "[(M+H)]+" "col12" 0.94 "J113L7M6O2" 143.09463 "Ovomaltine" +V101 "POS" 144.101905 "P9Z7W414 O2" "[(M+H)]+" "somecol" 4.66 "J113L7M6O2" 143.09463 "Ovomaltine"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test-data/mz-input-small.tsv Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,31 @@ +mz +80.04959021 +82.04819461 +83.01343941 +84.05585475 +87.05536392 +89.50682004 +90.97680734 +92.98092987 +94.57331384 +97.07602789 +99.5429594 +101.0708987 +102.066292 +102.2845376 +104.0034256 +104.5317528 +105.4460999 +105.7271343 +106.0231437 +106.2399954 +106.5116177 +106.7629705 +106.9814579 +107.2424051 +107.4569385 +107.6884734 +107.9272908 +108.1575604 +109.0777249 +110.0599023
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/todf.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,34 @@ +source('tolst.R') + +# Convert a list of key/value lists or a list of objects into a data frame. Each key becomes a column. +# x The object to convert to data frame. Either a list of key/value lists, or a list of objects. +# rm_na_col If true, remove all columns that contain only NA values. +todf <- function(x, rm_na_col = FALSE) { + + df <- data.frame() + + # x not null ? + if ( ! is.null(x) && length(x) > 0) { + + # fill data frame + for (i in 1:length(x)) { + lst <- if (typeof(x[[i]]) == 'S4') tolst(x[[i]]) else x[[i]] + for (k in names(lst)) { + v <- x[[i]][[k]] + df[i , k] <- if (length(v) > 1) paste0(v, collapse = ';') else v + } + } + + # remove NA columns + if (rm_na_col) { + drop <- character() + for (col in names(df)) + if (all(is.na(df[[col]]))) + drop <- c(drop, col) + if (length(drop) > 0) + df <- df[, !(names(df) %in% drop)] + } + } + + return(df) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tolst.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,30 @@ +################## +# OBJECT TO LIST # +################## + +.object_to_list <- function(obj) { + + if(is.null(obj)) + return(NULL) + + field_names <- names(obj$getRefClass()$fields()) + l <- c() + lapply( field_names, function(x) { l<<-c(l,list(obj$field(x))) } ) + names(l) <- field_names + return(l) +} + +########### +# TO LIST # +########### + +tolst <- function(v) { + + switch(typeof(v), + S4 = lst <- .object_to_list(v), + list = lst <- v, + stop("Unknown type '", typeof(v), "'.") + ) + + return(lst) +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tostr.R Tue Jul 12 12:02:37 2016 -0400 @@ -0,0 +1,189 @@ +source("tolst.R") + +# Convert lists and objects to string representation. Supported outputs are: +# _ Text. +# _ PHP code. +# _ R code (to be done). + +########################## +# SET STRING TO VARIABLE # +########################## + +# str The value converted to a string. +# mode The mode to use. +# var Variable name. +.set_str_to_variable <- function(str, mode = 'txt', var = NA_character_) { + + # Add variable + switch(mode, + txt = { str <- paste(var, '=', str) }, + php = { str <- paste0('$', var, ' = ', str, ';') }, + stop("Unknown mode '", mode, "'.") + ) + + return(str) +} + +################ +# QUOTE VALUES # +################ + +# values A vector of values. +# mode The mode to use. +# keys If the vector contains keys of a dictionary structured (depending on the mode, they will be quoted or not). +.quote_values <- function(values, mode = 'txt', keys = FALSE) { + + if (mode == 'txt' && keys) + return(values) + + # Quote string values + # TODO escape quote characters + if (is.character(values)) + return(unlist(lapply(values, function(x) { paste0('"', x, '"') } ))) + + return(values) +} + +############ +# SET KEYS # +############ + +# values Vector or list of values. +# mode The mode to use. +.set_keys <- function(values, mode = 'txt') { + + if ( ! is.null(names(values))) { + keys <- names(values) + indices <- 1:length(values) + switch(mode, + txt = { values <- lapply(indices, function(x) paste( if (nchar(keys[[x]]) == 0) x else keys[[x]], '=>', values[[x]])) }, + php = { values <- lapply(names(values), function(x) paste0('"', if (nchar(keys[[x]]) == 0) x else keys[[x]], '"', ' => ', values[[x]])) }, + stop("Unknown mode '", mode, "'.") + ) + } + + return(values) +} + +############### +# JOIN VALUES # +############### + +# values Vector or list of values to join. +# mode The mode to use. +.join_values <- function(values, mode = 'txt') { + + switch(mode, + txt = { str <- paste0('(', paste(values, collapse = ', '), ')') }, + php = { str <- paste0('[', paste(values, collapse = ', '), ']') }, + stop("Unknown mode '", mode, "'.") + ) + + return(str) +} + +############### +# NULL TO STR # +############### + +# value The NULL or NA value, or the vector of length 0. +# mode The mode to use. +# var Variable name. +.null_to_str <- function(value, mode = 'txt', var = NA_character_) { + + # Set to 'null' string + switch(mode, + txt = { str <- if (length(value) > 0 && is.na(value)) 'NA' else 'null' }, + php = { str <- 'NULL' }, + stop("Unknown mode '", mode, "'.") + ) + + if ( ! is.null(var) && ! is.na(var)) + str <- .set_str_to_variable(str, mode, var) + + return(str) +} + +################ +# VALUE TO STR # +################ + +# TODO hide this function ? value_to_str -> .value_to_str + +# value The value to convert. +# mode The mode to use. +# var Variable name. +# lst If true, print the output as a list or array, even if it contains only one value. +.value_to_str <- function(value, mode = 'txt', var = NA_character_, lst = FALSE) { + + if (is.null(value) || (length(value) == 0 && ! lst) || (length(value) > 0 && is.na(value))) + return(.null_to_str(value, mode = mode, var = var)) + + # Transform value to a string + value <- .quote_values(value, mode = mode) + str <- if (length(value) == 1 && ! lst && is.null(names(value))) as.character(value) else .join_values(.set_keys(value, mode = mode), mode = mode) + + # Set to variable + if ( ! is.null(var) && ! is.na(var)) + str <- .set_str_to_variable(str, mode, var) + + return(str) +} + +############### +# LIST TO STR # +############### + +# vlist The list to convert. +# mode The mode to use. +# var Variable name. +# lst If true, print the output as a list or array, even if it contains only one value. +.list_to_str <- function(vlist, mode = 'txt', var = NA_character_, lst = FALSE) { + + if (is.null(vlist) || (length(vlist) == 0 && ! lst) || (length(vlist) > 0 && is.na(vlist))) + return(.null_to_str(vlist, mode = mode, var = var)) + + # + vstr <- character() + if (length(vlist) > 0) { + keys <- unlist(lapply(names(vlist), function(x) if (nchar(x) == 0) x else .quote_values(x, mode = mode, keys = TRUE))) + values <- lapply(vlist, function(x) tostr(x, mode = mode)) + sep <- switch(mode, + txt = '=>', + php = '=>', + stop("Unknown mode '", mode, "'.") + ) + vstr <- unlist(lapply(1:length(vlist), function(i) if (is.null(keys) || nchar(keys[i]) == 0) values[[i]] else paste(keys[i], sep, values[[i]]))) + } + + # Join string values + if (length(vstr) > 1 || lst || ! is.null(keys)) + str <- .join_values(vstr, mode = mode) + else + str <- vstr + + # Set to variable + if ( ! is.null(var) && ! is.na(var)) + str <- .set_str_to_variable(str, mode, var) + + return(str) +} + +########## +# TO STR # +########## + +# obj The object to convert. +# mode The mode to use. +# var Variable name. +# lst If true, print the output as a list or array, even if it contains only one value. +tostr <- function(obj, mode = 'txt', var = NA_character_, lst = FALSE) { + + switch(typeof(obj), + S4 = str <- tostr(tolst(obj), mode = mode, var = var, lst = lst), + list = str <- .list_to_str(obj, mode = mode, var = var, lst = lst), + str <- .value_to_str(obj, mode = mode, var = var, lst = lst) + ) + + return(str) +}