A test to ensure Bio::PrimarySeqI->trunc() doesn't use clone() for a Bio::Seq::RichSe...
[bioperl-live.git] / t / Ontology / Ontology.t
blobc73b9a50c973fed4d3fc2e38954fc58434fdba38
1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id$
4 use strict;
6 BEGIN {
7     use lib '.';
8     use Bio::Root::Test;
10     test_begin(
11         -tests           => 55,
12         -requires_module => 'Graph'
13     );
15     use_ok('Bio::OntologyIO');
16     use_ok('Bio::Ontology::RelationshipType');
19 my $IS_A    = Bio::Ontology::RelationshipType->get_instance("IS_A");
20 my $PART_OF = Bio::Ontology::RelationshipType->get_instance("PART_OF");
22 my $parser = Bio::OntologyIO->new(
23     -format => "soflat",
24     -file   => test_input_file('sofa.ontology')
27 my $ont = $parser->next_ontology();
28 isa_ok( $ont, 'Bio::Ontology::Ontology' );
29 is( $ont->name, "Sequence Feature Ontology" );
31 my @roots = $ont->get_root_terms();
32 is( scalar(@roots),          1 );
33 is( $roots[0]->name(),       "Sequence_Feature_Ontology" );
34 is( $roots[0]->identifier(), "SO:0000000" );
36 my @terms = $ont->get_child_terms( $roots[0] );
37 is( scalar(@terms),    1 );
38 is( $terms[0]->name(), "sofa" );
39 @terms = $ont->get_child_terms( $terms[0] );
40 is( scalar(@terms),    1 );
41 is( $terms[0]->name(), "feature" );
42 my $featterm = $terms[0];
43 @terms = $ont->get_child_terms($featterm);
44 is( scalar(@terms), 10 );
46 # oligonucleotide has two parents, see whether this is handled
47 @terms = $ont->get_descendant_terms($featterm);
48 my ($term) = grep { $_->name() eq "oligonucleotide"; } @terms;
49 ok $term;
51 #TODO: {
52 #       local $TODO = '$term->identifier()';
53 is( $term->identifier(), "SO:0000696" );
57 @terms = $ont->get_ancestor_terms($term);
58 is( scalar(@terms), 7 );
59 is( scalar( grep { $_->name() eq "remark"; } @terms ),  1 );
60 is( scalar( grep { $_->name() eq "reagent"; } @terms ), 1 );
62 # processed_transcript has part-of and is-a children
63 @terms = $ont->get_descendant_terms($featterm);
64 ($term) = grep { $_->name() eq "processed_transcript"; } @terms;
65 ok $term;
67 #TODO: {
68 #       local $TODO = '$term->identifier()';
69 is( $term->identifier(), "SO:0000233" );
73 @terms = $ont->get_child_terms($term);
74 is( scalar(@terms), 4 );
75 @terms = $ont->get_child_terms( $term, $PART_OF );
76 is( scalar(@terms), 2 );
77 @terms = $ont->get_child_terms( $term, $IS_A );
78 is( scalar(@terms), 2 );
79 @terms = $ont->get_child_terms( $term, $PART_OF, $IS_A );
80 is( scalar(@terms), 4 );
82 # now all descendants:
83 @terms = $ont->get_descendant_terms($term);
84 is( scalar(@terms), 13 );
85 @terms = $ont->get_descendant_terms( $term, $PART_OF );
86 is( scalar(@terms), 2 );
87 @terms = $ont->get_descendant_terms( $term, $IS_A );
88 is( scalar(@terms), 5 );
89 @terms = $ont->get_descendant_terms( $term, $PART_OF, $IS_A );
90 is( scalar(@terms), 13 );
92 # TF_binding_site has 2 parents and different relationships in the two
93 # paths up (although the relationships to its two parents are of the
94 # same type, namely is-a)
95 @terms = $ont->get_descendant_terms($featterm);
96 ($term) = grep { $_->name() eq "TF_binding_site"; } @terms;
97 ok $term;
99 #TODO: {
100 #       local $TODO = '$term->identifier()';
101 is( $term->identifier(), "SO:0000235" );
105 @terms = $ont->get_parent_terms($term);
106 is( scalar(@terms), 2 );
107 my ($pterm) = grep { $_->name eq "regulatory_region"; } @terms;
108 ok $pterm;
109 @terms = $ont->get_parent_terms( $term, $PART_OF );
110 is( scalar(@terms), 0 );
111 @terms = $ont->get_parent_terms( $term, $IS_A );
112 is( scalar(@terms), 2 );
113 @terms = $ont->get_parent_terms( $term, $PART_OF, $IS_A );
114 is( scalar(@terms), 2 );
116 # now all ancestors:
117 @terms = $ont->get_ancestor_terms($term);
118 is( scalar(@terms), 6 );
119 @terms = $ont->get_ancestor_terms( $term, $PART_OF );
120 is( scalar(@terms), 0 );
121 @terms = $ont->get_ancestor_terms( $pterm, $PART_OF );
122 is( scalar(@terms), 1 );
123 @terms = $ont->get_ancestor_terms( $term, $IS_A );
124 is( scalar(@terms), 5 );
125 @terms = $ont->get_ancestor_terms( $pterm, $IS_A );
126 is( scalar(@terms), 0 );
127 @terms = $ont->get_ancestor_terms( $term, $PART_OF, $IS_A );
128 is( scalar(@terms), 6 );
130 # pull out all relationships
131 my @rels = $ont->get_relationships();
132 my @relset = grep { $_->object_term->name eq "sofa"; } @rels;
133 is( scalar(@relset), 1 );
134 @relset = grep { $_->subject_term->name eq "sofa"; } @rels;
135 is( scalar(@relset), 1 );
136 @relset = grep { $_->object_term->name eq "feature"; } @rels;
137 is( scalar(@relset), 10 );
138 @relset = grep { $_->subject_term->name eq "feature"; } @rels;
139 is( scalar(@relset), 1 );
140 @relset = grep { $_->object_term->identifier eq "SO:0000233"; } @rels;
141 is( scalar(@relset), 4 );
142 @relset = grep { $_->predicate_term->name eq "IS_A" } @relset;
143 is( scalar(@relset), 2 );
145 # relationships for a specific term only
146 ($term) = $ont->find_terms( -identifier => "SO:0000233" );
147 ok($term);
148 is( $term->identifier, "SO:0000233" );
149 is( $term->name,       "processed_transcript" );
150 @rels = $ont->get_relationships($term);
151 is( scalar(@rels), 5 );
152 @relset = grep { $_->predicate_term->name eq "IS_A"; } @rels;
153 is( scalar(@relset), 3 );
154 @relset = grep { $_->object_term->identifier eq "SO:0000233"; } @rels;
155 is( scalar(@relset), 4 );
157 SKIP: {
158     test_skip(-tests    => 3, -requires_module => 'XML::Parser::PerlSAX');
159     for my $file (qw/interpro.xml interpro_sample.xml interpro_relationship.xml/) {
160         my $parser = Bio::OntologyIO->new(
161             -format => "interpro",
162             -file   => test_input_file($file),
163         );
164         ok( $parser->next_ontology, "Interpro XML file $file can be parsed" );
165     }