Mercurial > repos > prog > lcmsmatching
diff ChebiCompound.R @ 0:e66bb061af06 draft
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit 3529b25417f8e1a5836474c9adec4b696d35099d-dirty
author | prog |
---|---|
date | Tue, 12 Jul 2016 12:02:37 -0400 |
parents | |
children | 253d531a0193 |
line wrap: on
line diff
--- /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) + } +}