File Coverage

Bio/TreeIO/svggraph.pm
Criterion Covered Total %
statement 63 65 96.9
branch 3 6 50.0
condition 9 17 52.9
subroutine 13 14 92.8
pod 2 2 100.0
total 90 104 86.5


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