diff BiodbEntry.R @ 2:20d69a062da3 draft

planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit d4048accde6bdfd5b3e14f5394902d38991854f8

--- a/BiodbEntry.R	Sat Sep 03 17:02:01 2016 -0400
+++ b/BiodbEntry.R	Thu Mar 02 08:55:00 2017 -0500
@@ -1,159 +1,182 @@
-if ( ! exists('BiodbEntry')) { # Do not load again if already loaded
+#############
+# CONSTANTS #
+#############
+
+BIODB.BASIC.CLASSES <- c('character', 'integer', 'double', 'logical')
 
-	source('biodb-common.R')
+########################
+# ENTRY ABSTRACT CLASS #
+########################
+
+BiodbEntry <- methods::setRefClass("BiodbEntry", fields = list(.fields ='list', .factory = "ANY"))
+
+###############
+# CONSTRUCTOR #
+###############
 
-	########################
-	# ENTRY ABSTRACT CLASS #
-	########################
-	
-	BiodbEntry <- setRefClass("BiodbEntry", fields = list(.fields ='list', .factory = "ANY"))
-	
-	###############
-	# CONSTRUCTOR #
-	###############
-	
-	BiodbEntry$methods( initialize = function(...) {
-	
-		.fields <<- list()
-		.factory <<- NULL
-	
-		callSuper(...) # calls super-class initializer with remaining parameters
-	})
-	
-	###################
-	# SET FIELD VALUE #
-	###################
-	
-	BiodbEntry$methods(	setFieldValue = function(field, value) {
-		.self$setField(field, value)
-	})
+BiodbEntry$methods( initialize = function(...) {
+
+	.fields <<- list()
+	.factory <<- NULL
+
+	callSuper(...) # calls super-class initializer with remaining parameters
+})
+
+###################
+# SET FIELD VALUE #
+###################
+
+BiodbEntry$methods(	setFieldValue = function(field, value) {
+
+	class = .self$getFieldClass(field)
 
-	BiodbEntry$methods(	setField = function(field, value) {
-
-		class = .self$getFieldClass(field)
+	# Secific case to handle objects.
+	if ( class ==" object" & !(isS4(value) & methods::is(value, "refClass")))
+	  stop(paste0('Cannot set a non RC instance to field "', field, '" in BiodEntry.'))
+	
+	# Check cardinality
+	if (class != 'data.frame' && .self$getFieldCardinality(field) == BIODB.CARD.ONE && length(value) > 1)
+		stop(paste0('Cannot set more that one value to single value field "', field, '" in BiodEntry.'))
 
-		# Check cardinality
-		if (class != 'data.frame' && .self$getFieldCardinality(field) == BIODB.CARD.ONE && length(value) > 1)
-			stop(paste0('Cannot set more that one value to single value field "', field, '" in BiodEntry.'))
+	# Check value class
+	value <- switch(class,
+		   'character' = as.character(value),
+		   'double' = as.double(value),
+		   'integer' = as.integer(value),
+		   'logical' = as.logical(value),
+		   value)
+	# TODO check value class
 
-		# Check value class
-		value <- switch(class,
-		       'character' = as.character(value),
-		       'double' = as.double(value),
-		       'integer' = as.integer(value),
-		       'logical' = as.logical(value),
-		       value)
-		# TODO check value class
+	.self$.fields[[field]] <- value
+})
 
-		.self$.fields[[field]] <- value
-	})
+###################
+# GET FIELD NAMES #
+###################
 
-	###################
-	# GET FIELD NAMES #
-	###################
+BiodbEntry$methods(	getFieldNames = function(field) {
+	return(names(.self$.fields))
+})
 
-	BiodbEntry$methods(	getFieldNames = function(field) {
-		return(names(.self$.fields))
-	})
+#############
+# HAS FIELD #
+#############
 
-	###################
-	# GET FIELD CLASS #
-	###################
+BiodbEntry$methods(	hasField = function(field) {
+	return(field %in% names(.self$.fields))
+})
 
-	BiodbEntry$methods(	getFieldClass = function(field) {
+###################
+# GET FIELD CLASS #
+###################
 
-		if ( ! field %in% BIODB.FIELDS[['name']])
-			stop(paste0('Unknown field "', field, '" in BiodEntry.'))
+BiodbEntry$methods(	getFieldClass = function(field) {
 
-		field.class <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'class']
+	if ( ! field %in% BIODB.FIELDS[['name']])
+		stop(paste0('Unknown field "', field, '" in BiodEntry.'))
 
-		return(field.class)
-	})
+	field.class <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'class']
+
+	return(field.class)
+})
 
-	#########################
-	# GET FIELD CARDINALITY #
-	#########################
-	
-	BiodbEntry$methods(	getFieldCardinality = function(field) {
+#########################
+# FIELD HAS BASIC CLASS #
+#########################
+
+BiodbEntry$methods(	fieldHasBasicClass = function(field) {
+	return(.self$getFieldClass(field) %in% BIODB.BASIC.CLASSES)
+})
 
-		if ( ! field %in% BIODB.FIELDS[['name']])
-			stop(paste0('Unknown field "', field, '" in BiodEntry.'))
+#########################
+# GET FIELD CARDINALITY #
+#########################
 
-		field.card <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'cardinality']
+BiodbEntry$methods(	getFieldCardinality = function(field) {
+
+	if ( ! field %in% BIODB.FIELDS[['name']])
+		stop(paste0('Unknown field "', field, '" in BiodEntry.'))
+
+	field.card <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'cardinality']
 
-		return(field.card)
-	})
-	
-	###################
-	# GET FIELD VALUE #
-	###################
-	
-	BiodbEntry$methods(	getFieldValue = function(field) {
-		return(.self$getField(field))
-	})
+	return(field.card)
+})
+
+###################
+# GET FIELD VALUE #
+###################
 
-	BiodbEntry$methods(	getField = function(field) {
+BiodbEntry$methods(	getFieldValue = function(field, compute = TRUE) {
 
-		if ( ! field %in% BIODB.FIELDS[['name']])
-			stop(paste0('Unknown field "', field, '" in BiodEntry.'))
+	if ( ! field %in% BIODB.FIELDS[['name']])
+		stop(paste0('Unknown field "', field, '" in BiodEntry.'))
 
-		if (field %in% names(.self$.fields))
-			return(.self$.fields[[field]])
-		else if (.self$.compute.field(field))
-			return(.self$.fields[[field]])
+	if (field %in% names(.self$.fields))
+		return(.self$.fields[[field]])
+	else if (compute && .self$.compute.field(field))
+		return(.self$.fields[[field]])
 
-		# Return NULL or NA
-		class = .self$getFieldClass(field)
-		return(if (class %in% c('character', 'integer', 'double', 'logical')) as.vector(NA, mode = class) else NULL)
-	})
-	
-	#################
-	# COMPUTE FIELD #
-	##################
-	
-	BiodbEntry$methods(	.compute.field = function(field) {
+	# Return NULL or NA
+	class = .self$getFieldClass(field)
+	return(if (class %in% BIODB.BASIC.CLASSES) as.vector(NA, mode = class) else NULL)
+})
+
+#################
+# COMPUTE FIELD #
+##################
 
-		if ( ! is.null(.self$.factory) && field %in% names(BIODB.FIELD.COMPUTING)) {
-			for (db in BIODB.FIELD.COMPUTING[[field]]) {
-				db.id <- .self$getField(paste0(db, 'id'))
-				if ( ! is.na(db.id)) {
-					db.compound <- .self$.factory$createEntry(db, type = BIODB.COMPOUND, id = db.id)
-					if ( ! is.null(db.compound)) {
-						.self$setField(field, db.compound$getField(field))
-						return(TRUE)
-					}
+BiodbEntry$methods(	.compute.field = function(field) {
+
+	if ( ! is.null(.self$.factory) && field %in% names(BIODB.FIELD.COMPUTING)) {
+		for (db in BIODB.FIELD.COMPUTING[[field]]) {
+			db.id <- .self$getField(paste0(db, 'id'))
+			if ( ! is.na(db.id)) {
+				db.entry <- .self$.factory$createEntry(db, id = db.id)
+				if ( ! is.null(db.entry)) {
+					.self$setField(field, db.entry$getField(field))
+					return(TRUE)
 				}
 			}
 		}
+	}
 
-		return(FALSE)
-	})
-	
-	############################
-	# GET FIELDS AS DATA FRAME #
-	############################
-	
-	BiodbEntry$methods(	getFieldsAsDataFrame = function(field) {
+	return(FALSE)
+})
 
-		df <- data.frame()
+############################
+# GET FIELDS AS DATA FRAME #
+############################
+###TODO add a limiting option to get some fields.
+BiodbEntry$methods(	getFieldsAsDataFrame = function() {
+	df <- data.frame()
+	# Loop on all fields
+	for (f in names(.self$.fields))
 
-		# Loop on all fields
-		for (f in names(.self$.fields))
+		# If field class is a basic type
+		if (.self$getFieldClass(f) %in% c('character', 'logical', 'integer', 'double')  &
+			length(.self$getFieldValue(f)) == 1)
+			df[1, f] <- .self$getFieldValue(f)
 
-			# If field class is a basic type
-			if (.self$getFieldClass(f) %in% c('character', 'logical', 'integer', 'double'))
-				df[1, f] <- .self$getFieldValue(f)
+	return(df)
+})
 
-		return(df)
-	})
+###########
+# FACTORY #
+###########
+
+BiodbEntry$methods(	setFactory = function(factory) {
+	is.null(factory) || inherits(factory, "BiodbFactory") || stop("The factory instance must inherit from BiodbFactory class.")
+	.factory <<- factory
+})
 
-	###########
-	# FACTORY #
-	###########
-	
-	BiodbEntry$methods(	setFactory = function(factory) {
+##############
+# DEPRECATED #
+##############
 
-		is.null(factory) || inherits(factory, "BiodbFactory") || stop("The factory instance must inherit from BiodbFactory class.")
-		.factory <<- factory
-	})
-}
+BiodbEntry$methods(	getField = function(field) {
+	return(.self$getFieldValue(field))
+})
+
+BiodbEntry$methods(	setField = function(field, value) {
+	.self$setFieldValue(field, value)
+})