File Coverage

Bio/Ontology/OBOEngine.pm
Criterion Covered Total %
statement 263 288 91.3
branch 66 96 68.7
condition 10 21 47.6
subroutine 51 53 96.2
pod 31 31 100.0
total 421 489 86.0


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Ontology::OBOEngine
3             #
4             # POD documentation - main docs before the code
5              
6             =head1 NAME
7              
8             Bio::Ontology::OBOEngine - An Ontology Engine for OBO style flat file
9             format from the Gene Ontology Consortium
10              
11             =head1 SYNOPSIS
12              
13             use Bio::Ontology::OBOEngine;
14              
15             my $parser = Bio::Ontology::OBOEngine->new
16             ( -file => "gene_ontology.obo" );
17              
18             my $engine = $parser->parse();
19              
20             =head1 DESCRIPTION
21              
22             Needs Graph.pm from CPAN.
23              
24             This module replaces SimpleGOEngine.pm, which is deprecated.
25              
26             =head1 FEEDBACK
27              
28             =head2 Mailing Lists
29              
30             User feedback is an integral part of the evolution of this and other
31             Bioperl modules. Send your comments and suggestions preferably to the
32             Bioperl mailing lists Your participation is much appreciated.
33              
34             bioperl-l@bioperl.org - General discussion
35             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
36              
37             =head2 Support
38              
39             Please direct usage questions or support issues to the mailing list:
40              
41             I
42              
43             rather than to the module maintainer directly. Many experienced and
44             reponsive experts will be able look at the problem and quickly
45             address it. Please include a thorough description of the problem
46             with code and data examples if at all possible.
47              
48             =head2 Reporting Bugs
49              
50             Report bugs to the Bioperl bug tracking system to help us keep track
51             the bugs and their resolution. Bug reports can be submitted via
52             the web:
53              
54             https://github.com/bioperl/bioperl-live/issues
55              
56             =head1 AUTHOR
57              
58             Sohel Merchant
59              
60             Email: s-merchant@northwestern.edu
61              
62             Address:
63              
64             Northwestern University
65             Center for Genetic Medicine (CGM), dictyBase
66             Suite 1206,
67             676 St. Clair st
68             Chicago IL 60611
69              
70             =head2 CONTRIBUTOR
71              
72             Hilmar Lapp, hlapp at gmx.net
73             Chris Mungall, cjm at fruitfly.org
74              
75             =head1 APPENDIX
76              
77             The rest of the documentation details each of the object
78             methods. Internal methods are usually preceded with a _
79              
80             =cut
81              
82             package Bio::Ontology::OBOEngine;
83              
84 3     3   918 use Bio::Ontology::SimpleGOEngine::GraphAdaptor;
  3         6  
  3         66  
85              
86 3     3   15 use strict;
  3         5  
  3         46  
87 3     3   328 use Bio::Ontology::RelationshipType;
  3         5  
  3         77  
88 3     3   923 use Bio::Ontology::RelationshipFactory;
  3         8  
  3         68  
89 3     3   16 use Data::Dumper;
  3         5  
  3         133  
90              
91 3     3   14 use constant TRUE => 1;
  3         5  
  3         143  
92 3     3   14 use constant FALSE => 0;
  3         5  
  3         106  
93 3     3   13 use constant IS_A => "IS_A";
  3         5  
  3         102  
94 3     3   13 use constant PART_OF => "PART_OF";
  3         6  
  3         98  
95 3     3   12 use constant RELATED_TO => "RELATED_TO";
  3         4  
  3         106  
96 3     3   12 use constant TERM => "TERM";
  3         5  
  3         106  
97 3     3   14 use constant TYPE => "TYPE";
  3         5  
  3         98  
98 3     3   14 use constant ONTOLOGY => "ONTOLOGY";
  3         3  
  3         98  
99 3     3   11 use constant REGULATES => "REGULATES";
  3         7  
  3         119  
100 3     3   17 use constant POSITIVELY_REGULATES => "POSITIVELY_REGULATES";
  3         5  
  3         133  
101 3     3   14 use constant NEGATIVELY_REGULATES => "NEGATIVELY_REGULATES";
  3         3  
  3         114  
102              
103              
104 3     3   13 use base qw(Bio::Root::Root Bio::Ontology::OntologyEngineI);
  3         5  
  3         6989  
105              
106              
107              
108             =head2 new
109              
110             Title : new
111             Usage : $engine = Bio::Ontology::OBOEngine->new()
112             Function: Creates a new OBOEngine
113             Returns : A new OBOEngine object
114             Args :
115              
116             =cut
117              
118             sub new {
119 7     7 1 19 my( $class, @args ) = @_;
120              
121 7         29 my $self = $class->SUPER::new( @args );
122              
123 7         25 $self->init();
124              
125 7         22 return $self;
126             } # new
127              
128              
129              
130             =head2 init
131              
132             Title : init()
133             Usage : $engine->init();
134             Function: Initializes this Engine.
135             Returns :
136             Args :
137              
138             =cut
139              
140             sub init {
141 7     7 1 12 my ( $self ) = @_;
142              
143 7         45 $self->{ "_is_a_relationship" } = Bio::Ontology::RelationshipType->get_instance( IS_A );
144 7         19 $self->{ "_part_of_relationship" } = Bio::Ontology::RelationshipType->get_instance( PART_OF );
145 7         17 $self->{ "_related_to_relationship" } = Bio::Ontology::RelationshipType->get_instance( RELATED_TO );
146              
147 7         18 $self->{'_regulates_relationship'} = Bio::Ontology::RelationshipType->get_instance(REGULATES);
148 7         19 $self->{'_positively_regulate'} = Bio::Ontology::RelationshipType->get_instance(POSITIVELY_REGULATES);
149 7         21 $self->{'_negatively_regulate'} = Bio::Ontology::RelationshipType->get_instance(NEGATIVELY_REGULATES);
150            
151              
152 7         51 $self->graph( Bio::Ontology::SimpleGOEngine::GraphAdaptor->new() ); # NG 05-02-16
153              
154             # set defaults for the factories
155 7         52 $self->relationship_factory(Bio::Ontology::RelationshipFactory->new(
156             -type => "Bio::Ontology::Relationship"));
157              
158             } # init
159              
160              
161              
162             =head2 is_a_relationship
163              
164             Title : is_a_relationship()
165             Usage : $IS_A = $engine->is_a_relationship();
166             Function: Returns a Bio::Ontology::RelationshipType object for "is-a"
167             relationships
168             Returns : Bio::Ontology::RelationshipType set to "IS_A"
169             Args :
170              
171             =cut
172              
173             sub is_a_relationship {
174 1207     1207 1 1539 my ( $self, $value ) = @_;
175              
176 1207 50       1590 if ( defined $value ) {
177 0         0 $self->throw( "Attempted to change immutable field" );
178             }
179              
180 1207         2420 return $self->{ "_is_a_relationship" };
181             } # is_a_relationship
182              
183              
184              
185             =head2 part_of_relationship
186              
187             Title : part_of_relationship()
188             Usage : $PART_OF = $engine->part_of_relationship();
189             Function: Returns a Bio::Ontology::RelationshipType object for "part-of"
190             relationships
191             Returns : Bio::Ontology::RelationshipType set to "PART_OF"
192             Args :
193              
194             =cut
195              
196             sub part_of_relationship {
197 57     57 1 87 my ( $self, $value ) = @_;
198              
199 57 50       97 if ( defined $value ) {
200 0         0 $self->throw( "Attempted to change immutable field" );
201             }
202              
203 57         113 return $self->{ "_part_of_relationship" };
204             } # part_of_relationship
205              
206              
207             =head2 related_to_relationship
208              
209             Title : related_to_relationship()
210             Usage : $RELATED_TO = $engine->related_to_relationship();
211             Function: Returns a Bio::Ontology::RelationshipType object for "related-to"
212             relationships
213             Returns : Bio::Ontology::RelationshipType set to "RELATED_TO"
214             Args :
215              
216             =cut
217              
218             sub related_to_relationship {
219 10     10 1 23 my ( $self, $value ) = @_;
220              
221 10 50       26 if ( defined $value ) {
222 0         0 $self->throw( "Attempted to change immutable field" );
223             }
224              
225 10         30 return $self->{ "_related_to_relationship" };
226             } # related_to_relationship
227              
228             =head2 regulates_relationship
229              
230             Title : regulates_relationship()
231             Usage : $REGULATES = $engine->regulates_relationship();
232             Function: Returns a Bio::Ontology::RelationshipType object for "regulates"
233             relationships
234             Returns : Bio::Ontology::RelationshipType set to "REGULATES"
235             Args :
236              
237             =cut
238              
239             sub regulates_relationship {
240 6     6 1 11 my ( $self, $value ) = @_;
241              
242 6 50       15 if ( defined $value ) {
243 0         0 $self->throw( "Attempted to change immutable field" );
244             }
245              
246 6         18 return $self->{ "_regulates_relationship" };
247             } # is_a_relationship
248              
249             =head2 positively_regulates_relationship
250              
251             Title : positively_regulates_relationship()
252             Usage : $REGULATES = $engine->positively_regulates_relationship();
253             Function: Returns a Bio::Ontology::RelationshipType object for "positively_regulates"
254             relationships
255             Returns : Bio::Ontology::RelationshipType set to "POSITIVELY_REGULATES"
256             Args :
257              
258             =cut
259              
260             sub positively_regulates_relationship {
261 6     6 1 12 my ( $self, $value ) = @_;
262              
263 6 50       13 if ( defined $value ) {
264 0         0 $self->throw( "Attempted to change immutable field" );
265             }
266              
267 6         17 return $self->{ "_positively_regulate" };
268             }
269              
270             =head2 negatively_regulates_relationship
271              
272             Title : negatively_regulates_relationship()
273             Usage : $REGULATES = $engine->negatively_regulates_relationship();
274             Function: Returns a Bio::Ontology::RelationshipType object for "negatively_regulates"
275             relationships
276             Returns : Bio::Ontology::RelationshipType set to "POSITIVELY_REGULATES"
277             Args :
278              
279             =cut
280              
281             sub negatively_regulates_relationship {
282 6     6 1 11 my ( $self, $value ) = @_;
283              
284 6 50       10 if ( defined $value ) {
285 0         0 $self->throw( "Attempted to change immutable field" );
286             }
287              
288 6         16 return $self->{ "_negatively_regulate" };
289             }
290              
291              
292             =head2 add_term
293              
294             Title : add_term
295             Usage : $engine->add_term( $term_obj );
296             Function: Adds a Bio::Ontology::TermI to this engine
297             Returns : true if the term was added and false otherwise (e.g., if the
298             term already existed in the ontology engine)
299             Args : Bio::Ontology::TermI`
300              
301             =cut
302              
303             sub add_term {
304 1412     1412 1 1775 my ( $self, $term ) = @_;
305              
306 1412 100       1889 return FALSE if $self->has_term( $term );
307              
308 1249         1821 my $goid = $self->_get_id($term);
309              
310 1249         1962 $self->graph()->add_vertex( $goid );
311 1249         43179 $self->graph()->set_vertex_attribute( $goid, TERM, $term ); # NG 05-02-16
312 1249         2226 return TRUE;
313              
314             } # add_term
315              
316              
317              
318             =head2 has_term
319              
320             Title : has_term
321             Usage : $engine->has_term( $term );
322             Function: Checks whether this engine contains a particular term
323             Returns : true or false
324             Args : Bio::Ontology::TermI
325             or
326             Term identifier (e.g. "GO:0012345")
327              
328             =cut
329              
330             sub has_term {
331 3923     3923 1 4573 my ( $self, $term ) = @_;
332 3923         5779 $term = $self->_get_id( $term );
333 3923 100       5844 if ( $self->graph()->has_vertex( $term ) ) {
334 1435         10362 return TRUE;
335             }
336             else {
337 2488         19710 return FALSE;
338             }
339              
340             } # has_term
341              
342              
343             =head2 add_relationship_type
344              
345             Title : add_relationship_type
346             Usage : $engine->add_relationship_type( $type_name, $ont );
347             Function: Adds a new relationship type to the engine. Use
348             get_relationship_type($type_name) to retrieve.
349             Returns : true if successfully added, false otherwise
350             Args : relationship type name to add (scalar)
351             ontology to which to assign the relationship type
352              
353             =cut
354              
355             sub add_relationship_type{
356 9     9 1 19 my ($self,@args) = @_;
357              
358 9 50       26 if(scalar(@_) == 3){
359 9         12 my $type_name = $args[0];
360 9         10 my $ont = $args[1];
361 9         42 $self->{ "_extra_relationship_types" }{$type_name} = Bio::Ontology::RelationshipType->get_instance($type_name,$ont);
362             #warn Dumper($self->{"_extra_relationship_types"}{$type_name});
363 9         20 return 1;
364             }
365 0         0 return 0;
366             }
367              
368              
369             =head2 get_relationship_type
370              
371             Title : get_relationship_type
372             Usage : $engine->get_relationship_type( $type_name );
373             Function: Gets a Bio::Ontology::RelationshipI object corresponding
374             to $type_name
375             Returns : a Bio::Ontology::RelationshipI object
376             Args :
377              
378             =cut
379              
380             sub get_relationship_type{
381 282     282 1 374 my ($self,$type_name) = @_;
382 282         549 return $self->{ "_extra_relationship_types" }{$type_name};
383             }
384              
385             =head2 add_relationship
386              
387             Title : add_relationship
388             Usage : $engine->add_relationship( $relationship );
389             $engine->add_relatioship( $subject_term, $predicate_term,
390             $object_term, $ontology );
391             $engine->add_relatioship( $subject_id, $predicate_id,
392             $object_id, $ontology);
393             Function: Adds a relationship to this engine
394             Returns : true if successfully added, false otherwise
395             Args : The relationship in one of three ways:
396              
397             a) subject (or child) term id, Bio::Ontology::TermI
398             (rel.type), object (or parent) term id, ontology
399              
400             or
401              
402             b) subject Bio::Ontology::TermI, predicate
403             Bio::Ontology::TermI (rel.type), object
404             Bio::Ontology::TermI, ontology
405              
406             or
407              
408             c) Bio::Ontology::RelationshipI-compliant object
409              
410             =cut
411              
412             # term objs or term ids
413             sub add_relationship {
414 1487     1487 1 2059 my ( $self, $child, $type, $parent, $ont ) = @_;
415              
416 1487 100       2409 if ( scalar( @_ ) == 2 ) {
417 2         6 $self->_check_class( $child, "Bio::Ontology::RelationshipI" );
418 2         5 $type = $child->predicate_term();
419 2         5 $parent = $child->object_term();
420 2         3 $ont = $child->ontology();
421 2         5 $child = $child->subject_term();
422             }
423              
424              
425 1487         2776 $self->_check_class( $type, "Bio::Ontology::TermI" );
426              
427 1487         2129 my $parentid = $self->_get_id( $parent );
428 1487         2110 my $childid = $self->_get_id( $child );
429              
430 1487         2043 my $g = $self->graph();
431              
432 1487 50       2388 $self->add_term($child) unless $g->has_vertex( $childid );
433 1487 50       9040 $self->add_term($parent) unless $g->has_vertex( $parentid );
434              
435             # This prevents multi graphs.
436 1487 100       8634 if ( $g->has_edge( $parentid, $childid ) ) {
437 15         298 return FALSE;
438             }
439              
440 1472         29319 $g->add_edge( $parentid, $childid );
441 1472         70241 $g->set_edge_attribute( $parentid, $childid, TYPE, $type ); # NG 05-02-16
442 1472         2800 $g->set_edge_attribute( $parentid, $childid, ONTOLOGY, $ont ); # NG 05-02-16
443              
444 1472         3827 return TRUE;
445              
446             } # add_relationship
447              
448              
449              
450              
451             =head2 get_relationships
452              
453              
454             Title : get_relationships
455             Usage : $engine->get_relationships( $term );
456             Function: Returns all relationships of a term, or all relationships in
457             the graph if no term is specified.
458             Returns : Relationship
459             Args : term id
460             or
461             Bio::Ontology::TermI
462              
463             =cut
464              
465             sub get_relationships {
466 7     7 1 19 my ( $self, $term ) = @_;
467              
468 7         18 my $g = $self->graph();
469              
470             # obtain the ID if term provided
471 7         13 my $termid;
472 7 100       20 if($term) {
473 3         11 $termid = $self->_get_id( $term );
474             # check for presence in the graph
475 3 50       11 if ( ! $g->has_vertex( $termid ) ) {
476 0         0 $self->throw( "no term with identifier \"$termid\" in ontology" );
477             }
478             }
479              
480             # now build the relationships
481 7         56 my $relfact = $self->relationship_factory();
482             # we'll build the relationships from edges
483 7         14 my @rels = ();
484 7 100       36 my @edges = $termid ? $g->edges_at( $termid ) : $g->edges(); # NG 05-02-13
485 7         32137 while(@edges) {
486 1343         1468 my ( $startid, $endid ) = @{ shift @edges }; # NG 05-02-16
  1343         2325  
487 1343         2303 my $rel = $relfact->create_object
488             (-subject_term => $self->get_terms($endid),
489             -object_term => $self->get_terms($startid),
490             -predicate_term => $g->get_edge_attribute($startid, $endid, TYPE),
491             -ontology => $g->get_edge_attribute($startid, $endid, ONTOLOGY));
492 1343         3221 push( @rels, $rel );
493              
494             }
495              
496 7         132 return @rels;
497              
498             } # get_relationships
499              
500             =head2 get_all_relationships
501              
502              
503             Title : get_all_relationships
504             Usage : @rels = $engine->get_all_relationships();
505             Function: Returns all relationships in the graph.
506             Returns : Relationship
507             Args :
508              
509             =cut
510              
511             sub get_all_relationships {
512 0     0 1 0 return shift->get_relationships(@_);
513             } # get_all_relationships
514              
515              
516              
517             =head2 get_predicate_terms
518              
519             Title : get_predicate_terms
520             Usage : $engine->get_predicate_terms();
521             Function: Returns the types of relationships this engine contains
522             Returns : Bio::Ontology::RelationshipType
523             Args :
524              
525             =cut
526              
527             sub get_predicate_terms {
528 3     3 1 5 my ( $self ) = @_;
529              
530 3         9 my @a = (
531             $self->is_a_relationship(),
532             $self->part_of_relationship(),
533             $self->related_to_relationship(),
534             $self->regulates_relationship(),
535             $self->positively_regulates_relationship(),
536             $self->negatively_regulates_relationship(),
537             );
538              
539 3         4 foreach my $termname (keys %{$self->{ "_extra_relationship_types" }}){
  3         13  
540 4         7 push @a, $self->{ "_extra_relationship_types" }{ $termname };
541             }
542              
543 3         9 return @a;
544             } # get_predicate_terms
545              
546              
547              
548              
549             =head2 get_child_terms
550              
551             Title : get_child_terms
552             Usage : $engine->get_child_terms( $term_obj, @rel_types );
553             $engine->get_child_terms( $term_id, @rel_types );
554             Function: Returns the children of this term
555             Returns : Bio::Ontology::TermI
556             Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType
557             or
558             term id, Bio::Ontology::RelationshipType
559              
560             if NO Bio::Ontology::RelationshipType is indicated: children
561             of ALL types are returned
562              
563             =cut
564              
565             sub get_child_terms {
566 326     326 1 411 my ( $self, $term, @types ) = @_;
567              
568 326         465 return $self->_get_child_parent_terms_helper( $term, TRUE, @types );
569              
570             } # get_child_terms
571              
572              
573             =head2 get_descendant_terms
574              
575             Title : get_descendant_terms
576             Usage : $engine->get_descendant_terms( $term_obj, @rel_types );
577             $engine->get_descendant_terms( $term_id, @rel_types );
578             Function: Returns the descendants of this term
579             Returns : Bio::Ontology::TermI
580             Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType
581             or
582             term id, Bio::Ontology::RelationshipType
583              
584             if NO Bio::Ontology::RelationshipType is indicated:
585             descendants of ALL types are returned
586              
587             =cut
588              
589             sub get_descendant_terms {
590 10     10 1 24 my ( $self, $term, @types ) = @_;
591              
592 10         18 my %ids = ();
593 10         15 my @ids = ();
594              
595 10         38 $term = $self->_get_id( $term );
596              
597 10 50       30 if ( ! $self->graph()->has_vertex( $term ) ) {
598 0         0 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
599             }
600              
601 10         99 $self->_get_descendant_terms_helper( $term, \%ids, \@types );
602              
603 10         49 while( ( my $id ) = each ( %ids ) ) {
604 290         486 push( @ids, $id );
605             }
606              
607 10         24 return $self->get_terms( @ids );
608              
609             } # get_descendant_terms
610              
611              
612             =head2 get_parent_terms
613              
614             Title : get_parent_terms
615             Usage : $engine->get_parent_terms( $term_obj, @rel_types );
616             $engine->get_parent_terms( $term_id, @rel_types );
617             Function: Returns the parents of this term
618             Returns : Bio::Ontology::TermI
619             Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType
620             or
621             term id, Bio::Ontology::RelationshipType
622              
623             if NO Bio::Ontology::RelationshipType is indicated:
624             parents of ALL types are returned
625              
626             =cut
627              
628             sub get_parent_terms {
629 105     105 1 150 my ( $self, $term, @types ) = @_;
630              
631 105         173 return $self->_get_child_parent_terms_helper( $term, FALSE, @types );
632              
633             } # get_parent_terms
634              
635              
636              
637             =head2 get_ancestor_terms
638              
639             Title : get_ancestor_terms
640             Usage : $engine->get_ancestor_terms( $term_obj, @rel_types );
641             $engine->get_ancestor_terms( $term_id, @rel_types );
642             Function: Returns the ancestors of this term
643             Returns : Bio::Ontology::TermI
644             Args : Bio::Ontology::TermI, Bio::Ontology::RelationshipType
645             or
646             term id, Bio::Ontology::RelationshipType
647              
648             if NO Bio::Ontology::RelationshipType is indicated:
649             ancestors of ALL types are returned
650              
651             =cut
652              
653             sub get_ancestor_terms {
654 14     14 1 38 my ( $self, $term, @types ) = @_;
655              
656 14         22 my %ids = ();
657 14         26 my @ids = ();
658              
659 14         36 $term = $self->_get_id( $term );
660              
661 14 50       40 if ( ! $self->graph()->has_vertex( $term ) ) {
662 0         0 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
663             }
664              
665 14         146 $self->_get_ancestor_terms_helper( $term, \%ids, \@types );
666              
667 14         50 while( ( my $id ) = each ( %ids ) ) {
668 61         110 push( @ids, $id );
669             }
670              
671 14         31 return $self->get_terms( @ids );
672              
673             } # get_ancestor_terms
674              
675              
676              
677              
678              
679             =head2 get_leaf_terms
680              
681             Title : get_leaf_terms
682             Usage : $engine->get_leaf_terms();
683             Function: Returns the leaf terms
684             Returns : Bio::Ontology::TermI
685             Args :
686              
687             =cut
688              
689             sub get_leaf_terms {
690 2     2 1 5 my ( $self ) = @_;
691              
692 2         6 my @a = $self->graph()->sink_vertices();
693              
694 2         1797 return $self->get_terms( @a );
695              
696             }
697              
698              
699              
700             =head2 get_root_terms()
701              
702             Title : get_root_terms
703             Usage : $engine->get_root_terms();
704             Function: Returns the root terms
705             Returns : Bio::Ontology::TermI
706             Args :
707              
708             =cut
709              
710             sub get_root_terms {
711 7     7 1 17 my ( $self ) = @_;
712              
713              
714 7         19 my @a = $self->graph()->source_vertices();
715              
716 7         35719 return $self->get_terms( @a );
717              
718             }
719              
720              
721             =head2 get_terms
722              
723             Title : get_terms
724             Usage : @terms = $engine->get_terms( "GO:1234567", "GO:2234567" );
725             Function: Returns term objects with given identifiers
726             Returns : Bio::Ontology::TermI, or the term corresponding to the
727             first identifier if called in scalar context
728             Args : term ids
729              
730             =cut
731              
732             sub get_terms {
733 3554     3554 1 24311 my ( $self, @ids ) = @_;
734              
735 3554         3223 my @terms = ();
736              
737 3554         3729 foreach my $id ( @ids ) {
738 10025 100       11400 if ( $self->graph()->has_vertex( $id ) ) {
739 10018         53667 push( @terms, $self->graph()->get_vertex_attribute( $id, TERM ) ); # NG 05-02-16
740             }
741             }
742              
743 3554 100       8882 return wantarray ? @terms : shift(@terms);
744              
745             } # get_terms
746              
747              
748             =head2 get_all_terms
749              
750             Title : get_all_terms
751             Usage : $engine->get_all_terms();
752             Function: Returns all terms in this engine
753             Returns : Bio::Ontology::TermI
754             Args :
755              
756             =cut
757              
758             sub get_all_terms {
759 8     8 1 17 my ( $self ) = @_;
760              
761 8         24 return( $self->get_terms( $self->graph()->vertices() ) );
762              
763             } # get_all_terms
764              
765              
766             =head2 find_terms
767              
768             Title : find_terms
769             Usage : ($term) = $oe->find_terms(-identifier => "SO:0000263");
770             Function: Find term instances matching queries for their attributes.
771              
772             This implementation can efficiently resolve queries by
773             identifier.
774              
775             Example :
776             Returns : an array of zero or more Bio::Ontology::TermI objects
777             Args : Named parameters. The following parameters should be recognized
778             by any implementations:
779              
780             -identifier query by the given identifier
781             -name query by the given name
782              
783             =cut
784              
785             sub find_terms{
786 8     8 1 70 my ($self,@args) = @_;
787 8         15 my @terms;
788              
789 8         57 my ($id,$name) = $self->_rearrange([qw(IDENTIFIER NAME)],@args);
790              
791 8 100       28 if(defined($id)) {
792 4         15 @terms = $self->get_terms($id);
793             } else {
794 4         10 @terms = $self->get_all_terms();
795             }
796 8 100       158 if(defined($name)) {
797 4         18 @terms = grep { $_->name() eq $name; } @terms;
  3027         3954  
798             }
799 8         35 return @terms;
800             }
801              
802              
803             =head2 find_identically_named_terms
804              
805             Title : find_identically_named_terms
806             Usage : ($term) = $oe->find_identically_named_terms($term0);
807             Function: Find term instances where names match the query term
808             name exactly
809             Example :
810             Returns : an array of zero or more Bio::Ontology::TermI objects
811             Args : a Bio::Ontology::TermI object
812              
813             =cut
814              
815             sub find_identically_named_terms{
816 1     1 1 3 my ($self,$qterm) = @_;
817 1 50 33     12 $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
818             unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
819              
820 1         2 my %matching_terms;
821              
822 1         4 foreach my $term ($self->get_all_terms) {
823 1008 100 50     1263 $matching_terms{$term->identifier} = $term and next
824             if $term->name eq $qterm->name;
825             }
826 1         91 return values %matching_terms;
827             }
828              
829              
830             =head2 find_identical_terms
831              
832             Title : find_identical_terms
833             Usage : ($term) = $oe->find_identical_terms($term0);
834             Function: Find term instances where name or synonym
835             matches the query exactly
836             Example :
837             Returns : an array of zero or more Bio::Ontology::TermI objects
838             Args : a Bio::Ontology::TermI object
839              
840             =cut
841              
842             sub find_identical_terms{
843 1     1 1 3 my ($self,$qterm) = @_;
844 1 50 33     54 $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
845             unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
846              
847 1         2 my %matching_terms;
848              
849 1         4 foreach my $qstring ($qterm->name, $qterm->each_synonym) {
850 1         4 foreach my $term ($self->get_all_terms) {
851 1008         1276 foreach my $string ( $term->name, $term->each_synonym() ) {
852 1281 100 50     1774 $matching_terms{$term->identifier} = $term and next
853             if $string eq $qstring;
854             }
855             }
856             }
857 1         11 return values %matching_terms;
858             }
859              
860             =head2 find_similar_terms
861              
862             Title : find_similar_terms
863             Usage : ($term) = $oe->find_similar_terms($term0);
864             Function: Find term instances where name or synonym, or part of one,
865             matches the query.
866             Example :
867             Returns : an array of zero or more Bio::Ontology::TermI objects
868             Args : a Bio::Ontology::TermI object
869              
870             =cut
871              
872             sub find_similar_terms{
873 1     1 1 2 my ($self,$qterm) = @_;
874 1 50 33     13 $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
875             unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
876              
877 1         2 my %matching_terms;
878              
879 1         4 foreach my $qstring ($qterm->name, $qterm->each_synonym) {
880 1         4 foreach my $term ($self->get_all_terms) {
881              
882 1008         1860 foreach my $string ( $term->name, $term->each_synonym() ) {
883 1281 100 50     9854 $matching_terms{$term->identifier} = $term and next
      66        
884             if $string =~ /\Q$qstring\E/ or $qstring =~ /\Q$string\E/;
885             }
886             }
887             }
888 1         13 return values %matching_terms;
889             }
890              
891              
892             =head2 relationship_factory
893              
894             Title : relationship_factory
895             Usage : $fact = $obj->relationship_factory()
896             Function: Get/set the object factory to be used when relationship
897             objects are created by the implementation on-the-fly.
898              
899             Example :
900             Returns : value of relationship_factory (a Bio::Factory::ObjectFactoryI
901             compliant object)
902             Args : on set, a Bio::Factory::ObjectFactoryI compliant object
903              
904             =cut
905              
906             sub relationship_factory{
907 14     14 1 24 my $self = shift;
908              
909 14 100       50 return $self->{'relationship_factory'} = shift if @_;
910 7         19 return $self->{'relationship_factory'};
911             }
912              
913             =head2 term_factory
914              
915             Title : term_factory
916             Usage : $fact = $obj->term_factory()
917             Function: Get/set the object factory to be used when term objects are
918             created by the implementation on-the-fly.
919              
920             Note that this ontology engine implementation does not
921             create term objects on the fly, and therefore setting this
922             attribute is meaningless.
923              
924             Example :
925             Returns : value of term_factory (a Bio::Factory::ObjectFactoryI
926             compliant object)
927             Args : on set, a Bio::Factory::ObjectFactoryI compliant object
928              
929             =cut
930              
931             sub term_factory{
932 0     0 1 0 my $self = shift;
933              
934 0 0       0 if(@_) {
935 0         0 $self->warn("setting term factory, but ".ref($self).
936             " does not create terms on-the-fly");
937 0         0 return $self->{'term_factory'} = shift;
938             }
939 0         0 return $self->{'term_factory'};
940             }
941              
942             =head2 graph
943              
944             Title : graph()
945             Usage : $engine->graph();
946             Function: Returns the Graph this engine is based on
947             Returns : Graph
948             Args :
949              
950             =cut
951              
952             sub graph {
953 29039     29039 1 31286 my ( $self, $value ) = @_;
954              
955 29039 100       33001 if ( defined $value ) {
956 7         25 $self->_check_class( $value, 'Bio::Ontology::SimpleGOEngine::GraphAdaptor' ); # NG 05-02-16
957 7         13 $self->{ "_graph" } = $value;
958             }
959              
960 29039         46837 return $self->{ "_graph" };
961             } # graph
962              
963              
964             # Internal methods
965             # ----------------
966             # Checks the correct format of a GOBO-formatted id
967             # Gets the id out of a term or id string
968             sub _get_id {
969 8979     8979   9743 my ( $self, $term ) = @_;
970 8979         8460 my $id = $term;
971              
972 8979 100       11734 if ( ref($term) ) {
973              
974             # use TermI standard API
975 7427 50       13895 $self->throw( "Object doesn't implement Bio::Ontology::TermI" )
976             unless $term->isa("Bio::Ontology::TermI");
977 7427         10686 $id = $term->identifier();
978              
979             # if there is no ID, we need to fake one from ontology name and name
980             # in order to achieve uniqueness
981 7427 50       10013 if ( !$id ) {
982 0 0       0 $id = $term->ontology->name() if $term->ontology();
983 0 0       0 $id = $id ? $id . '|' : '';
984 0         0 $id .= $term->name();
985             }
986             }
987              
988             # if $term->isa("Bio::Ontology::GOterm")||($id =~ /^[A-Z_]{1,8}:\d{1,}$/);
989 8979 50 66     29693 return $id if $term->isa("Bio::Ontology::OBOterm") || ( $id =~ /^\w+:\w+$/ );
990              
991             # prefix with something if only numbers
992             # if($id =~ /^\d+$/) {
993             # $self->warn(ref($self).": identifier [$id] is only numbers - ".
994             # "prefixing with 'GO:'");
995             # return "GO:" . $id;
996             # }
997             # we shouldn't have gotten here if it's at least a remotely decent ID
998 0 0       0 $self->throw( ref($self) . ": non-standard identifier '$id'\n" )
999             unless $id =~ /\|/;
1000              
1001 0         0 return $id;
1002             }
1003              
1004             # Helper for getting children and parent terms
1005             sub _get_child_parent_terms_helper {
1006 431     431   602 my ( $self, $term, $do_get_child_terms, @types ) = @_;
1007              
1008 431         547 foreach my $type ( @types ) {
1009 117         195 $self->_check_class( $type, "Bio::Ontology::TermI" );
1010             }
1011              
1012 431         463 my @relative_terms = ();
1013              
1014 431         570 $term = $self->_get_id( $term );
1015 431 50       794 if ( ! $self->graph()->has_vertex( $term ) ) {
1016 0         0 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
1017             }
1018              
1019 431         2611 my @all_relative_terms = ();
1020 431 100       566 if ( $do_get_child_terms ) {
1021 326         447 @all_relative_terms = $self->graph()->successors( $term );
1022             }
1023             else {
1024 105         140 @all_relative_terms = $self->graph()->predecessors( $term );
1025             }
1026              
1027 431         11419 foreach my $relative ( @all_relative_terms ) {
1028 494 100       991 if ( scalar( @types ) > 0 ) {
1029 133         181 foreach my $type ( @types ) {
1030 170         172 my $relative_type;
1031 170 100       203 if ( $do_get_child_terms ) {
1032 93         130 $relative_type = $self->graph()->get_edge_attribute ($term, $relative, TYPE ); # NG 05-02-16
1033             }
1034             else {
1035 77         113 $relative_type = $self->graph()->get_edge_attribute ($relative, $term, TYPE ); # NG 05-02-16
1036             }
1037 170 100       324 if ( $relative_type->equals( $type ) ) {
1038 90         196 push( @relative_terms, $relative );
1039             }
1040             }
1041             }
1042             else {
1043 361         491 push( @relative_terms, $relative );
1044             }
1045             }
1046              
1047 431         684 return $self->get_terms( @relative_terms );
1048              
1049             } # get_child_terms
1050              
1051              
1052             # Recursive helper
1053             sub _get_descendant_terms_helper {
1054 309     309   438 my ( $self, $term, $ids_ref, $types_ref ) = @_;
1055              
1056 309         488 my @child_terms = $self->get_child_terms( $term, @$types_ref );
1057              
1058 309 100       508 if ( scalar( @child_terms ) < 1 ) {
1059 191         384 return;
1060             }
1061              
1062 118         152 foreach my $child_term ( @child_terms ) {
1063 299         558 my $child_term_id = $self->_get_id($child_term->identifier());
1064 299         571 $ids_ref->{ $child_term_id } = 0;
1065 299         460 $self->_get_descendant_terms_helper( $child_term_id, $ids_ref, $types_ref );
1066             }
1067              
1068             } # _get_descendant_terms_helper
1069              
1070              
1071             # Recursive helper
1072             sub _get_ancestor_terms_helper {
1073 90     90   138 my ( $self, $term, $ids_ref, $types_ref ) = @_;
1074              
1075 90         149 my @parent_terms = $self->get_parent_terms( $term, @$types_ref );
1076              
1077 90 100       150 if ( scalar( @parent_terms ) < 1 ) {
1078 32         80 return;
1079             }
1080              
1081 58         76 foreach my $parent_term ( @parent_terms ) {
1082 76         144 my $parent_term_id = $self->_get_id($parent_term->identifier());
1083 76         143 $ids_ref->{ $parent_term_id } = 0;
1084 76         146 $self->_get_ancestor_terms_helper( $parent_term_id, $ids_ref, $types_ref );
1085             }
1086              
1087             } # get_ancestor_terms_helper
1088              
1089             sub _check_class {
1090 1613     1613   2428 my ( $self, $value, $expected_class ) = @_;
1091              
1092 1613 50       5800 if ( ! defined( $value ) ) {
    50          
    50          
1093 0           $self->throw( "Found [undef] where [$expected_class] expected" );
1094             }
1095             elsif ( ! ref( $value ) ) {
1096 0           $self->throw( "Found [scalar] where [$expected_class] expected" );
1097             }
1098             elsif ( ! $value->isa( $expected_class ) ) {
1099 0           $self->throw( "Found [" . ref( $value ) . "] where [$expected_class] expected" );
1100             }
1101              
1102             } # _check_class
1103              
1104             #################################################################
1105             # aliases
1106             #################################################################
1107              
1108             *get_relationship_types = \&get_predicate_terms;
1109              
1110              
1111              
1112              
1113             1;