Bio/TreeIO/tabtree.pm

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