Bio/Ontology/OBOEngine.pm

   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<bioperl-l@bioperl.org>
  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 use Bio::Ontology::SimpleGOEngine::GraphAdaptor;
  85
  86 use strict;
  87 use Bio::Ontology::RelationshipType;
  88 use Bio::Ontology::RelationshipFactory;
  89 use Data::Dumper;
  90
  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";
 102
 103
 104 use base qw(Bio::Root::Root Bio::Ontology::OntologyEngineI);
 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     my( $class, @args ) = @_;
 120
 121     my $self = $class->SUPER::new( @args );
 122
 123     $self->init();
 124
 125     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     my ( $self ) = @_;
 142
 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 );
 146
 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);
 150
 151
 152     $self->graph( Bio::Ontology::SimpleGOEngine::GraphAdaptor->new() );        # NG 05-02-16
 153
 154     # set defaults for the factories
 155     $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     my ( $self, $value ) = @_;
 175
 176     if ( defined $value ) {
 177         $self->throw( "Attempted to change immutable field" );
 178     }
 179
 180     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     my ( $self, $value ) = @_;
 198
 199     if ( defined $value ) {
 200         $self->throw( "Attempted to change immutable field" );
 201     }
 202
 203     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     my ( $self, $value ) = @_;
 220
 221     if ( defined $value ) {
 222         $self->throw( "Attempted to change immutable field" );
 223     }
 224
 225     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     my ( $self, $value ) = @_;
 241
 242     if ( defined $value ) {
 243         $self->throw( "Attempted to change immutable field" );
 244     }
 245
 246     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     my ( $self, $value ) = @_;
 262
 263     if ( defined $value ) {
 264         $self->throw( "Attempted to change immutable field" );
 265     }
 266
 267     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     my ( $self, $value ) = @_;
 283
 284     if ( defined $value ) {
 285         $self->throw( "Attempted to change immutable field" );
 286     }
 287
 288     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     my ( $self, $term ) = @_;
 305
 306     return FALSE if $self->has_term( $term );
 307
 308     my $goid = $self->_get_id($term);
 309
 310     $self->graph()->add_vertex( $goid );
 311     $self->graph()->set_vertex_attribute( $goid, TERM, $term );        # NG 05-02-16
 312     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     my ( $self, $term ) = @_;
 332     $term = $self->_get_id( $term );
 333     if ( $self->graph()->has_vertex( $term ) ) {
 334         return TRUE;
 335     }
 336     else {
 337         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    my ($self,@args) = @_;
 357
 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;
 364    }
 365    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    my ($self,$type_name) = @_;
 382    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     my ( $self, $child, $type, $parent, $ont ) = @_;
 415
 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();
 422     }
 423
 424
 425     $self->_check_class( $type, "Bio::Ontology::TermI" );
 426
 427     my $parentid = $self->_get_id( $parent );
 428     my $childid = $self->_get_id( $child );
 429
 430     my $g = $self->graph();
 431
 432     $self->add_term($child) unless $g->has_vertex( $childid );
 433     $self->add_term($parent) unless $g->has_vertex( $parentid );
 434
 435     # This prevents multi graphs.
 436     if ( $g->has_edge( $parentid, $childid ) ) {
 437         return FALSE;
 438     }
 439
 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
 443
 444     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     my ( $self, $term ) = @_;
 467
 468     my $g = $self->graph();
 469
 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" );
 477         }
 478     }
 479
 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 );
 493
 494     }
 495
 496     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     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     my ( $self ) = @_;
 529
 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(),
 537            );
 538
 539     foreach my $termname (keys %{$self->{ "_extra_relationship_types" }}){
 540       push @a, $self->{ "_extra_relationship_types" }{ $termname };
 541     }
 542
 543     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     my ( $self, $term, @types ) = @_;
 567
 568     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     my ( $self, $term, @types ) = @_;
 591
 592     my %ids = ();
 593     my @ids = ();
 594
 595     $term = $self->_get_id( $term );
 596
 597     if ( ! $self->graph()->has_vertex( $term ) ) {
 598         $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
 599     }
 600
 601     $self->_get_descendant_terms_helper( $term, \%ids, \@types );
 602
 603     while( ( my $id ) = each ( %ids ) ) {
 604         push( @ids, $id );
 605     }
 606
 607     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     my ( $self, $term, @types ) = @_;
 630
 631     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     my ( $self, $term, @types ) = @_;
 655
 656     my %ids = ();
 657     my @ids = ();
 658
 659     $term = $self->_get_id( $term );
 660
 661     if ( ! $self->graph()->has_vertex( $term ) ) {
 662         $self->throw( "Ontology does not contain a term with an identifier of \"$term\"" );
 663     }
 664
 665     $self->_get_ancestor_terms_helper( $term, \%ids, \@types );
 666
 667     while( ( my $id ) = each ( %ids ) ) {
 668         push( @ids, $id );
 669     }
 670
 671     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     my ( $self ) = @_;
 691
 692     my @a = $self->graph()->sink_vertices();
 693
 694     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     my ( $self ) = @_;
 712
 713
 714     my @a = $self->graph()->source_vertices();
 715
 716     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     my ( $self, @ids ) = @_;
 734
 735     my @terms = ();
 736
 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
 740         }
 741     }
 742
 743     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     my ( $self ) = @_;
 760
 761     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     my ($self,@args) = @_;
 787     my @terms;
 788
 789     my ($id,$name) = $self->_rearrange([qw(IDENTIFIER NAME)],@args);
 790
 791     if(defined($id)) {
 792         @terms = $self->get_terms($id);
 793     } else {
 794         @terms = $self->get_all_terms();
 795     }
 796     if(defined($name)) {
 797         @terms = grep { $_->name() eq $name; } @terms;
 798     }
 799     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     my ($self,$qterm) = @_;
 817     $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
 818         unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
 819
 820     my %matching_terms;
 821
 822     foreach my $term ($self->get_all_terms) {
 823         $matching_terms{$term->identifier} = $term and next
 824             if $term->name eq $qterm->name;
 825     }
 826     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     my ($self,$qterm) = @_;
 844     $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
 845         unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
 846
 847     my %matching_terms;
 848
 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;
 854             }
 855         }
 856     }
 857     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     my ($self,$qterm) = @_;
 874     $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
 875         unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");
 876
 877     my %matching_terms;
 878
 879     foreach my $qstring ($qterm->name, $qterm->each_synonym) {
 880         foreach my $term ($self->get_all_terms) {
 881
 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/;
 885             }
 886         }
 887     }
 888     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     my $self = shift;
 908
 909     return $self->{'relationship_factory'} = shift if @_;
 910     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     my $self = shift;
 933
 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;
 938     }
 939     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     my ( $self, $value ) = @_;
 954
 955     if ( defined $value ) {
 956         $self->_check_class( $value, 'Bio::Ontology::SimpleGOEngine::GraphAdaptor' ); # NG 05-02-16
 957         $self->{ "_graph" } = $value;
 958     }
 959
 960     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     my ( $self, $term ) = @_;
 970     my $id = $term;
 971
 972     if ( ref($term) ) {
 973
 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();
 978
 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();
 985         }
 986     }
 987
 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+$/ );
 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     $self->throw( ref($self) . ": non-standard identifier '$id'\n" )
 999       unless $id =~ /\|/;
1000
1001     return $id;
1002 }
1003
1004 # Helper for getting children and parent terms
1005 sub _get_child_parent_terms_helper {
1006     my ( $self, $term, $do_get_child_terms, @types ) = @_;
1007
1008     foreach my $type ( @types ) {
1009         $self->_check_class( $type, "Bio::Ontology::TermI" );
1010     }
1011
1012     my @relative_terms = ();
1013
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\"" );
1017     }
1018
1019     my @all_relative_terms = ();
1020     if ( $do_get_child_terms ) {
1021         @all_relative_terms = $self->graph()->successors( $term );
1022     }
1023     else {
1024         @all_relative_terms = $self->graph()->predecessors( $term );
1025     }
1026
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
1033                 }
1034                 else {
1035                   $relative_type = $self->graph()->get_edge_attribute ($relative, $term, TYPE ); # NG 05-02-16
1036                 }
1037                 if ( $relative_type->equals( $type ) ) {
1038                     push( @relative_terms, $relative );
1039                 }
1040             }
1041         }
1042         else {
1043             push( @relative_terms, $relative );
1044         }
1045     }
1046
1047     return $self->get_terms( @relative_terms );
1048
1049 } # get_child_terms
1050
1051
1052 # Recursive helper
1053 sub _get_descendant_terms_helper {
1054     my ( $self, $term, $ids_ref, $types_ref ) = @_;
1055
1056     my @child_terms = $self->get_child_terms( $term, @$types_ref );
1057
1058     if ( scalar( @child_terms ) < 1 ) {
1059         return;
1060     }
1061
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 );
1066     }
1067
1068 } # _get_descendant_terms_helper
1069
1070
1071 # Recursive helper
1072 sub _get_ancestor_terms_helper {
1073     my ( $self, $term, $ids_ref, $types_ref ) = @_;
1074
1075     my @parent_terms = $self->get_parent_terms( $term, @$types_ref );
1076
1077     if ( scalar( @parent_terms ) < 1 ) {
1078         return;
1079     }
1080
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 );
1085     }
1086
1087 } # get_ancestor_terms_helper
1088
1089 sub _check_class {
1090     my ( $self, $value, $expected_class ) = @_;
1091
1092     if ( ! defined( $value ) ) {
1093         $self->throw( "Found [undef] where [$expected_class] expected" );
1094     }
1095     elsif ( ! ref( $value ) ) {
1096         $self->throw( "Found [scalar] where [$expected_class] expected" );
1097     }
1098     elsif ( ! $value->isa( $expected_class ) ) {
1099         $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;