/[cl-godb]/cl-godb/graph.lisp
ViewVC logotype

Contents of /cl-godb/graph.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Mon Aug 15 18:59:31 2005 UTC (8 years, 8 months ago) by mantoniotti
Branch: NYUBIG, MAIN
CVS Tags: Start, HEAD
Changes since 1.1: +0 -0 lines
Initial import.
1 ;;; -*- Mode: Lisp -*-
2
3 ;;; graph.lisp --
4 ;;; Functions related to the manipulation of the GO taxonomies.
5
6 (in-package "GODB")
7
8 (eval-when (:compile-toplevel :load-toplevel :execute)
9 (require "sql")
10 (require "odbc"))
11
12
13 #.(sql:enable-sql-reader-syntax)
14
15 #|
16 (defvar +rel-is-a+ 2)
17 (defvar +rel-part-of+ 3)
18 |#
19
20 (defgeneric n-children (gh go-acc)
21 (:documentation "Counts the number of children the term has.
22 arguments: go handle, go-id
23 usage: (godb:n-children mygohandle ""GO:0000126"")
24 returns: int number of children that term has"))
25
26 (defgeneric n-parents (gh go-acc)
27 (:documentation "Counts the number of children the term has.
28 arguments: go handle, accession number
29 usage: (godb:get-child-relationships mygohandle ""GO:0000126"")
30 returns: List of objects of type relationship
31 notes:"))
32
33 (defgeneric get-child-relationships (gh go-acc)
34 (:documentation "Gets children for the input accession and returns an object of type
35 relationship for each child.
36 arguments: go handle, accession number
37 usage: (godb:get-child-relationships mygohandle ""GO:0000126"")
38 returns: List of objects of type relationship"))
39
40 (defgeneric get-parent-relationships (gh go-acc)
41 (:documentation "Gets parents for the input accession and returns an object of type
42 relationship for each parent.
43 arguments: go handle, accession number
44 usage: (godb:get-parent-relationships mygohandle ""GO:0000126"")
45 returns: list of objects of type relationship"))
46
47 (defgeneric get-relationships (gh go-acc)
48 (:documentation "This function calls get-child-relationships and get-parent-relationships
49 and then returns all relations.
50 arguments: go handle, accession number
51 usage: (godb:get-relationships mygohandle ""GO:0000126"")
52 returns: list of objects of type relationship"))
53
54 (defgeneric get-child-terms (gh go-acc)
55 (:documentation "Gets children for the input accession using is-a hierarchy and returns them as objects of type term.
56 arguments: go handle, accession
57 usage: (godb:get-child-terms mygohandle ""GO:0000124"")
58 returns: list of objects of type term
59 notes: This function finds the ids for all children of the input accession
60 then it checks if they are already in the hash table. If they are not,
61 they are then added. In both cases, the children slot of the parent's
62 term object is filled with a list of references to the childrens' term
63 objects."))
64
65
66 (defgeneric get-parent-terms (gh go-acc)
67 (:documentation "Gets parents for the input accession using is-a hierarchy and returns them as objects of type term.
68 arguments: go handle, accession
69 usage: (godb:get-parent-terms mygohandle ""GO:0000124"")
70 returns: list of objects of type term
71 notes: This function finds the ids for all parents of the input accession
72 then it checks if they are already in the hash table. If they are not,
73 they are then added. In both cases, the is-a slot of the child's
74 term object is filled with a list of references to the parents' term
75 objects."))
76
77 (defgeneric get-component-terms (gh go-acc)
78 (:documentation "Gets children for the input accession using part-of hierarchy and returns them as objects of type term.
79 arguments: go handle, accession
80 usage: (godb:get-component-terms mygohandle ""GO:0000124"")
81 returns: list of objects of type term
82 notes: This function finds the ids for all children of the input accession
83 then it checks if they are already in the hash table. If they are not,
84 they are then added. In both cases, the components slot of the parent's
85 term object is filled with a list of references to the childrens' term
86 objects."))
87
88
89 (defgeneric get-container-terms (gh go-acc)
90 (:documentation "Gets parents for the input accession using part-of hierarchy and returns them as objects of type term.
91 arguments: go handle, accession
92 usage: (godb:get-container-terms mygohandle ""GO:0000124"")
93 returns: list of objects of type term
94 notes: This function finds the ids for all parents of the input accession
95 then it checks if they are already in the hash table. If they are not,
96 they are then added. In both cases, the part-of slot of the child's
97 term object is filled with a list of references to the parents' term
98 objects."))
99
100
101 (defgeneric get-all-descendants (gh go-acc)
102 (:documentation "Gets children for the input accession using part-of hierarchy AND is-a hierarchy.
103 arguments: go handle, accession
104 usage: (godb:get-all-descendants mygohandle ""GO:0000124"")
105 returns: list of objects of type term"))
106
107
108 (defgeneric get-all-ancestors (gh go-acc)
109 (:documentation "Gets parents for the input accession using part-of hierarchy AND is-a hierarchy
110 arguments: go handle, accession
111 usage: (godb:get-all-ancestors mygohandle ""GO:0000124"")
112 returns: list of objects of type term"))
113
114
115 (defgeneric is-leaf-node (gh go-acc)
116 (:documentation "Checks whether the given accession is a leaf node or not.
117 arguments: go handle, go-id
118 usage: (godb:is-leaf-node gh go-id)
119 returns: T if it's a leaf node, NIL if it's not"))
120
121
122 (defgeneric ancestor-p (gh term1 term2)
123 (:documentation "Tests whether term2 is an ancestor of term1
124 arguments: go handle, object of type term, object of type term
125 usage: (godb:ancestor-p gh term1 term2)
126 returns: T or NIL"))
127
128 (defgeneric descendant-p (gh term1 term2)
129 (:documentation "Tests whether term1 is an descendant of term2
130 arguments: go handle, object of type term, object of type term
131 usage: (godb:descendant-p gh term1 term2)
132 returns: T or NIL"))
133
134
135 ;;;Methods
136
137 (defmethod n-children ((gh go-handle) (go-term term))
138
139 (n-children gh (accession go-term))
140 )
141
142 (defmethod n-children ((gh go-handle) (go-acc symbol))
143 (n-children gh (string go-acc))
144 )
145
146
147 (defmethod n-children ((gh go-handle) (go-acc string))
148 ;; counts children in is-a relationship
149 (let ((myterm (godb::get-term-by-acc gh go-acc)))
150 (when myterm
151 (if (children myterm)
152 (list-length (children myterm))
153 (let ((num (sql:select [count [*]]
154 :from '([term "PARENT"] [term2term] [term "CHILD"])
155 :where [and [= ["PARENT" acc] go-acc]
156 [= ["PARENT" id] [term2term.term1_id]]
157 [= ["CHILD" id] [term2term.term2_id]]
158 [= +rel-is-a+ [term2term.relationship_type_id]]])))
159 num)
160 ))))
161
162
163 (defmethod n-parents ((gh go-handle) (go-acc symbol))
164 (n-parents gh (string go-acc))
165 )
166
167 (defmethod n-parents ((gh go-handle) (go-acc string))
168 ;; counts parents in is-a relationship
169 (let ((myterm (godb::get-term-by-acc gh go-acc)))
170 (when myterm
171 (if (is-a myterm)
172 (list-length (is-a myterm))
173 (let ((num (sql:select [count [*]]
174 :from '([term "PARENT"] [term2term] [term "CHILD"])
175 :where [and [= ["CHILD" acc] go-acc]
176 [= ["PARENT" id] [term2term.term1_id]]
177 [= ["CHILD" id] [term2term.term2_id]]
178 [= +rel-is-a+ [term2term.relationship_type_id]]])))
179 num)
180 ))))
181
182
183
184 (defmethod get-child-relationships ((gh go-handle) (go-acc symbol))
185 (get-child-relationships gh (string go-acc))
186 )
187
188
189 (defmethod get-child-relationships ((gh go-handle) (go-acc string))
190 (let ((myterm (gethash (intern go-acc "GODB") (term-accession-index gh))))
191 (if myterm
192 (let ((kids nil))
193 (dolist (x (is-a myterm))
194 (if (gethash x (term-id-index gh))
195 (let ((kid-acc (accession (gethash x (term-id-index gh)))))
196 (let ((kid-acc (accession (godb:get-term gh x))))
197
198 (let ((new-relation (make-instance 'relationship
199 :acc1 go-acc
200 :acc2 kid-acc
201 :type +rel-is-a+)))
202 (push new-relation kids)))))kids))
203
204 (let ((children (sql:select [parent.acc] [child.acc] [term2term.relationship_type_id]
205 :from '([term "PARENT"] [term2term] [term "CHILD"])
206 :where [and [= ["PARENT" acc] go-acc]
207 [= ["PARENT" id] [term2term.term1_id]]
208 [= ["CHILD" id][term2term.term2_id]]
209 [= +rel-is-a+ [term2term.relationship_type_id]]])))
210 (when children
211 (let ((kids nil))
212 (dolist (x children)
213 (let ((new-relation (make-instance 'relationship
214 :acc1 (intern (first x) "GODB")
215 :acc2 (intern (nth 1 x) "GODB")
216 :type (nth 2 x))))
217 (push new-relation kids)))
218 kids))))))
219
220
221 (defmethod get-parent-relationships ((gh go-handle) (go-acc symbol))
222 (get-parent-relationships gh (string go-acc))
223 )
224
225 (defmethod get-parent-relationships ((gh go-handle) (go-acc string))
226 (let ((myterm (gethash (intern go-acc "GODB") (term-accession-index gh))))
227 (if myterm
228 (let ((parents nil))
229 (dolist (x (part-of myterm))
230 (if (gethash x (term-id-index gh))
231 (let ((par-acc (accession (gethash x (term-id-index gh)))))
232 (let ((par-acc (accession (godb:get-term gh x))))
233
234 (let ((new-relation (make-instance 'relationship
235 :acc1 (intern go-acc "GODB")
236 :acc2 par-acc
237 :type +rel-part-of+)))
238 (push new-relation parents))))) parents))
239
240
241 (let ((parents (sql:select [parent.acc] [child.acc] [term2term.relationship_type_id]
242 :from '([term "PARENT"] [term2term] [term "CHILD"])
243 :where [and [= ["CHILD" acc] go-acc]
244 [= ["CHILD" id] [term2term.term2_id]]
245 [= ["PARENT" id] [term2term.term1_id]]
246 [= +rel-is-a+ [term2term.relationship_type_id]]])))
247 (when parents
248 (let ((parlist nil))
249 (dolist (x parents)
250 (let ((new-relation (make-instance 'relationship
251 :acc1 (intern (first x) "GODB")
252 :acc2 (intern (nth 1 x) "GODB")
253 :type (nth 2 x))))
254 (push new-relation parlist)))
255 parlist))))))
256
257
258 (defmethod get-relationships ((gh go-handle) (go-acc symbol))
259 (get-relationships gh (string go-acc))
260 )
261
262 (defmethod get-relationships ((gh go-handle) (go-acc string))
263 (let* ((parents (get-parent-relationships gh go-acc))
264 (children (get-child-relationships gh go-acc)))
265 (format t "Parents: ~A ~%Children: ~A" parents children)
266 ))
267
268
269 (defmethod get-child-terms ((gh go-handle) (go-term term))
270 (get-child-terms gh (accession go-term)))
271
272
273 (defmethod get-child-terms ((gh go-handle) (go-acc symbol))
274 (get-child-terms gh (string go-acc)))
275
276
277 (defmethod get-child-terms ((gh go-handle) (go-acc string))
278 (let ((myterm (godb:get-term-by-acc gh go-acc)))
279 (when myterm
280 (if (children myterm)
281 (children myterm)
282 (let* ((kids nil)
283 (children-list (sql:select ["CHILD" id]
284 :from '([term "PARENT"] [term2term] [term "CHILD"])
285 :where [and [= ["PARENT" acc] go-acc]
286 [= ["PARENT" id] [term2term.term1_id]]
287 [= ["CHILD" id] [term2term.term2_id]]
288 [= +rel-is-a+ [term2term.relationship_type_id]]]
289 :flatp t)))
290 (dolist (x children-list)
291 (if (gethash x (term-id-index gh))
292 (push (gethash x (term-id-index gh)) kids)
293 (let ((rel (godb:get-term gh x)))
294 (push rel kids))))
295 (setf (children myterm) kids)
296 kids)))))
297
298
299 (defmethod get-parent-terms ((gh go-handle) (go-term term))
300 (get-parent-terms gh (accession go-term)))
301
302
303 (defmethod get-parent-terms ((gh go-handle) (go-acc symbol))
304 (get-parent-terms gh (string go-acc)))
305
306
307 (defmethod get-parent-terms ((gh go-handle) (go-acc string))
308 (let ((myterm (godb:get-term-by-acc gh go-acc)))
309 (when myterm
310 (if (is-a myterm)
311 (is-a myterm)
312 (let* ((parents nil)
313 (parent-list (sql:select ["PARENT" id]
314 :from '([term "PARENT"] [term2term] [term "CHILD"])
315 :where [and [= ["CHILD" acc] go-acc]
316 [= ["PARENT" id] [term2term.term1_id]]
317 [= ["CHILD" id] [term2term.term2_id]]
318 [= +rel-is-a+ [term2term.relationship_type_id]]]
319 :flatp t)))
320 (dolist (x parent-list)
321 (if (gethash x (term-id-index gh))
322 (push (gethash x (term-id-index gh)) parents)
323 (let ((rel (godb:get-term gh x)))
324 (push rel parents))))
325 (setf (is-a myterm) parents)
326 parents)))))
327
328 (defmethod get-container-terms ((gh go-handle) (go-term term))
329 (get-container-terms gh (accession go-term)))
330
331
332 (defmethod get-container-terms ((gh go-handle) (go-acc symbol))
333 (get-container-terms gh (string go-acc)))
334
335
336 (defmethod get-container-terms ((gh go-handle) (go-acc string))
337 (let ((myterm (godb:get-term-by-acc gh go-acc)))
338 (when myterm
339 (if (part-of myterm)
340 (part-of myterm)
341 (let* ((parents nil)
342 (parent-list (sql:select ["PARENT" id]
343 :from '([term "PARENT"] [term2term] [term "CHILD"])
344 :where [and [= ["CHILD" acc] go-acc]
345 [= ["PARENT" id] [term2term.term1_id]]
346 [= ["CHILD" id] [term2term.term2_id]]
347 [= +rel-part-of+ [term2term.relationship_type_id]]]
348 :flatp t)))
349 (dolist (x parent-list)
350 (if (gethash x (term-id-index gh))
351 (push (gethash x (term-id-index gh)) parents)
352 (let ((rel (godb:get-term gh x)))
353 (push rel parents))))
354 (setf (part-of myterm) parents)
355 parents)))))
356
357 (defmethod get-component-terms ((gh go-handle) (go-term term))
358 (get-component-terms gh (accession go-term)))
359
360
361 (defmethod get-component-terms ((gh go-handle) (go-acc symbol))
362 (get-component-terms gh (string go-acc)))
363
364
365 (defmethod get-component-terms ((gh go-handle) (go-acc string))
366 (let ((myterm (godb:get-term-by-acc gh go-acc)))
367 (when myterm
368 (if (components myterm)
369 (components myterm)
370 (let* ((p-children nil)
371 (p-list (sql:select ["CHILD" id]
372 :from '([term "PARENT"] [term2term] [term "CHILD"])
373 :where [and [= ["PARENT" acc] go-acc]
374 [= ["PARENT" id] [term2term.term1_id]]
375 [= ["CHILD" id] [term2term.term2_id]]
376 [= +rel-part-of+ [term2term.relationship_type_id]]]
377 :flatp t)))
378 (dolist (x p-list)
379 (if (gethash x (term-id-index gh))
380 (push (gethash x (term-id-index gh)) p-children)
381 (let ((rel (godb:get-term gh x)))
382 (push rel p-children))))
383 (setf (components myterm) p-children)
384 p-children)))))
385
386
387
388 (defmethod get-all-descendants ((gh go-handle) (go-term term))
389 (get-all-descendants gh (accession go-term)))
390
391 (defmethod get-all-descendants ((gh go-handle) (go-acc symbol))
392 (get-all-descendants gh (string go-acc)))
393
394 (defmethod get-all-descendants ((gh go-handle) (go-acc string))
395 (append (get-component-terms gh go-acc)
396 (get-child-terms gh go-acc)))
397
398
399 (defmethod get-all-ancestors ((gh go-handle) (go-term term))
400 (get-all-ancestors gh (accession go-term)))
401
402 (defmethod get-all-ancestors ((gh go-handle) (go-acc symbol))
403 (get-all-ancestors gh (string go-acc)))
404
405 (defmethod get-all-ancestors ((gh go-handle) (go-acc string))
406 (append (get-parent-terms gh go-acc)
407 (get-container-terms gh go-acc)))
408
409
410
411
412 (defmethod is-leaf-node ((gh go-handle) go-acc)
413 (if (get-child-terms gh go-acc)
414 NIL
415 T))
416
417
418
419 (defmethod ancestor-p ((gh go-handle) (term1 term) (term2 term))
420 ;; Checks if term 2 is an ancestor of term 1
421 ;; if is-a slot is empty, need to fill it
422 (let ((parent-list (get-parent-terms gh term2))))
423
424 (if (eq term1 term2)
425 t
426 (some #'(lambda (p) (ancestor-p gh term1 p)) (is-a term2))))
427
428 (defmethod descendant-p ((gh go-handle) (term1 term) (term2 term))
429 ;; Checks if term 1 is a descendant of term 2
430 ;; need to add check. If children slot is empty, fill it
431 (let ((child-list (godb:get-child-terms gh term2))))
432
433 (if (eq (term-id term1) (term-id term2))
434 t
435 (some #'(lambda (p) (descendant-p gh term1 p)) (children term2))))
436
437
438
439 (defun choose-leaves-from-set (gh term-set)
440 "Given a list of terms and a go handle, the function returns the terms
441 which are not parents of any of the others in the list."
442 (declare (type list term-set))
443 (let* ((leaves-set (make-hash-table))
444 (leaf-list nil))
445 ;; First fill the hash-table
446 (dolist (term term-set)
447 (setf (gethash (term-id term) leaves-set) term))
448
449 (dolist (term term-set)
450 (loop for l being the hash-values in leaves-set
451 using (hash-key l-id)
452 when (and (not (eq l term)) (descendant-p gh term l))
453 do (remhash l-id leaves-set)))
454 (loop for l being the hash-values in leaves-set
455 do (push l leaf-list))
456 leaf-list))
457
458
459 (defun count-all-nodes ()
460 "Returns the number of nodes."
461 (sql:select [count [*]] :from [|term|]))
462
463
464
465 #.(sql:disable-sql-reader-syntax)
466
467 ;;; end of file -- gograph.lisp --

  ViewVC Help
Powered by ViewVC 1.1.5