Mercurial > repos > prog > lcmsmatching
comparison 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 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:e66bb061af06 |
---|---|
1 if ( ! exists('ChebiCompound')) { # Do not load again if already loaded | |
2 | |
3 source('BiodbEntry.R') | |
4 | |
5 ##################### | |
6 # CLASS DECLARATION # | |
7 ##################### | |
8 | |
9 ChebiCompound <- setRefClass("ChebiCompound", contains = "BiodbEntry") | |
10 | |
11 ########### | |
12 # FACTORY # | |
13 ########### | |
14 | |
15 createChebiCompoundFromHtml <- function(contents, drop = TRUE) { | |
16 | |
17 library(XML) | |
18 | |
19 compounds <- list() | |
20 | |
21 # Define xpath expressions | |
22 xpath.expr <- character() | |
23 # xpath.expr[[RBIODB.ACCESSION]] <- "//b[starts-with(., 'CHEBI:')]" | |
24 xpath.expr[[RBIODB.INCHI]] <- "//td[starts-with(., 'InChI=')]" | |
25 xpath.expr[[RBIODB.INCHIKEY]] <- "//td[text()='InChIKey']/../td[2]" | |
26 | |
27 for (html in contents) { | |
28 | |
29 # Create instance | |
30 compound <- ChebiCompound$new() | |
31 | |
32 # Parse HTML | |
33 xml <- htmlTreeParse(html, asText = TRUE, useInternalNodes = TRUE) | |
34 | |
35 # Test generic xpath expressions | |
36 for (field in names(xpath.expr)) { | |
37 v <- xpathSApply(xml, xpath.expr[[field]], xmlValue) | |
38 if (length(v) > 0) | |
39 compound$setField(field, v) | |
40 } | |
41 | |
42 # Get accession | |
43 accession <- xpathSApply(xml, "//b[starts-with(., 'CHEBI:')]", xmlValue) | |
44 if (length(accession) > 0) { | |
45 accession <- sub('^CHEBI:([0-9]+)$', '\\1', accession, perl = TRUE) | |
46 compound$setField(RBIODB.ACCESSION, accession) | |
47 } | |
48 | |
49 compounds <- c(compounds, compound) | |
50 } | |
51 | |
52 # Replace elements with no accession id by NULL | |
53 compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x) | |
54 | |
55 # If the input was a single element, then output a single object | |
56 if (drop && length(contents) == 1) | |
57 compounds <- compounds[[1]] | |
58 | |
59 return(compounds) | |
60 } | |
61 } |