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 use strict;
  69
  70 use base qw(Bio::Root::Root Bio::AnnotationI Bio::TreeIO);
  71
  72
  73 sub new {
  74   my($class,@args) = @_;
  75
  76   my $self = $class->SUPER::new(@args);
  77
  78   my ($tree_id, $tree_obj, $tag) =
  79       $self->_rearrange([ qw(
  80                               TREE_ID
  81                               TREE_OBJ
  82                               TAGNAME
  83                          ) ], @args);
  84
  85   defined $tag                        && $self->tagname($tag);
  86   defined $tree_id                    && $self->tree_id($tree_id);
  87   defined $tree_obj                   && $self->tree($tree_obj);
  88   return $self;
  89
  90 # other possible variables to store
  91 #                              TREE_PROGRAM
  92 #                              TREE_METHOD
  93 #                              TREE_FREQUENCY
  94 #  defined $program                    && $self->program($program);
  95 #  defined $method                     && $self->method($method);
  96 #  defined $freq                       && $self->freq($tree_freq);
  97
  98 }
  99
 100 =head1 AnnotationI implementing functions
 101
 102 =cut
 103
 104 =head2 as_text
 105
 106  Title   : as_text
 107  Usage   : $ann_tree->as_text();
 108  Function: output tree as a string
 109  Returns : a newic tree file
 110  Args    : None
 111
 112 =cut
 113
 114 sub as_text{
 115   my ($self) = @_;
 116
 117   my $tree = $self->tree || $self->throw("Tree object absent");
 118   my $treeio = Bio::TreeIO->new();
 119   $treeio->write_tree($tree);
 120 }
 121
 122 =head2 display_text
 123
 124  Title   : display_text
 125  Usage   : my $str = $ann->display_text();
 126  Function: returns a string. Unlike as_text(), this method returns a string
 127            formatted as would be expected for te specific implementation.
 128
 129            One can pass a callback as an argument which allows custom text
 130            generation; the callback is passed the current instance and any text
 131            returned
 132  Example :
 133  Returns : a string
 134  Args    : [optional] callback
 135
 136 =cut
 137
 138 {
 139   my $DEFAULT_CB = sub { $_[0]->as_text || ''};
 140
 141   sub display_text {
 142     my ($self, $cb) = @_;
 143     $cb ||= $DEFAULT_CB;
 144     $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
 145     return $cb->($self);
 146   }
 147
 148 }
 149
 150 =head2 hash_tree
 151
 152  Title   : hash_tree
 153  Usage   : my $hashtree = $value->hash_tree
 154  Function: For supporting the AnnotationI interface just returns the value
 155            as a hashref with the key 'value' pointing to the value
 156  Returns : hashrf to tree
 157  Args    : none
 158
 159 =cut
 160
 161 sub hash_tree{
 162     my $self = shift;
 163     my $h = {};
 164     $h->{'value'} = $self->tree();
 165     return $h;
 166 }
 167
 168 =head2 tagname
 169
 170  Title   : tagname
 171  Usage   : $obj->tagname($newval)
 172  Function: Get/set the tagname for this annotation value.
 173            Setting this is optional. If set, it obviates the need to
 174            provide a tag to Bio::AnnotationCollectionI when adding
 175            this object. When obtaining an AnnotationI object from the
 176            collection, the collection will set the value to the tag
 177            under which it was stored unless the object has a tag
 178            stored already.
 179  Returns : value of tagname (a scalar)
 180  Args    : new value (a scalar, optional)
 181
 182
 183 =cut
 184
 185 sub tagname{
 186     my ($self,$value) = @_;
 187     if( defined $value) {
 188         $self->{'tagname'} = $value;
 189     }
 190     return $self->{'tagname'};
 191 }
 192
 193 =head1 Specific accessors for Tree
 194
 195 =head2 tree_id
 196
 197  Title   : tree_id
 198  Usage   : $obj->tree_id($newval)
 199  Function: Get/set a name for the tree
 200  Returns : value of tagname (a scalar)
 201  Args    : new value (a scalar, optional)
 202
 203
 204 =cut
 205
 206 sub tree_id {
 207     my $self = shift;
 208     return $self->{'tree_id'} = shift if defined($_[0]);
 209     return $self->{'tree_id'};
 210 }
 211
 212 =head2 tree
 213
 214  Title   : tree
 215  Usage   : $obj->tree($newval)
 216  Function: Get/set tree
 217  Returns : tree ref
 218  Args    : new value (a tree ref, optional)
 219
 220
 221 =cut
 222
 223 sub tree {
 224     my $self = shift;
 225     return $self->{'tree'} = shift if defined($_[0]);
 226     return $self->{'tree'};
 227 }
 228
 229 1;
 230