maint: restructure to use Dist::Zilla
[bioperl-live.git] / lib / Bio / Ontology / OBOEngine.pm
blob2997a6eaec5dd6626f0b7b312ff2e6b8576cdda3
2 # BioPerl module for Bio::Ontology::OBOEngine
4 # POD documentation - main docs before the code
6 =head1 NAME
8 Bio::Ontology::OBOEngine - An Ontology Engine for OBO style flat file
9 format from the Gene Ontology Consortium
11 =head1 SYNOPSIS
13 use Bio::Ontology::OBOEngine;
15 my $parser = Bio::Ontology::OBOEngine->new
16 ( -file => "gene_ontology.obo" );
18 my $engine = $parser->parse();
20 =head1 DESCRIPTION
22 Needs Graph.pm from CPAN.
24 This module replaces SimpleGOEngine.pm, which is deprecated.
26 =head1 FEEDBACK
28 =head2 Mailing Lists
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.
34 bioperl-l@bioperl.org - General discussion
35 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
37 =head2 Support
39 Please direct usage questions or support issues to the mailing list:
41 I<bioperl-l@bioperl.org>
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.
48 =head2 Reporting Bugs
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:
54 https://github.com/bioperl/bioperl-live/issues
56 =head1 AUTHOR
58 Sohel Merchant
60 Email: s-merchant@northwestern.edu
62 Address:
64 Northwestern University
65 Center for Genetic Medicine (CGM), dictyBase
66 Suite 1206,
67 676 St. Clair st
68 Chicago IL 60611
70 =head2 CONTRIBUTOR
72 Hilmar Lapp, hlapp at gmx.net
73 Chris Mungall, cjm at fruitfly.org
75 =head1 APPENDIX
77 The rest of the documentation details each of the object
78 methods. Internal methods are usually preceded with a _
80 =cut
82 package Bio::Ontology::OBOEngine;
84 use Bio::Ontology::SimpleGOEngine::GraphAdaptor;
86 use strict;
87 use Bio::Ontology::RelationshipType;
88 use Bio::Ontology::RelationshipFactory;
89 use Data::Dumper;
91 use constant TRUE => 1;
92 use constant FALSE => 0;
93 use constant IS_A => "IS_A";
94 use constant PART_OF => "PART_OF";
95 use constant RELATED_TO => "RELATED_TO";
96 use constant TERM => "TERM";
97 use constant TYPE => "TYPE";
98 use constant ONTOLOGY => "ONTOLOGY";
99 use constant REGULATES => "REGULATES";
100 use constant POSITIVELY_REGULATES => "POSITIVELY_REGULATES";
101 use constant NEGATIVELY_REGULATES => "NEGATIVELY_REGULATES";
104 use base qw(Bio::Root::Root Bio::Ontology::OntologyEngineI);
108 =head2 new
110 Title : new
111 Usage : $engine = Bio::Ontology::OBOEngine->new()
112 Function: Creates a new OBOEngine
113 Returns : A new OBOEngine object
114 Args :
116 =cut
118 sub new {
119 my( $class, @args ) = @_;
121 my $self = $class->SUPER::new( @args );
123 $self->init();
125 return $self;
126 } # new
130 =head2 init
132 Title : init()
133 Usage : $engine->init();
134 Function: Initializes this Engine.
135 Returns :
136 Args :
138 =cut
140 sub init {
141 my ( $self ) = @_;
143 $self->{ "_is_a_relationship" } = Bio::Ontology::RelationshipType->get_instance( IS_A );
144 $self->{ "_part_of_relationship" } = Bio::Ontology::RelationshipType->get_instance( PART_OF );
145 $self->{ "_related_to_relationship" } = Bio::Ontology::RelationshipType->get_instance( RELATED_TO );
147 $self->{'_regulates_relationship'} = Bio::Ontology::RelationshipType->get_instance(REGULATES);
148 $self->{'_positively_regulate'} = Bio::Ontology::RelationshipType->get_instance(POSITIVELY_REGULATES);
149 $self->{'_negatively_regulate'} = Bio::Ontology::RelationshipType->get_instance(NEGATIVELY_REGULATES);
152 $self->graph( Bio::Ontology::SimpleGOEngine::GraphAdaptor->new() ); # NG 05-02-16
154 # set defaults for the factories
155 $self->relationship_factory(Bio::Ontology::RelationshipFactory->new(
156 -type => "Bio::Ontology::Relationship"));
158 } # init
162 =head2 is_a_relationship
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 :
171 =cut
173 sub is_a_relationship {
174 my ( $self, $value ) = @_;
176 if ( defined $value ) {
177 $self->throw( "Attempted to change immutable field" );
180 return $self->{ "_is_a_relationship" };
181 } # is_a_relationship
185 =head2 part_of_relationship
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 :
194 =cut
196 sub part_of_relationship {
197 my ( $self, $value ) = @_;
199 if ( defined $value ) {
200 $self->throw( "Attempted to change immutable field" );
203 return $self->{ "_part_of_relationship" };
204 } # part_of_relationship
207 =head2 related_to_relationship
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 :
216 =cut
218 sub related_to_relationship {
219 my ( $self, $value ) = @_;
221 if ( defined $value ) {
222 $self->throw( "Attempted to change immutable field" );
225 return $self->{ "_related_to_relationship" };
226 } # related_to_relationship
228 =head2 regulates_relationship
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 :
237 =cut
239 sub regulates_relationship {
240 my ( $self, $value ) = @_;
242 if ( defined $value ) {
243 $self->throw( "Attempted to change immutable field" );
246 return $self->{ "_regulates_relationship" };
247 } # is_a_relationship
249 =head2 positively_regulates_relationship
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 :
258 =cut
260 sub positively_regulates_relationship {
261 my ( $self, $value ) = @_;
263 if ( defined $value ) {
264 $self->throw( "Attempted to change immutable field" );
267 return $self->{ "_positively_regulate" };
270 =head2 negatively_regulates_relationship
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 :
279 =cut
281 sub negatively_regulates_relationship {
282 my ( $self, $value ) = @_;
284 if ( defined $value ) {
285 $self->throw( "Attempted to change immutable field" );
288 return $self->{ "_negatively_regulate" };
292 =head2 add_term
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`
301 =cut
303 sub add_term {
304 my ( $self, $term ) = @_;
306 return FALSE if $self->has_term( $term );
308 my $goid = $self->_get_id($term);
310 $self->graph()->add_vertex( $goid );
311 $self->graph()->set_vertex_attribute( $goid, TERM, $term ); # NG 05-02-16
312 return TRUE;
314 } # add_term
318 =head2 has_term
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
326 Term identifier (e.g. "GO:0012345")
328 =cut
330 sub has_term {
331 my ( $self, $term ) = @_;
332 $term = $self->_get_id( $term );
333 if ( $self->graph()->has_vertex( $term ) ) {
334 return TRUE;
336 else {
337 return FALSE;
340 } # has_term
343 =head2 add_relationship_type
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
353 =cut
355 sub add_relationship_type{
356 my ($self,@args) = @_;
358 if(scalar(@_) == 3){
359 my $type_name = $args[0];
360 my $ont = $args[1];
361 $self->{ "_extra_relationship_types" }{$type_name} = Bio::Ontology::RelationshipType->get_instance($type_name,$ont);
362 #warn Dumper($self->{"_extra_relationship_types"}{$type_name});
363 return 1;
365 return 0;
369 =head2 get_relationship_type
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 :
378 =cut
380 sub get_relationship_type{
381 my ($self,$type_name) = @_;
382 return $self->{ "_extra_relationship_types" }{$type_name};
385 =head2 add_relationship
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:
397 a) subject (or child) term id, Bio::Ontology::TermI
398 (rel.type), object (or parent) term id, ontology
402 b) subject Bio::Ontology::TermI, predicate
403 Bio::Ontology::TermI (rel.type), object
404 Bio::Ontology::TermI, ontology
408 c) Bio::Ontology::RelationshipI-compliant object
410 =cut
412 # term objs or term ids
413 sub add_relationship {
414 my ( $self, $child, $type, $parent, $ont ) = @_;
416 if ( scalar( @_ ) == 2 ) {
417 $self->_check_class( $child, "Bio::Ontology::RelationshipI" );
418 $type = $child->predicate_term();
419 $parent = $child->object_term();
420 $ont = $child->ontology();
421 $child = $child->subject_term();
425 $self->_check_class( $type, "Bio::Ontology::TermI" );
427 my $parentid = $self->_get_id( $parent );
428 my $childid = $self->_get_id( $child );
430 my $g = $self->graph();
432 $self->add_term($child) unless $g->has_vertex( $childid );
433 $self->add_term($parent) unless $g->has_vertex( $parentid );
435 # This prevents multi graphs.
436 if ( $g->has_edge( $parentid, $childid ) ) {
437 return FALSE;
440 $g->add_edge( $parentid, $childid );
441 $g->set_edge_attribute( $parentid, $childid, TYPE, $type ); # NG 05-02-16
442 $g->set_edge_attribute( $parentid, $childid, ONTOLOGY, $ont ); # NG 05-02-16
444 return TRUE;
446 } # add_relationship
451 =head2 get_relationships
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
461 Bio::Ontology::TermI
463 =cut
465 sub get_relationships {
466 my ( $self, $term ) = @_;
468 my $g = $self->graph();
470 # obtain the ID if term provided
471 my $termid;
472 if($term) {
473 $termid = $self->_get_id( $term );
474 # check for presence in the graph
475 if ( ! $g->has_vertex( $termid ) ) {
476 $self->throw( "no term with identifier \"$termid\" in ontology" );
480 # now build the relationships
481 my $relfact = $self->relationship_factory();
482 # we'll build the relationships from edges
483 my @rels = ();
484 my @edges = $termid ? $g->edges_at( $termid ) : $g->edges(); # NG 05-02-13
485 while(@edges) {
486 my ( $startid, $endid ) = @{ shift @edges }; # NG 05-02-16
487 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 push( @rels, $rel );
496 return @rels;
498 } # get_relationships
500 =head2 get_all_relationships
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 :
509 =cut
511 sub get_all_relationships {
512 return shift->get_relationships(@_);
513 } # get_all_relationships
517 =head2 get_predicate_terms
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 :
525 =cut
527 sub get_predicate_terms {
528 my ( $self ) = @_;
530 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(),
539 foreach my $termname (keys %{$self->{ "_extra_relationship_types" }}){
540 push @a, $self->{ "_extra_relationship_types" }{ $termname };
543 return @a;
544 } # get_predicate_terms
549 =head2 get_child_terms
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
558 term id, Bio::Ontology::RelationshipType
560 if NO Bio::Ontology::RelationshipType is indicated: children
561 of ALL types are returned
563 =cut
565 sub get_child_terms {
566 my ( $self, $term, @types ) = @_;
568 return $self->_get_child_parent_terms_helper( $term, TRUE, @types );
570 } # get_child_terms
573 =head2 get_descendant_terms
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
582 term id, Bio::Ontology::RelationshipType
584 if NO Bio::Ontology::RelationshipType is indicated:
585 descendants of ALL types are returned
587 =cut
589 sub get_descendant_terms {
590 my ( $self, $term, @types ) = @_;
592 my %ids = ();
593 my @ids = ();
595 $term = $self->_get_id( $term );
597 if ( ! $self->graph()->has_vertex( $term ) ) {
598 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
601 $self->_get_descendant_terms_helper( $term, \%ids, \@types );
603 while( ( my $id ) = each ( %ids ) ) {
604 push( @ids, $id );
607 return $self->get_terms( @ids );
609 } # get_descendant_terms
612 =head2 get_parent_terms
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
621 term id, Bio::Ontology::RelationshipType
623 if NO Bio::Ontology::RelationshipType is indicated:
624 parents of ALL types are returned
626 =cut
628 sub get_parent_terms {
629 my ( $self, $term, @types ) = @_;
631 return $self->_get_child_parent_terms_helper( $term, FALSE, @types );
633 } # get_parent_terms
637 =head2 get_ancestor_terms
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
646 term id, Bio::Ontology::RelationshipType
648 if NO Bio::Ontology::RelationshipType is indicated:
649 ancestors of ALL types are returned
651 =cut
653 sub get_ancestor_terms {
654 my ( $self, $term, @types ) = @_;
656 my %ids = ();
657 my @ids = ();
659 $term = $self->_get_id( $term );
661 if ( ! $self->graph()->has_vertex( $term ) ) {
662 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
665 $self->_get_ancestor_terms_helper( $term, \%ids, \@types );
667 while( ( my $id ) = each ( %ids ) ) {
668 push( @ids, $id );
671 return $self->get_terms( @ids );
673 } # get_ancestor_terms
679 =head2 get_leaf_terms
681 Title : get_leaf_terms
682 Usage : $engine->get_leaf_terms();
683 Function: Returns the leaf terms
684 Returns : Bio::Ontology::TermI
685 Args :
687 =cut
689 sub get_leaf_terms {
690 my ( $self ) = @_;
692 my @a = $self->graph()->sink_vertices();
694 return $self->get_terms( @a );
700 =head2 get_root_terms()
702 Title : get_root_terms
703 Usage : $engine->get_root_terms();
704 Function: Returns the root terms
705 Returns : Bio::Ontology::TermI
706 Args :
708 =cut
710 sub get_root_terms {
711 my ( $self ) = @_;
714 my @a = $self->graph()->source_vertices();
716 return $self->get_terms( @a );
721 =head2 get_terms
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
730 =cut
732 sub get_terms {
733 my ( $self, @ids ) = @_;
735 my @terms = ();
737 foreach my $id ( @ids ) {
738 if ( $self->graph()->has_vertex( $id ) ) {
739 push( @terms, $self->graph()->get_vertex_attribute( $id, TERM ) ); # NG 05-02-16
743 return wantarray ? @terms : shift(@terms);
745 } # get_terms
748 =head2 get_all_terms
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 :
756 =cut
758 sub get_all_terms {
759 my ( $self ) = @_;
761 return( $self->get_terms( $self->graph()->vertices() ) );
763 } # get_all_terms
766 =head2 find_terms
768 Title : find_terms
769 Usage : ($term) = $oe->find_terms(-identifier => "SO:0000263");
770 Function: Find term instances matching queries for their attributes.
772 This implementation can efficiently resolve queries by
773 identifier.
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:
780 -identifier query by the given identifier
781 -name query by the given name
783 =cut
785 sub find_terms{
786 my ($self,@args) = @_;
787 my @terms;
789 my ($id,$name) = $self->_rearrange([qw(IDENTIFIER NAME)],@args);
791 if(defined($id)) {
792 @terms = $self->get_terms($id);
793 } else {
794 @terms = $self->get_all_terms();
796 if(defined($name)) {
797 @terms = grep { $_->name() eq $name; } @terms;
799 return @terms;
803 =head2 find_identically_named_terms
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
813 =cut
815 sub find_identically_named_terms{
816 my ($self,$qterm) = @_;
817 $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
818 unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
820 my %matching_terms;
822 foreach my $term ($self->get_all_terms) {
823 $matching_terms{$term->identifier} = $term and next
824 if $term->name eq $qterm->name;
826 return values %matching_terms;
830 =head2 find_identical_terms
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
840 =cut
842 sub find_identical_terms{
843 my ($self,$qterm) = @_;
844 $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
845 unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
847 my %matching_terms;
849 foreach my $qstring ($qterm->name, $qterm->each_synonym) {
850 foreach my $term ($self->get_all_terms) {
851 foreach my $string ( $term->name, $term->each_synonym() ) {
852 $matching_terms{$term->identifier} = $term and next
853 if $string eq $qstring;
857 return values %matching_terms;
860 =head2 find_similar_terms
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
870 =cut
872 sub find_similar_terms{
873 my ($self,$qterm) = @_;
874 $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
875 unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
877 my %matching_terms;
879 foreach my $qstring ($qterm->name, $qterm->each_synonym) {
880 foreach my $term ($self->get_all_terms) {
882 foreach my $string ( $term->name, $term->each_synonym() ) {
883 $matching_terms{$term->identifier} = $term and next
884 if $string =~ /\Q$qstring\E/ or $qstring =~ /\Q$string\E/;
888 return values %matching_terms;
892 =head2 relationship_factory
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.
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
904 =cut
906 sub relationship_factory{
907 my $self = shift;
909 return $self->{'relationship_factory'} = shift if @_;
910 return $self->{'relationship_factory'};
913 =head2 term_factory
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.
920 Note that this ontology engine implementation does not
921 create term objects on the fly, and therefore setting this
922 attribute is meaningless.
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
929 =cut
931 sub term_factory{
932 my $self = shift;
934 if(@_) {
935 $self->warn("setting term factory, but ".ref($self).
936 " does not create terms on-the-fly");
937 return $self->{'term_factory'} = shift;
939 return $self->{'term_factory'};
942 =head2 graph
944 Title : graph()
945 Usage : $engine->graph();
946 Function: Returns the Graph this engine is based on
947 Returns : Graph
948 Args :
950 =cut
952 sub graph {
953 my ( $self, $value ) = @_;
955 if ( defined $value ) {
956 $self->_check_class( $value, 'Bio::Ontology::SimpleGOEngine::GraphAdaptor' ); # NG 05-02-16
957 $self->{ "_graph" } = $value;
960 return $self->{ "_graph" };
961 } # graph
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 my ( $self, $term ) = @_;
970 my $id = $term;
972 if ( ref($term) ) {
974 # use TermI standard API
975 $self->throw( "Object doesn't implement Bio::Ontology::TermI" )
976 unless $term->isa("Bio::Ontology::TermI");
977 $id = $term->identifier();
979 # if there is no ID, we need to fake one from ontology name and name
980 # in order to achieve uniqueness
981 if ( !$id ) {
982 $id = $term->ontology->name() if $term->ontology();
983 $id = $id ? $id . '|' : '';
984 $id .= $term->name();
988 # if $term->isa("Bio::Ontology::GOterm")||($id =~ /^[A-Z_]{1,8}:\d{1,}$/);
989 return $id if $term->isa("Bio::Ontology::OBOterm") || ( $id =~ /^\w+:\w+$/ );
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;
997 # we shouldn't have gotten here if it's at least a remotely decent ID
998 $self->throw( ref($self) . ": non-standard identifier '$id'\n" )
999 unless $id =~ /\|/;
1001 return $id;
1004 # Helper for getting children and parent terms
1005 sub _get_child_parent_terms_helper {
1006 my ( $self, $term, $do_get_child_terms, @types ) = @_;
1008 foreach my $type ( @types ) {
1009 $self->_check_class( $type, "Bio::Ontology::TermI" );
1012 my @relative_terms = ();
1014 $term = $self->_get_id( $term );
1015 if ( ! $self->graph()->has_vertex( $term ) ) {
1016 $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
1019 my @all_relative_terms = ();
1020 if ( $do_get_child_terms ) {
1021 @all_relative_terms = $self->graph()->successors( $term );
1023 else {
1024 @all_relative_terms = $self->graph()->predecessors( $term );
1027 foreach my $relative ( @all_relative_terms ) {
1028 if ( scalar( @types ) > 0 ) {
1029 foreach my $type ( @types ) {
1030 my $relative_type;
1031 if ( $do_get_child_terms ) {
1032 $relative_type = $self->graph()->get_edge_attribute ($term, $relative, TYPE ); # NG 05-02-16
1034 else {
1035 $relative_type = $self->graph()->get_edge_attribute ($relative, $term, TYPE ); # NG 05-02-16
1037 if ( $relative_type->equals( $type ) ) {
1038 push( @relative_terms, $relative );
1042 else {
1043 push( @relative_terms, $relative );
1047 return $self->get_terms( @relative_terms );
1049 } # get_child_terms
1052 # Recursive helper
1053 sub _get_descendant_terms_helper {
1054 my ( $self, $term, $ids_ref, $types_ref ) = @_;
1056 my @child_terms = $self->get_child_terms( $term, @$types_ref );
1058 if ( scalar( @child_terms ) < 1 ) {
1059 return;
1062 foreach my $child_term ( @child_terms ) {
1063 my $child_term_id = $self->_get_id($child_term->identifier());
1064 $ids_ref->{ $child_term_id } = 0;
1065 $self->_get_descendant_terms_helper( $child_term_id, $ids_ref, $types_ref );
1068 } # _get_descendant_terms_helper
1071 # Recursive helper
1072 sub _get_ancestor_terms_helper {
1073 my ( $self, $term, $ids_ref, $types_ref ) = @_;
1075 my @parent_terms = $self->get_parent_terms( $term, @$types_ref );
1077 if ( scalar( @parent_terms ) < 1 ) {
1078 return;
1081 foreach my $parent_term ( @parent_terms ) {
1082 my $parent_term_id = $self->_get_id($parent_term->identifier());
1083 $ids_ref->{ $parent_term_id } = 0;
1084 $self->_get_ancestor_terms_helper( $parent_term_id, $ids_ref, $types_ref );
1087 } # get_ancestor_terms_helper
1089 sub _check_class {
1090 my ( $self, $value, $expected_class ) = @_;
1092 if ( ! defined( $value ) ) {
1093 $self->throw( "Found [undef] where [$expected_class] expected" );
1095 elsif ( ! ref( $value ) ) {
1096 $self->throw( "Found [scalar] where [$expected_class] expected" );
1098 elsif ( ! $value->isa( $expected_class ) ) {
1099 $self->throw( "Found [" . ref( $value ) . "] where [$expected_class] expected" );
1102 } # _check_class
1104 #################################################################
1105 # aliases
1106 #################################################################
1108 *get_relationship_types = \&get_predicate_terms;