annotate PubchemCompound.R @ 0:e66bb061af06 draft

planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit 3529b25417f8e1a5836474c9adec4b696d35099d-dirty

1 if ( ! exists('PubchemCompound')) { # Do not load again if already loaded
2 
3 	source('BiodbEntry.R')
4 
5 	#####################
6 	# CLASS DECLARATION #
7 	#####################
8 
9 	PubchemCompound <- setRefClass("PubchemCompound", contains = "BiodbEntry")
10 
11 	###########
12 	# FACTORY #
13 	###########
14 
15 	createPubchemCompoundFromXml <- function(contents, drop = TRUE) {
16 
17 		library(XML)
18 
19 		compounds <- list()
20 
21 		# Set XML namespace
22 		ns <- c(pubchem = "http://pubchem.ncbi.nlm.nih.gov/pug_view")
23 
24 		# Define xpath expressions
25 		xpath.expr <- character()
26 		xpath.expr[[RBIODB.ACCESSION]] <- "//pubchem:RecordType[text()='CID']/../pubchem:RecordNumber"
27 		xpath.expr[[RBIODB.INCHI]] <- "//pubchem:Name[text()='InChI']/../pubchem:StringValue"
28 		xpath.expr[[RBIODB.INCHIKEY]] <- "//pubchem:Name[text()='InChI Key']/../pubchem:StringValue"
29 
30 		for (content in contents) {
31 
32 			# Create instance
33 			compound <- PubchemCompound$new()
34 
35 			# Parse XML
36 			xml <-  xmlInternalTreeParse(content, asText = TRUE)
37 
38 			# Unknown compound
39 			fault <- xpathSApply(xml, "/pubchem:Fault", xmlValue, namespaces = ns)
40 			if (length(fault) == 0) {
41 
42 				# Test generic xpath expressions
43 				for (field in names(xpath.expr)) {
44 					v <- xpathSApply(xml, xpath.expr[[field]], xmlValue, namespaces = ns)
45 					if (length(v) > 0)
46 						compound$setField(field, v)
47 				}
48 
49 				# Get name
50 				name <- NA_character_
51 				tryCatch( { name <- xpathSApply(xml, "//pubchem:Name[text()='IUPAC Name']/../pubchem:StringValue", xmlValue, namespaces = ns) }, warning = function(w) {})
52 				if (is.na(name))
53 					tryCatch( { name <- xpathSApply(xml, "//pubchem:Name[text()='Record Title']/../pubchem:StringValue", xmlValue, namespaces = ns) }, warning = function(w) {})
54 				if ( ! is.na(name))
55 					compound$setField(RBIODB.NAME, name)
56 
57 			}
58 
59 			compounds <- c(compounds, compound)
60 		}
61 
62 		# Replace elements with no accession id by NULL
63 		compounds <- lapply(compounds, function(x) if (is.na(x$getField(RBIODB.ACCESSION))) NULL else x)
64 
65 		# If the input was a single element, then output a single object
66 		if (drop && length(contents) == 1)
67 			compounds <- compounds[[1]]
68 	
69 		return(compounds)
70 	}
71 }