~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/Ontology/Term.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# $Id: Term.pm,v 1.18 2003/12/18 08:18:36 juguang Exp $
 
1
# $Id: Term.pm,v 1.31.4.1 2006/10/02 23:10:22 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::Ontology::Term
4
4
#
20
20
 
21
21
# POD documentation - main docs before the code
22
22
 
23
 
 
24
23
=head1 NAME
25
24
 
26
 
Term - interface for ontology terms
 
25
Bio::Ontology::Term - implementation of the interface for ontology terms
27
26
 
28
27
=head1 SYNOPSIS
29
28
 
41
40
 
42
41
=head1 DESCRIPTION
43
42
 
44
 
This is "dumb" interface for ontology terms providing basic methods
45
 
(it provides no functionality related to graphs). It implements the
46
 
L<Bio::Ontology::TermI> interface.
 
43
This is a simple implementation for ontology terms providing basic
 
44
methods (it provides no functionality related to graphs). It
 
45
implements the L<Bio::Ontology::TermI> interface.
47
46
 
48
47
This class also implements L<Bio::IdentifiableI> and
49
48
L<Bio::DescribableI>.
56
55
Bioperl modules. Send your comments and suggestions preferably to one
57
56
of the Bioperl mailing lists.  Your participation is much appreciated.
58
57
 
59
 
  bioperl-l@bioperl.org             - General discussion
60
 
  http://bio.perl.org/MailList.html - About the mailing lists
 
58
  bioperl-l@bioperl.org                  - General discussion
 
59
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
61
60
 
62
61
=head2 Reporting Bugs
63
62
 
64
63
Report bugs to the Bioperl bug tracking system to help us keep track
65
 
the bugs and their resolution.  Bug reports can be submitted via email
66
 
or the web:
 
64
the bugs and their resolution.  Bug reports can be submitted via the web:
67
65
 
68
 
  bioperl-bugs@bio.perl.org
69
 
  http://bugzilla.bioperl.org/
 
66
  http://bugzilla.open-bio.org/
70
67
 
71
68
=head1 AUTHOR
72
69
 
93
90
# Let the code begin...
94
91
 
95
92
package Bio::Ontology::Term;
96
 
use vars qw( @ISA );
97
93
use strict;
98
 
use Bio::Root::Object;
99
 
use Bio::Ontology::TermI;
100
94
use Bio::Ontology::Ontology;
101
95
use Bio::Ontology::OntologyStore;
102
 
use Bio::IdentifiableI;
103
 
use Bio::DescribableI;
104
96
 
105
97
use constant TRUE    => 1;
106
98
use constant FALSE   => 0;
107
99
 
108
 
@ISA = qw( Bio::Root::Root
109
 
           Bio::Ontology::TermI
110
 
           Bio::IdentifiableI
111
 
           Bio::DescribableI
112
 
         );
 
100
use base qw(Bio::Root::Root Bio::Ontology::TermI Bio::IdentifiableI Bio::DescribableI);
113
101
 
114
102
 
115
103
 
116
104
=head2 new
117
105
 
118
106
 Title   : new
119
 
 Usage   : $term = Bio::Ontology::Term->new( 
 
107
 Usage   : $term = Bio::Ontology::Term->new(
120
108
                -identifier  => "16847",
121
109
                -name        => "1-aminocyclopropane-1-carboxylate synthase",
122
110
                -definition  => "Catalysis of ...",
128
116
           -name                  => the name of this term [scalar]
129
117
           -definition            => the definition of this term [scalar]
130
118
           -ontology              => the ontology this term lives in
131
 
                                     (a L<Bio::Ontology::OntologyI> object)
 
119
                                     (a Bio::Ontology::OntologyI object)
132
120
           -version               => version information [scalar]
133
121
           -is_obsolete           => the obsoleteness of this term [0 or 1]
134
122
           -comment               => a comment [scalar]
135
 
           -dblinks               => L<Bio::Annotation::DBLink> objects
136
 
                                     [reference to array] 
137
 
           -references            => L<Bio::Annotation::Reference> objects
138
 
                                     [reference to array]
 
123
           -dblinks               => Bio::Annotation::DBLink objects
 
124
                                     [reference to array]
 
125
           -references            => Bio::Annotation::Reference objects
 
126
                                     [reference to array]
 
127
 
 
128
See L<Bio::Ontology::OntologyI>, L<Bio::Annotation::Reference>,
 
129
L<Bio::Annotation::DBLink>.
139
130
 
140
131
=cut
141
132
 
144
135
    my( $class,@args ) = @_;
145
136
 
146
137
    my $self = $class->SUPER::new( @args );
147
 
#    return $self;
148
 
#}
149
 
 
150
 
#sub _initialize {
151
 
#    my ($self, @args) =@_;
152
138
    my ( $identifier,
153
139
         $name,
154
140
         $definition,
155
141
         $category,
156
 
         $ont,
 
142
                        $ont,
157
143
         $version,
158
144
         $is_obsolete,
159
145
         $comment,
160
 
         $dblinks, $references)
161
 
        = $self->_rearrange( [ qw( IDENTIFIER
162
 
                                   NAME
163
 
                                   DEFINITION
164
 
                                   CATEGORY
165
 
                   ONTOLOGY
166
 
                                   VERSION
167
 
                                   IS_OBSOLETE
168
 
                                   COMMENT
169
 
                   DBLINKS REFERENCES
 
146
                        $dblinks,
 
147
                        $references)
 
148
        = $self->_rearrange( [ qw( IDENTIFIER
 
149
                                                                                NAME
 
150
                                                                                DEFINITION
 
151
                                                                                CATEGORY
 
152
                                                                                ONTOLOGY
 
153
                                                                                VERSION
 
154
                                                                                IS_OBSOLETE
 
155
                                                                                COMMENT
 
156
                                                                                DBLINKS
 
157
                                                                                REFERENCES
170
158
       ) ], @args );
171
159
 
172
160
    $self->init();
173
 
    
 
161
 
174
162
    defined($identifier)   && $self->identifier( $identifier );
175
163
    defined($name)         && $self->name( $name );
176
164
    defined($definition)   && $self->definition( $definition );
182
170
    ref($dblinks)          && $self->add_dblink(@$dblinks);
183
171
    ref($references)       && $self->add_reference(@$references);
184
172
 
185
 
return $self;
 
173
    return $self;
186
174
} # new
187
175
 
188
176
 
209
197
=head2 identifier
210
198
 
211
199
 Title   : identifier
212
 
 Usage   : $term->identifier( "0003947" );
 
200
 Usage   : $term->identifier( "GO:0003947" );
213
201
           or
214
202
           print $term->identifier();
215
203
 Function: Set/get for the identifier of this Term.
226
214
} # identifier
227
215
 
228
216
 
229
 
 
230
 
 
231
217
=head2 name
232
218
 
233
219
 Title   : name
248
234
} # name
249
235
 
250
236
 
251
 
 
252
 
 
253
 
 
254
237
=head2 definition
255
238
 
256
239
 Title   : definition
280
263
 Function: Get the ontology this term is in.
281
264
 
282
265
           Note that with the ontology in hand you can query for all
283
 
           related terms etc. See L<Bio::Ontology::OntologyI>.
 
266
           related terms etc.
284
267
 
285
 
 Returns : The ontology of this Term as a L<Bio::Ontology::OntologyI>
 
268
 Returns : The ontology of this Term as a Bio::Ontology::OntologyI
286
269
           implementing object.
287
 
 Args    : On set, the  ontology of this Term as a L<Bio::Ontology::OntologyI>
 
270
 Args    : On set, the  ontology of this Term as a Bio::Ontology::OntologyI
288
271
           implementing object or a string representing its name.
289
272
 
 
273
See L<Bio::Ontology::OntologyI>.
 
274
 
290
275
=cut
291
276
 
292
277
sub ontology {
294
279
    my $ont;
295
280
 
296
281
    if(@_) {
297
 
        $ont = shift;
298
 
        if($ont) {
299
 
            $ont = Bio::Ontology::Ontology->new(-name => $ont) if ! ref($ont);
300
 
            if(! $ont->isa("Bio::Ontology::OntologyI")) {
301
 
                $self->throw(ref($ont)." does not implement ".
302
 
                             "Bio::Ontology::OntologyI. Bummer.");
303
 
            }
304
 
        }
305
 
        return $self->{"_ontology"} = $ont;
 
282
        $ont = shift;
 
283
        if($ont) {
 
284
            $ont = Bio::Ontology::Ontology->new(-name => $ont) if ! ref($ont);
 
285
            if(! $ont->isa("Bio::Ontology::OntologyI")) {
 
286
                $self->throw(ref($ont)." does not implement ".
 
287
                             "Bio::Ontology::OntologyI. Bummer.");
 
288
            }
 
289
        }
 
290
        return $self->{"_ontology"} = $ont;
306
291
    }
307
292
    return $self->{"_ontology"};
308
293
} # ontology
349
334
} # is_obsolete
350
335
 
351
336
 
352
 
 
353
 
 
354
 
 
355
337
=head2 comment
356
338
 
357
339
 Title   : comment
411
393
 
412
394
    # avoid duplicates
413
395
    foreach my $syn (@values) {
414
 
        next if grep { $_ eq $syn; } @{$self->{ "_synonyms" }};
415
 
        push( @{ $self->{ "_synonyms" } }, $syn );
 
396
        next if grep { $_ eq $syn; } @{$self->{ "_synonyms" }};
 
397
        push( @{ $self->{ "_synonyms" } }, $syn );
416
398
    }
417
399
 
418
400
} # add_synonym
443
425
 Usage   : @ds = $term->get_dblinks();
444
426
 Function: Returns a list of each dblinks of this GO term.
445
427
 Returns : A list of dblinks [array of [scalars]].
446
 
 Args    :
 
428
 Args    : A scalar indicating the context (optional).
 
429
           If omitted, all dblinks will be returned.
447
430
 
448
431
=cut
449
432
 
450
433
sub get_dblinks {
451
434
    my $self = shift;
 
435
    my $context = shift;
452
436
 
453
 
    return @{$self->{ "_dblinks" }} if exists($self->{ "_dblinks" });
 
437
    if (defined($context)) {
 
438
        return @{$self->{_dblinks}->{$context}}
 
439
            if exists($self->{_dblinks}->{$context});
 
440
    } else {
 
441
        return map { @$_ } values %{$self->{_dblinks}};
 
442
    }
454
443
    return ();
455
444
} # get_dblinks
456
445
 
457
446
 
 
447
=head2 get_dblink_context
 
448
 
 
449
  Title   : get_dblink_context
 
450
  Usage   : @context = $term->get_dblink_context;
 
451
  Function: Return all context existing in Term
 
452
  Returns : a list of scalar
 
453
  Args    : [none]
 
454
 
 
455
=cut
 
456
 
 
457
sub get_dblink_context {
 
458
    my $self=shift;
 
459
    return keys %{$self->{_dblinks}};
 
460
}
 
461
 
458
462
=head2 add_dblink
459
463
 
460
464
 Title   : add_dblink
469
473
=cut
470
474
 
471
475
sub add_dblink {
472
 
    my ( $self, @values ) = @_;
473
 
 
474
 
    return unless( @values );
475
 
 
476
 
    # avoid duplicates
477
 
    foreach my $dbl (@values) {
478
 
        next if grep { $_ eq $dbl; } @{$self->{ "_dblinks" }};
479
 
        push( @{ $self->{ "_dblinks" } }, $dbl );
480
 
    }
481
 
 
 
476
    my $self = shift;
 
477
    $self->add_dblink_context($_,'_default') foreach @_;
482
478
} # add_dblink
483
479
 
484
480
 
 
481
=head2 has_dblink
 
482
 
 
483
  Title   : has_dblink
 
484
  Usage   : $term->has_dblink($dblink);
 
485
  Function: Checks if a DBXref is already existing in the OBOterm object
 
486
  Return  : TRUE/FALSE
 
487
  Args    : [arg1] A DBxref identifier
 
488
 
 
489
=cut
 
490
 
 
491
sub has_dblink {
 
492
    my ( $self, $value ) = @_;
 
493
    return unless defined $value;
 
494
    my $context = "_default";
 
495
    $self->throw("'all' is a reserved word for context.") if $context eq 'all';
 
496
    $context ||= '_default';
 
497
    if ( ( $self->{_dblinks}->{$context} ) && grep { $_ eq $value }
 
498
        @{ $self->{_dblinks}->{$context} } )
 
499
    {
 
500
        return TRUE;
 
501
    }
 
502
    else {
 
503
        return FALSE;
 
504
    }
 
505
}
 
506
 
 
507
 
 
508
=head2 add_dblink_context
 
509
 
 
510
  Title   : add_dblink_context
 
511
  Usage   : $term->add_dblink_context($db, $context);
 
512
  Function: add a dblink with its context
 
513
  Return  : [none]
 
514
  Args    : [arg1] an object of Bio::Annotation::DBLink
 
515
            [arg2] a string for context; if omitted, the
 
516
                   default/context-less one will be used.
 
517
 
 
518
=cut
 
519
 
 
520
sub add_dblink_context {
 
521
    my ($self, $value, $context)=@_;
 
522
    return unless defined $value;
 
523
    $self->throw("'all' is a reserved word for context.") if $context eq 'all';
 
524
    $context ||= '_default';
 
525
    if (! exists($self->{_dblinks}->{$context})) {
 
526
        $self->{_dblinks}->{$context} = [];
 
527
    }
 
528
    if (grep {$_ eq $value} @{$self->{_dblinks}->{$context}}) {
 
529
        $self->warn("$value exists in the dblink of $context");
 
530
    }
 
531
    push @{$self->{_dblinks}->{$context}}, $value;
 
532
}
 
533
 
485
534
=head2 remove_dblinks
486
535
 
487
536
 Title   : remove_dblinks()
488
537
 Usage   : $term->remove_dblinks();
489
538
 Function: Deletes (and returns) the definition references of this GO term.
490
539
 Returns : A list of definition references [array of [scalars]].
491
 
 Args    :
 
540
 Args    : Context. If omitted or equal to 'all', all dblinks
 
541
           will be removed.
492
542
 
493
543
=cut
494
544
 
495
545
sub remove_dblinks {
496
 
    my ( $self ) = @_;
497
 
 
498
 
    my @a = $self->get_dblinks();
499
 
    $self->{ "_dblinks" } = [];
500
 
    return @a;
501
 
 
 
546
    my ($self, $context) = @_;
 
547
    $context = undef if $context && ($context eq "all");
 
548
    my @old = $self->get_dblinks($context);
 
549
    if (defined($context)) {
 
550
        $self->{_dblinks}->{$context}=[];
 
551
    } else {
 
552
        $self->{_dblinks} = {};
 
553
    }
 
554
    return @old;
502
555
} # remove_dblinks
503
556
 
504
557
 
531
584
sub add_reference {
532
585
    my ($self, @values) =@_;
533
586
    return unless @values;
534
 
    # Avoid duplicates
 
587
    # avoid duplicates and undefs
535
588
    foreach my $reference (@values){
 
589
        next unless $reference;
536
590
        next if grep{$_ eq $reference} @{$self->{_references}};
537
591
        push @{$self->{_references}}, $reference;
538
592
    }
596
650
 
597
651
    # avoid duplicates
598
652
    foreach my $id (@_) {
599
 
        next if grep { !$_ or $_ eq $id; } @{$self->{ "_secondary_ids" }};
600
 
        push( @{ $self->{ "_secondary_ids" } }, $id );
 
653
        next if grep { !$_ or $_ eq $id; } @{$self->{ "_secondary_ids" }};
 
654
        push( @{ $self->{ "_secondary_ids" } }, $id );
601
655
    }
602
656
 
603
657
} # add_secondary_id
679
733
 
680
734
    return $ont->authority(@_) if $ont;
681
735
    $self->throw("cannot manipulate authority prior to ".
682
 
                 "setting the namespace or ontology") if @_;
683
 
    return undef;
 
736
                 "setting the namespace or ontology") if @_;
 
737
    return;
684
738
}
685
739
 
686
740
 
716
770
 Usage   : $string    = $obj->display_name()
717
771
 Function: A string which is what should be displayed to the user.
718
772
 
719
 
           The definition in L<Bio::DescribableI> states that the
720
 
           string should not contain spaces. As this isn't very
 
773
           The definition in Bio::DescribableI states that the
 
774
           string should not contain spaces. As this is not very
721
775
           sensible for ontology terms, we relax this here. The
722
776
           implementation just forwards to name().
723
777
 
743
797
           This forwards to definition(). The caveat is that the text
744
798
           will often be longer for ontology term definitions than the
745
799
           255 characters stated in the definition in
746
 
           L<Bio::DescribableI>.
 
800
           Bio::DescribableI.
747
801
 
748
802
 Returns : A scalar
749
803
 Args    : on set, the new value (a scalar)
764
818
 
765
819
=cut
766
820
 
767
 
=head2 category
768
 
 
769
 
 Title   : category
770
 
 Usage   :
771
 
 Function: This method is deprecated. Use ontology() instead.
772
 
 Example :
773
 
 Returns :
774
 
 Args    :
775
 
 
776
 
 
777
 
=cut
778
 
 
779
 
sub category {
780
 
    my $self = shift;
781
 
 
782
 
    $self->warn("TermI::category is deprecated and being phased out. ".
783
 
                "Use TermI::ontology instead.");
784
 
 
785
 
    # called in set mode?
786
 
    if(@_) {
787
 
        # yes; what is incompatible with ontology() is if we were given
788
 
        # a TermI object
789
 
        my $arg = shift;
790
 
        $arg = $arg->name() if ref($arg) && $arg->isa("Bio::Ontology::TermI");
791
 
        return $self->ontology($arg,@_);
792
 
    } else {
793
 
        # No, called in get mode. This is always incompatible with ontology()
794
 
        # since category is supposed to return a TermI.
795
 
        my $ont = $self->ontology();
796
 
        my $term;
797
 
        if(defined($ont)) {
798
 
            $term = Bio::Ontology::Term->new(-name => $ont->name(),
799
 
                                             -identifier =>$ont->identifier());
800
 
        }
801
 
        return $term;
802
 
    }
803
 
} # category
804
 
 
805
821
*each_synonym = \&get_synonyms;
806
822
*add_synonyms = \&add_synonym;
807
823
*each_dblink = \&get_dblinks;