File Coverage

blib/lib/Graph/Writer/HTK.pm

Criterion	Covered	Total	%
statement	39	49	79.5
branch	2	4	50.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	47	59	79.6

#
# Graph::Writer::HTK - perl module for writing a Graph as an HTK lattice
#
package Graph::Writer::HTK;
$Graph::Writer::HTK::VERSION = '2.08';
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__