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