From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

# -*-Perl-*-
## Bioperl Test Harness Script for Modules
## # $Id: Ontology.t,v 1.3 2003/05/24 23:05:35 lapp Exp $
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.t'
use strict;
BEGIN {
# to handle systems with no installed Test module
# we include the t dir (where a copy of Test.pm is located)
# as a fallback
eval { require Test; };
if( $@ ) {
use lib 't';
}
use Test;
eval { require 'Graph.pm' };
if( $@ ) {
print STDERR "\nGraph.pm doesn't seem to be installed on this system -- the GO Parser needs it...\n\n";
plan tests => 1;
ok( 1 );
exit( 0 );
}
plan tests => 50;
}
my $IS_A = Bio::Ontology::RelationshipType->get_instance( "IS_A" );
my $PART_OF = Bio::Ontology::RelationshipType->get_instance( "PART_OF" );
my $io = Bio::Root::IO->new(); # less typing from now on
my $parser = Bio::OntologyIO->new(
-format => "soflat",
-file => $io->catfile("t", "data",
"sofa.ontology"));
my $ont = $parser->next_ontology();
ok ($ont);
ok ($ont->name, "Sequence Feature Ontology");
my @roots = $ont->get_root_terms();
ok (scalar(@roots), 1);
ok ($roots[0]->name(), "Sequence_Feature_Ontology");
ok ($roots[0]->identifier(), "SO:0000000");
my @terms = $ont->get_child_terms($roots[0]);
ok (scalar(@terms), 1);
ok ($terms[0]->name(), "sofa");
@terms = $ont->get_child_terms($terms[0]);
ok (scalar(@terms), 1);
ok ($terms[0]->name(), "feature");
my $featterm = $terms[0];
@terms = $ont->get_child_terms($featterm);
ok (scalar(@terms), 10);
# oligonucleotide has two parents, see whether this is handled
@terms = $ont->get_descendant_terms($featterm);
my ($term) = grep { $_->name() eq "oligonucleotide"; } @terms;
ok $term;
skip(! $term, $term->identifier(), "SO:0000696");
@terms = $ont->get_ancestor_terms($term);
ok (scalar(@terms), 7);
ok (scalar(grep { $_->name() eq "remark"; } @terms), 1);
ok (scalar(grep { $_->name() eq "reagent"; } @terms), 1);
# processed_transcript has part-of and is-a children
@terms = $ont->get_descendant_terms($featterm);
($term) = grep { $_->name() eq "processed_transcript"; } @terms;
ok $term;
skip(! $term, $term->identifier(), "SO:0000233");
@terms = $ont->get_child_terms($term);
ok (scalar(@terms), 4);
@terms = $ont->get_child_terms($term, $PART_OF);
ok (scalar(@terms), 2);
@terms = $ont->get_child_terms($term, $IS_A);
ok (scalar(@terms), 2);
@terms = $ont->get_child_terms($term, $PART_OF, $IS_A);
ok (scalar(@terms), 4);
# now all descendants:
@terms = $ont->get_descendant_terms($term);
ok (scalar(@terms), 13);
@terms = $ont->get_descendant_terms($term, $PART_OF);
ok (scalar(@terms), 2);
@terms = $ont->get_descendant_terms($term, $IS_A);
ok (scalar(@terms), 5);
@terms = $ont->get_descendant_terms($term, $PART_OF, $IS_A);
ok (scalar(@terms), 13);
# TF_binding_site has 2 parents and different relationships in the two
# paths up (although the relationships to its two parents are of the
# same type, namely is-a)
@terms = $ont->get_descendant_terms($featterm);
($term) = grep { $_->name() eq "TF_binding_site"; } @terms;
ok $term;
skip(! $term, $term->identifier(), "SO:0000235");
@terms = $ont->get_parent_terms($term);
ok (scalar(@terms), 2);
my ($pterm) = grep { $_->name eq "regulatory_region"; } @terms;
ok $pterm;
@terms = $ont->get_parent_terms($term, $PART_OF);
ok (scalar(@terms), 0);
@terms = $ont->get_parent_terms($term, $IS_A);
ok (scalar(@terms), 2);
@terms = $ont->get_parent_terms($term, $PART_OF, $IS_A);
ok (scalar(@terms), 2);
# now all ancestors:
@terms = $ont->get_ancestor_terms($term);
ok (scalar(@terms), 6);
@terms = $ont->get_ancestor_terms($term, $PART_OF);
ok (scalar(@terms), 0);
@terms = $ont->get_ancestor_terms($pterm, $PART_OF);
ok (scalar(@terms), 1);
@terms = $ont->get_ancestor_terms($term, $IS_A);
ok (scalar(@terms), 5);
@terms = $ont->get_ancestor_terms($pterm, $IS_A);
ok (scalar(@terms), 0);
@terms = $ont->get_ancestor_terms($term, $PART_OF, $IS_A);
ok (scalar(@terms), 6);
# pull out all relationships
my @rels = $ont->get_relationships();
my @relset = grep { $_->object_term->name eq "sofa"; } @rels;
ok (scalar(@relset), 1);
@relset = grep { $_->subject_term->name eq "sofa"; } @rels;
ok (scalar(@relset), 1);
@relset = grep { $_->object_term->name eq "feature"; } @rels;
ok (scalar(@relset), 10);
@relset = grep { $_->subject_term->name eq "feature"; } @rels;
ok (scalar(@relset), 1);
@relset = grep { $_->object_term->identifier eq "SO:0000233"; } @rels;
ok (scalar(@relset), 4);
@relset = grep { $_->predicate_term->name eq "IS_A" } @relset;
ok (scalar(@relset), 2);
# relationships for a specific term only
($term) = $ont->find_terms(-identifier => "SO:0000233");
ok ($term);
ok ($term->identifier, "SO:0000233");
ok ($term->name, "processed_transcript");
@rels = $ont->get_relationships($term);
ok (scalar(@rels), 5);
@relset = grep { $_->predicate_term->name eq "IS_A"; } @rels;
ok (scalar(@relset), 3);
@relset = grep { $_->object_term->identifier eq "SO:0000233"; } @rels;
ok (scalar(@relset), 4);