Bio/TreeIO/svggraph.pm

   1 #
   2 # BioPerl module for Bio::TreeIO::svg-graph
   3 #
   4 # Cared for by Allen Day <allenday@ucla.edu>
   5 #
   6 # Copyright Brian O'Connor
   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::svggraph - A simple output format that converts a Tree object to an SVG output
  15
  16 =head1 SYNOPSIS
  17
  18   use Bio::TreeIO;
  19   my $in = Bio::TreeIO->new(-file => 'input', -format => 'newick');
  20   my $out = Bio::TreeIO->new(-file => '>output', -format => 'svggraph');
  21
  22   while( my $tree = $in->next_tree ) {
  23       my $svg_xml = $out->write_tree($tree);
  24   }
  25
  26 =head1 DESCRIPTION
  27
  28 This outputs a tree as an SVG graphic using the SVG::Graph API
  29
  30 =head1 FEEDBACK
  31
  32 =head2 Mailing Lists
  33
  34 User feedback is an integral part of the evolution of this and other
  35 Bioperl modules. Send your comments and suggestions preferably to
  36 the Bioperl mailing list.  Your participation is much appreciated.
  37
  38   bioperl-l@bioperl.org                  - General discussion
  39   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  40
  41 =head2 Reporting Bugs
  42
  43 Report bugs to the Bioperl bug tracking system to help us keep track
  44 of the bugs and their resolution. Bug reports can be submitted via the
  45 web:
  46
  47   http://bugzilla.open-bio.org/
  48
  49 =head1 AUTHOR - Brian OConnor
  50
  51 Email brian.oconnor-at-excite.com
  52
  53 =head1 CONTRIBUTORS
  54
  55 Allen Day
  56 Guillaume Rousse, Guillaume-dot-Rousse-at-inria-dot-fr
  57
  58 =head1 APPENDIX
  59
  60 The rest of the documentation details each of the object methods.
  61 Internal methods are usually preceded with a _
  62
  63 =cut
  64
  65
  66 # Let the code begin...
  67
  68
  69 package Bio::TreeIO::svggraph;
  70 use strict;
  71
  72 # Object preamble - inherits from Bio::Root::Root
  73
  74 use SVG::Graph;
  75 use SVG::Graph::Data;
  76 use SVG::Graph::Data::Tree;
  77 use SVG::Graph::Data::Node;
  78 use Bio::Tree::TreeI;
  79 use Bio::Tree::Node;
  80 use Tree::DAG_Node;
  81
  82
  83 use base qw(Bio::TreeIO);
  84
  85 =head2 new
  86
  87  Title   : new
  88  Usage   : my $obj = Bio::TreeIO::svggraph->new();
  89  Function: Builds a new Bio::TreeIO::svggraph object
  90  Returns : Bio::TreeIO::svggraph
  91  Args    :-width    => image width (default 1600)
  92           -height   => image height (default 1000)
  93           -margin   => margin (default 30)
  94           -stroke   => stroke color (default 'black')
  95           -stroke_width=> stroke width (default 2)
  96           -font_size=> font size (default '10px')
  97           -nomalize => undef or 'log' (default is undef)
  98
  99 =cut
 100
 101 sub _initialize {
 102     my $self = shift;
 103     my ($width,$height,$margin,$stroke,
 104         $stroke_width,$font_size,
 105         $normalize) = $self->_rearrange([qw
 106                                          (WIDTH
 107                                           HEIGHT
 108                                           MARGIN
 109                                           STROKE
 110                                           STROKE_WIDTH
 111                                           FONT_SIZE
 112                                           NORMALIZE)],
 113                                         @_);
 114     $self->{_width}        = $width || 1600;
 115     $self->{_height}       = $height || 1000;
 116     $self->{_margin}       = defined $margin ? $margin : 30;
 117     $self->{_stroke}       = $stroke || 'black';
 118     $self->{_stroke_width} = $stroke_width || 2;
 119     $self->{_font_size}    = $font_size || '10px';
 120     $self->{_normalize}    = $normalize || '';
 121     $self->SUPER::_initialize(@_);
 122 }
 123
 124 =head2 write_tree
 125
 126  Title   : write_tree
 127  Usage   : $treeio->write_tree($tree);
 128  Function: Write a tree out to data stream in newick/phylip format
 129  Returns : none
 130  Args    : Bio::Tree::TreeI object
 131
 132 =cut
 133
 134 sub write_tree{
 135    my ($self,$tree) = @_;
 136    my $line = $self->_write_tree_Helper($tree->get_root_node);
 137    $self->_print($line. "\n");
 138    $self->flush if $self->_flush_on_write && defined $self->_fh;
 139    return;
 140 }
 141
 142 sub _write_tree_Helper {
 143    my ($self,$node) = @_;
 144
 145    my $graph = SVG::Graph->new
 146        ('width'   => $self->{'_width'},
 147         'height'  => $self->{'_height'},
 148         'margin'  => $self->{'_margin'});
 149
 150    my $group0 = $graph->add_frame;
 151    my $tree = SVG::Graph::Data::Tree->new;
 152    my $root = SVG::Graph::Data::Node->new;
 153    $root->name($node->id);
 154    $self->_decorateRoot($root, $node->each_Descendent());
 155    $tree->root($root);
 156    $group0->add_data($tree);
 157
 158    $group0->add_glyph('tree',
 159                       'stroke'      =>$self->{'_stroke'},
 160                       'stroke-width'=>$self->{'_stroke_width'},
 161                       'font-size'   =>$self->{'_font_size'});
 162
 163    return($graph->draw);
 164 }
 165
 166
 167 =head2 decorateRoot
 168
 169  Title   : _decorateRoot
 170  Usage   : internal methods
 171  Function:
 172  Example :
 173  Returns :
 174  Args    :
 175
 176
 177 =cut
 178
 179 sub _decorateRoot {
 180     my ($self,$previousNode,@children) = @_;
 181     for my $child (@children) {
 182         my $currNode = SVG::Graph::Data::Node->new;
 183         $currNode->branch_label($child->id);
 184         my $length = $child->branch_length;
 185       CASE:
 186         {  # is this right? copies from Guillame
 187             if ($self->{_normalize} eq 'log') {
 188                 $length = log($length + 1);
 189                 last CASE;
 190             }
 191         }
 192         $currNode->branch_length($length);
 193         $previousNode->add_daughter($currNode);
 194         $self->_decorateRoot($currNode, $child->each_Descendent());
 195     }
 196 }
 197
 198
 199 =head2 next_tree
 200
 201  Title   : next_tree
 202  Usage   :
 203  Function: Sorry not possible with this format
 204  Returns : none
 205  Args    : none
 206
 207
 208 =cut
 209
 210 sub next_tree{
 211     $_[0]->throw("Sorry the format 'svggraph' can only be used as an output format");
 212 }
 213
 214 1;