branch-1-6/Bio/TreeIO/tabtree.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::TreeIO::tabtree
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Jason Stajich <jason@bioperl.org>
   8 #
   9 # Copyright Jason Stajich
  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::TreeIO::tabtree - A simple output format which displays a tree as an ASCII drawing
  18
  19 =head1 SYNOPSIS
  20
  21   use Bio::TreeIO;
  22   my $in = Bio::TreeIO->new(-file => 'input', -format => 'newick');
  23   my $out = Bio::TreeIO->new(-file => '>output', -format => 'tabtree');
  24
  25   while( my $tree = $in->next_tree ) {
  26       $out->write_tree($tree);
  27   }
  28
  29 =head1 DESCRIPTION
  30
  31 This is a made up format just for outputting trees as an ASCII drawing.
  32
  33 =head1 FEEDBACK
  34
  35 =head2 Mailing Lists
  36
  37 User feedback is an integral part of the evolution of this and other
  38 Bioperl modules. Send your comments and suggestions preferably to
  39 the Bioperl mailing list.  Your participation is much appreciated.
  40
  41   bioperl-l@bioperl.org                  - General discussion
  42   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  43
  44 =head2 Support
  45
  46 Please direct usage questions or support issues to the mailing list:
  47
  48 I<bioperl-l@bioperl.org>
  49
  50 rather than to the module maintainer directly. Many experienced and
  51 reponsive experts will be able look at the problem and quickly
  52 address it. Please include a thorough description of the problem
  53 with code and data examples if at all possible.
  54
  55 =head2 Reporting Bugs
  56
  57 Report bugs to the Bioperl bug tracking system to help us keep track
  58 of the bugs and their resolution. Bug reports can be submitted via the
  59 web:
  60
  61   http://bugzilla.open-bio.org/
  62
  63 =head1 AUTHOR - Jason Stajich
  64
  65 Email jason@bioperl.org
  66
  67 =head1 APPENDIX
  68
  69 The rest of the documentation details each of the object methods.
  70 Internal methods are usually preceded with a _
  71
  72 =cut
  73
  74
  75 # Let the code begin...
  76
  77
  78 package Bio::TreeIO::tabtree;
  79 use strict;
  80
  81 # Object preamble - inherits from Bio::Root::Root
  82
  83
  84
  85 use base qw(Bio::TreeIO);
  86
  87 =head2 new
  88
  89  Title   : new
  90  Usage   : my $obj = Bio::TreeIO::tabtree->new();
  91  Function: Builds a new Bio::TreeIO::tabtree object
  92  Returns : Bio::TreeIO::tabtree
  93  Args    :
  94
  95
  96 =cut
  97
  98 sub new {
  99   my($class,@args) = @_;
 100
 101   my $self = $class->SUPER::new(@args);
 102
 103 }
 104
 105 =head2 write_tree
 106
 107  Title   : write_tree
 108  Usage   : $treeio->write_tree($tree);
 109  Function: Write a tree out to data stream in newick/phylip format
 110  Returns : none
 111  Args    : Bio::Tree::TreeI object
 112
 113 =cut
 114
 115 sub write_tree{
 116    my ($self,$tree) = @_;
 117    my $line = _write_tree_Helper($tree->get_root_node,"");
 118    $self->_print($line. "\n");
 119    $self->flush if $self->_flush_on_write && defined $self->_fh;
 120    return;
 121 }
 122
 123 sub _write_tree_Helper {
 124     my ($node,$indent) = @_;
 125     return unless defined $node;
 126
 127     my @d = $node->each_Descendent();
 128     my $line = "";
 129     my ($i,$lastchild) = (0,scalar @d - 1);
 130     for my $n ( @d ) {
 131         if( $n->is_Leaf ) {
 132             $line .= sprintf("%s| \n%s\\-%s\n",
 133                              $indent,$indent,$n->id || '');
 134         } else {
 135             $line .= sprintf("$indent|  %s\n",( $n->id ?
 136                                                sprintf("(%s)",$n->id) : ''));
 137         }
 138         my $new_indent = $indent . (($i == $lastchild) ? "| " : "  ");
 139         if( $n != $node ) {
 140             # avoid the unlikely case of cycles
 141             $line .= _write_tree_Helper($n,$new_indent);
 142         }
 143     }
 144     return $line;
 145 }
 146
 147 =head2 next_tree
 148
 149  Title   : next_tree
 150  Usage   :
 151  Function: Sorry not possible with this format
 152  Returns : none
 153  Args    : none
 154
 155
 156 =cut
 157
 158 sub next_tree{
 159     $_[0]->throw("Sorry the format 'tabtree' can only be used as an output format at this time");
 160 }
 161
 162 1;