lib/Bio/Annotation/Tree.pm

   1 # BioPerl module for Bio::Annotation::Tree
   2 #
   3 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   4 #
   5 # Cared for by Weigang Qiu <weigang at genectr.hunter.cuny.edu>
   6 #
   7 # Based on the Bio::Annotation::DBLink by Ewan Birney
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::Annotation::Tree - Provide a tree as an annotation to a Bio::AnnotatableI
  16 object
  17
  18 =head1 SYNOPSIS
  19
  20    # Read a tree and an alignment
  21
  22    $treeio=Bio::TreeIO->new(-file=>'foo.dnd', -format=>'newic');
  23    $tree=$treeio->next_tree;
  24    $alnio=Bio::AlignIO->new(-file=>'foo.aln', -format=>'clustalw');
  25    $aln=$alnio->next_aln;
  26
  27    # Construct a tree annotation
  28    $ann_tree = Bio::Annotation::Tree->new (-tree_id  => 'mytree',
  29                                            -tree_obj     => $tree,
  30                                             );
  31
  32    # Add the tree annotation to AlignI
  33    $ac = Bio::Annotation::Collection->new();
  34    $ac->add_Annotation('tree', $ann_tree);
  35    $aln->annotation($ac);
  36
  37    # NOTE & TODO:
  38    # The above procedures are sensible only if
  39    # the tree is generated from the alignment.  However,
  40    # currently no effort has been made to check the consistency
  41    # between the tree OTU names and the sequence names
  42
  43 =head1 DESCRIPTION
  44
  45 Provides a Bio::AnnotationI object which contains a Bio::Tree::TreeI, which can
  46 be added to a Bio::AnnotationCollectionI, which in turn be attached to a
  47 Bio::AnnotatableI (typically a Bio::AlignI object)
  48
  49 =head1 AUTHOR
  50
  51 Weigang Qiu - weigang at genectr.hunter.cuny.edu
  52
  53 =head1 CONTRIBUTORS
  54
  55 Aaron Mackey
  56 Jason Stajich
  57
  58 =head1 APPENDIX
  59
  60 The rest of the documentation details each of the object
  61 methods. Internal methods are usually preceded with a '_'
  62
  63 =cut
  64
  65 # Let the code begin...
  66
  67 package Bio::Annotation::Tree;
  68
  69 use strict;
  70
  71 use base qw(Bio::Root::Root Bio::AnnotationI Bio::TreeIO);
  72
  73
  74 sub new {
  75   my($class,@args) = @_;
  76
  77   my $self = $class->SUPER::new(@args);
  78
  79   my ($tree_id, $tree_obj, $tag) =
  80       $self->_rearrange([ qw(
  81                               TREE_ID
  82                               TREE_OBJ
  83                               TAGNAME
  84                          ) ], @args);
  85
  86   defined $tag                        && $self->tagname($tag);
  87   defined $tree_id                    && $self->tree_id($tree_id);
  88   defined $tree_obj                   && $self->tree($tree_obj);
  89   return $self;
  90
  91 # other possible variables to store
  92 #                              TREE_PROGRAM
  93 #                              TREE_METHOD
  94 #                              TREE_FREQUENCY
  95 #  defined $program                    && $self->program($program);
  96 #  defined $method                     && $self->method($method);
  97 #  defined $freq                       && $self->freq($tree_freq);
  98
  99 }
 100
 101 =head1 AnnotationI implementing functions
 102
 103 =cut
 104
 105 =head2 as_text
 106
 107  Title   : as_text
 108  Usage   : $ann_tree->as_text();
 109  Function: output tree as a string
 110  Returns : a newic tree file
 111  Args    : None
 112
 113 =cut
 114
 115 sub as_text{
 116   my ($self) = @_;
 117
 118   my $tree = $self->tree || $self->throw("Tree object absent");
 119   my $treeio = Bio::TreeIO->new();
 120   $treeio->write_tree($tree);
 121 }
 122
 123 =head2 display_text
 124
 125  Title   : display_text
 126  Usage   : my $str = $ann->display_text();
 127  Function: returns a string. Unlike as_text(), this method returns a string
 128            formatted as would be expected for te specific implementation.
 129
 130            One can pass a callback as an argument which allows custom text
 131            generation; the callback is passed the current instance and any text
 132            returned
 133  Example :
 134  Returns : a string
 135  Args    : [optional] callback
 136
 137 =cut
 138
 139 {
 140   my $DEFAULT_CB = sub { $_[0]->as_text || ''};
 141
 142   sub display_text {
 143     my ($self, $cb) = @_;
 144     $cb ||= $DEFAULT_CB;
 145     $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
 146     return $cb->($self);
 147   }
 148
 149 }
 150
 151 =head2 hash_tree
 152
 153  Title   : hash_tree
 154  Usage   : my $hashtree = $value->hash_tree
 155  Function: For supporting the AnnotationI interface just returns the value
 156            as a hashref with the key 'value' pointing to the value
 157  Returns : hashrf to tree
 158  Args    : none
 159
 160 =cut
 161
 162 sub hash_tree{
 163     my $self = shift;
 164     my $h = {};
 165     $h->{'value'} = $self->tree();
 166     return $h;
 167 }
 168
 169 =head2 tagname
 170
 171  Title   : tagname
 172  Usage   : $obj->tagname($newval)
 173  Function: Get/set the tagname for this annotation value.
 174            Setting this is optional. If set, it obviates the need to
 175            provide a tag to Bio::AnnotationCollectionI when adding
 176            this object. When obtaining an AnnotationI object from the
 177            collection, the collection will set the value to the tag
 178            under which it was stored unless the object has a tag
 179            stored already.
 180  Returns : value of tagname (a scalar)
 181  Args    : new value (a scalar, optional)
 182
 183
 184 =cut
 185
 186 sub tagname{
 187     my ($self,$value) = @_;
 188     if( defined $value) {
 189         $self->{'tagname'} = $value;
 190     }
 191     return $self->{'tagname'};
 192 }
 193
 194 =head1 Specific accessors for Tree
 195
 196 =head2 tree_id
 197
 198  Title   : tree_id
 199  Usage   : $obj->tree_id($newval)
 200  Function: Get/set a name for the tree
 201  Returns : value of tagname (a scalar)
 202  Args    : new value (a scalar, optional)
 203
 204
 205 =cut
 206
 207 sub tree_id {
 208     my $self = shift;
 209     return $self->{'tree_id'} = shift if defined($_[0]);
 210     return $self->{'tree_id'};
 211 }
 212
 213 =head2 tree
 214
 215  Title   : tree
 216  Usage   : $obj->tree($newval)
 217  Function: Get/set tree
 218  Returns : tree ref
 219  Args    : new value (a tree ref, optional)
 220
 221
 222 =cut
 223
 224 sub tree {
 225     my $self = shift;
 226     return $self->{'tree'} = shift if defined($_[0]);
 227     return $self->{'tree'};
 228 }
 229
 230 1;
 231