lib/Bio/Annotation/Relation.pm

   1 # $Id: Relation.pm 14708 2008-06-10 00:08:17Z heikki $
   2 #
   3 # BioPerl module for Bio::Annotation::Relation
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by bioperl <bioperl-l@bioperl.org>
   8 #
   9 # Copyright bioperl
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::Annotation::Relation - Relationship (pairwise) with other objects SeqI and NodeI;
  18
  19 =head1 SYNOPSIS
  20
  21    use Bio::Annotation::Relation;
  22    use Bio::Annotation::Collection;
  23
  24    my $col = Bio::Annotation::Collection->new();
  25    my $sv = Bio::Annotation::Relation->new(-type => "paralogy" -to => "someSeqI");
  26    $col->add_Annotation('tagname', $sv);
  27
  28 =head1 DESCRIPTION
  29
  30 Scalar value annotation object
  31
  32 =head1 FEEDBACK
  33
  34 =head2 Mailing Lists
  35
  36 User feedback is an integral part of the evolution of this and other
  37 Bioperl modules. Send your comments and suggestions preferably to one
  38 of the Bioperl mailing lists. Your participation is much appreciated.
  39
  40   bioperl-l@bioperl.org                  - General discussion
  41   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  42
  43 =head2 Support
  44
  45 Please direct usage questions or support issues to the mailing list:
  46
  47 I<bioperl-l@bioperl.org>
  48
  49 rather than to the module maintainer directly. Many experienced and
  50 reponsive experts will be able look at the problem and quickly
  51 address it. Please include a thorough description of the problem
  52 with code and data examples if at all possible.
  53
  54 =head2 Reporting Bugs
  55
  56 Report bugs to the Bioperl bug tracking system to help us keep track
  57 the bugs and their resolution.  Bug reports can be submitted via
  58 the web:
  59
  60   https://github.com/bioperl/bioperl-live/issues
  61
  62 =head1 AUTHOR  - Mira Han
  63
  64 Email mirhan@indiana.edu
  65
  66 =head1 APPENDIX
  67
  68 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
  69
  70 =cut
  71
  72
  73 # Let the code begin...
  74
  75
  76 package Bio::Annotation::Relation;
  77
  78 use strict;
  79
  80 # Object preamble - inherits from Bio::Root::Root
  81
  82 use base qw(Bio::Root::Root Bio::AnnotationI);
  83
  84 =head2 new
  85
  86  Title   : new
  87  Usage   : my $sv = Bio::Annotation::Relation->new();
  88  Function: Instantiate a new Relation object
  89  Returns : Bio::Annotation::Relation object
  90  Args    : -type    => $type of relation [optional]
  91            -to     => $obj which $self is in relation to [optional]
  92            -tagname  => $tag to initialize the tagname [optional]
  93            -tag_term => ontology term representation of the tag [optional]
  94
  95 =cut
  96
  97 sub new{
  98    my ($class,@args) = @_;
  99
 100    my $self = $class->SUPER::new(@args);
 101
 102    my ($type, $to, $tag, $term) =
 103        $self->_rearrange([qw(TYPE TO TAGNAME TAG_TERM)], @args);
 104
 105    # set the term first
 106    defined $term   && $self->tag_term($term);
 107    defined $type && $self->type($type);
 108    defined $to  && $self->to($to);
 109    defined $tag    && $self->tagname($tag);
 110
 111    return $self;
 112 }
 113
 114
 115 =head1 AnnotationI implementing functions
 116
 117 =cut
 118
 119 =head2 as_text
 120
 121  Title   : as_text
 122  Usage   : my $text = $obj->as_text
 123  Function: return the string "Value: $v" where $v is the value
 124  Returns : string
 125  Args    : none
 126
 127
 128 =cut
 129
 130 sub as_text{
 131    my ($self) = @_;
 132
 133    return $self->type." to  ".$self->to->id;
 134 }
 135
 136 =head2 display_text
 137
 138  Title   : display_text
 139  Usage   : my $str = $ann->display_text();
 140  Function: returns a string. Unlike as_text(), this method returns a string
 141            formatted as would be expected for te specific implementation.
 142
 143            One can pass a callback as an argument which allows custom text
 144            generation; the callback is passed the current instance and any text
 145            returned
 146  Example :
 147  Returns : a string
 148  Args    : [optional] callback
 149
 150 =cut
 151
 152 {
 153   my $DEFAULT_CB = sub { return $_[0]->type." to  ".$_[0]->to->id };
 154   #my $DEFAULT_CB = sub { $_[0]->value};
 155
 156   sub display_text {
 157     my ($self, $cb) = @_;
 158     $cb ||= $DEFAULT_CB;
 159     $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
 160     return $cb->($self);
 161   }
 162
 163 }
 164
 165 =head2 hash_tree
 166
 167  Title   : hash_tree
 168  Usage   : my $hashtree = $value->hash_tree
 169  Function: For supporting the AnnotationI interface just returns the value
 170            as a hashref with the key 'value' pointing to the value
 171  Returns : hashrf
 172  Args    : none
 173
 174
 175 =cut
 176
 177 sub hash_tree{
 178     my $self = shift;
 179
 180     my $h = {};
 181     $h->{'type'} = $self->type;
 182     $h->{'to'} = $self->to;
 183     return $h;
 184 }
 185
 186 =head2 tagname
 187
 188  Title   : tagname
 189  Usage   : $obj->tagname($newval)
 190  Function: Get/set the tagname for this annotation value.
 191
 192            Setting this is optional. If set, it obviates the need to
 193            provide a tag to AnnotationCollection when adding this
 194            object.
 195
 196  Example :
 197  Returns : value of tagname (a scalar)
 198  Args    : new value (a scalar, optional)
 199
 200
 201 =cut
 202
 203 sub tagname{
 204     my $self = shift;
 205
 206     # check for presence of an ontology term
 207     if($self->{'_tag_term'}) {
 208         # keep a copy in case the term is removed later
 209         $self->{'tagname'} = $_[0] if @_;
 210         # delegate to the ontology term object
 211         return $self->tag_term->name(@_);
 212     }
 213     return $self->{'tagname'} = shift if @_;
 214     return $self->{'tagname'};
 215 }
 216
 217
 218 =head1 Specific accessors for Relation
 219
 220 =cut
 221
 222 =head2 type
 223
 224  Title   : type
 225  Usage   : $obj->type($newval)
 226  Function: Get/Set the type
 227  Returns : type of relation
 228  Args    : newtype (optional)
 229
 230
 231 =cut
 232
 233 sub type{
 234    my ($self,$type) = @_;
 235
 236    if( defined $type) {
 237       $self->{'type'} = $type;
 238     }
 239     return $self->{'type'};
 240 }
 241
 242 =head2 to
 243
 244  Title   : to
 245  Usage   : $obj->to($newval)
 246  Function: Get/Set the object which $self is in relation to
 247  Returns : the object which the relation applies to
 248  Args    : new target object (optional)
 249
 250
 251 =cut
 252
 253 sub to{
 254    my ($self,$to) = @_;
 255
 256    if( defined $to) {
 257       $self->{'to'} = $to;
 258     }
 259     return $self->{'to'};
 260 }
 261
 262 =head2 confidence
 263
 264  Title   : confidence
 265  Usage   : $self->confidence($newval)
 266  Function: Gives the confidence value.
 267  Example :
 268  Returns : value of confidence
 269  Args    : newvalue (optional)
 270
 271
 272 =cut
 273
 274 sub confidence{
 275    my ($self,$value) = @_;
 276    if( defined $value) {
 277       $self->{'confidence'} = $value;
 278     }
 279     return $self->{'confidence'};
 280
 281 }
 282
 283 =head2 confidence_type
 284
 285  Title   : confidence_type
 286  Usage   : $self->confidence_type($newtype)
 287  Function: Gives the confidence type.
 288  Example :
 289  Returns : type of confidence
 290  Args    : newtype (optional)
 291
 292
 293 =cut
 294
 295 sub confidence_type{
 296    my ($self,$type) = @_;
 297    if( defined $type) {
 298       $self->{'confidence_type'} = $type;
 299     }
 300     return $self->{'confidence_type'};
 301 }
 302
 303 =head2 tag_term
 304
 305  Title   : tag_term
 306  Usage   : $obj->tag_term($newval)
 307  Function: Get/set the L<Bio::Ontology::TermI> object representing
 308            the tag name.
 309
 310            This is so you can specifically relate the tag of this
 311            annotation to an entry in an ontology. You may want to do
 312            this to associate an identifier with the tag, or a
 313            particular category, such that you can better match the tag
 314            against a controlled vocabulary.
 315
 316            This accessor will return undef if it has never been set
 317            before in order to allow this annotation to stay
 318            light-weight if an ontology term representation of the tag
 319            is not needed. Once it is set to a valid value, tagname()
 320            will actually delegate to the name() of this term.
 321
 322  Example :
 323  Returns : a L<Bio::Ontology::TermI> compliant object, or undef
 324  Args    : on set, new value (a L<Bio::Ontology::TermI> compliant
 325            object or undef, optional)
 326
 327
 328 =cut
 329
 330 sub tag_term{
 331     my $self = shift;
 332
 333     return $self->{'_tag_term'} = shift if @_;
 334     return $self->{'_tag_term'};
 335 }
 336
 337 1;