From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

RVOSA / Bio-Phylo-0.56 / lib / Bio / Phylo / Unparsers / Hennig86.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
—
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
—
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

              
package Bio::Phylo::Unparsers::Hennig86;
use strict;
use base 'Bio::Phylo::Unparsers::Abstract';
use Bio::Phylo;
use Bio::Phylo::Util::CONSTANT qw'/looks_like/ :objecttypes';
use Bio::Phylo::Util::Exceptions 'throw';
my $MATRIX  = _MATRIX_;
my $PROJECT = _PROJECT_;
my %typemap = (
    'continuous' => 'cont',
    'dna'        => 'dna',
    'protein'    => 'prot',
    'restriction'=> 'num',
    'rna'        => 'rna',
    'standard'   => 'num',
);
=head1 NAME
Bio::Phylo::Unparsers::Hennig86 - Serializer used by Bio::Phylo::IO, no serviceable
parts inside
=head1 DESCRIPTION
This module turns the supplied object into a Hennig86 string. The supplied
object has to either be a L<Bio::Phylo::Matrices::Matrix> object or a
L<Bio::Phylo::Project> object, whose first matrix is exported to Hennig86. In
other words, this only works on things that are or contain character state
matrices. 
=begin comment
 Type    : Wrapper
 Title   : _to_string
 Usage   : my $hennig_string = $obj->_to_string;
 Function: Stringifies a Bio::Phylo object into a Hennig86 string
 Alias   :
 Returns : SCALAR
 Args    : Bio::Phylo::* object
=end comment
=cut
sub _to_string {
    my $self = shift;
    my $obj  = $self->{'PHYLO'};
    my $matrix;
    if ( looks_like_implementor $obj, '_type' ) {
        if ( $obj->_type == $MATRIX ) {
            $matrix = $obj;
        }
        elsif ( $obj->_type == $PROJECT ) {
            ($matrix) = @{ $obj->get_items(_MATRIX_) };
        }
        else {
            throw 'ObjectMismatch' => "Can't serialize ".ref($obj)." objects as Hennig86";
        }
        return $self->_serialize_matrix($matrix);
    }
    else {
        throw 'ObjectMismatch' => "Can't serialize supplied argument as Hennig86";
    }    
}
sub _serialize_matrix {
    my ( $self, $matrix ) = @_;    
    my $hennig86 = $self->_create_header($matrix);
    my $to = $matrix->get_type_object;
    for my $row ( @{ $matrix->get_entities } ) {
        $hennig86 .= $row->get_nexus_name . "\t";
        my @char = $row->get_char;
        my @encoded;
        for my $c ( @char ) {
            if ( $to->is_ambiguous($c) ) {
                my @states = @{ $to->get_states_for_symbol($c) };
                push @encoded, '[' . $to->join(\@states) . ']';
            }
            else {
                push @encoded, $c;
            }
        }
        $hennig86 .= $to->join(\@encoded) . "\n";
    }
    return $hennig86 .= ";\n";
}
sub _create_header {
    my ( $self, $matrix ) = @_;
     
    my $comment = "Hennig86 matrix written by ".ref($self)." ".Bio::Phylo->VERSION." on ".localtime();
     
    # calculate nstates
    my $nstates = scalar keys %{ $matrix->calc_state_counts };
     
    # calculate ntax and nchar
    my ( $ntax, $nchar ) = ( $matrix->get_ntax, $matrix->get_nchar );
     
    # map type to hennig86 tokens
    my $type = lc $matrix->get_type;
    my $hennig86type = $typemap{ $type } || throw 'BadFormat' => "Can't write $type matrices to Hennig86";
    my $template = << 'TEMPLATE';
nstates %d
xread
'%s'
%d %d
& [%s]
TEMPLATE
    return sprintf $template, $nstates, $comment, $nchar, $ntax, $hennig86type;
}
# podinherit_insert_token
=head1 SEE ALSO
There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo> 
for any user or developer questions and discussions.
=over
=item L<Bio::Phylo::IO>
The hennig86 unparser is called by the L<Bio::Phylo::IO> object.
Look there to learn how to unparse objects.
=item L<Bio::Phylo::Manual>
Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>.
=item Hennig86 file format
To learn more about the Hennig86 format, visit
L<http://www.phylo.org/tools/hennig.html>.
=back
=head1 CITATION
If you use Bio::Phylo in published research, please cite it:
B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
I<BMC Bioinformatics> B<12>:63.
L<http://dx.doi.org/10.1186/1471-2105-12-63>
=cut
1;