Mercurial > repos > prog > lcmsmatching

comparison BiodbEntry.R @ 2:20d69a062da3 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
author prog
date Thu, 02 Mar 2017 08:55:00 -0500
parents 253d531a0193
children
comparison
equal deleted inserted replaced
1:253d531a0193 2:20d69a062da3
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 VALUE #
25 ###################
26
27 BiodbEntry$methods( setFieldValue = function(field, value) {
28 .self$setField(field, value)
29 })
30 40
31 BiodbEntry$methods( setField = function(field, value) { 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
32 49
33 class = .self$getFieldClass(field) 50 .self$.fields[[field]] <- value
51 })
34 52
35 # Check cardinality 53 ###################
36 if (class != 'data.frame' && .self$getFieldCardinality(field) == BIODB.CARD.ONE && length(value) > 1) 54 # GET FIELD NAMES #
37 stop(paste0('Cannot set more that one value to single value field "', field, '" in BiodEntry.')) 55 ###################
38 56
39 # Check value class 57 BiodbEntry$methods( getFieldNames = function(field) {
40 value <- switch(class, 58 return(names(.self$.fields))
41 'character' = as.character(value), 59 })
42 'double' = as.double(value),
43 'integer' = as.integer(value),
44 'logical' = as.logical(value),
45 value)
46 # TODO check value class
47 60
48 .self$.fields[[field]] <- value 61 #############
49 }) 62 # HAS FIELD #
63 #############
50 64
51 ################### 65 BiodbEntry$methods( hasField = function(field) {
52 # GET FIELD NAMES # 66 return(field %in% names(.self$.fields))
53 ################### 67 })
54 68
55 BiodbEntry$methods( getFieldNames = function(field) { 69 ###################
56 return(names(.self$.fields)) 70 # GET FIELD CLASS #
57 }) 71 ###################
58 72
59 ################### 73 BiodbEntry$methods( getFieldClass = function(field) {
60 # GET FIELD CLASS #
61 ###################
62 74
63 BiodbEntry$methods( getFieldClass = function(field) { 75 if ( ! field %in% BIODB.FIELDS[['name']])
76 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
64 77
65 if ( ! field %in% BIODB.FIELDS[['name']]) 78 field.class <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'class']
66 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
67 79
68 field.class <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'class'] 80 return(field.class)
81 })
69 82
70 return(field.class) 83 #########################
71 }) 84 # FIELD HAS BASIC CLASS #
85 #########################
72 86
73 ######################### 87 BiodbEntry$methods( fieldHasBasicClass = function(field) {
74 # GET FIELD CARDINALITY # 88 return(.self$getFieldClass(field) %in% BIODB.BASIC.CLASSES)
75 ######################### 89 })
76
77 BiodbEntry$methods( getFieldCardinality = function(field) {
78 90
79 if ( ! field %in% BIODB.FIELDS[['name']]) 91 #########################
80 stop(paste0('Unknown field "', field, '" in BiodEntry.')) 92 # GET FIELD CARDINALITY #
93 #########################
81 94
82 field.card <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'cardinality'] 95 BiodbEntry$methods( getFieldCardinality = function(field) {
83 96
84 return(field.card) 97 if ( ! field %in% BIODB.FIELDS[['name']])
85 }) 98 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
86
87 ###################
88 # GET FIELD VALUE #
89 ###################
90
91 BiodbEntry$methods( getFieldValue = function(field) {
92 return(.self$getField(field))
93 })
94 99
95 BiodbEntry$methods( getField = function(field) { 100 field.card <- BIODB.FIELDS[which(field == BIODB.FIELDS[['name']]), 'cardinality']
96 101
97 if ( ! field %in% BIODB.FIELDS[['name']]) 102 return(field.card)
98 stop(paste0('Unknown field "', field, '" in BiodEntry.')) 103 })
99 104
100 if (field %in% names(.self$.fields)) 105 ###################
101 return(.self$.fields[[field]]) 106 # GET FIELD VALUE #
102 else if (.self$.compute.field(field)) 107 ###################
103 return(.self$.fields[[field]])
104 108
105 # Return NULL or NA 109 BiodbEntry$methods( getFieldValue = function(field, compute = TRUE) {
106 class = .self$getFieldClass(field)
107 return(if (class %in% c('character', 'integer', 'double', 'logical')) as.vector(NA, mode = class) else NULL)
108 })
109
110 #################
111 # COMPUTE FIELD #
112 ##################
113
114 BiodbEntry$methods( .compute.field = function(field) {
115 110
116 if ( ! is.null(.self$.factory) && field %in% names(BIODB.FIELD.COMPUTING)) { 111 if ( ! field %in% BIODB.FIELDS[['name']])
117 for (db in BIODB.FIELD.COMPUTING[[field]]) { 112 stop(paste0('Unknown field "', field, '" in BiodEntry.'))
118 db.id <- .self$getField(paste0(db, 'id')) 113
119 if ( ! is.na(db.id)) { 114 if (field %in% names(.self$.fields))
120 db.compound <- .self$.factory$createEntry(db, type = BIODB.COMPOUND, id = db.id) 115 return(.self$.fields[[field]])
121 if ( ! is.null(db.compound)) { 116 else if (compute && .self$.compute.field(field))
122 .self$setField(field, db.compound$getField(field)) 117 return(.self$.fields[[field]])
123 return(TRUE) 118
124 } 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)
125 } 138 }
126 } 139 }
127 } 140 }
141 }
128 142
129 return(FALSE) 143 return(FALSE)
130 }) 144 })
131
132 ############################
133 # GET FIELDS AS DATA FRAME #
134 ############################
135
136 BiodbEntry$methods( getFieldsAsDataFrame = function(field) {
137 145
138 df <- data.frame() 146 ############################
147 # GET FIELDS AS DATA FRAME #
148 ############################
149 ###TODO add a limiting option to get some fields.
150 BiodbEntry$methods( getFieldsAsDataFrame = function() {
151 df <- data.frame()
152 # Loop on all fields
153 for (f in names(.self$.fields))
139 154
140 # Loop on all fields 155 # If field class is a basic type
141 for (f in names(.self$.fields)) 156 if (.self$getFieldClass(f) %in% c('character', 'logical', 'integer', 'double') &
157 length(.self$getFieldValue(f)) == 1)
158 df[1, f] <- .self$getFieldValue(f)
142 159
143 # If field class is a basic type 160 return(df)
144 if (.self$getFieldClass(f) %in% c('character', 'logical', 'integer', 'double')) 161 })
145 df[1, f] <- .self$getFieldValue(f)
146 162
147 return(df) 163 ###########
148 }) 164 # FACTORY #
165 ###########
149 166
150 ########### 167 BiodbEntry$methods( setFactory = function(factory) {
151 # FACTORY # 168 is.null(factory) || inherits(factory, "BiodbFactory") || stop("The factory instance must inherit from BiodbFactory class.")
152 ########### 169 .factory <<- factory
153 170 })
154 BiodbEntry$methods( setFactory = function(factory) {
155 171
156 is.null(factory) || inherits(factory, "BiodbFactory") || stop("The factory instance must inherit from BiodbFactory class.") 172 ##############
157 .factory <<- factory 173 # DEPRECATED #
158 }) 174 ##############
159 } 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 })