use Bio::Ontology::OBOEngine;

  my $parser = Bio::Ontology::OBOEngine->new
        ( -file => "gene_ontology.obo" );

  my $engine = $parser->parse();

    my( $class, @args ) = @_;

    my $self = $class->SUPER::new( @args );

    $self->init();

    return $self;
} # new

    my ( $self ) = @_;

    $self->{ "_is_a_relationship" }       = Bio::Ontology::RelationshipType->get_instance( IS_A );
    $self->{ "_part_of_relationship" }    = Bio::Ontology::RelationshipType->get_instance( PART_OF );
    $self->{ "_related_to_relationship" } = Bio::Ontology::RelationshipType->get_instance( RELATED_TO );

    $self->graph( Bio::Ontology::SimpleGOEngine::GraphAdaptor->new() );        # NG 05-02-16

    # set defaults for the factories
    $self->relationship_factory(Bio::Ontology::RelationshipFactory->new(
                                     -type => "Bio::Ontology::Relationship"));

} # init

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->throw( "Attempted to change immutable field" );
    }

    return $self->{ "_is_a_relationship" };
} # is_a_relationship

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->throw( "Attempted to change immutable field" );
    }

    return $self->{ "_part_of_relationship" };
} # part_of_relationship

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->throw( "Attempted to change immutable field" );
    }

    return $self->{ "_related_to_relationship" };
} # related_to_relationship

    my ( $self, $term ) = @_;

    return FALSE if $self->has_term( $term );

    my $goid = $self->_get_id($term);

    $self->graph()->add_vertex( $goid );
    $self->graph()->set_vertex_attribute( $goid, TERM, $term );        # NG 05-02-16
    return TRUE;

} # add_term

    my ( $self, $term ) = @_;
    $term = $self->_get_id( $term );
    if ( $self->graph()->has_vertex( $term ) ) {
        return TRUE;
    }
    else {
        return FALSE;
    }

} # has_term

   my ($self,@args) = @_;

   if(scalar(@_) == 3){
         my $type_name = $args[0];
         my $ont = $args[1];
         $self->{ "_extra_relationship_types" }{$type_name} = Bio::Ontology::RelationshipType->get_instance($type_name,$ont);
#warn Dumper($self->{"_extra_relationship_types"}{$type_name});
         return 1;
   }
   return 0;

   my ($self,$type_name) = @_;
   return $self->{ "_extra_relationship_types" }{$type_name};

    my ( $self, $child, $type, $parent, $ont ) = @_;

    if ( scalar( @_ ) == 2 ) {
        $self->_check_class( $child, "Bio::Ontology::RelationshipI" );
        $type   = $child->predicate_term();
        $parent = $child->object_term();
        $ont    = $child->ontology();
        $child  = $child->subject_term();
    }


    $self->_check_class( $type, "Bio::Ontology::TermI" );

    my $parentid = $self->_get_id( $parent );
    my $childid = $self->_get_id( $child );

    my $g = $self->graph();

    $self->add_term($child) unless $g->has_vertex( $childid );
    $self->add_term($parent) unless $g->has_vertex( $parentid );

    # This prevents multi graphs.
    if ( $g->has_edge( $parentid, $childid ) ) {
        return FALSE;
    }

    $g->add_edge( $parentid, $childid );
    $g->set_edge_attribute( $parentid, $childid, TYPE, $type );           # NG 05-02-16
    $g->set_edge_attribute( $parentid, $childid, ONTOLOGY, $ont ); # NG 05-02-16

    return TRUE;

} # add_relationship

    my ( $self, $term ) = @_;

    my $g = $self->graph();

    # obtain the ID if term provided
    my $termid;
    if($term) {
        $termid = $self->_get_id( $term );
        # check for presence in the graph
        if ( ! $g->has_vertex( $termid ) ) {
            $self->throw( "no term with identifier\" $termid\" in ontology" );
        }
    }

    # now build the relationships
    my $relfact = $self->relationship_factory();
    # we'll build the relationships from edges
    my @rels = ();
    my @edges = $termid ? $g->edges_at( $termid ) : $g->edges(); # NG 05-02-13
    while(@edges) {
      my ( $startid, $endid ) = @{ shift @edges }; # NG 05-02-16
      my $rel = $relfact->create_object
        (-subject_term   => $self->get_terms($endid),
         -object_term    => $self->get_terms($startid),
         -predicate_term => $g->get_edge_attribute($startid, $endid, TYPE),
         -ontology       => $g->get_edge_attribute($startid, $endid, ONTOLOGY));
      push( @rels, $rel );

    }

    return @rels;

} # get_relationships

    return shift->get_relationships(@_);
} # get_all_relationships

    my ( $self ) = @_;

    my @a = ( $self->is_a_relationship(),
              $self->part_of_relationship(),
              $self->related_to_relationship());

        foreach my $termname (keys %{$self->{ "_extra_relationship_types" }}){
          push @a, $self->{ "_extra_relationship_types" }{ $termname };
        }

    return @a;
} # get_predicate_terms

    my ( $self, $term, @types ) = @_;

    return $self->_get_child_parent_terms_helper( $term, TRUE, @types );

} # get_child_terms

    my ( $self, $term, @types ) = @_;

    my %ids = ();
    my @ids = ();

    $term = $self->_get_id( $term );

    if ( ! $self->graph()->has_vertex( $term ) ) {
        $self->throw( "Ontology does not contain a term with an identifier of\" $term\"" );
    }

    $self->_get_descendant_terms_helper( $term,\% ids,\@ types );

    while( ( my $id ) = each ( %ids ) ) {
        push( @ids, $id );
    }

    return $self->get_terms( @ids );

} # get_descendant_terms

    my ( $self, $term, @types ) = @_;

    return $self->_get_child_parent_terms_helper( $term, FALSE, @types );

} # get_parent_terms

    my ( $self, $term, @types ) = @_;

    my %ids = ();
    my @ids = ();

    $term = $self->_get_id( $term );

    if ( ! $self->graph()->has_vertex( $term ) ) {
        $self->throw( "Ontology does not contain a term with an identifier of\" $term\"" );
    }

    $self->_get_ancestor_terms_helper( $term,\% ids,\@ types );

    while( ( my $id ) = each ( %ids ) ) {
        push( @ids, $id );
    }

    return $self->get_terms( @ids );

} # get_ancestor_terms

    my ( $self ) = @_;

    my @a = $self->graph()->sink_vertices();

    return $self->get_terms( @a );

    my ( $self ) = @_;


    my @a = $self->graph()->source_vertices();

    return $self->get_terms( @a );

    my ( $self, @ids ) = @_;

    my @terms = ();

    foreach my $id ( @ids ) {
        if ( $self->graph()->has_vertex( $id ) ) {
          push( @terms, $self->graph()->get_vertex_attribute( $id, TERM ) ); # NG 05-02-16
        }
    }

    return wantarray ? @terms : shift(@terms);

} # get_terms

    my ( $self ) = @_;

    return( $self->get_terms( $self->graph()->vertices() ) );

} # get_all_terms

    my ($self,@args) = @_;
    my @terms;

    my ($id,$name) = $self->_rearrange([qw(IDENTIFIER NAME)],@args);

    if(defined($id)) {
        @terms = $self->get_terms($id);
    } else {
        @terms = $self->get_all_terms();
    }
    if(defined($name)) {
        @terms = grep { $_->name() eq $name; } @terms;
    }
    return @terms;

    my ($self,$qterm) = @_;
    $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
        unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");

    my %matching_terms;

    foreach my $term ($self->get_all_terms) {
        $matching_terms{$term->identifier} = $term and next
            if $term->name eq $qterm->name;
    }
    return values %matching_terms;

    my ($self,$qterm) = @_;
    $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
        unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");

    my %matching_terms;

    foreach my $qstring ($qterm->name, $qterm->each_synonym) {
        foreach my $term ($self->get_all_terms) {
            foreach my $string ( $term->name, $term->each_synonym() ) {
                $matching_terms{$term->identifier} = $term and next
                    if $string eq $qstring;
            }
        }
    }
    return values %matching_terms;

    my ($self,$qterm) = @_;
    $self->throw("Argument doesn't implement Bio::Ontology::TermI. " . "Bummer." )
        unless defined $qterm and $qterm->isa("Bio::Ontology::TermI");

    my %matching_terms;

    foreach my $qstring ($qterm->name, $qterm->each_synonym) {
        foreach my $term ($self->get_all_terms) {

            foreach my $string ( $term->name, $term->each_synonym() ) {
                $matching_terms{$term->identifier} = $term and next
                    if $string =~ /$qstring/ or $qstring =~ /$string/;
            }
        }
    }
    return values %matching_terms;

    my $self = shift;

    return $self->{'relationship_factory'} = shift if @_;
    return $self->{'relationship_factory'};

    my $self = shift;

    if(@_) {
        $self->warn("setting term factory, but ".ref($self).
                    " does not create terms on-the-fly");
        return $self->{'term_factory'} = shift;
    }
    return $self->{'term_factory'};

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->_check_class( $value, 'Bio::Ontology::SimpleGOEngine::GraphAdaptor' ); # NG 05-02-16
        $self->{ "_graph" } = $value;
    }

    return $self->{ "_graph" };
} # graph

    my ( $self, $term ) = @_;
    my $id = $term;

    if ( ref($term) ) {

        # use TermI standard API
        $self->throw(
            "Object doesn't implement Bio::Ontology::TermI. " . "Bummer." )
          unless $term->isa("Bio::Ontology::TermI");
        $id = $term->identifier();

        # if there is no ID, we need to fake one from ontology name and name
        # in order to achieve uniqueness
        if ( !$id ) {
            $id = $term->ontology->name() if $term->ontology();
            $id = $id ? $id . '|' : '';
            $id .= $term->name();
        }
    }

    return $id

#        if $term->isa("Bio::Ontology::GOterm")||($id =~ /^[A-Z_]{1,8}:\d{1,}$/);
      if $term->isa("Bio::Ontology::OBOterm") || ( $id =~ /^\w+:\w+$/ );

    # prefix with something if only numbers
    #     if($id =~ /^\d+$/) {
    #         $self->warn(ref($self).": identifier [$id] is only numbers - ".
    #                     "prefixing with 'GO:'");
    #         return "GO:" . $id;
    #     }
    # we shouldn't have gotten here if it's at least a remotely decent ID
    $self->throw( ref($self) . ": non-standard identifier '$id'\n" )
      unless $id =~ /\|/;
    return $id;
}    # _get_id

    my ( $self, $term, $do_get_child_terms, @types ) = @_;

    foreach my $type ( @types ) {
        $self->_check_class( $type, "Bio::Ontology::TermI" );
    }

    my @relative_terms = ();

    $term = $self->_get_id( $term );
    if ( ! $self->graph()->has_vertex( $term ) ) {
        $self->throw( "Ontology does not contain a term with an identifier of\" $term\"" );
    }

    my @all_relative_terms = ();
    if ( $do_get_child_terms ) {
        @all_relative_terms = $self->graph()->successors( $term );
    }
    else {
        @all_relative_terms = $self->graph()->predecessors( $term );
    }

    foreach my $relative ( @all_relative_terms ) {
        if ( scalar( @types ) > 0 ) {
            foreach my $type ( @types ) {
                my $relative_type;
                if ( $do_get_child_terms ) {
                  $relative_type = $self->graph()->get_edge_attribute ($term, $relative, TYPE );  # NG 05-02-16
                }
                else {
                  $relative_type = $self->graph()->get_edge_attribute ($relative, $term, TYPE ); # NG 05-02-16
                }
                if ( $relative_type->equals( $type ) ) {
                    push( @relative_terms, $relative );
                }
            }
        }
        else {
            push( @relative_terms, $relative );
        }
    }

    return $self->get_terms( @relative_terms );

} # get_child_terms

    my ( $self, $term, $ids_ref, $types_ref ) = @_;

    my @child_terms = $self->get_child_terms( $term, @$types_ref );

    if ( scalar( @child_terms ) < 1 ) {
        return;
    }

    foreach my $child_term ( @child_terms ) {
        my $child_term_id = $self->_get_id($child_term->identifier());
        $ids_ref->{ $child_term_id } = 0;
        $self->_get_descendant_terms_helper( $child_term_id, $ids_ref, $types_ref );
    }

} # _get_descendant_terms_helper

    my ( $self, $term, $ids_ref, $types_ref ) = @_;

    my @parent_terms = $self->get_parent_terms( $term, @$types_ref );

    if ( scalar( @parent_terms ) < 1 ) {
        return;
    }

    foreach my $parent_term ( @parent_terms ) {
        my $parent_term_id = $self->_get_id($parent_term->identifier());
        $ids_ref->{ $parent_term_id } = 0;
        $self->_get_ancestor_terms_helper( $parent_term_id, $ids_ref, $types_ref );
    }

} # get_ancestor_terms_helper

    my ( $self, $value, $expected_class ) = @_;

    if ( ! defined( $value ) ) {
        $self->throw( "Found [undef] where [$expected_class] expected" );
    }
    elsif ( ! ref( $value ) ) {
        $self->throw( "Found [scalar] where [$expected_class] expected" );
    }
    elsif ( ! $value->isa( $expected_class ) ) {
        $self->throw( "Found [" . ref( $value ) . "] where [$expected_class] expected" );
    }

} # _check_class

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  http://bugzilla.open-bio.org/

  Northwestern University
  Center for Genetic Medicine (CGM), dictyBase
  Suite 1206,
  676 St. Clair st
  Chicago IL 60611

 Hilmar Lapp, hlapp at gmx.net
 Chris Mungall,   cjm at fruitfly.org