File Coverage

blib/lib/Bio/Phylo/Unparsers/Nhx.pm
Criterion Covered Total %
statement 34 44 77.2
branch 3 10 30.0
condition n/a
subroutine 8 10 80.0
pod n/a
total 45 64 70.3


line stmt bran cond sub pod time code
1             package Bio::Phylo::Unparsers::Nhx;
2 1     1   6 use strict;
  1         2  
  1         29  
3 1     1   5 use warnings;
  1         1  
  1         31  
4 1     1   5 use base 'Bio::Phylo::Unparsers::Abstract';
  1         2  
  1         268  
5 1     1   6 use Bio::Phylo::IO 'unparse';
  1         2  
  1         59  
6 1     1   7 use Bio::Phylo::Util::CONSTANT qw':objecttypes :namespaces';
  1         2  
  1         633  
7              
8             =head1 NAME
9              
10             Bio::Phylo::Unparsers::Nhx - Serializer used by Bio::Phylo::IO, no serviceable parts inside
11              
12             =head1 DESCRIPTION
13              
14             This module turns a tree object into a New Hampshire eXtended-formatted (parenthetical)
15             tree description. It is called by the L<Bio::Phylo::IO> facade, don't call it directly.
16             You can pass the following additional arguments to the unparse call:
17            
18             # by default, names for tips are derived from $node->get_name, if
19             # 'internal' is specified, uses $node->get_internal_name, if 'taxon'
20             # uses $node->get_taxon->get_name, if 'taxon_internal' uses
21             # $node->get_taxon->get_internal_name, if $key, uses $node->get_generic($key)
22             -tipnames => one of (internal|taxon|taxon_internal|$key)
23            
24             # for things like a translate table in nexus, or to specify truncated
25             # 10-character names, you can pass a translate mapping as a hashref.
26             # to generate the translated names, the strings obtained following the
27             # -tipnames rules are used.
28             -translate => { Homo_sapiens => 1, Pan_paniscus => 2 }
29            
30             # if set, appends labels to internal nodes (names obtained from the same
31             # source as specified by '-tipnames')
32             -nodelabels => 1
33            
34             # specifies a branch length sprintf number formatting template, default is %f
35             -blformat => '%e'
36              
37             In addition, you can influence what key/value pairs are inserted into the NHX "hot
38             comments" in two ways. The first way (and the way that is least likely to cause
39             unintentional mishaps) is by attaching a Meta annotation to a node. This annotation
40             has to be associated with the NHX namespace. Here is an example:
41              
42             use Bio::Phylo::Util::CONSTANT ':classnames';
43            
44             # ...other things happening...
45             $node->set_namespaces( 'nhx' => _NS_NHX_ );
46             $node->set_meta_object( 'nhx:foo' => 'bar' );
47            
48             # which results in: [&&NHX:foo=bar]
49              
50             The other way is by using the set/get generic methods, e.g.:
51              
52             $node->set_generic( 'foo' => 'bar');
53              
54             However, this is riskier because everything you attach to an object using these methods
55             will be inserted into the NHX, including references (which won't serialize well).
56              
57             =begin comment
58              
59             Type : Wrapper
60             Title : _to_string($tree)
61             Usage : $newick->_to_string($tree);
62             Function: Prepares for the recursion to unparse the tree object into a
63             newick string.
64             Alias :
65             Returns : SCALAR
66             Args : Bio::Phylo::Forest::Tree
67              
68             =end comment
69              
70             =cut
71              
72             sub _to_string {
73 1     1   2 my $self = shift;
74 1         7 my $tree = $self->{'PHYLO'};
75 1         4 my $type = $tree->_type;
76            
77             # collect distinct NHX keys
78 1         2 my %keys;
79 1 50       3 if ( $type == _TREE_ ) {
    0          
    0          
80 1         2 _get_keys_from_tree($tree,\%keys);
81             }
82             elsif ( $type == _FOREST_ ) {
83 0         0 my $forest = $tree;
84 0     0   0 $forest->visit(sub{_get_keys_from_tree(shift,\%keys)});
  0         0  
85             }
86             elsif ( $type == _PROJECT_ ) {
87 0         0 my $project = $tree;
88             $project->visit(sub{
89 0     0   0 my $forest = shift;
90 0         0 $forest->visit(sub{_get_keys_from_tree(shift,\%keys)});
  0         0  
91 0         0 });
92             }
93              
94             # transform arguments
95 1         12 my %args = (
96             '-format' => 'newick',
97             '-nhxstyle' => 'nhx',
98             '-nhxkeys' => [ keys %keys ],
99             '-phylo' => $tree,
100             );
101 1         3 for my $key (qw(TRANSLATE TIPNAMES NODELABELS BLFORMAT)) {
102 4 50       12 if ( my $val = $self->{$key} ) {
103 0         0 my $arg = '-' . lc($key);
104 0         0 $args{$arg} = $val;
105             }
106             }
107 1         17 return unparse(%args);
108             }
109              
110             sub _get_keys_from_tree {
111 1     1   3 my ( $tree, $hashref ) = @_;
112             $tree->visit(sub{
113 215     215   386 my $node = shift;
114 215         269 for my $m ( @{ $node->get_meta } ) {
  215         451  
115 645 50       1332 if ( $m->get_predicate_namespace eq _NS_NHX_ ) {
116 645         1207 my ( $pre, $key ) = split /:/, $m->get_predicate;
117 645         1081 $hashref->{$key}++;
118 645         1347 $node->set_generic( $key => $m->get_object );
119             }
120             }
121 1         15 });
122             }
123              
124             # podinherit_insert_token
125              
126             =head1 SEE ALSO
127              
128             There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo>
129             for any user or developer questions and discussions.
130              
131             =over
132              
133             =item L<Bio::Phylo::IO>
134              
135             The NHX unparser is called by the L<Bio::Phylo::IO> object.
136             Look there to learn how to unparse newick strings.
137              
138             =item L<Bio::Phylo::Manual>
139              
140             Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>.
141              
142             =back
143              
144             =head1 CITATION
145              
146             If you use Bio::Phylo in published research, please cite it:
147              
148             B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
149             and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
150             I<BMC Bioinformatics> B<12>:63.
151             L<http://dx.doi.org/10.1186/1471-2105-12-63>
152              
153             =cut
154              
155             1;