| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Bio::Phylo::Unparsers::Nhx; |
|
2
|
1
|
|
|
1
|
|
6
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
35
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use base 'Bio::Phylo::Unparsers::Abstract'; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
271
|
|
|
4
|
1
|
|
|
1
|
|
5
|
use Bio::Phylo::IO 'unparse'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
45
|
|
|
5
|
1
|
|
|
1
|
|
6
|
use Bio::Phylo::Util::CONSTANT qw':objecttypes :namespaces'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
603
|
|
|
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 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
|
|
2
|
my $self = shift; |
|
73
|
1
|
|
|
|
|
8
|
my $tree = $self->{'PHYLO'}; |
|
74
|
1
|
|
|
|
|
7
|
my $type = $tree->_type; |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# collect distinct NHX keys |
|
77
|
1
|
|
|
|
|
1
|
my %keys; |
|
78
|
1
|
50
|
|
|
|
3
|
if ( $type == _TREE_ ) { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
79
|
1
|
|
|
|
|
4
|
_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
|
|
|
|
|
16
|
my %args = ( |
|
95
|
|
|
|
|
|
|
'-format' => 'newick', |
|
96
|
|
|
|
|
|
|
'-nhxstyle' => 'nhx', |
|
97
|
|
|
|
|
|
|
'-nhxkeys' => [ keys %keys ], |
|
98
|
|
|
|
|
|
|
'-phylo' => $tree, |
|
99
|
|
|
|
|
|
|
); |
|
100
|
1
|
|
|
|
|
4
|
for my $key (qw(TRANSLATE TIPNAMES NODELABELS BLFORMAT)) { |
|
101
|
4
|
50
|
|
|
|
11
|
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
|
|
292
|
my $node = shift; |
|
113
|
215
|
|
|
|
|
244
|
for my $m ( @{ $node->get_meta } ) { |
|
|
215
|
|
|
|
|
459
|
|
|
114
|
645
|
50
|
|
|
|
1451
|
if ( $m->get_predicate_namespace eq _NS_NHX_ ) { |
|
115
|
645
|
|
|
|
|
1269
|
my ( $pre, $key ) = split /:/, $m->get_predicate; |
|
116
|
645
|
|
|
|
|
1138
|
$hashref->{$key}++; |
|
117
|
645
|
|
|
|
|
1571
|
$node->set_generic( $key => $m->get_object ); |
|
118
|
|
|
|
|
|
|
} |
|
119
|
|
|
|
|
|
|
} |
|
120
|
1
|
|
|
|
|
21
|
}); |
|
121
|
|
|
|
|
|
|
} |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# podinherit_insert_token |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
There is a mailing list at L |
|
128
|
|
|
|
|
|
|
for any user or developer questions and discussions. |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=over |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=item L |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
The NHX unparser is called by the L object. |
|
135
|
|
|
|
|
|
|
Look there to learn how to unparse newick strings. |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=item L |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Also see the manual: L and L. |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=back |
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head1 CITATION |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
If you use Bio::Phylo in published research, please cite it: |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
B, B, B, B |
|
148
|
|
|
|
|
|
|
and B, 2011. Bio::Phylo - phyloinformatic analysis using Perl. |
|
149
|
|
|
|
|
|
|
I B<12>:63. |
|
150
|
|
|
|
|
|
|
L |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=cut |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
1; |