Bio/TreeIO/cluster.pm

   1 #
   2 # BioPerl module for Bio::TreeIO::cluster
   3 #
   4 # Contributed by Guillaume Rousse <Guillaume-dot-Rousse-at-inria-dot-fr>
   5 #
   6 # Copyright INRIA
   7 #
   8 # You may distribute this module under the same terms as perl itself
   9
  10 # POD documentation - main docs before the code
  11
  12 =head1 NAME
  13
  14 Bio::TreeIO::cluster - A TreeIO driver module for parsing Algorithm::Cluster::treecluster() output
  15
  16 =head1 SYNOPSIS
  17
  18   # do not use this module directly
  19   use Bio::TreeIO;
  20   use Algorithm::Cluster;
  21   my ($result, $linkdist) = Algorithm::Cluster::treecluster(
  22     distances => $matrix
  23   );
  24   my $treeio = Bio::TreeIO->new(
  25     -format   => 'cluster',
  26     -result   =>  $result,
  27     -linkdist =>  $linkdist,
  28     -labels   =>  $labels
  29   );
  30   my $tree = $treeio->next_tree;
  31
  32 =head1 DESCRIPTION
  33
  34 This is a driver module for parsing Algorithm::Cluster::treecluster() output.
  35
  36 =head1 FEEDBACK
  37
  38 =head2 Mailing Lists
  39
  40 User feedback is an integral part of the evolution of this and other
  41 Bioperl modules. Send your comments and suggestions preferably to
  42 the Bioperl mailing list.  Your participation is much appreciated.
  43
  44   bioperl-l@bioperl.org                  - General discussion
  45   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  46
  47 =head2 Support
  48
  49 Please direct usage questions or support issues to the mailing list:
  50
  51 I<bioperl-l@bioperl.org>
  52
  53 rather than to the module maintainer directly. Many experienced and
  54 reponsive experts will be able look at the problem and quickly
  55 address it. Please include a thorough description of the problem
  56 with code and data examples if at all possible.
  57
  58 =head2 Reporting Bugs
  59
  60 Report bugs to the Bioperl bug tracking system to help us keep track
  61 of the bugs and their resolution. Bug reports can be submitted via
  62 the web:
  63
  64   https://github.com/bioperl/bioperl-live/issues
  65
  66 =head1 AUTHOR - Guillaume Rousse
  67
  68 Email Guillaume-dot-Rousse-at-inria-dot-fr
  69
  70 =head1 CONTRIBUTORS
  71
  72 Jason Stajich - jason-at-bioperl-dot-org
  73
  74 =head1 APPENDIX
  75
  76 The rest of the documentation details each of the object methods.
  77 Internal methods are usually preceded with a _
  78
  79 =cut
  80
  81
  82 # Let the code begin...
  83
  84
  85 package Bio::TreeIO::cluster;
  86 use strict;
  87
  88 use Bio::Event::EventGeneratorI;
  89 use IO::String;
  90
  91 use base qw(Bio::TreeIO);
  92
  93 =head2 new
  94
  95  Title   : new
  96  Usage   : my $obj = Bio::TreeIO::cluster->new();
  97  Function: Builds a new Bio::TreeIO::cluster object for reading Algorithm::Cluster::treecluster output
  98  Returns : Bio::TreeIO::cluster
  99  Args    :-result   => Algorithm::Cluster result
 100           -linkdist => distance between links
 101           -labels   => node labels
 102
 103 =cut
 104
 105 sub _initialize {
 106   my $self = shift;
 107   ($self->{_result},$self->{_linkdist},
 108    $self->{_labels}) = $self->_rearrange([qw
 109                                           (RESULT LINKDIST LABELS)],
 110                                          @_);
 111   $self->SUPER::_initialize(@_);
 112 }
 113
 114 =head2 next_tree
 115
 116  Title   : next_tree
 117  Usage   : my $tree = $treeio->next_tree
 118  Function: Gets the next tree in the stream
 119  Returns : Bio::Tree::TreeI
 120  Args    : none
 121
 122
 123 =cut
 124
 125 sub next_tree {
 126     my ($self) = @_;
 127     if( ! $self->{_result} ){
 128         $self->warn("Must provide value 'result' and 'linkdist' and 'labels' when initializing a TreeIO::cluster object");
 129         return;
 130     }
 131     $self->_eventHandler->start_document();
 132
 133     # build tree from the root
 134     $self->_eventHandler->start_element({Name => 'tree'});
 135     $self->_recurse(-1, 0);
 136     $self->_recurse(-1, 1);
 137     $self->_eventHandler->end_element({Name => 'tree'});
 138
 139     return $self->_eventHandler->end_document;
 140 }
 141
 142 sub _recurse {
 143     my ($self, $line, $column) = @_;
 144
 145     my $id  = $self->{_result}->[$line]->[$column];
 146     if ($id >= 0) {
 147         # leaf
 148         $self->debug("leaf $id\n");
 149         $self->debug("distance $self->{_linkdist}->[$line]\n");
 150         $self->debug("label $self->{_labels}->[$id]\n");
 151         $self->_eventHandler->start_element({Name => 'node'});
 152         $self->_eventHandler->start_element({Name => 'branch_length'});
 153         $self->_eventHandler->characters($self->{_linkdist}->[$line]);
 154         $self->_eventHandler->end_element({Name => 'branch_length'});
 155         $self->_eventHandler->start_element({Name => 'id'});
 156         $self->_eventHandler->characters($self->{_labels}->[$id]);
 157         $self->_eventHandler->end_element({Name => 'id'});
 158         $self->_eventHandler->start_element({Name => 'leaf'});
 159         $self->_eventHandler->characters(1);
 160         $self->_eventHandler->end_element({Name => 'leaf'});
 161         $self->_eventHandler->end_element({Name => 'node'});
 162     } else {
 163         # internal node
 164         $self->debug("internal node $id\n");
 165         $self->debug("distance $self->{_linkdist}->[$line]\n");
 166         $self->_eventHandler->start_element({Name => 'node'});
 167         $self->_eventHandler->start_element({Name => 'branch_length'});
 168         $self->_eventHandler->characters($self->{_linkdist}->[$line]);
 169         $self->_eventHandler->end_element({Name => 'branch_length'});
 170         $self->_eventHandler->start_element({Name => 'leaf'});
 171         $self->_eventHandler->characters(0);
 172         $self->_eventHandler->end_element({Name => 'leaf'});
 173         $self->_eventHandler->start_element({Name => 'tree'});
 174         my $child_id = - ($id + 1);
 175         $self->_recurse($child_id, 0);
 176         $self->_recurse($child_id, 1);
 177         $self->_eventHandler->end_element({Name => 'tree'});
 178         $self->_eventHandler->end_element({Name => 'node'});
 179
 180     }
 181 }
 182
 183 =head2 write_tree
 184
 185  Title   : write_tree
 186  Usage   :
 187  Function: Sorry not possible with this format
 188  Returns : none
 189  Args    : none
 190
 191
 192 =cut
 193
 194 sub write_tree{
 195     $_[0]->throw("Sorry the format 'cluster' can only be used as an input format");
 196 }
 197
 198 1;