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; |