Mercurial > repos > prog > lcmsmatching
diff ChemspiderCompound.R @ 0:3afe41d3e9e7 draft
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit bb4d3e23d99828bfee16d31d794c49a17313ec2f
| author | prog |
|---|---|
| date | Mon, 11 Jul 2016 09:12:03 -0400 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ChemspiderCompound.R Mon Jul 11 09:12:03 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) + } +} +
