#!/usr/bin/perl
# score_lattice.pl: Mark Hasegawa-Johnson, October 2003
# Illinois Speech and Language Engineering (ISLE group)
#
# Usage text (printed if score_lattice.pl is called with no arguments):
$USAGE=<<ENDUSAGE;

score_lattice.pl: Score lattices against a reference transcription.

Usage:
 score_lattice.pl TRUTH.mlf < lattice_list.scp > score_file.txt
Example:
 ls latdir/*.lat | score_lattice.pl TRUTH.mlf > score_file.txt

This script reads a reference MLF and one or more HTK lattice files,
and computes a few useful statistics such as lattice error rate,
one-best error rate, number of arcs per input word, and number of arcs
per second.  All output statistics are tallied separately for each
lattice file, and for the global average.

The input script file should contain a list of lattice files to be
scored.  The name of each lattice file must correspond to a label
section in the MLF (extension and directory are ignored), or the
lattice file is ignored (not scored).

Lattices are in HTK format.  Words must be attached to the edges, not
the nodes.  Nodes may have times, but times are ignored.  Edges may
have acoustic probability scores (labeled a=) and language model
probability scores (labeled l=).  

Two Viterbi searches are performed in each lattice.  One search
computes the maximum-likelihood path through the lattice, from node 0
to the node with highest index.  The search algorithm assumes that the
start node on every edge has lower index than its end node, and that
at least one path exists from node 0 to any node in the network.  The
search algorithm maximizes the sum of acoustic scores, if available,
plus language model scores, if available. If neither are available, an
arbitrary path is chosen (based on numbering of the nodes).  The ML
word string is printed to output, along with the Levenshtein distance
between this ML path and the true transcription; this Levenshtein
distance is called the 1-best WER.

The second search computes the path (from any !ENTER to any !EXIT)
with minimum Levenshtein distance from the true transcription.  This
path is also printed to output, and its Levenshtein distance is called
the lattice WER.

Output (on STDOUT) includes 1-best and lattice WER for every lattice,
as well as the global tallies of these two quantities.  Global WER is
(N-S-I-D)/N, where N is the total number of words, S is total number
of substitution errors, I is total number of insertion errors, D is
total number of deletion errors.

ENDUSAGE

####################################################################
# GLOBAL VARIABLES

# Conversion rates for various file formats
$MLFPERIOD = 0.0000001;

# Math functions
sub abs { my($x)=shift; ($x>0) ? $x : -$x ; }
sub round { $_[0] =~ /([^\.]*)(.*)/; ($2 >= 0.5) ? $1+1 : $1; }

 
###################################################
# Subroutine to read MLF entry
#
# Syntax: $data = read_MLF_entry("filename", \*INPUTFILE);
#
# Returned value $data is an arrayref of arrayrefs
# $$tran[0][0] is first seg start time, $$tran[0][1] is end time,
# @$$tran[0][2..$#{$$tran[0]}] is the sequence of labels at first time.
#
sub read_MLF_entry {
  my($filename) = $_[0];
  my($fh) = $_[1];
  my(@tran) = ();
  my(@labels) = ();
  
  # Read all continuous lines that begin with a char other than period
  for($l=<$fh>; $l =~ /^[^\.]/; $l=<$fh>) {
    # Option 1: line is in "time time labels" format
    if ($l=~/(\d+)\s+(\d+)\s+(.*)/ ) {
      @labels = split(/\s+/,$3);
      push(@tran, [ $1 * $MLFPERIOD, $2 * $MLFPERIOD, @labels ] );
    }
    # Option 2: line contains any non-whitespace labels, but no times
    elsif ($l =~ /\S/) {
      @labels = split(/\s+/,$l);
      push(@tran, [ 0, 0, @labels ] );
    }
  }
  return(\@tran);
}

###################################################
# Subroutine to read an HTK lattice file
#
# Syntax: ($nodes, $edges, $header) = read_HTK_lattice(\*FILEHANDLE)
#
# $nodes is an arrayref of nodes
#    each node is an arrayref containing the following data:
#    [ back, forw, time ]
#    where forw is an arrayref of indices of forward edges,
#    back is an arrayref of indices of backward edges.
#    time is the time-alignment of this node
# $edges is an arrayref of edges
#    each edge is an arrayref as follows:
#    [ sn, en, word, ap, lp ]
#    sn is the index of the start node
#    en is the index of the end node
#    word is the word on this node
#    ap is the acoustic probability
#    lp is the language model probability
# $header is a hashref containing the header information
#
sub read_HTK_lattice {
  my($fh) = $_[0];
  my(@nodes) = ();
  my(@edges) = ();
  my(%header) = ();
  my($line);

  # Read lines of the file
  while($line = <$fh>) {
    # Node number given by I=
    if($line =~ /I=(\d+)/) {
      my($nodenum) = $1;
      unless(exists($nodes[$nodenum])) { $nodes[$nodenum] = [ [],[],0 ]; }
      if($line =~ /t=([\.\d]+)/) { $nodes[$nodenum][2] = $1; }
    }
    # Edge number given by J=
    elsif($line =~ /J=(\d+)/) {
      my($edgenum) = $1;
      my(@edge) = (0,0,'',0,0);
      if($line =~ /S=(\d+)/) { 
	$edge[0] = $1;
	# Tell the start node that I am one of its forward edges
	push(@{$nodes[$1][1]}, $edgenum);
      }
      if($line =~ /E=(\d+)/) { 
	$edge[1] = $1; 
	# Tell the end node that I am one of its backward edges
	push(@{$nodes[$1][0]}, $edgenum);
      }
      # Get the word label
      if($line =~ /W=(\S+)/) { $edge[2] = $1; }
      # Get the acoustic score
      if($line =~ /a=([\-\.\d]+)/) { $edge[3] = $1; }
      # Get the language model score
      if($line =~ /l=([\-\.\d]+)/) { $edge[4] = $1; }
      $edges[$edgenum] = \@edge;
    }
    # Otherwise, try to read header information
    else {
      while ($line =~ s/(\S+)=(\S+)//) { $header{$1} = $2; }
    }    
  }

  return(\@nodes, \@edges, \%header);
}

###################################################
# Subroutine to write an HTK lattice file
#
# Syntax: ($N, $L) = write_HTK_lattice($nodes, $edges, $header, \*FILEHANDLE)
#
# $nodes is an arrayref of nodes
# $edges is an arrayref of edges
# $header is a hashref containing HTK lattice header information
# FILEHANDLE is the opened output file
#
# $N is the number of nodes actually written to the file
# $L is the number of edges actually written to the file
#
sub write_HTK_lattice {
  my($nodes) = $_[0];
  my($edges) = $_[1];
  my($header) = $_[2];
  my($fh) = $_[3];
  my($N) = 0;
  my($L) = 0;

  # Print header information
  print $fh "VERSION=1.0\n";
  print $fh "UTTERANCE=",$$header{'UTTERANCE'},"\n";
  print $fh "lmname=",$$header{'lmname'},"\n";
  print $fh "lmscale=",$$header{'lmscale'}," ";
  print $fh "wdpenalty=",$$header{'wdpenalty'},"\n";
  print $fh "vocab=",$$header{'vocab'},"\n";
  print $fh sprintf("N=%-5d L=%-7d\n",0+@{$nodes},0+@{$edges});

  # Print nodes
  foreach $N (0..$#{$nodes}) {
    print $fh sprintf("I=%-5d ",$N);
    if (exists($$nodes[$N][2])) 
      { print $fh sprintf("t=%4.2f",$$nodes[$N][2]); }
    print $fh "\n";
  }
  # Print edges
  foreach $L (0..$#{$edges}) {
    print $fh sprintf("J=%-7d S=%-5d E=%-5d W=%-20s a=%7.7f l=%7.7f\n",
		      $L, @{$$edges[$L]});
  }
  return($N,$L);
}

###################################################
# Find the maximum-likelihood path through a lattice
#
# ( $optnodes, $optedges, $logprob ) = viterbi($nodes, $edges)
#
# $nodes - arrayref of nodes
# $edges - arrayref of edges
# $optnodes - arrayref of node indices along the optimum path
# $optedges - arrayref of edge indices along the optimum path
# $logprob - the log probability of the optimum path
# 
# This function makes a few critical assumptions:
#  1. the start node of any edge has lower number than its end node
#  2. a complete path through the lattice is any path connecting
#     node 0 to node $#node.
#  3. there is a path from node 0 forward to any node in the network
#
sub viterbi {
  my($nodes) = $_[0];
  my($edges) = $_[1];

  # $bp[$i] is the optimum backpointer from node $i
  my(@bp) = ( 0 ); 
  # $ep[$i] is the edge leading backward from node $i
  my(@ep) = ( 0 ); 
  # $lp[$i] is the maximum log probability along any path to node $i
  my(@lp) = ( 0 ); 

  # Find log probability and backpointer at each node
  foreach $i (1..$#{$nodes}) {
    $lp[$i] = -10000000000000;
    # Search through all edges going backward from this node
    foreach $ei (@{$$nodes[$i][0]}) {
      # Test value: logprob of previous node, plus acoust, plus lm
      my($test) = $lp[$$edges[$ei][0]] + $$edges[$ei][3] + $$edges[$ei][4];
      if($test > $lp[$i]) { 
	$lp[$i] = $test;
	$bp[$i] = $$edges[$ei][0];
	$ep[$i] = $ei;
      }
    }
  }
  
  # Now perform traceback, and put edge indices into result
  my(@optnodes) = ( $#{$nodes} );
  my(@optedges) = ();
  while ($optnodes[0] > 0) {
    unshift(@optedges, $ep[$optnodes[0]]); 
    unshift(@optnodes, $bp[$optnodes[0]]); 
  }
  return(\@optnodes, \@optedges, $lp[$#nodes]);
}

###################################################
# Find the minimum-Levenshtein path through a lattice
#
# ( $optnodes, $optedges, $errors ) = minlevenshtein($nodes, $edges, $wrds)
#
# $nodes - arrayref of nodes
# $edges - arrayref of edges
# $wrds - arrayref containing list of the wrds in the correct transcription
#
# $optnodes - arrayref of node indices along the optimum path
# $optedges - arrayref of edge indices along the optimum path
# $errors = [ S, D, I ] along minimum-Levenshtein path
#   ( N is @trans ).
# 
# This function finds the path from node 0 to node $#nodes
# that matches transcription $trans with minimum Levenshtein 
# distance.  The following assumptions are used:
#
#  1. the start node of any edge has lower number than its end node
#  2. a complete path through the lattice is any path connecting
#     node 0 to node $#node.
#  3. there is a path from node 0 forward to any node in the network
#
sub minlevenshtein {
  my($nodes) = $_[0];
  my($edges) = $_[1];
  my($wrds) = $_[2];

  # $bl[$n][$i] is the best previous level, from node $i, at level $n
  my(@bl) = ( [0] ); 
  # $be[$n][$i] is the best edge leading into node $i at level $n
  my(@be) = ( [0] ); 
  # $E[$n][$i]= min Levenshtein dist up to node $i at level $n
  my(@E) = ( [0] ); 
  
  # Initialize: at level 0, cost to each node equals # wrds in path
  foreach $i (1..$#{$nodes}) {
    $E[0][$i] = 10000000;
    foreach $ei (@{$$nodes[$i][0]}) {
      if($E[0][$$edges[$ei][0]] < $E[0][$i]-1) {
	$E[0][$i] = $E[0][$$edges[$ei][0]] + 1; 
	$be[0][$i] = $ei; $bl[0][$i] = 0;
      }
    }
  } 

  # Now compute minimum-Levenshtein path at each higher level
  foreach $n (1..($#{$wrds}+1)) {
    foreach $i (0..$#{$nodes}) {
      # $E[$n][$i] is no larger than $E[$n-1][$i] + one deletion
      #  If $$wrds[$n-1] is '', no deletion is counted!
      $E[$n][$i] = $E[$n-1][$i] + (($$wrds[$n-1] eq '') ? 0 : 1);
      $bl[$n][$i] = $bl[$n-1][$i]; $be[$n][$i] = $be[$n-1][$i];

      # Search through all edges going backward from this node
      foreach $ei (@{$$nodes[$i][0]}) {
	# First possibility: look back and down
	if($E[$n-1][$$edges[$ei][0]] < $E[$n][$i]) {
	  # If word on the edge matches word in transcription, no cost
	  if($$edges[$ei][2] eq $$wrds[$n-1]) {
	    $E[$n][$i] = $E[$n-1][$$edges[$ei][0]]; 
	    $be[$n][$i] = $ei; $bl[$n][$i] = $n-1;
	  }
	  # Otherwise, consider possibility of substitution
	  elsif ($E[$n-1][$$edges[$ei][0]] < $E[$n][$i]-1) {
	    $E[$n][$i] = $E[$n-1][$$edges[$ei][0]] + 1; 
	    $be[$n][$i] = $ei; $bl[$n][$i] = $n-1;
	  }
	}

	# Second possibility: look back at same ref level
	if(($E[$n][$$edges[$ei][0]] < $E[$n][$i])) {
	  # If edge is empty, no cost
	  if ($$edges[$ei][2] eq '') {
	    $E[$n][$i] = $E[$n][$$edges[$ei][0]]; 
	    $be[$n][$i] = $ei; $bl[$n][$i] = $n;
	  }
	  # Otherwise, consider possibility of insertion
	  elsif($E[$n][$$edges[$ei][0]] < $E[$n][$i]-1) {
	    $E[$n][$i] = $E[$n][$$edges[$ei][0]] + 1; 
	    $be[$n][$i] = $ei; $bl[$n][$i] = $n;
	  }
	}
      }
    }
  }
    
  # Now perform traceback, and put edge indices into result
  my(@optnodes) = ( $#{$nodes} );
  my(@optlevels) = ( $#{$wrds}+1 );
  my(@optedges) = ();
  while ($optnodes[0] > 0) {
    my($lev) = $optlevels[0]; my($nod)=$optnodes[0];
    unshift(@optedges, $be[$lev][$nod]);
    unshift(@optnodes, $$edges[$be[$lev][$nod]][0]);
    unshift(@optlevels, $bl[$lev][$nod]);
  }
  return(\@optnodes, \@optedges, $E[$#{$wrds}+1][$#{$nodes}]);
}

###################################################
# Extract word string from an MLF-style transcription
#
# $wrds = trans2wrds($trans)
#
# $wrds: arrayref of wrds
# $trans: arrayref of transcriptions
#
sub trans2wrds {
  my(@trans) = @{$_[0]};
  my(@wrds) = ();
  foreach $t (@trans) { push(@wrds, $$t[2]); }
  return(\@wrds);
}

###################################################
# normalize_word:
# Remove distinctions not useful for scoring a lattice
# from a word in input transcription or on a lattice edge.
#
# This function should be same as normalize_words.pl,
# except that filled pauses, noise, and laughter are
# replace with a null string "".
#
# $outword = normalize_word($inword)
#
sub normalize_word {
  # Set the word to upper case
  my($l) = uc($_[0]);
    
  # Any compound including the word "laugh" means "laugh"
  $l =~ s/.*LAUGH.*//;
  
  # These words seem to be used for various filled pauses
  #   Replace all with UH or UM
  $l =~ s/.*(EPENTHETIC|FILLEDSIL|FALSESTART|HESITATION|GLOTTAL).*//;
  $l =~ s/.*(TRUNCATEDP).*//;
  $l =~ s/.*(NASAL|MMM).*//;
  $l =~ s/\b(UH|UM|UMM)\b//;
  
  # Eliminate various background noise notations
  $l =~ s/\bSIL\b//;
  
  # These words mean silence even if extended, e.g. SILENCEDUETOSPLICE
  $l =~ s/.*(H\#|CROFF|UNKNOWN|CLICK|SILENCE|BREATH).*//;
  $l =~ s/.*(CROSSTALK|STATIC|NOISE|SMACK|BUZZ|HUMM).*//;
  
  # Replace periods by apostrophes
  $l =~ s/\./\'/g;
  # Eliminate second in any series of apostrophes
  $l =~ s/\'\'/\'/g;    
  
  # Eliminate commentary between brackets, braces, or parentheses,
  #  after underscore, or after ? or ! or #
  # This should come last, so that # doesn't keep H# from being used
  $l =~ s/\[.*\]//;
  $l =~ s/\{.*\}//;
  $l =~ s/\(.*\)//;
  $l =~ s/(_|\!|\?|\#).*//;
  
  # Eliminate quotation marks
  $l =~ s/\"//g;
  
  # Return outword
  return($l);
}

###################################################
# Extract word string from an arrayref of edge indices
#
# $wrds = edges2wrds($indices, $edges)
#
# $wrds: arrayref of wrds
# $indices: arrayref of indices
# $edges: arrayref of edges, indexed by $indices
#
sub edges2wrds {
  my($indices) = $_[0];
  my($edges) = $_[1];
  my(@wrds) = ();
  foreach $ei (@{$indices}) { push(@wrds, ${$edges}[$ei][2]); }
  return(\@wrds);
}

###################################################
# Find Levenshtein statistics between two symbol strings
#
# $stats = levenshtein( $ref, $test )
#
# $stats = [ N, S, D, I, E=S+D+I ]
# $ref = reference string
# $test = test string
#
# N counts the number of non-null wrds in $ref.
# S, D, I = number of subs, dels, ins, and total errors
#   in the best alignment of $ref with $test.
#   Insertions and deletions do not count null wrds ('').
#   E=S+D+I.
#
sub levenshtein {
  my($ref) = $_[0];
  my($test) = $_[1];
  my(@stats) = ();
  my($m); my($n);
  my($numref)=0; 
  my($numtest)=0; 

  # If zero wrds observed in test list, (SDIE) = (0,D,0,D)
  foreach $m (0..($#{$ref}+1)) { 
    if( $m>0 && $$ref[$m-1] ne '') { $numref++ };
    $stats[$m][0] = [0,$numref,0,$numref]; 
  }

  # If zero wrds observed in ref list, (SDIE) = (0,I,I)
  foreach $n (0..($#{$test}+1)) { 
    if( $n>0 && $$test[$n-1] ne '') { $numtest++ };
    $stats[$m][0] = [0,0,$numtest,$numtest]; 
  }

  # m is index into the ref list, n is index into the test list    
  foreach $m (1..($#{$ref}+1)) { foreach $n (1..($#{$test}+1)) {

    # If wrds are equal, there is no cost; 
    #   Otherwise, we suffer at least one substitution
    @{$stats[$m][$n]} = @{$stats[$m-1][$n-1]};
    unless($$ref[$m-1] eq $$test[$n-1]) 
      { $stats[$m][$n][0]++; $stats[$m][$n][3]++; }
    
    # If $ref[$m-1] eq '', we can skip it without cost
    if ($$ref[$m-1] eq '' && $stats[$m-1][$n][3] < $stats[$m][$n][3]) 
      { @{$stats[$m][$n]} = @{$stats[$m-1][$n]}; }
    # Otherwise, if deletion results in minimum cost, use it
    elsif ($stats[$m-1][$n][3] < $stats[$m][$n][3] - 1) {
      @{$stats[$m][$n]} = @{$stats[$m-1][$n]};
      $stats[$m][$n][1]++; $stats[$m][$n][3]++;
    }
    
    # If $test[$n-1] eq '', we can skip it without cost
    if ($$test[$n-1] eq '' && $stats[$m][$n-1][3] < $stats[$m][$n][3]) 
      { @{$stats[$m][$n]} = @{$stats[$m][$n-1]}; }
    # Otherwise, if insertion results in lower cost, use it
    elsif ($stats[$m][$n-1][3] < $stats[$m][$n][3] - 1) {
      @{$stats[$m][$n]} = @{$stats[$m][$n-1]};
      $stats[$m][$n][2]++; $stats[$m][$n][3]++;
    }
  }}

  return( $numref, @{$stats[$#{$ref}+1][$#{$test}+1]} );
}



################################################################
# Main program

if (@ARGV==0) { print STDERR $USAGE; exit; }

# Read in all lines from the reference MLF
%IMLF  = ();
open(MLF_FILE, $ARGV[0]) || die "Unable to open MLF $ARGV[0]: $!";
while (<MLF_FILE>) {
  # If this line starts a transcription, read it
  if (/\".*\/([^\/\.]+)[^\/]*\"/) {
    my($filename) = $1;
    $IMLF{$filename} = read_MLF_entry($filename,\*MLF_FILE);
  }
}
close(MLF_FILE);

# Initialize global stats
@global_maxprobstats = (0,0,0,0,0);
@global_minlevstats = (0,0,0,0,0);
$globalarcs = 0;
$globaltime = 0;

# Process each lattice file in STDIN
while (<STDIN>) {
  chop;
  $latfile = $_;

  # read the lattice file
  unless(open(LATFILE, $latfile)) {
    print STDERR "Unable to read from lattice $latfile: $!";
    next;
  }
  @graph = read_HTK_lattice(\*LATFILE);
  close(LATFILE);
  foreach $j (0..$#{$graph[1]}) 
    { $graph[1][$j][2] = normalize_word($graph[1][$j][2]); }
  
  # DEBUG: write the lattice
  #print STDERR "Read the following lattice from $latfile:\n";
  #write_HTK_lattice(@graph, \*STDERR);
  
  # get wrds from the transcription
  # filename = UTTERANCE from the header, minus dirs & exts
  $filename = $graph[2]{'UTTERANCE'};
  $filename =~ s/\S+\///; $filename =~ s/\.\S+//;
  unless(exists($IMLF{$filename})) {
    print STDERR "$filename not found in $ARGV[0]\n"; 
    next;
  }
  $words = trans2wrds($IMLF{$filename});
  foreach $i (0..$#{$words}) { $$words[$i] = normalize_word($$words[$i]); }
  print "Words: ", @$words, "\n";

  # find maxprob path, extract test words, and compute Levenshtein
  @maxprob = viterbi(@graph[0..1]);
  $maxprobtest = edges2wrds($maxprob[1], $graph[1]);
  @maxprobstats = levenshtein($words, $maxprobtest);

  # DEBUG: write out the edge words on ML path
  print "ML PATH: ";
  foreach $i (0..$#{$maxprob[1]}) { print ",",$graph[1][$maxprob[1][$i]][2]; }
  print "\n";
  
  # find minlevenshtein path, extract test words, compute Levenshtein
  @minlev = minlevenshtein(@graph[0..1],$words);
  $minlevtest = edges2wrds($minlev[1], $graph[1]);
  @minlevstats = levenshtein($words, $minlevtest);

  # DEBUG: write out the edge words on ML path
  print "MIN PATH: ";
  foreach $i (0..$#{$minlev[1]}) { print ",",$graph[1][$minlev[1][$i]][2]; }
  print "\n";
  
  # print output for this graph
  print "UTTERANCE=$filename\n";
  print sprintf("Lattice: N=%d, S=%d, D=%d, I=%d, E=%d, error=%d\n",
		$minlevstats[0], $minlevstats[1], $minlevstats[2], 
		$minlevstats[3], $minlevstats[4], $minlev[2]);
  print sprintf(" 1-best: N=%d, S=%d, D=%d, I=%d, E=%d, logprob=%g\n", 
		$maxprobstats[0], $maxprobstats[1], $maxprobstats[2], 
		$maxprobstats[3], $maxprobstats[4], $maxprob[2]);
  $arcs = @{$graph[1]};   $globalarcs += $arcs;
  print sprintf("ARCS/WRD=$arcs/$minlevstats[0] (%.2f)\n",
		$arcs/$minlevstats[0]);
  if ($#{$graph[0]} >0 && exists($graph[0][$#{$graph[0]}][2])) {
    $utt_time = $graph[0][$#{$graph[0]}][2];
    if($utt_time > 0) {
      print sprintf("ARCS/SEC=$arcs/$utt_time (%.2f)\n",$arcs/$utt_time);
      $globaltime += $utt_time;
    }
  }
  $"=','; 
  print "REF_TRANSCR: <@{$words}>\n";
  print "ORACLE_PATH: <@{$minlevtest}>\n";
  print "ML_PATH:     <@{$maxprobtest}>\n";
  $"=' ';
  print ".\n";
  
  # Add stats to the global stats
  for(my($n)=0; $n<@minlevstats; $n++) {
    $global_maxprobstats[$n] += $maxprobstats[$n];
    $global_minlevstats[$n] += $minlevstats[$n];
  }
  # Print one-line summary to STDERR
  print STDERR sprintf("$filename: (%d+%d+%d)/%d, (%d+%d+%d)/%d, ARCS=%d\n",
		       $maxprobstats[1],$maxprobstats[2],$maxprobstats[3],
		       $maxprobstats[0],$minlevstats[1],$minlevstats[2],
		       $minlevstats[3],$minlevstats[0],$arcs);
}

# Print out global stats
print "***************************************************************\n";
print "SUMMARY\n";
print sprintf("Lattice_WER=%.2f%%, N=%d, S=%d, D=%d, I=%d, E=%d\n",
	      100*$global_minlevstats[4]/$global_minlevstats[0], 
	      $global_minlevstats[0], $global_minlevstats[1],
	      $global_minlevstats[2], $global_minlevstats[3],
	      $global_minlevstats[4]);
print sprintf(" 1-best_WER=%.2f%%, N=%d, S=%d, D=%d, I=%d, E=%d\n", 
	      100*$global_maxprobstats[4]/$global_maxprobstats[0], 
	      $global_maxprobstats[0], $global_maxprobstats[1], 
	      $global_maxprobstats[2], $global_maxprobstats[3],
	      $global_maxprobstats[4]);
print sprintf("ARCS/WORD=$globalarcs/$global_minlevstats[0] (%.2f)\n",
	      $globalarcs/$global_minlevstats[0]);
if ($globaltime > 0) 
  { print sprintf("ARCS/SEC=$globalarcs/$globaltime (%.2f)\n",
		  $globalarcs/$globaltime); }

