Mercurial > repos > prog > lcmsmatching
comparison ChebiEntry.R @ 2:20d69a062da3 draft
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit d4048accde6bdfd5b3e14f5394902d38991854f8
| author | prog | 
|---|---|
| date | Thu, 02 Mar 2017 08:55:00 -0500 | 
| parents | |
| children | 
   comparison
  equal
  deleted
  inserted
  replaced
| 1:253d531a0193 | 2:20d69a062da3 | 
|---|---|
| 1 ##################### | |
| 2 # CLASS DECLARATION # | |
| 3 ##################### | |
| 4 | |
| 5 ChebiEntry <- methods::setRefClass("ChebiEntry", contains = "BiodbEntry") | |
| 6 | |
| 7 ########### | |
| 8 # FACTORY # | |
| 9 ########### | |
| 10 | |
| 11 createChebiEntryFromHtml <- function(contents, drop = TRUE) { | |
| 12 | |
| 13 entries <- list() | |
| 14 | |
| 15 # Define xpath expressions | |
| 16 xpath.expr <- character() | |
| 17 # xpath.expr[[BIODB.ACCESSION]] <- "//b[starts-with(., 'CHEBI:')]" | |
| 18 xpath.expr[[BIODB.INCHI]] <- "//td[starts-with(., 'InChI=')]" | |
| 19 xpath.expr[[BIODB.INCHIKEY]] <- "//td[text()='InChIKey']/../td[2]" | |
| 20 | |
| 21 for (content in contents) { | |
| 22 | |
| 23 # Create instance | |
| 24 entry <- ChebiEntry$new() | |
| 25 | |
| 26 if ( ! is.null(content) && ! is.na(content)) { | |
| 27 | |
| 28 # Parse HTML | |
| 29 xml <- XML::htmlTreeParse(content, asText = TRUE, useInternalNodes = TRUE) | |
| 30 | |
| 31 # Test generic xpath expressions | |
| 32 for (field in names(xpath.expr)) { | |
| 33 v <- XML::xpathSApply(xml, xpath.expr[[field]], XML::xmlValue) | |
| 34 if (length(v) > 0) | |
| 35 entry$setField(field, v) | |
| 36 } | |
| 37 | |
| 38 # Get accession | |
| 39 accession <- XML::xpathSApply(xml, "//b[starts-with(., 'CHEBI:')]", XML::xmlValue) | |
| 40 if (length(accession) > 0) { | |
| 41 accession <- sub('^CHEBI:([0-9]+)$', '\\1', accession, perl = TRUE) | |
| 42 entry$setField(BIODB.ACCESSION, accession) | |
| 43 } | |
| 44 } | |
| 45 | |
| 46 entries <- c(entries, entry) | |
| 47 } | |
| 48 | |
| 49 # Replace elements with no accession id by NULL | |
| 50 entries <- lapply(entries, function(x) if (is.na(x$getField(BIODB.ACCESSION))) NULL else x) | |
| 51 | |
| 52 # If the input was a single element, then output a single object | |
| 53 if (drop && length(contents) == 1) | |
| 54 entries <- entries[[1]] | |
| 55 | |
| 56 return(entries) | |
| 57 } | 
