Mercurial > repos > prog > lcmsmatching

comparison BiodbEntry.R @ 1:45e985cd8e9e draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit d4048accde6bdfd5b3e14f5394902d38991854f8-dirty
author prog
date Tue, 31 Jan 2017 05:27:24 -0500
parents 3afe41d3e9e7
children
comparison
equal deleted inserted replaced
0:3afe41d3e9e7 1:45e985cd8e9e
1 if ( ! exists('BiodbEntry')) { # Do not load again if already loaded 1 #############
2 # CONSTANTS #
3 #############
2 4
3 source('biodb-common.R') 5 BIODB.BASIC.CLASSES <- c('character', 'integer', 'double', 'logical')
4 6
5 ######################## 7 ########################
6 # ENTRY ABSTRACT CLASS # 8 # ENTRY ABSTRACT CLASS #
7 ######################## 9 ########################
10
11 BiodbEntry <- methods::setRefClass("BiodbEntry", fields = list(.fields ='list', .factory = "ANY"))
12
13 ###############
14 # CONSTRUCTOR #
15 ###############
16
17 BiodbEntry$methods( initialize = function(...) {
18
19 .fields <<- list()
20 .factory <<- NULL
21
22 callSuper(...) # calls super-class initializer with remaining parameters
23 })
24
25 ###################
26 # SET FIELD VALUE #
27 ###################
28
29 BiodbEntry$methods( setFieldValue = function(field, value) {
30
31 class = .self$getFieldClass(field)
32
33 # Secific case to handle objects.
34 if ( class ==" object" & !(isS4(value) & methods::is(value, "refClass")))
35 stop(paste0('Cannot set a non RC instance to field "', field, '" in BiodEntry.'))
8 36
9 BiodbEntry <- setRefClass("BiodbEntry", fields = list(.fields ='list', .factory = "ANY")) 37 # Check cardinality
10 38 if (class != 'data.frame' && .self$getFieldCardinality(field) == BIODB.CARD.ONE && length(value) > 1)
11 ############### 39 stop(paste0('Cannot set more that one value to single value field "', field, '" in BiodEntry.'))
12 # CONSTRUCTOR #
13 ###############
14
15 BiodbEntry$methods( initialize = function(...) {
16
17 .fields <<- list()
18 .factory <<- NULL
19
20 callSuper(...) # calls super-class initializer with remaining parameters
21 })
22
23 #############
24 # SET FIELD #
25 #############
26
27 BiodbEntry$methods( setField = function(field, value) {
28 40
29 class = .self$getFieldClass(field) 41 # Check value class
42 value <- switch(class,
43 'character' = as.character(value),
44 'double' = as.double(value),
45 'integer' = as.integer(value),
46 'logical' = as.logical(value),
47 value)
48 # TODO check value class
30 49
31 # Check cardinality 50 .self$.fields[[field]] <- value
32 if (class != 'data.frame' && .self$getFieldCardinality(field) == RBIODB.CARD.ONE && length(value) > 1) 51 })
33 stop(paste0('Cannot set more that one value to single value field "', field, '" in BiodEntry.'))
34 52
35 # Check value class 53 ###################
36 value <- switch(class, 54 # GET FIELD NAMES #
37 'character' = as.character(value), 55 ###################
38 'double' = as.double(value),
39 'integer' = as.integer(value),
40 'logical' = as.logical(value),
41 value)
42 # TODO check value class
43 56
44 .self$.fields[[field]] <- value 57 BiodbEntry$methods( getFieldNames = function(field) {
45 }) 58 return(names(.self$.fields))
59 })
46 60
47 ################### 61 #############
48 # GET FIELD CLASS # 62 # HAS FIELD #
49 ################### 63 #############
50
51 BiodbEntry$methods( getFieldClass = function(field) {
52 64
53 if ( ! field %in% RBIODB.FIELDS[['name']]) 65 BiodbEntry$methods( hasField = function(field) {
54 stop(paste0('Unknown field "', field, '" in BiodEntry.')) 66 return(field %in% names(.self$.fields))
67 })
55 68
56 field.class <- RBIODB.FIELDS[which(field == RBIODB.FIELDS[['name']]), 'class'] 69 ###################
70 # GET FIELD CLASS #
71 ###################
57 72
58 return(field.class) 73 BiodbEntry$methods( getFieldClass = function(field) {
59 })
60 74
61 ######################### 75 if ( ! field %in% BIODB.FIELDS[['name']])
62 # GET FIELD CARDINALITY # 76 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
63 #########################
64
65 BiodbEntry$methods( getFieldCardinality = function(field) {
66 77
67 if ( ! field %in% RBIODB.FIELDS[['name']]) 78 field.class <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'class']
68 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
69 79
70 field.card <- RBIODB.FIELDS[which(field == RBIODB.FIELDS[['name']]), 'cardinality'] 80 return(field.class)
81 })
71 82
72 return(field.card) 83 #########################
73 }) 84 # FIELD HAS BASIC CLASS #
74 85 #########################
75 #############
76 # GET FIELD #
77 #############
78
79 BiodbEntry$methods( getField = function(field) {
80 86
81 if ( ! field %in% RBIODB.FIELDS[['name']]) 87 BiodbEntry$methods( fieldHasBasicClass = function(field) {
82 stop(paste0('Unknown field "', field, '" in BiodEntry.')) 88 return(.self$getFieldClass(field) %in% BIODB.BASIC.CLASSES)
89 })
83 90
84 if (field %in% names(.self$.fields)) 91 #########################
85 return(.self$.fields[[field]]) 92 # GET FIELD CARDINALITY #
86 else if (.self$.compute.field(field)) 93 #########################
87 return(.self$.fields[[field]])
88 94
89 # Return NULL or NA 95 BiodbEntry$methods( getFieldCardinality = function(field) {
90 class = .self$getFieldClass(field)
91 return(if (class %in% c('character', 'integer', 'double', 'logical')) as.vector(NA, mode = class) else NULL)
92 })
93
94 #################
95 # COMPUTE FIELD #
96 ##################
97
98 BiodbEntry$methods( .compute.field = function(field) {
99 96
100 if ( ! is.null(.self$.factory) && field %in% names(RBIODB.FIELD.COMPUTING)) { 97 if ( ! field %in% BIODB.FIELDS[['name']])
101 for (db in RBIODB.FIELD.COMPUTING[[field]]) { 98 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
102 db.id <- .self$getField(paste0(db, 'id')) 99
103 if ( ! is.na(db.id)) { 100 field.card <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'cardinality']
104 db.compound <- .self$.factory$createEntry(db, type = RBIODB.COMPOUND, id = db.id) 101
105 if ( ! is.null(db.compound)) { 102 return(field.card)
106 .self$setField(field, db.compound$getField(field)) 103 })
107 return(TRUE) 104
108 } 105 ###################
106 # GET FIELD VALUE #
107 ###################
108
109 BiodbEntry$methods( getFieldValue = function(field, compute = TRUE) {
110
111 if ( ! field %in% BIODB.FIELDS[['name']])
112 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
113
114 if (field %in% names(.self$.fields))
115 return(.self$.fields[[field]])
116 else if (compute && .self$.compute.field(field))
117 return(.self$.fields[[field]])
118
119 # Return NULL or NA
120 class = .self$getFieldClass(field)
121 return(if (class %in% BIODB.BASIC.CLASSES) as.vector(NA, mode = class) else NULL)
122 })
123
124 #################
125 # COMPUTE FIELD #
126 ##################
127
128 BiodbEntry$methods( .compute.field = function(field) {
129
130 if ( ! is.null(.self$.factory) && field %in% names(BIODB.FIELD.COMPUTING)) {
131 for (db in BIODB.FIELD.COMPUTING[[field]]) {
132 db.id <- .self$getField(paste0(db, 'id'))
133 if ( ! is.na(db.id)) {
134 db.entry <- .self$.factory$createEntry(db, id = db.id)
135 if ( ! is.null(db.entry)) {
136 .self$setField(field, db.entry$getField(field))
137 return(TRUE)
109 } 138 }
110 } 139 }
111 } 140 }
141 }
112 142
113 return(FALSE) 143 return(FALSE)
114 }) 144 })
115 145
116 ########### 146 ############################
117 # FACTORY # 147 # GET FIELDS AS DATA FRAME #
118 ########### 148 ############################
119 149 ###TODO add a limiting option to get some fields.
120 BiodbEntry$methods( setFactory = function(factory) { 150 BiodbEntry$methods( getFieldsAsDataFrame = function() {
151 df <- data.frame()
152 # Loop on all fields
153 for (f in names(.self$.fields))
121 154
122 is.null(factory) || inherits(factory, "BiodbFactory") || stop("The factory instance must inherit from BiodbFactory class.") 155 # If field class is a basic type
123 .factory <<- factory 156 if (.self$getFieldClass(f) %in% c('character', 'logical', 'integer', 'double') &
124 }) 157 length(.self$getFieldValue(f)) == 1)
125 } 158 df[1, f] <- .self$getFieldValue(f)
159
160 return(df)
161 })
162
163 ###########
164 # FACTORY #
165 ###########
166
167 BiodbEntry$methods( setFactory = function(factory) {
168 is.null(factory) || inherits(factory, "BiodbFactory") || stop("The factory instance must inherit from BiodbFactory class.")
169 .factory <<- factory
170 })
171
172 ##############
173 # DEPRECATED #
174 ##############
175
176 BiodbEntry$methods( getField = function(field) {
177 return(.self$getFieldValue(field))
178 })
179
180 BiodbEntry$methods( setField = function(field, value) {
181 .self$setFieldValue(field, value)
182 })