Bio/Ontology/OBOEngine.pm

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