—

              
#
# Graph::Writer::HTK - perl module for writing a Graph as an HTK lattice
#
package Graph::Writer::HTK;
$Graph::Writer::HTK::VERSION = '2.10';
use 5.006;
use strict;
use warnings;
#=======================================================================
#=======================================================================
use parent 'Graph::Writer';
my @graph_attributes = qw(base lmname lmscale wdpenalty);
my %node_attributes =
(
    'W' => [ 'WORD', 'label' ],
    't' => [ 'time' ],
    'v' => [ 'var' ],
    'L' => [ 'L' ],
);
my %edge_attributes =
(
    'W' => [ 'WORD', 'label' ],
    'v' => [ 'var' ],
    'd' => [ 'div' ],
    'a' => [ 'acoustic' ],
    'n' => [ 'ngram' ],
    'l' => [ 'language', 'weight' ],
);
#=======================================================================
#
# _write_graph
#
# dump the graph out as an HTK lattice to the given filehandle.
#
#=======================================================================
sub _write_graph
{
    my $self  = shift;
    my $graph = shift;
    my $FILE  = shift;
    my $nvertices;
    my $nedges;
    my $v;
    my $from;
    my $to;
    my %v2n;
    my $node_num;
    my $edge_num;
    print $FILE "VERSION=1.0\n";
    print $FILE "N=",int($graph->vertices),"  L=",int($graph->edges),"\n";
    $node_num = 0;
    foreach $v (sort $graph->vertices)
    {
        $v2n{$v} = $node_num;
        print $FILE "I=$node_num";
        foreach my $field (keys %node_attributes)
        {
            foreach my $attr (@{ $node_attributes{$field} })
            {
                if ($graph->has_vertex_attribute($v, $attr))
                {
                    print $FILE "  $field=",
                                $graph->get_vertex_attribute($v, $attr);
                    last;
                }
            }
        }
        print $FILE "\n";
        ++$node_num;
    }
    $edge_num = 0;
    foreach my $edge (sort _by_vertex $graph->edges)
    {
        ($from, $to) = @$edge;
        print $FILE "J=$edge_num  S=", $v2n{$from}, "  E=", $v2n{$to};
        foreach my $field (keys %edge_attributes)
        {
            foreach my $attr (@{ $edge_attributes{$field} })
            {
                if ($graph->has_edge_attribute($from, $to, $attr))
                {
                    print $FILE "  $field=",
                                $graph->get_vertex_attribute($from, $to, $attr);
                    last;
                }
            }
        }
        print $FILE "\n";
        ++$edge_num;
    }
    return 1;
}
sub _by_vertex
{
    return $a->[0].$a->[1] cmp $b->[0].$b->[1];
}
1;
__END__
HideShow 57 lines of Pod
=head1 NAME
Graph::Writer::HTK - write a perl Graph out as an HTK lattice file
=head1 SYNOPSIS
  use Graph::Writer::HTK;
  $writer = Graph::Reader::HTK->new();
  $reader->write_graph($graph, 'mylattice.lat');
=head1 DESCRIPTION
This module will write a directed graph to a file
in the L<HTK|http://htk.eng.cam.ac.uk> lattice format.
The graph must be an instance of the L<Graph> class.
=head1 SEE ALSO
=over 4
=item L<Graph>
Jarkko Hietaniemi's Graph class and others, used for representing
and manipulating directed graphs. Available from CPAN.
Also described / used in the chapter on directed graph algorithms
in the B<Algorithms in Perl> book from O'Reilly.
=item L<Graph::Writer>
The base-class for this module, which defines the public methods,
and describes the ideas behind Graph reader and writer modules.
=item L<Graph::Reader::HTK>
A class which will read a perl Graph from an HTK lattice file.
=back
=head1 REPOSITORY
L<https://github.com/neilb/Graph-ReadWrite>
=head1 AUTHOR
Neil Bowers E<lt>neil@bowers.comE<gt>
=head1 COPYRIGHT
Copyright (c) 2000-2012, Neil Bowers. All rights reserved.
Copyright (c) 2000, Canon Research Centre Europe. All rights reserved.
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut