| Bio-Phylo documentation | Contained in the Bio-Phylo distribution. |
Bio::Phylo::Unparsers::Newick - Serializer used by Bio::Phylo::IO, no serviceable parts inside
This module turns a tree object into a newick formatted (parenthetical) tree description. It is called by the Bio::Phylo::IO facade, don't call it directly. You can pass the following additional arguments to the unparse call:
# by default, names for tips are derived from $node->get_name, if
# 'internal' is specified, uses $node->get_internal_name, if 'taxon'
# uses $node->get_taxon->get_name, if 'taxon_internal' uses
# $node->get_taxon->get_internal_name, if $key, uses $node->get_generic($key)
-tipnames => one of (internal|taxon|taxon_internal|$key)
# for things like a translate table in nexus, or to specify truncated
# 10-character names, you can pass a translate mapping as a hashref.
# to generate the translated names, the strings obtained following the
# -tipnames rules are used.
-translate => { Homo_sapiens => 1, Pan_paniscus => 2 }
# array ref used to specify keys, which are embedded as key/value pairs (where
# the value is obtained from $node->get_generic($key)) in comments,
# formatted depending on '-nhxstyle', which could be 'nhx' (default), i.e.
# [&&NHX:$key1=$value1:$key2=$value2] or 'mesquite', i.e.
# [% $key1 = $value1, $key2 = $value2 ]
-nhxkeys => [ $key1, $key2 ]
# if set, appends labels to internal nodes (names obtained from the same
# source as specified by '-tipnames')
-nodelabels => 1
# specifies a formatting style / dialect
-nhxstyle => one of (mesquite|nhx)
# specifies a branch length sprintf number formatting template, default is %f
-blformat => '%e'
The newick unparser is called by the Bio::Phylo::IO object. Look there to learn how to unparse newick strings.
Also see the manual: Bio::Phylo::Manual and http://rutgervos.blogspot.com.
If you use Bio::Phylo in published research, please cite it:
Rutger A Vos, Jason Caravas, Klaas Hartmann, Mark A Jensen and Chase Miller, 2011. Bio::Phylo - phyloinformatic analysis using Perl. BMC Bioinformatics 12:63. http://dx.doi.org/10.1186/1471-2105-12-63
$Id: Newick.pm 1660 2011-04-02 18:29:40Z rvos $
| Bio-Phylo documentation | Contained in the Bio-Phylo distribution. |
# $Id: Newick.pm 1660 2011-04-02 18:29:40Z rvos $ package Bio::Phylo::Unparsers::Newick; use strict; use base 'Bio::Phylo::Unparsers::Abstract'; use Bio::Phylo::Forest::Tree; use Bio::Phylo::Util::CONSTANT ':objecttypes';
sub _to_string { my $self = shift; my $tree = $self->{'PHYLO'}; my $type = $tree->_type; if ( $type == _TREE_ ) { my $root = $tree->get_root; my %args; for my $key (qw(TRANSLATE TIPNAMES NHXKEYS NODELABELS BLFORMAT NHXSTYLE)) { if ( my $val = $self->{$key} ) { my $arg = '-' . lc($key); $args{$arg} = $val; } } return $root->to_newick(%args); } elsif ( $type == _FOREST_ ) { my $forest = $tree; my $newick = ""; for my $tree ( @{ $forest->get_entities } ) { my $root = $tree->get_root; my %args; for my $key ( qw(TRANSLATE TIPNAMES NHXKEYS NODELABELS BLFORMAT NHXSTYLE)) { if ( my $val = $self->{$key} ) { my $arg = '-' . lc($key); $args{$arg} = $val; } } $newick .= $root->to_newick(%args) . "\n"; } return $newick; } elsif ( $type == _PROJECT_ ) { my $project = $tree; my $newick = ""; for my $forest ( @{ $project->get_forests } ) { for my $tree ( @{ $forest->get_entities } ) { my $root = $tree->get_root; my %args; for my $key ( qw(TRANSLATE TIPNAMES NHXKEYS NODELABELS BLFORMAT NHXSTYLE)) { if ( my $val = $self->{$key} ) { my $arg = '-' . lc($key); $args{$arg} = $val; } } $newick .= $root->to_newick(%args) . "\n"; } } return $newick; } }
{ my $string = q{}; #no warnings 'uninitialized'; sub __to_string { my ( $self, $tree, $n ) = @_; if ( !$n->get_parent ) { if ( defined $n->get_branch_length ) { $string = $n->get_name . ':' . $n->get_branch_length . ';'; } else { $string = defined $n->get_name ? $n->get_name . ';' : ';'; } } elsif ( !$n->get_previous_sister ) { if ( defined $n->get_branch_length ) { $string = $n->get_name . ':' . $n->get_branch_length . $string; } else { $string = $n->get_name . $string; } } else { if ( defined $n->get_branch_length ) { $string = $n->get_name . ':' . $n->get_branch_length . ',' . $string; } else { $string = $n->get_name . ',' . $string; } } if ( $n->get_first_daughter ) { $n = $n->get_first_daughter; $string = ')' . $string; $self->__to_string( $tree, $n ); while ( $n->get_next_sister ) { $n = $n->get_next_sister; $self->__to_string( $tree, $n ); } $string = '(' . $string; } } } # podinherit_insert_token
1;