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)
+	}
+}