|
0
|
1 # $Id: SimpleGOEngine.pm,v 1.3.2.6 2003/06/30 05:04:06 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Ontology::SimpleGOEngine
|
|
|
4 #
|
|
|
5 # Cared for by Christian M. Zmasek <czmasek@gnf.org> or <cmzmasek@yahoo.com>
|
|
|
6 #
|
|
|
7 # (c) Christian M. Zmasek, czmasek@gnf.org, 2002.
|
|
|
8 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
|
|
|
9 #
|
|
|
10 # You may distribute this module under the same terms as perl itself.
|
|
|
11 # Refer to the Perl Artistic License (see the license accompanying this
|
|
|
12 # software package, or see http://www.perl.com/language/misc/Artistic.html)
|
|
|
13 # for the terms under which you may use, modify, and redistribute this module.
|
|
|
14 #
|
|
|
15 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
|
|
16 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
|
|
17 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
18 #
|
|
|
19 # You may distribute this module under the same terms as perl itself
|
|
|
20
|
|
|
21 # POD documentation - main docs before the code
|
|
|
22
|
|
|
23 =head1 NAME
|
|
|
24
|
|
|
25 SimpleGOEngine - a Ontology Engine for GO implementing OntologyEngineI
|
|
|
26
|
|
|
27 =head1 SYNOPSIS
|
|
|
28
|
|
|
29 use Bio::Ontology::SimpleGOEngine;
|
|
|
30
|
|
|
31 my $parser = Bio::Ontology::SimpleGOEngine->new
|
|
|
32 ( -defs_file => "/home/czmasek/GO/GO.defs",
|
|
|
33 -files => ["/home/czmasek/GO/component.ontology",
|
|
|
34 "/home/czmasek/GO/function.ontology",
|
|
|
35 "/home/czmasek/GO/process.ontology"] );
|
|
|
36
|
|
|
37 my $engine = $parser->parse();
|
|
|
38
|
|
|
39 my $IS_A = Bio::Ontology::RelationshipType->get_instance( "IS_A" );
|
|
|
40 my $PART_OF = Bio::Ontology::RelationshipType->get_instance( "PART_OF" );
|
|
|
41
|
|
|
42
|
|
|
43 =head1 DESCRIPTION
|
|
|
44
|
|
|
45 Needs Graph.pm from CPAN.
|
|
|
46
|
|
|
47 =head1 FEEDBACK
|
|
|
48
|
|
|
49 =head2 Mailing Lists
|
|
|
50
|
|
|
51 User feedback is an integral part of the evolution of this and other
|
|
|
52 Bioperl modules. Send your comments and suggestions preferably to the
|
|
|
53 Bioperl mailing lists Your participation is much appreciated.
|
|
|
54
|
|
|
55 bioperl-l@bioperl.org - General discussion
|
|
|
56 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
57
|
|
|
58 =head2 Reporting Bugs
|
|
|
59
|
|
|
60 report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
61 the bugs and their resolution. Bug reports can be submitted via
|
|
|
62 email or the web:
|
|
|
63
|
|
|
64 bioperl-bugs@bio.perl.org
|
|
|
65 http://bugzilla.bioperl.org/
|
|
|
66
|
|
|
67 =head1 AUTHOR
|
|
|
68
|
|
|
69 Christian M. Zmasek
|
|
|
70
|
|
|
71 Email: czmasek@gnf.org or cmzmasek@yahoo.com
|
|
|
72
|
|
|
73 WWW: http://www.genetics.wustl.edu/eddy/people/zmasek/
|
|
|
74
|
|
|
75 Address:
|
|
|
76
|
|
|
77 Genomics Institute of the Novartis Research Foundation
|
|
|
78 10675 John Jay Hopkins Drive
|
|
|
79 San Diego, CA 92121
|
|
|
80
|
|
|
81 =head1 APPENDIX
|
|
|
82
|
|
|
83 The rest of the documentation details each of the object
|
|
|
84 methods. Internal methods are usually preceded with a _
|
|
|
85
|
|
|
86 =cut
|
|
|
87
|
|
|
88
|
|
|
89 # Let the code begin...
|
|
|
90
|
|
|
91
|
|
|
92
|
|
|
93 package Bio::Ontology::SimpleGOEngine;
|
|
|
94
|
|
|
95 use Graph::Directed;
|
|
|
96
|
|
|
97 use vars qw( @ISA );
|
|
|
98 use strict;
|
|
|
99 use Bio::Root::Root;
|
|
|
100 use Bio::Ontology::RelationshipType;
|
|
|
101 use Bio::Ontology::RelationshipFactory;
|
|
|
102 use Bio::Ontology::OntologyEngineI;
|
|
|
103
|
|
|
104 use constant TRUE => 1;
|
|
|
105 use constant FALSE => 0;
|
|
|
106 use constant IS_A => "IS_A";
|
|
|
107 use constant PART_OF => "PART_OF";
|
|
|
108 use constant TERM => "TERM";
|
|
|
109 use constant TYPE => "TYPE";
|
|
|
110 use constant ONTOLOGY => "ONTOLOGY";
|
|
|
111
|
|
|
112 @ISA = qw( Bio::Root::Root
|
|
|
113 Bio::Ontology::OntologyEngineI );
|
|
|
114
|
|
|
115
|
|
|
116
|
|
|
117 =head2 new
|
|
|
118
|
|
|
119 Title : new
|
|
|
120 Usage : $engine = Bio::Ontology::SimpleGOEngine->new()
|
|
|
121 Function: Creates a new SimpleGOEngine
|
|
|
122 Returns : A new SimpleGOEngine object
|
|
|
123 Args :
|
|
|
124
|
|
|
125 =cut
|
|
|
126
|
|
|
127 sub new {
|
|
|
128 my( $class, @args ) = @_;
|
|
|
129
|
|
|
130 my $self = $class->SUPER::new( @args );
|
|
|
131
|
|
|
132 $self->init();
|
|
|
133
|
|
|
134 return $self;
|
|
|
135 } # new
|
|
|
136
|
|
|
137
|
|
|
138
|
|
|
139 =head2 init
|
|
|
140
|
|
|
141 Title : init()
|
|
|
142 Usage : $engine->init();
|
|
|
143 Function: Initializes this Engine.
|
|
|
144 Returns :
|
|
|
145 Args :
|
|
|
146
|
|
|
147 =cut
|
|
|
148
|
|
|
149 sub init {
|
|
|
150 my ( $self ) = @_;
|
|
|
151
|
|
|
152 $self->{ "_is_a_relationship" } = Bio::Ontology::RelationshipType->get_instance( IS_A );
|
|
|
153 $self->{ "_part_of_relationship" } = Bio::Ontology::RelationshipType->get_instance( PART_OF );
|
|
|
154
|
|
|
155 $self->graph( Graph::Directed->new() );
|
|
|
156
|
|
|
157 # set defaults for the factories
|
|
|
158 $self->relationship_factory(Bio::Ontology::RelationshipFactory->new(
|
|
|
159 -type => "Bio::Ontology::Relationship"));
|
|
|
160
|
|
|
161 } # init
|
|
|
162
|
|
|
163
|
|
|
164
|
|
|
165 =head2 is_a_relationship
|
|
|
166
|
|
|
167 Title : is_a_relationship()
|
|
|
168 Usage : $IS_A = $engine->is_a_relationship();
|
|
|
169 Function: Returns a Bio::Ontology::RelationshipType object for "is-a"
|
|
|
170 relationships
|
|
|
171 Returns : Bio::Ontology::RelationshipType set to "IS_A"
|
|
|
172 Args :
|
|
|
173
|
|
|
174 =cut
|
|
|
175
|
|
|
176 sub is_a_relationship {
|
|
|
177 my ( $self, $value ) = @_;
|
|
|
178
|
|
|
179 if ( defined $value ) {
|
|
|
180 $self->throw( "Attempted to change immutable field" );
|
|
|
181 }
|
|
|
182
|
|
|
183 return $self->{ "_is_a_relationship" };
|
|
|
184 } # is_a_relationship
|
|
|
185
|
|
|
186
|
|
|
187
|
|
|
188 =head2 part_of_relationship
|
|
|
189
|
|
|
190 Title : part_of_relationship()
|
|
|
191 Usage : $PART_OF = $engine->part_of_relationship();
|
|
|
192 Function: Returns a Bio::Ontology::RelationshipType object for "part-of"
|
|
|
193 relationships
|
|
|
194 Returns : Bio::Ontology::RelationshipType set to "PART_OF"
|
|
|
195 Args :
|
|
|
196
|
|
|
197 =cut
|
|
|
198
|
|
|
199 sub part_of_relationship {
|
|
|
200 my ( $self, $value ) = @_;
|
|
|
201
|
|
|
202 if ( defined $value ) {
|
|
|
203 $self->throw( "Attempted to change immutable field" );
|
|
|
204 }
|
|
|
205
|
|
|
206 return $self->{ "_part_of_relationship" };
|
|
|
207 } # part_of_relationship
|
|
|
208
|
|
|
209
|
|
|
210
|
|
|
211
|
|
|
212 =head2 add_term
|
|
|
213
|
|
|
214 Title : add_term
|
|
|
215 Usage : $engine->add_term( $term_obj );
|
|
|
216 Function: Adds a Bio::Ontology::TermI to this engine
|
|
|
217 Returns : true if the term was added and false otherwise (e.g., if the
|
|
|
218 term already existed in the ontology engine)
|
|
|
219 Args : Bio::Ontology::TermI
|
|
|
220
|
|
|
221
|
|
|
222 =cut
|
|
|
223
|
|
|
224 sub add_term {
|
|
|
225 my ( $self, $term ) = @_;
|
|
|
226
|
|
|
227 return FALSE if $self->has_term( $term );
|
|
|
228
|
|
|
229 my $goid = $self->_get_id($term);
|
|
|
230
|
|
|
231 $self->graph()->add_vertex( $goid );
|
|
|
232 $self->graph()->set_attribute( TERM, $goid, $term );
|
|
|
233
|
|
|
234 return TRUE;
|
|
|
235
|
|
|
236 } # add_term
|
|
|
237
|
|
|
238
|
|
|
239
|
|
|
240 =head2 has_term
|
|
|
241
|
|
|
242 Title : has_term
|
|
|
243 Usage : $engine->has_term( $term );
|
|
|
244 Function: Checks whether this engine contains a particular term
|
|
|
245 Returns : true or false
|
|
|
246 Args : Bio::Ontology::TermI
|
|
|
247 or
|
|
|
248 erm identifier (e.g. "GO:0012345")
|
|
|
249
|
|
|
250
|
|
|
251 =cut
|
|
|
252
|
|
|
253 sub has_term {
|
|
|
254 my ( $self, $term ) = @_;
|
|
|
255 $term = $self->_get_id( $term );
|
|
|
256 if ( $self->graph()->has_vertex( $term ) ) {
|
|
|
257 return TRUE;
|
|
|
258 }
|
|
|
259 else {
|
|
|
260 return FALSE;
|
|
|
261 }
|
|
|
262
|
|
|
263 } # has_term
|
|
|
264
|
|
|
265
|
|
|
266
|
|
|
267 =head2 add_relationship
|
|
|
268
|
|
|
269 Title : add_relationship
|
|
|
270 Usage : $engine->add_relationship( $relationship );
|
|
|
271 $engine->add_relatioship( $subject_term, $predicate_term, $object_term, $ontology );
|
|
|
272 $engine->add_relatioship( $subject_id, $predicate_id, $object_id, $ontology);
|
|
|
273 Function: Adds a relationship to this engine
|
|
|
274 Returns : true if successfully added, false otherwise
|
|
|
275 Args : term id, Bio::Ontology::TermI (rel.type), term id, ontology
|
|
|
276 or
|
|
|
277 Bio::Ontology::TermI, Bio::Ontology::TermI (rel.type), Bio::Ontology::TermI, ontology
|
|
|
278 or
|
|
|
279 Bio::Ontology::RelationshipI
|
|
|
280
|
|
|
281 =cut
|
|
|
282
|
|
|
283 # term objs or term ids
|
|
|
284 sub add_relationship {
|
|
|
285 my ( $self, $child, $type, $parent, $ont ) = @_;
|
|
|
286
|
|
|
287 if ( scalar( @_ ) == 2 ) {
|
|
|
288 $self->_check_class( $child, "Bio::Ontology::RelationshipI" );
|
|
|
289 $type = $child->predicate_term();
|
|
|
290 $parent = $child->object_term();
|
|
|
291 $ont = $child->ontology();
|
|
|
292 $child = $child->subject_term();
|
|
|
293 }
|
|
|
294
|
|
|
295
|
|
|
296 $self->_check_class( $type, "Bio::Ontology::TermI" );
|
|
|
297
|
|
|
298 my $parentid = $self->_get_id( $parent );
|
|
|
299 my $childid = $self->_get_id( $child );
|
|
|
300
|
|
|
301 my $g = $self->graph();
|
|
|
302
|
|
|
303 $self->add_term($child) unless $g->has_vertex( $childid );
|
|
|
304 $self->add_term($parent) unless $g->has_vertex( $parentid );
|
|
|
305
|
|
|
306 # This prevents multi graphs.
|
|
|
307 if ( $g->has_edge( $parentid, $childid ) ) {
|
|
|
308 return FALSE;
|
|
|
309 }
|
|
|
310
|
|
|
311 $g->add_edge( $parentid, $childid );
|
|
|
312 $g->set_attribute( TYPE, $parentid, $childid, $type );
|
|
|
313 $g->set_attribute( ONTOLOGY, $parentid, $childid, $ont );
|
|
|
314
|
|
|
315 return TRUE;
|
|
|
316
|
|
|
317 } # add_relationship
|
|
|
318
|
|
|
319
|
|
|
320
|
|
|
321
|
|
|
322 =head2 get_relationships
|
|
|
323
|
|
|
324
|
|
|
325 Title : get_relationships
|
|
|
326 Usage : $engine->get_relationships( $term );
|
|
|
327 Function: Returns all relationships of a term, or all relationships in
|
|
|
328 the graph if no term is specified.
|
|
|
329 Returns : Relationship[]
|
|
|
330 Args : term id
|
|
|
331 or
|
|
|
332 Bio::Ontology::TermI
|
|
|
333
|
|
|
334 =cut
|
|
|
335
|
|
|
336 sub get_relationships {
|
|
|
337 my ( $self, $term ) = @_;
|
|
|
338
|
|
|
339 my $g = $self->graph();
|
|
|
340
|
|
|
341 # obtain the ID if term provided
|
|
|
342 my $termid;
|
|
|
343 if($term) {
|
|
|
344 $termid = $self->_get_id( $term );
|
|
|
345 # check for presence in the graph
|
|
|
346 if ( ! $g->has_vertex( $termid ) ) {
|
|
|
347 $self->throw( "no term with identifier \"$termid\" in ontology" );
|
|
|
348 }
|
|
|
349 }
|
|
|
350
|
|
|
351 # now build the relationships
|
|
|
352 my $relfact = $self->relationship_factory();
|
|
|
353 # we'll build the relationships from edges
|
|
|
354 my @rels = ();
|
|
|
355 my @edges = $g->edges($termid);
|
|
|
356 while(@edges) {
|
|
|
357 my $startid = shift(@edges);
|
|
|
358 my $endid = shift(@edges);
|
|
|
359 my $rel = $relfact->create_object(
|
|
|
360 -subject_term => $self->get_terms($endid),
|
|
|
361 -object_term => $self->get_terms($startid),
|
|
|
362 -predicate_term => $g->get_attribute(TYPE,
|
|
|
363 $startid, $endid),
|
|
|
364 -ontology => $g->get_attribute(ONTOLOGY,
|
|
|
365 $startid, $endid));
|
|
|
366 push( @rels, $rel );
|
|
|
367 }
|
|
|
368
|
|
|
369 return @rels;
|
|
|
370
|
|
|
371 } # get_relationships
|
|
|
372
|
|
|
373 =head2 get_all_relationships
|
|
|
374
|
|
|
375
|
|
|
376 Title : get_all_relationships
|
|
|
377 Usage : @rels = $engine->get_all_relationships();
|
|
|
378 Function: Returns all relationships in the graph.
|
|
|
379 Returns : Relationship[]
|
|
|
380 Args :
|
|
|
381
|
|
|
382 =cut
|
|
|
383
|
|
|
384 sub get_all_relationships {
|
|
|
385 return shift->get_relationships(@_);
|
|
|
386 } # get_all_relationships
|
|
|
387
|
|
|
388
|
|
|
389
|
|
|
390 =head2 get_predicate_terms
|
|
|
391
|
|
|
392 Title : get_predicate_terms
|
|
|
393 Usage : $engine->get_predicate_terms();
|
|
|
394 Function: Returns the types of relationships this engine contains
|
|
|
395 Returns : Bio::Ontology::RelationshipType[]
|
|
|
396 Args :
|
|
|
397
|
|
|
398
|
|
|
399 =cut
|
|
|
400
|
|
|
401 sub get_predicate_terms {
|
|
|
402 my ( $self ) = @_;
|
|
|
403
|
|
|
404 my @a = ( $self->is_a_relationship(),
|
|
|
405 $self->part_of_relationship() );
|
|
|
406
|
|
|
407 return @a;
|
|
|
408 } # get_predicate_terms
|
|
|
409
|
|
|
410
|
|
|
411
|
|
|
412
|
|
|
413 =head2 get_child_terms
|
|
|
414
|
|
|
415 Title : get_child_terms
|
|
|
416 Usage : $engine->get_child_terms( $term_obj, @rel_types );
|
|
|
417 $engine->get_child_terms( $term_id, @rel_types );
|
|
|
418 Function: Returns the children of this term
|
|
|
419 Returns : Bio::Ontology::TermI[]
|
|
|
420 Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType[]
|
|
|
421 or
|
|
|
422 term id, Bio::Ontology::RelationshipType[]
|
|
|
423
|
|
|
424 if NO Bio::Ontology::RelationshipType[] is indicated: children
|
|
|
425 of ALL types are returned
|
|
|
426
|
|
|
427 =cut
|
|
|
428
|
|
|
429 sub get_child_terms {
|
|
|
430 my ( $self, $term, @types ) = @_;
|
|
|
431
|
|
|
432 return $self->_get_child_parent_terms_helper( $term, TRUE, @types );
|
|
|
433
|
|
|
434 } # get_child_terms
|
|
|
435
|
|
|
436
|
|
|
437 =head2 get_descendant_terms
|
|
|
438
|
|
|
439 Title : get_descendant_terms
|
|
|
440 Usage : $engine->get_descendant_terms( $term_obj, @rel_types );
|
|
|
441 $engine->get_descendant_terms( $term_id, @rel_types );
|
|
|
442 Function: Returns the descendants of this term
|
|
|
443 Returns : Bio::Ontology::TermI[]
|
|
|
444 Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType[]
|
|
|
445 or
|
|
|
446 term id, Bio::Ontology::RelationshipType[]
|
|
|
447
|
|
|
448 if NO Bio::Ontology::RelationshipType[] is indicated: descendants
|
|
|
449 of ALL types are returned
|
|
|
450
|
|
|
451 =cut
|
|
|
452
|
|
|
453 sub get_descendant_terms {
|
|
|
454 my ( $self, $term, @types ) = @_;
|
|
|
455
|
|
|
456 my %ids = ();
|
|
|
457 my @ids = ();
|
|
|
458
|
|
|
459 $term = $self->_get_id( $term );
|
|
|
460
|
|
|
461 if ( ! $self->graph()->has_vertex( $term ) ) {
|
|
|
462 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
|
|
|
463 }
|
|
|
464
|
|
|
465 $self->_get_descendant_terms_helper( $term, \%ids, \@types );
|
|
|
466
|
|
|
467 while( ( my $id ) = each ( %ids ) ) {
|
|
|
468 push( @ids, $id );
|
|
|
469 }
|
|
|
470
|
|
|
471 return $self->get_terms( @ids );
|
|
|
472
|
|
|
473 } # get_descendant_terms
|
|
|
474
|
|
|
475
|
|
|
476
|
|
|
477
|
|
|
478 =head2 get_parent_terms
|
|
|
479
|
|
|
480 Title : get_parent_terms
|
|
|
481 Usage : $engine->get_parent_terms( $term_obj, @rel_types );
|
|
|
482 $engine->get_parent_terms( $term_id, @rel_types );
|
|
|
483 Function: Returns the parents of this term
|
|
|
484 Returns : Bio::Ontology::TermI[]
|
|
|
485 Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType[]
|
|
|
486 or
|
|
|
487 term id, Bio::Ontology::RelationshipType[]
|
|
|
488
|
|
|
489 if NO Bio::Ontology::RelationshipType[] is indicated: parents
|
|
|
490 of ALL types are returned
|
|
|
491
|
|
|
492 =cut
|
|
|
493
|
|
|
494 sub get_parent_terms {
|
|
|
495 my ( $self, $term, @types ) = @_;
|
|
|
496
|
|
|
497 return $self->_get_child_parent_terms_helper( $term, FALSE, @types );
|
|
|
498
|
|
|
499 } # get_parent_terms
|
|
|
500
|
|
|
501
|
|
|
502
|
|
|
503 =head2 get_ancestor_terms
|
|
|
504
|
|
|
505 Title : get_ancestor_terms
|
|
|
506 Usage : $engine->get_ancestor_terms( $term_obj, @rel_types );
|
|
|
507 $engine->get_ancestor_terms( $term_id, @rel_types );
|
|
|
508 Function: Returns the ancestors of this term
|
|
|
509 Returns : Bio::Ontology::TermI[]
|
|
|
510 Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType[]
|
|
|
511 or
|
|
|
512 term id, Bio::Ontology::RelationshipType[]
|
|
|
513
|
|
|
514 if NO Bio::Ontology::RelationshipType[] is indicated: ancestors
|
|
|
515 of ALL types are returned
|
|
|
516
|
|
|
517 =cut
|
|
|
518
|
|
|
519 sub get_ancestor_terms {
|
|
|
520 my ( $self, $term, @types ) = @_;
|
|
|
521
|
|
|
522 my %ids = ();
|
|
|
523 my @ids = ();
|
|
|
524
|
|
|
525 $term = $self->_get_id( $term );
|
|
|
526
|
|
|
527 if ( ! $self->graph()->has_vertex( $term ) ) {
|
|
|
528 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
|
|
|
529 }
|
|
|
530
|
|
|
531 $self->_get_ancestor_terms_helper( $term, \%ids, \@types );
|
|
|
532
|
|
|
533 while( ( my $id ) = each ( %ids ) ) {
|
|
|
534 push( @ids, $id );
|
|
|
535 }
|
|
|
536
|
|
|
537 return $self->get_terms( @ids );
|
|
|
538
|
|
|
539 } # get_ancestor_terms
|
|
|
540
|
|
|
541
|
|
|
542
|
|
|
543
|
|
|
544
|
|
|
545 =head2 get_leaf_terms
|
|
|
546
|
|
|
547 Title : get_leaf_terms
|
|
|
548 Usage : $engine->get_leaf_terms();
|
|
|
549 Function: Returns the leaf terms
|
|
|
550 Returns : Bio::Ontology::TermI[]
|
|
|
551 Args :
|
|
|
552
|
|
|
553 =cut
|
|
|
554
|
|
|
555 sub get_leaf_terms {
|
|
|
556 my ( $self ) = @_;
|
|
|
557
|
|
|
558 my @a = $self->graph()->sink_vertices();
|
|
|
559
|
|
|
560 return $self->get_terms( @a );
|
|
|
561
|
|
|
562 }
|
|
|
563
|
|
|
564
|
|
|
565
|
|
|
566 =head2 get_root_terms()
|
|
|
567
|
|
|
568 Title : get_root_terms
|
|
|
569 Usage : $engine->get_root_terms();
|
|
|
570 Function: Returns the root terms
|
|
|
571 Returns : Bio::Ontology::TermI[]
|
|
|
572 Args :
|
|
|
573
|
|
|
574 =cut
|
|
|
575
|
|
|
576 sub get_root_terms {
|
|
|
577 my ( $self ) = @_;
|
|
|
578
|
|
|
579
|
|
|
580 my @a = $self->graph()->source_vertices();
|
|
|
581
|
|
|
582 return $self->get_terms( @a );
|
|
|
583
|
|
|
584 }
|
|
|
585
|
|
|
586
|
|
|
587 =head2 get_terms
|
|
|
588
|
|
|
589 Title : get_terms
|
|
|
590 Usage : @terms = $engine->get_terms( "GO:1234567", "GO:2234567" );
|
|
|
591 Function: Returns term objects with given identifiers
|
|
|
592 Returns : Bio::Ontology::TermI[], or the term corresponding to the
|
|
|
593 first identifier if called in scalar context
|
|
|
594 Args : term ids[]
|
|
|
595
|
|
|
596
|
|
|
597 =cut
|
|
|
598
|
|
|
599 sub get_terms {
|
|
|
600 my ( $self, @ids ) = @_;
|
|
|
601
|
|
|
602 my @terms = ();
|
|
|
603
|
|
|
604 foreach my $id ( @ids ) {
|
|
|
605 if ( $self->graph()->has_vertex( $id ) ) {
|
|
|
606 push( @terms, $self->graph()->get_attribute( TERM, $id ) );
|
|
|
607 }
|
|
|
608 }
|
|
|
609
|
|
|
610 return wantarray ? @terms : shift(@terms);
|
|
|
611
|
|
|
612 } # get_terms
|
|
|
613
|
|
|
614
|
|
|
615 =head2 get_all_terms
|
|
|
616
|
|
|
617 Title : get_all_terms
|
|
|
618 Usage : $engine->get_all_terms();
|
|
|
619 Function: Returns all terms in this engine
|
|
|
620 Returns : Bio::Ontology::TermI[]
|
|
|
621 Args :
|
|
|
622
|
|
|
623 =cut
|
|
|
624
|
|
|
625 sub get_all_terms {
|
|
|
626 my ( $self ) = @_;
|
|
|
627
|
|
|
628 return( $self->get_terms( $self->graph()->vertices() ) );
|
|
|
629
|
|
|
630 } # get_all_terms
|
|
|
631
|
|
|
632
|
|
|
633 =head2 find_terms
|
|
|
634
|
|
|
635 Title : find_terms
|
|
|
636 Usage : ($term) = $oe->find_terms(-identifier => "SO:0000263");
|
|
|
637 Function: Find term instances matching queries for their attributes.
|
|
|
638
|
|
|
639 This implementation can efficiently resolve queries by
|
|
|
640 identifier.
|
|
|
641
|
|
|
642 Example :
|
|
|
643 Returns : an array of zero or more Bio::Ontology::TermI objects
|
|
|
644 Args : Named parameters. The following parameters should be recognized
|
|
|
645 by any implementations:
|
|
|
646
|
|
|
647 -identifier query by the given identifier
|
|
|
648 -name query by the given name
|
|
|
649
|
|
|
650
|
|
|
651 =cut
|
|
|
652
|
|
|
653 sub find_terms{
|
|
|
654 my ($self,@args) = @_;
|
|
|
655 my @terms;
|
|
|
656
|
|
|
657 my ($id,$name) = $self->_rearrange([qw(IDENTIFIER NAME)],@args);
|
|
|
658
|
|
|
659 if(defined($id)) {
|
|
|
660 @terms = $self->get_terms($id);
|
|
|
661 } else {
|
|
|
662 @terms = $self->get_all_terms();
|
|
|
663 }
|
|
|
664 if(defined($name)) {
|
|
|
665 @terms = grep { $_->name() eq $name; } @terms;
|
|
|
666 }
|
|
|
667 return @terms;
|
|
|
668 }
|
|
|
669
|
|
|
670 =head2 relationship_factory
|
|
|
671
|
|
|
672 Title : relationship_factory
|
|
|
673 Usage : $fact = $obj->relationship_factory()
|
|
|
674 Function: Get/set the object factory to be used when relationship
|
|
|
675 objects are created by the implementation on-the-fly.
|
|
|
676
|
|
|
677 Example :
|
|
|
678 Returns : value of relationship_factory (a Bio::Factory::ObjectFactoryI
|
|
|
679 compliant object)
|
|
|
680 Args : on set, a Bio::Factory::ObjectFactoryI compliant object
|
|
|
681
|
|
|
682
|
|
|
683 =cut
|
|
|
684
|
|
|
685 sub relationship_factory{
|
|
|
686 my $self = shift;
|
|
|
687
|
|
|
688 return $self->{'relationship_factory'} = shift if @_;
|
|
|
689 return $self->{'relationship_factory'};
|
|
|
690 }
|
|
|
691
|
|
|
692 =head2 term_factory
|
|
|
693
|
|
|
694 Title : term_factory
|
|
|
695 Usage : $fact = $obj->term_factory()
|
|
|
696 Function: Get/set the object factory to be used when term objects are
|
|
|
697 created by the implementation on-the-fly.
|
|
|
698
|
|
|
699 Note that this ontology engine implementation does not
|
|
|
700 create term objects on the fly, and therefore setting this
|
|
|
701 attribute is meaningless.
|
|
|
702
|
|
|
703 Example :
|
|
|
704 Returns : value of term_factory (a Bio::Factory::ObjectFactoryI
|
|
|
705 compliant object)
|
|
|
706 Args : on set, a Bio::Factory::ObjectFactoryI compliant object
|
|
|
707
|
|
|
708
|
|
|
709 =cut
|
|
|
710
|
|
|
711 sub term_factory{
|
|
|
712 my $self = shift;
|
|
|
713
|
|
|
714 if(@_) {
|
|
|
715 $self->warn("setting term factory, but ".ref($self).
|
|
|
716 " does not create terms on-the-fly");
|
|
|
717 return $self->{'term_factory'} = shift;
|
|
|
718 }
|
|
|
719 return $self->{'term_factory'};
|
|
|
720 }
|
|
|
721
|
|
|
722 =head2 graph
|
|
|
723
|
|
|
724 Title : graph()
|
|
|
725 Usage : $engine->graph();
|
|
|
726 Function: Returns the Graph this engine is based on
|
|
|
727 Returns : Graph
|
|
|
728 Args :
|
|
|
729
|
|
|
730 =cut
|
|
|
731
|
|
|
732 sub graph {
|
|
|
733 my ( $self, $value ) = @_;
|
|
|
734
|
|
|
735 if ( defined $value ) {
|
|
|
736 $self->_check_class( $value, "Graph::Directed" );
|
|
|
737 $self->{ "_graph" } = $value;
|
|
|
738 }
|
|
|
739
|
|
|
740 return $self->{ "_graph" };
|
|
|
741 } # graph
|
|
|
742
|
|
|
743
|
|
|
744
|
|
|
745 # Internal methods
|
|
|
746 # ----------------
|
|
|
747
|
|
|
748
|
|
|
749 # Checks the correct format of a GOBO-formatted id
|
|
|
750 # Gets the id out of a term or id string
|
|
|
751 sub _get_id {
|
|
|
752 my ( $self, $term ) = @_;
|
|
|
753
|
|
|
754 if(ref($term)) {
|
|
|
755 return $term->GO_id() if $term->isa("Bio::Ontology::GOterm");
|
|
|
756 # if not a GOterm, use standard API
|
|
|
757 $self->throw("Object doesn't implement Bio::Ontology::TermI. ".
|
|
|
758 "Bummer.")
|
|
|
759 unless $term->isa("Bio::Ontology::TermI");
|
|
|
760 $term = $term->identifier();
|
|
|
761 }
|
|
|
762 # don't fuss if it looks remotely standard
|
|
|
763 return $term if $term =~ /^[A-Z]{1,8}:\d{3,}$/;
|
|
|
764 # prefix with something if only numbers
|
|
|
765 if($term =~ /^\d+$/) {
|
|
|
766 $self->warn(ref($self).": identifier [$term] is only numbers - ".
|
|
|
767 "prefixing with 'GO:'");
|
|
|
768 return "GO:" . $term;
|
|
|
769 }
|
|
|
770 # we shouldn't have gotten here if it's at least a remotely decent ID
|
|
|
771 $self->warn(ref($self).
|
|
|
772 ": Are you sure '$term' is a valid identifier? ".
|
|
|
773 "If you see problems, this may be the cause.");
|
|
|
774 return $term;
|
|
|
775 } # _get_id
|
|
|
776
|
|
|
777
|
|
|
778 # Helper for getting children and parent terms
|
|
|
779 sub _get_child_parent_terms_helper {
|
|
|
780 my ( $self, $term, $do_get_child_terms, @types ) = @_;
|
|
|
781
|
|
|
782 foreach my $type ( @types ) {
|
|
|
783 $self->_check_class( $type, "Bio::Ontology::TermI" );
|
|
|
784 }
|
|
|
785
|
|
|
786 my @relative_terms = ();
|
|
|
787
|
|
|
788 $term = $self->_get_id( $term );
|
|
|
789 if ( ! $self->graph()->has_vertex( $term ) ) {
|
|
|
790 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
|
|
|
791 }
|
|
|
792
|
|
|
793 my @all_relative_terms = ();
|
|
|
794 if ( $do_get_child_terms ) {
|
|
|
795 @all_relative_terms = $self->graph()->successors( $term );
|
|
|
796 }
|
|
|
797 else {
|
|
|
798 @all_relative_terms = $self->graph()->predecessors( $term );
|
|
|
799 }
|
|
|
800
|
|
|
801 foreach my $relative ( @all_relative_terms ) {
|
|
|
802 if ( scalar( @types ) > 0 ) {
|
|
|
803 foreach my $type ( @types ) {
|
|
|
804 my $relative_type;
|
|
|
805 if ( $do_get_child_terms ) {
|
|
|
806 $relative_type = $self->graph()->get_attribute( TYPE, $term, $relative );
|
|
|
807 }
|
|
|
808 else {
|
|
|
809 $relative_type = $self->graph()->get_attribute( TYPE, $relative, $term );
|
|
|
810 }
|
|
|
811 if ( $relative_type->equals( $type ) ) {
|
|
|
812 push( @relative_terms, $relative );
|
|
|
813 }
|
|
|
814 }
|
|
|
815 }
|
|
|
816 else {
|
|
|
817 push( @relative_terms, $relative );
|
|
|
818 }
|
|
|
819 }
|
|
|
820
|
|
|
821 return $self->get_terms( @relative_terms );
|
|
|
822
|
|
|
823 } # get_child_terms
|
|
|
824
|
|
|
825
|
|
|
826 # Recursive helper
|
|
|
827 sub _get_descendant_terms_helper {
|
|
|
828 my ( $self, $term, $ids_ref, $types_ref ) = @_;
|
|
|
829
|
|
|
830 my @child_terms = $self->get_child_terms( $term, @$types_ref );
|
|
|
831
|
|
|
832 if ( scalar( @child_terms ) < 1 ) {
|
|
|
833 return;
|
|
|
834 }
|
|
|
835
|
|
|
836 foreach my $child_term ( @child_terms ) {
|
|
|
837 my $child_term_id = $child_term->identifier();
|
|
|
838 $ids_ref->{ $child_term_id } = 0;
|
|
|
839 $self->_get_descendant_terms_helper( $child_term_id, $ids_ref, $types_ref );
|
|
|
840 }
|
|
|
841
|
|
|
842 } # _get_descendant_terms_helper
|
|
|
843
|
|
|
844
|
|
|
845 # Recursive helper
|
|
|
846 sub _get_ancestor_terms_helper {
|
|
|
847 my ( $self, $term, $ids_ref, $types_ref ) = @_;
|
|
|
848
|
|
|
849 my @parent_terms = $self->get_parent_terms( $term, @$types_ref );
|
|
|
850
|
|
|
851 if ( scalar( @parent_terms ) < 1 ) {
|
|
|
852 return;
|
|
|
853 }
|
|
|
854
|
|
|
855 foreach my $parent_term ( @parent_terms ) {
|
|
|
856 my $parent_term_id = $parent_term->identifier();
|
|
|
857 $ids_ref->{ $parent_term_id } = 0;
|
|
|
858 $self->_get_ancestor_terms_helper( $parent_term_id, $ids_ref, $types_ref );
|
|
|
859 }
|
|
|
860
|
|
|
861 } # get_ancestor_terms_helper
|
|
|
862
|
|
|
863
|
|
|
864
|
|
|
865 sub _check_class {
|
|
|
866 my ( $self, $value, $expected_class ) = @_;
|
|
|
867
|
|
|
868 if ( ! defined( $value ) ) {
|
|
|
869 $self->throw( "Found [undef] where [$expected_class] expected" );
|
|
|
870 }
|
|
|
871 elsif ( ! ref( $value ) ) {
|
|
|
872 $self->throw( "Found [scalar] where [$expected_class] expected" );
|
|
|
873 }
|
|
|
874 elsif ( ! $value->isa( $expected_class ) ) {
|
|
|
875 $self->throw( "Found [" . ref( $value ) . "] where [$expected_class] expected" );
|
|
|
876 }
|
|
|
877
|
|
|
878 } # _check_class
|
|
|
879
|
|
|
880
|
|
|
881 #################################################################
|
|
|
882 # aliases
|
|
|
883 #################################################################
|
|
|
884
|
|
|
885 *get_relationship_types = \&get_predicate_terms;
|
|
|
886
|
|
|
887
|
|
|
888 1;
|
