#!/usr/bin/perl -w
use strict;

#################################
# History:
#
# version 15: * word alignment tuned to include consideration of metadata
#               attributes in addition to word spelling and type/subtype.
#
# version 14: * use of UEM data changed - rather than discard rttm data
#               in the UEM exclusion zones, the data are processed normally
#               and SU end boundaries in the exclusion zones are not counted
#               during scoring.
#             * count SU boundary errors explicitly rather than inferring
#               them from SU statistics.
#
# version 13: * accommodate multiple hyphens when splitting hyphenated words
#             * penalize SU mapping score for differences in SU endpoints
#
# version 12: * debug discard_unannotated_SUs
#
# version 11: * score frags and noscore NON-LEX and NON-SPEECH
#             * modify word alignment to
#                 - allow frag to match frag ignoring orthography
#                 - allow fp to match fp ignoring orthography
#
# version 10: * fix bug in md_score
#             * fix bug in discard_unannotated_SUs
#
# version 9:  * fix bug in translating sys time to ref time
#             * upgrade word representation from CTM to RTTM
#
# version 8:  * bug fix, plus rule change for discarding unannotated SU's:
#                - discard sys output SU's that map to unannotated ref SU's
#                  or that are are unmapped but overlap an unannotated ref SU.
#                - discard unannotated ref SU's.
#
# version 7:  * code around an error in the Unix implementation of Perl
#
# version 6:  * fix bug in handling of unannotated SU's
#             * reinstitute scoring of SU type (since the basic
#               eval plan which ignores SU type is computed separately)
#
# version 5:  added Error(SU) as defined be eval plan v6.
#
# version 4:  modified to discard all ref SU's of type 'unannotated'
#             and all sys SU's that are mapped to them and 
#             to discard all unmapped sys SU's that overlap
#             the discarded ref SU's of  type 'unannotated'
#             fixed to score only SU boundary and not on SU boundary and SU type
#             fixed 'uninitialized variable' error in reading in rttm file
#             
# version 3:  converted to run from RTTM input files
#
# version 2:  minor bug fixed in interpretation of SU extent limit
#
# version 1:  adapted from md-eval-v05
#
#################################

######
# Intro
my ($date, $time) = date_time_stamp();
print "su-eval run on $date at $time\n";
print "command line:  ", $0, " ", join(" ", @ARGV), "\n";
my $usage = "\n\nUsage: $0 [-h] -r <ref_file> -s <src_file>\n\n".
    "Description:  su-eval computes EARS SU performance statistics\n".
    "      by comparing system output data with reference data\n".
    "INPUT:\n".
    "  -r <ref-file>  A file containing reference data, in RTTM format.\n".
    "       This data must include word level transcripts in addition to\n".
    "       the SU information being evaluated.\n".
    "  -s <sys-file>  A file containing system output data, in RTTM format.\n".
    "       If the word-mediated alignment option is used then this data\n".
    "       must include word level transcripts in addition to the SU output\n".
    "       data being evaluated.\n".
    "  input options:\n".
    "    -w for word-mediated alignment.\n".
    "       * The default (time-mediated) alignment aligns ref and sys metadata\n".
    "         according to the time overlap of the original ref and sys metadata\n".
    "         time intervals.\n".
    "       * Word-mediated alignment aligns ref and sys metadata according to\n".
    "         the alignment of the words that are subsumed within the metadata\n".
    "         time intervals.\n".
    "    -W for word-optimized mapping.\n".
    "       * The default (time-optimized) mapping maps ref and sys metadata\n".
    "         so as to maximize the time overlap of mapped metadata events.\n".
    "       * Word-optimized mapping maps ref and sys metadata so as to\n".
    "         maximize the overlap in terms of the number of reference words\n".
    "         that are subsumed within the overlapping time interval.\n".
    "    -t <time gap> The maximum time gap allowed between matching reference\n".
    "       and system output words (in seconds).  This parameter is in effect\n".
    "       only when word-mediated adjustment of SU times is in effect (i.e.,\n".
    "       only when the -w option is invoked).\n".
    "    -T <time gap> The maximum time gap allowed between matching reference\n".
    "       and system output SU's (in seconds).  This parameter is in effect\n".
    "       only when time-optimized mapping of SU's is in effect (i.e., only\n".
    "       when the -W option is not invoked).\n".
    "    -l <SU extent limit>  The maximum SU extent used to compute overlap\n".
    "       between reference and system output SU's.  For time-optimized SU\n".
    "       mapping this is the maximum time extent.  For word-optimized SU\n".
    "       mapping (using the -W option) this is the maximum number of words.\n".
    "       SU extent is limited to the last part of the SU.\n".
    "    -u <uem-file> A file containing the evaluation partitions,\n".
    "       in UEM format.\n".
    "    -g <glm-file> A file containing word transformations used to\n".
    "       standardize the representation of words.\n".
    "    -o to allow recognition of overlapped speech.  With this option,\n".
    "       separate recognition passes are made through the STT output\n".
    "       speech for each reference speaker.\n".
    "    -e to examine the chronology and joint mapping of words and metadata\n".
    "    -d for word alignment and error calculation details\n".
    "    -D for metadata event alignment and error calculation details\n".
    "OUTPUT:\n".
    "  Performance statistics are written to STDOUT.\n".
    "\n";

######
#global data
my %md_types = (filler => {filled_pause => 1, discourse_marker => 1, explicit_editing_term => 1},
		edit   => {repetition => 1, revision => 1, restart => 1, simple => 1, complex => 1},
		ip     => {filler => 1, edit => 1, "edit&filler" => 1},
		su     => {statement => 1, question => 1, backchannel => 1, incomplete => 1,
			   clausal => 1, coordinating => 1, unannotated => 1});
use vars qw ($opt_h $opt_w $opt_W $opt_d $opt_D $opt_r $opt_s $opt_l);
use vars qw ($opt_t $opt_T $opt_g $opt_p $opt_o $opt_a $opt_u $opt_e);
use Getopt::Std;
getopts ('hdDwWoer:s:t:T:g:p:a:u:l:');
die $usage if defined($opt_h);
die "\n\nFATAL ERROR:  no reference data file specified$usage" unless defined $opt_r;
die "\n\nFATAL ERROR:  no system output data file specified$usage" unless defined $opt_s;

my (%glm, %uem);
my $exp_id = "";
my $inputs = "";
my $t_gap = defined $opt_t ? $opt_t : 1;
my $T_gap = defined $opt_T ? $opt_T : 0.25;
my $W_gap = 0.1;
my $su_time_limit = defined $opt_l ? $opt_l : 0.5;
my $su_word_limit = defined $opt_l ? $opt_l : 2.0;
my $max_delta_score = $opt_w ? 10 : 1;
$max_delta_score = $opt_p if defined $opt_p;
print "word-based SU alignment, max gap between matching words = $t_gap sec\n" if $opt_w;
$opt_W ? (print "word-optimized SU mapping, max gap between matching SU's = $W_gap words, max extent to match = $su_word_limit words\n") :
         (print "time-optimized SU mapping, max gap between matching SU's = $T_gap sec, max extent to match = $su_time_limit sec\n");

{
    my (%ref, %sys);

    get_glm_data (\%glm, $opt_g);

    get_uem_data (\%uem, $opt_u);

    get_rttm_data ("REF", \%ref, $opt_r);

    get_rttm_data ("SYS", \%sys, $opt_s);

    evaluate (\%ref, \%sys);
}

#################################

sub get_glm_data {

    my ($data, $file) = @_;
    my ($record, @fields, $word, %words);

    return unless defined $file;
    open DATA, $file or die "\n\nFATAL ERROR:  unable to open glm file '$file'$usage";
    while ($record = <DATA>) {
	chomp $record;
	$record = lc $record; #lower case
	next if $record =~ /^\s*$/;
	next if $record =~ /^\s*(\[|\*|\%|\;)/;
        @fields = split /\s+=>\s+/, $record;
	shift @fields if $fields[0] eq "";
        next unless @fields > 1;
	$fields[0] =~ s/^\s+//;
        $fields[1] =~ s/[^a-z-'_ \.].*//;
        next if $fields[0] =~ /^\s*$/ or $fields[1] =~ /^\s*$/;
        $data->{$fields[0]} = [split /\s+/, $fields[1]];
    }
    close DATA;
}


#################################

sub get_uem_data {

    my ($data, $file) = @_;
    my ($record, @fields, $seg);

    return unless defined $file;
    open DATA, $file or die "\n\nFATAL ERROR:  unable to open uem file '$file'$usage";
    while ($record = <DATA>) {
	chomp $record;
	next if $record =~ /^\s*[\#;]|^\s*$/;
	@fields = split /\s+/, $record;
	shift @fields if $fields[0] eq "";
	die "\n\nFATAL ERROR:  insufficient number of fields in UEM record '$record'\n\n"
	    unless @fields >= 4;
	undef $seg;
	$seg->{FILE} = shift @fields;
	$seg->{CHNL} = shift @fields;
	$seg->{TBEG} = shift @fields;
	$seg->{TEND} = shift @fields;
        $seg->{FILE} =~ s/.*\///;      #strip directory 
        $seg->{FILE} =~ s/\.[^.]*//;   #strip file type
        $seg->{TBEG} =~ s/[^0-9\.]//g; #strip non-numeric (commas)
        $seg->{TEND} =~ s/[^0-9\.]//g; #strip non-numeric (commas)
	push @{$data->{$seg->{FILE}}{$seg->{CHNL}}}, $seg;
    }
    close DATA;
}

#################################

sub get_rttm_data {

    my ($type, $data, $file) = @_;
    my ($record, @fields, $data_type, $word, @words, $token, $chnl);

    open DATA, $file or die "\n\nFATAL ERROR:  unable to open RTTM file '$file'$usage";
    while ($record = <DATA>) {
	$exp_id .= $record if $type eq "SYS" and $record =~ /^\s*;;\s*EXP-ID:\s*/i;
	$inputs .= $record if $type eq "SYS" and $record =~ /^\s*;;\s*INPUTS:\s*/i;
	chomp $record;
	next if $record =~ /^\s*[\#;]|^\s*$/;
	@fields = split /\s+/, $record;
	shift @fields if $fields[0] eq "";
	$data_type = shift @fields;

	if ($data_type =~ /^LEXEME$/) {
	    undef $word;
	    $word->{TYPE} = $data_type;
	    $word->{FILE} = shift @fields;
	    $word->{CHNL} = shift @fields;
	    $word->{TBEG} = shift @fields;
	    $word->{TBEG} =~ s/\*//;
	    $word->{TDUR} = shift @fields;
	    $word->{TDUR} =~ s/\*//;
	    $word->{WORD} = lc shift @fields;
	    $word->{SUBT} = shift @fields;
	    $word->{SPKR} = shift @fields;
	    $word->{CONF} = shift @fields;
	    
	    $word->{CONF} = "-"       unless defined $word->{CONF};
	    $word->{SPKR} = "unknown" unless defined $word->{SPKR};
	    $word->{TEND} = $word->{TBEG}+$word->{TDUR};
	    $word->{TMID} = $word->{TBEG}+$word->{TDUR}/2;
	    $word->{WTYP} = ($data_type =~ /^NON-SPEECH$/      ? "misc"    :
			     ($data_type =~ /^NON-LEX$/        ? "non-lex" :
			      ($word->{SUBT} =~ /^fp$/         ? "fp"      :
			       ($word->{SUBT} =~ /^frag$/      ? "frag"    :
				($word->{SUBT} =~ /^un-lex$/   ? "un-lex"  :
				 ($word->{SUBT} =~ /^for-lex$/ ? "for-lex" : "lex"))))));
	    @words = standardize_word ($word);
	    foreach $word (@words) {
		push @{$data->{CTM}{$word->{FILE}}{$word->{CHNL}}}, $word;
	    }
	}
	elsif ($data_type =~ /^(FILLER|EDIT|IP|SU)$/) {
	    undef $token;
	    $token->{TYPE} = lc $data_type;
	    $token->{FILE} = shift @fields;
	    $token->{CHNL} = shift @fields;
	    $token->{TBEG} = shift @fields;
	    $token->{TBEG} =~ s/\*//;
	    $token->{TDUR} = shift @fields;
	    $token->{TDUR} =~ s/\*//;
	    $token->{TDUR} = 0 if $token->{TDUR} eq "<NA>";
	    $token->{WORD} = shift @fields;
	    $token->{SUBT} = lc shift @fields;
	    $token->{SPKR} = shift @fields;
	    $token->{CONF} = shift @fields;
	    $token->{TEND} = $token->{TBEG}+$token->{TDUR};
	    $token->{TMID} = $token->{TBEG}+$token->{TDUR}/2;
	    defined $md_types{$token->{TYPE}}{$token->{SUBT}} or die
		("\n\nFATAL ERROR:  unknown disfluency subtype ($token->{SUBT}) in file '$file'\n".
		 "    record is '$record'\n\n");
	    push @{$data->{MDTM}{$token->{FILE}}{$token->{CHNL}}}, $token;
	    push @{$data->{su}{$token->{FILE}}{$token->{CHNL}}}, $token if $token->{TYPE} eq "su";
	}
    }
    close DATA;

    foreach $data_type (keys %$data) {
	foreach $file (keys %{$data->{$data_type}}) {
	    foreach $chnl (keys %{$data->{$data_type}{$file}}) {
		@{$data->{$data_type}{$file}{$chnl}} =
		    sort {$a->{TBEG} <=> $b->{TBEG}} @{$data->{$data_type}{$file}{$chnl}};
	    }
	}
    }
}

#################################

sub token_in_eval_partition {

    my ($token) = @_;
    my ($partition, $midpoint);

    return 1 unless %uem; #not using UEM partition specification
    foreach $partition (@{$uem{$token->{FILE}}{$token->{CHNL}}}) {
	return 1 if $token->{TMID} > $partition->{TBEG}	and
	    $token->{TMID} < $partition->{TEND};
    }
    return 0;
}

#################################

sub evaluate {

    my ($ref_data, $sys_data) = @_;
    my ($file, $spkr, $chnl);
    my ($ref_wds, $sys_wds, $ref_mds, $sys_mds, $type, %counts);
    my %subtypes = (su     => ["statement", "question", "backchannel", "incomplete"]);

    foreach $file (sort keys %{$ref_data->{CTM}}) {
	die "\n\nFATAL ERROR:  no STT output for file '$file'\n\n" unless defined $sys_data->{CTM}{$file};
	foreach $chnl (sort keys %{$ref_data->{CTM}{$file}}) {
	    $ref_wds = $ref_data->{CTM}{$file}{$chnl};
	    $sys_wds = $sys_data->{CTM}{$file}{$chnl};
	    die "\n\nFATAL ERROR:  no STT output for channel '$chnl' of '$file'\n\n" unless defined $sys_wds;
	    if ($opt_w) {
		tag_words_with_metadata_attributes ($ref_data->{MDTM}{$file}{$chnl}, $ref_wds);
		tag_words_with_metadata_attributes ($sys_data->{MDTM}{$file}{$chnl}, $sys_wds);
		if ($opt_o) {
		    foreach $spkr (word_kinds ($ref_wds, "SPKR")) {
			align_words ($ref_wds, $sys_wds, $spkr);
			trace_best_word_path ($ref_wds, $sys_wds, $spkr);
		    }
		}
		else {
		    align_words ($ref_wds, $sys_wds);
		    trace_best_word_path ($ref_wds, $sys_wds);
		}
	    }
	    annotate_words ($ref_wds, $sys_wds, $ref_data->{MDTM}{$file}{$chnl});
	    map_syswd_times_to_ref ($ref_wds, $sys_wds);
	    score_word_path ($file, $chnl, $ref_wds, $sys_wds, $opt_d) if $opt_w;

	    foreach $type (sort keys %subtypes) {
		$ref_mds = $ref_data->{$type}{$file}{$chnl} ? $ref_data->{$type}{$file}{$chnl} : [];
		$sys_mds = $sys_data->{$type}{$file}{$chnl} ? $sys_data->{$type}{$file}{$chnl} : [];
		map_metadata_to_words ($sys_mds, $sys_wds, $ref_mds, $ref_wds);
		align_metadata ($ref_mds, $sys_mds);
		trace_best_metadata_path ($ref_mds, $sys_mds);
		($counts{$type}{$file}{$chnl}) = 
		    score_metadata_path ($type, $file, $chnl, $ref_mds, $sys_mds, $ref_wds, $opt_D);
		examine_metadata_mapping ($type, $file, $chnl, $ref_wds, $ref_mds, $sys_wds, $sys_mds) if $opt_e;
	    }
	}
    }
    foreach $type (sort keys %subtypes) {
	performance_analysis (uc $type, $counts{$type}, $subtypes{$type}, $opt_a);
    }
}

#################################

sub tag_words_with_metadata_attributes {

    my ($mds, $wds) = @_;
    my ($md, $iwbeg, $iwend);

    foreach $md (@$mds) {
	next unless $md->{TYPE} =~ /^(filler|edit|su)$/;
	($iwbeg, $iwend) = md_word_indices ($md, $wds);
	next unless $iwbeg <= $iwend;
	$wds->[$iwend]{"MD_$md->{TYPE}"} = 1;
	$wds->[$iwend]{"MD_ip"} = 1 if $md->{TYPE} eq "EDIT";
	$wds->[$iwbeg]{"MD_ip"} = 1 if $md->{TYPE} eq "FILLER";
    }
    return;
}

#################################

sub examine_metadata_mapping {

    my ($type, $file, $chnl, $ref_wds, $ref_mds, $sys_wds, $sys_mds) = @_;
    my (@events, $event, $wd, $ref_md, $sys_md, @ref_map, $i);

    print "\nChronological display of reference and system output SU's, integrated with reference words\n"
	."  for file $file, channel $chnl\n";
    print           "    --------- reference ------------- | --------- system output ---------\n";
    $opt_w ? (print "    REF wrds-SUs        beg/end_times | SYS wrds-SUs        adjusted_times     source_times\n") :
	      print "    REF wrds-SUs        beg/end_times |   SYS SUs           beg/end_times\n";

#create a combined vector of word events and metadata beg/end events, with timing info
    undef @ref_map;
    for ($i=0; $i<@$ref_wds; $i++) {
	$wd = $ref_wds->[$i];
	$ref_map[$wd->{MAP}] = $i if defined $wd->{MAP};
	$event = {TYPE => "REFWD", TIME => $wd->{TMID}, EVENT => $wd, SYSWD => $wd->{MAP}};
	push @events, $event;
    }

    for ($i=0; $i<@$sys_wds; $i++) {
	$wd = $sys_wds->[$i];
	$event = {TYPE => "SYSWD", TIME => $wd->{RTMID}, EVENT => $wd, REFWD => $ref_map[$i]};
	push @events, $event;
    }

    undef @ref_map;
    for ($i=0; $i<@$ref_mds; $i++) {
	$ref_md = $ref_mds->[$i];
	$ref_map[$ref_md->{MAP}] = $i if defined $ref_md->{MAP};
	$event = {TYPE => "REFMD1", TIME => $ref_md->{TBEG}, EVENT => $ref_md, SYSMD => $ref_md->{MAP}};
	push @events, $event;
	$event = {TYPE => "REFMD2", TIME => $ref_md->{TEND}, EVENT => $ref_md, SYSMD => $ref_md->{MAP}};
	push @events, $event;
    }

    for ($i=0; $i<@$sys_mds; $i++) {
	$sys_md = $sys_mds->[$i];
	$event = {TYPE => "SYSMD1", TIME => $sys_md->{RTBEG}, EVENT => $sys_md, REFMD => $ref_map[$i]};
	push @events, $event;
	$event = {TYPE => "SYSMD2", TIME => $sys_md->{RTEND}, EVENT => $sys_md, REFMD => $ref_map[$i]};
	push @events, $event;
    }
    @events = sort {$a->{TIME}+($a->{TYPE}=~/1$/?0.0001:0) <=> $b->{TIME}+($b->{TYPE}=~/1$/?0.0001:0)} @events;
    foreach $event (@events) {
	if ($event->{TYPE} =~ /REFMD/) {
	    $ref_md = $event->{EVENT};
	    $event->{TYPE} eq "REFMD1" ?
		(printf "beg %-12.12s %-4.4s%8.2f%8.2f |",
		     $ref_md->{TYPE}, $ref_md->{SUBT}, $ref_md->{TBEG}, $ref_md->{TEND}) :
		(printf "end %-12.12s %-4.4s%8s%8.2f |",
		     $ref_md->{TYPE}, $ref_md->{SUBT}, "--- ", $ref_md->{TEND});
	    if (defined $event->{EVENT}{MAP}) {
		$sys_md = $sys_mds->[$event->{EVENT}{MAP}];
		if ($event->{TYPE} eq "REFMD1") {
		    $opt_w ?
			(printf " %-12.12s %-4.4s (%7.2f%8s)%8.2f%8.2f",
			     $sys_md->{TYPE}, $sys_md->{SUBT}, $sys_md->{RTBEG}, "--- ", $sys_md->{TBEG}, $sys_md->{TEND}) :
			(printf " %-12.12s %-4.4s%8.2f%8.2f",
			     $sys_md->{TYPE}, $sys_md->{SUBT}, $sys_md->{TBEG}, $sys_md->{TEND});
		    my $dw = delta_metadata_error_words ("BEG", $ref_md->{WBEG}, $sys_md->{RWBEG}, $ref_wds);
		    print " dw=$dw" if abs ($dw) > 0;
		    printf "%s", (abs($dw)>1 ? (abs($dw)>2 ? (abs($dw)>3 ? (abs($dw)>4 ? "!!!!" : "!!!") : "!!") : "!") : "");
		}
		else {
		    $opt_w ?
			(printf " %-12.12s %-4.4s (%7s%8.2f)%8s%8.2f",
			     $sys_md->{TYPE}, $sys_md->{SUBT}, "--- ", $sys_md->{RTEND}, "--- ", $sys_md->{TEND}) :
			(printf " %-12.12s %-4.4s%8s%8.2f", $sys_md->{TYPE}, $sys_md->{SUBT}, "--- ", $sys_md->{TEND});
		    my $dw = delta_metadata_error_words ("END", $ref_md->{WEND}, $sys_md->{RWEND}, $ref_wds);
		    print " dw=$dw" if abs ($dw) > 0;
		    printf "%s", (abs($dw)>1 ? (abs($dw)>2 ? (abs($dw)>3 ? (abs($dw)>4 ? "!!!!" : "!!!") : "!!") : "!") : "");
		}
	    }
	    print "\n";
	}
	elsif ($event->{TYPE} =~ /SYSMD/) {
	    next if defined $event->{REFMD};
	    $sys_md = $event->{EVENT};
	    if ($event->{TYPE} eq "SYSMD1") {
		$opt_w ?
		    (printf "%-38s| %-12.12s %-4.4s (%7.2f%8s)%8.2f%8.2f\n", "beg",
		         $sys_md->{TYPE}, $sys_md->{SUBT}, $sys_md->{RTBEG}, "--- ", $sys_md->{TBEG}, $sys_md->{TEND}) :
		    (printf "%-38s| %-12.12s %-4.4s%8.2f%8.2f\n", "beg",
		         $sys_md->{TYPE}, $sys_md->{SUBT}, $sys_md->{TBEG}, $sys_md->{TEND});
	    }
	    else {
		$opt_w ?
		    (printf "%-38s| %-12.12s %-4.4s (%7s%8.2f)%8s%8.2f\n", "end",
		         $sys_md->{TYPE}, $sys_md->{SUBT}, "--- ", $sys_md->{RTEND}, "--- ", $sys_md->{TEND}) :
		    (printf "%-38s| %-12.12s %-4.4s%8s%8.2f\n", "end",
		         $sys_md->{TYPE}, $sys_md->{SUBT}, "--- ", $sys_md->{TEND});
	    }
	}
	elsif ($event->{TYPE} eq "REFWD") {
	    $wd = $event->{EVENT};
	    printf "    %12.12s %-4.4s%8.2f%8.2f | ", $wd->{WORD}, $wd->{WTYP}, $wd->{TBEG}, $wd->{TEND};
	    $wd = defined $event->{EVENT}{MAP} ? $sys_wds->[$event->{EVENT}{MAP}] : undef;
	    printf "%12.12s %-4.4s (%7.2f%8.2f)%8.2f%8.2f", $wd->{WORD}, $wd->{WTYP},
	        $wd->{RTBEG}, $wd->{RTEND}, $wd->{TBEG}, $wd->{TEND} if defined $wd and $opt_w;
	    print "\n";
	}
	elsif ($event->{TYPE} eq "SYSWD") {
	    next unless $opt_w;
	    next if defined $event->{REFWD};
	    $wd = $event->{EVENT};
	    printf "%38s| %12.12s %-4.4s (%7.2f%8.2f)%8.2f%8.2f\n", " ", $wd->{WORD}, $wd->{WTYP},
	        $wd->{RTBEG}, $wd->{RTEND}, $wd->{TBEG}, $wd->{TEND};
	}
    }
}

#################################

sub map_syswd_times_to_ref {

    my ($ref_wds, $sys_wds) = @_;
    my ($wd, @ref_map);

#map system output metadata times to ref words
    my $i=0;
    foreach $wd (@$ref_wds) {
	$ref_map[$wd->{MAP}] = $i if defined $wd->{MAP};
	$i++;
    }
    foreach $wd (@$sys_wds) {
	$wd->{RTBEG} = adjust_sys_time_to_ref ($wd->{TBEG}, $sys_wds, $ref_wds, \@ref_map);
	$wd->{RTEND} = adjust_sys_time_to_ref ($wd->{TEND}, $sys_wds, $ref_wds, \@ref_map);
	$wd->{RTDUR} = $wd->{RTEND} - $wd->{RTBEG};
	$wd->{RTMID} = $wd->{RTBEG} + $wd->{RTDUR}/2;
    }
}

#################################

sub performance_analysis {

    my ($metadata_type, $counts, $subtypes, $analyses) = @_;
    my ($file, $chnl, $spkr, $word, $type, $type_counts, $key);
    my (@files, @chnls, @spkrs, @types);
    my (%nall, %nberr);
    my ($subtype, @sys_subtypes, $sys_subtype, %nconf, %offsets);

    printf "\n*** Performance analysis for %ss***\n", $metadata_type;

#initialize
    foreach $subtype (@$subtypes, "{FA}") {
	foreach $sys_subtype (@$subtypes, "{Miss}") {
	    $nconf{ALL}{$subtype}{$sys_subtype} = 0;
	}
    }

#compute marginal counts
    @files = keys %$counts;
    foreach $file (@files) {
	@chnls = keys %{$counts->{$file}};
	foreach $chnl (@chnls) {
	    $type_counts = $counts->{$file}{$chnl};
	    foreach $type ("REF", "DEL", "INS") {
		$nberr{ALL}{$type} += $type_counts->{END_WORDS}{$type} if
		    defined $type_counts->{END_WORDS}{$type};
	    }
	    foreach $type ("WBEG", "WEND") {
		foreach $key (keys %{$type_counts->{WORD_OFFSET}{$type}}) {
		    $offsets{ALL}{$type}{$key} += $type_counts->{WORD_OFFSET}{$type}{$key};
		}
	    }
	    @types = keys %$type_counts;
	    foreach $type (@types) {
		@spkrs = keys %{$type_counts->{REF}};
		foreach $spkr (@spkrs) {
		    foreach $subtype (@$subtypes) {
			next if $type eq "END_WORDS" or $type eq "WORD_OFFSET";
			if ($type eq "CONFUSION") {
			    @sys_subtypes = keys %{$type_counts->{$type}{$spkr}{$subtype}};
			    foreach $sys_subtype (@sys_subtypes) {
				$nconf{ALL}{$subtype}{$sys_subtype} +=
				    $type_counts->{$type}{$spkr}{$subtype}{$sys_subtype};
			    }
			}
			elsif (defined $type_counts->{$type}{$spkr}{$subtype}) {
			    $nconf{ALL}{$subtype}{"{Miss}"} += $type_counts->{$type}{$spkr}{$subtype} if $type eq "DEL";
			    $nconf{ALL}{"{FA}"}{$subtype} += $type_counts->{$type}{$spkr}{$subtype} if $type eq "INS";
			    $nall{ALL}{$type}    += $type_counts->{$type}{$spkr}{$subtype};
			}
		    }
		}
	    }
	}
    }
    print_marginal_scores ($metadata_type, "all data", \%nall, \%nconf, \%nberr, \%offsets);
}

#################################

sub print_offset_stats {

    my ($counts) = @_;
    my (@offsets, $count, $min, $max, $i);

    @offsets = (keys %{$counts->{WBEG}}, keys %{$counts->{WEND}});
    $min = min (-3, @offsets);
    $max = max (3, @offsets);
    print "  word offsets:  <-3  ";
    for ($i=-3; $i<=3; $i++) {
	printf "%5d", $i;
    }
    print "     >3\n";
    print "           BEG:";
    for ($count=0,$i=$min; $i<-3; $i++) {
	$count += $counts->{WBEG}{$i} if defined $counts->{WBEG}{$i};
    }	    
    printf "%5d  ", $count if defined $count;
    print "    -  ", unless defined $count;
    for ($i=-3; $i<=3; $i++) {
	$count = $counts->{WBEG}{$i};
	printf "%5d", $count if defined $count;
	print "    -", unless defined $count;
    }
    for ($count=0,$i=4; $i<=$max; $i++) {
	$count += $counts->{WBEG}{$i} if defined $counts->{WBEG}{$i};
    }	    
    printf "%7d", $count if defined $count;
    print "      -", unless defined $count;
    
    print "\n           END:";
    for ($count=0,$i=$min; $i<-3; $i++) {
	$count += $counts->{WEND}{$i} if defined $counts->{WEND}{$i};
    }	    
    printf "%5d  ", $count if defined $count;
    print "    -  ", unless defined $count;
    for ($i=-3; $i<=3; $i++) {
	$count = $counts->{WEND}{$i};
	printf "%5d", $count if defined $count;
	print "    -", unless defined $count;
    }
    for ($count=0,$i=4; $i<=$max; $i++) {
	$count += $counts->{WEND}{$i} if defined $counts->{WEND}{$i};
    }	    
    printf "%7d", $count if defined $count;
    print "      -", unless defined $count;
    print "\n";
}

#################################

sub print_marginal_scores {

    my ($metadata_type, $variable, $depod_counts, $conf_counts, $end_counts, $offset_counts) = @_;
    my ($type, $nerr, $norm, $name, $ref, $sys, $category, $counts);
    my ($count, $min, $max, $i, @offsets);

    print "\n$metadata_type analysis conditioned on $variable\n";

#SU (exact) boundary detection
    foreach $category (sort keys %$end_counts) {
	$counts = $end_counts->{$category};
	foreach $type ("REF", "DEL", "INS") {
	    $counts->{$type} = 0 unless defined $counts->{$type};
	}
	$norm = 100/max($counts->{REF},1);
	print "\n$metadata_type (exact) boundary detection statistics -- in terms of SU end words\n";
	printf "%13s%5s %5s %5s %5s %5s   %6s %6s %6s %6s\n", "",
	    "Nref", "Ndel", "Nins", "Nsub", "Nerr", "%Del", "%Ins", "%Sub", "%Err";
	$nerr = $counts->{DEL} + $counts->{INS};
	printf "%10.10s   %5d %5d %5d %5s %5d   %6.2f %6.2f %6.6s %6.2f\n", $category,
	    $counts->{REF}, $counts->{DEL}, $counts->{INS}, "<ns>", $nerr,
            min(999.99,$norm*$counts->{DEL}), min(999.99,$norm*$counts->{INS}),
	    "<ns>", min(999.99,$norm*$nerr);
    }

#SU detection
    foreach $category (sort keys %$depod_counts) {
	$counts = $depod_counts->{$category};
	foreach $type ("REF", "DEL", "INS", "SUB") {
	    $counts->{$type} = 0 unless defined $counts->{$type};
	}
	$norm = 100/max($counts->{REF},1);
	print "\n$metadata_type detection statistics -- in terms of \# of SUs\n";
	printf "%13s%5s %5s %5s %5s %5s   %6s %6s %6s %6s\n", "",
            "Nref", "Ndel", "Nins", "Nsub", "Nerr", "%Del", "%Ins", "%Sub", "%Err";
	$nerr = $counts->{DEL} + $counts->{INS} + $counts->{SUB};
	printf "%10.10s   %5d %5d %5d %5d %5d   %6.2f %6.2f %6.2f %6.2f\n", $category,
	    $counts->{REF}, $counts->{DEL}, $counts->{INS}, $counts->{SUB}, $nerr,
            min(999.99,$norm*$counts->{DEL}), min(999.99,$norm*$counts->{INS}),
            min(999.99,$norm*$counts->{SUB}), min(999.99,$norm*$nerr);
    }

#SU classification
    foreach $category (sort keys %$conf_counts) {
	$counts = $conf_counts->{$category};
	print "\n$metadata_type detection confusion matrix -- in terms of \# of SUs\n";
	printf "%24.24s", "$category - ref\\sys";
	foreach $name (sort keys %{$counts->{"{FA}"}}) {
	    print "    " if $name eq "{Miss}";
	    printf "%10.8s", $name;
	}
	print "\n";
	foreach $ref (sort keys %$counts) {
	    print "\n" if $ref eq "{FA}";
	    printf "%24.24s", $ref;
	    foreach $sys (sort keys %{$counts->{$ref}}) {
		next if $ref eq "{FA}" and $sys eq "{Miss}";
		print "    " if $sys eq "{Miss}";
		printf "%8d  ", $counts->{$ref}{$sys};
	    }
	    print "\n";
	}
    }

#offsets
    foreach $category (sort keys %$offset_counts) {
	print "\n$metadata_type word offset statistics for $category\n";
	print_offset_stats ($offset_counts->{$category});
    }
}

#################################

sub word_kinds {

    my ($words, $kind) = @_;
    my ($word, %count);

    foreach $word (@$words) {
	$count{$word->{$kind}}++;
    }
    return sort keys %count;
}

#################################

sub standardize_word {

    my ($word) = @_;
    my (@split_word, @words, $tbeg, $tdur, $part, $new_word);

    $word->{WORD} =~ lc $word->{WORD}; #lower case

    if (defined $glm{$word->{WORD}}) { #split glm words
	@split_word = @{$glm{$word->{WORD}}};
    }
    elsif ($word->{WORD} =~ /^([^-]+|mm-hmm|uh-huh|um-hmm)$/) {
	return $word;
    }
    elsif ($word->{WORD} =~ /.+-.+/) { #split hyphenated words
	$word->{WORD} =~ s/(.+)-(.+)/$1 $2/g;
	@split_word = split /\s+/, $word->{WORD};
    }
    else { #don't split word
	return $word;
    }

#split word and prorate time equally to each part
    $tbeg = $word->{TBEG};
    $tdur = $word->{TDUR}/@split_word;
    foreach $part (@split_word) {
	$new_word = {FILE => $word->{FILE}, CHNL => $word->{CHNL}, TBEG => $tbeg,
		     TDUR => $tdur, TEND => $tbeg+$tdur, TMID => $tbeg+$tdur/2,
		     WORD => $part, CONF => $word->{CONF}, SPKR => $word->{SPKR},
		     TYPE => $word->{TYPE}, SUBT => $word->{SUBT}, WTYP => $word->{WTYP}};
	push @words, $new_word;
	$tbeg += $tdur;
    }
    return @words;
}

#################################

sub annotate_words {

    my ($ref_wds, $sys_wds, $mds) = @_;
    my ($ref_index, $ref_word, $sys_index, $index, $word, $md_index, $md);
    my ($sys_word, $spkr, $score, $best_spkr, $best_score, @speakers);

#select the best ref word for each STT output word that has multiple reference word matches
    for ($sys_index=0; $sys_index<@$sys_wds; $sys_index++) {
	$sys_word = $sys_wds->[$sys_index];
	next unless defined $sys_word->{MAP};
	undef $best_score;
	@speakers = sort keys %{$sys_word->{MAP}};
	next unless @speakers > 1;
	foreach $spkr (@speakers) {
	    next unless defined $sys_word->{MAP}{$spkr};
	    $ref_word = $sys_word->{MAP}{$spkr}{REFPTR};
	    $score = $ref_word->{PATHS}{$sys_index}{SCORE};
	    next if defined $best_score and $best_score > $score;
	    $best_score = $score;
	    $best_spkr = $spkr;
	}
	next unless defined $best_score;
	foreach $spkr (@speakers) {
	    next if $spkr eq $best_spkr;
	    $sys_word->{MAP}{$spkr} = undef;
	    $ref_word = $sys_word->{MAP}{$best_spkr}{REFPTR};
	    $ref_word->{MAP} = undef;
	}
    }

#tag overlapping speech (i.e., words that overlap other words in time)
    for ($ref_index=0; $ref_index<@$ref_wds; $ref_index++) {
	$ref_word = $ref_wds->[$ref_index];
	$ref_word->{OVERLAP} = "NON-OVERLAPPING" unless defined $ref_word->{OVERLAP};
	$index = $ref_index;
	while (++$index<@$ref_wds) {
	    $word = $ref_wds->[$index];
	    last unless word_overlap ($ref_word, $word);
	    next unless $word->{SPKR} ne $ref_word->{SPKR};
	    $word->{OVERLAP} = $ref_word->{OVERLAP} = "OVERLAPPING";
	}
    }

#tag fluent speech (i.e., words that are not part of DEPODs)
    for ($ref_index=0; $ref_index<@$ref_wds; $ref_index++) {
	$ref_word = $ref_wds->[$ref_index];
	$ref_word->{FLUENCY} = "FLUENT";
	for ($md_index=0; defined $mds and $md_index<@$mds; $md_index++) {
	    $md = $mds->[$md_index];
	    next unless $md->{TYPE} =~ /^(filler|edit)$/;
	    $ref_word->{FLUENCY} = "NON-FLUENT" if metadata_covers_word ($md, $ref_word);
	}
    }
}

#################################

sub metadata_covers_word {

    my ($md, $word) = @_;

    return 0 if ($word->{TMID} < $md->{TBEG} or
		 $word->{TMID} > $md->{TEND});
    return 1;
}

#################################

sub closest_ref_word { #find the ref word closest in time to the sys word

    my ($ref_wds, $sys_word) = @_;
    my ($ref_word, $overlap, $max_overlap, $closest_word);

    $max_overlap=0;
    foreach $ref_word (@$ref_wds) {
	$overlap = word_overlap ($ref_word, $sys_word);
	next unless defined $overlap and $overlap > $max_overlap;
	$closest_word = $ref_word;
	$max_overlap = $overlap;
    }
    $closest_word = {SPKR => "unknown", OVERLAP => "NON-OVERLAPPING"}
        unless defined $closest_word;
    return $closest_word;
}

#################################

sub align_words {

    my ($ref_wds, $sys_wds, $spkr) = @_;
    my ($ref_word, $sys_word, $prev_ref, $path, $ref_path);
    my ($ref_index, $sys_index, $index, $pruning_threshold);
    my ($word_score, $path_score, $best_score, %cum_insertion_score);

#compute cumulative insertion score for STT output
    $cum_insertion_score{-1} = 0;
    for ($sys_index=0; $sys_index<@$sys_wds; $sys_index++) {
	$sys_word = $sys_wds->[$sys_index];
	$cum_insertion_score{$sys_index} = $cum_insertion_score{$sys_index-1};
	$cum_insertion_score{$sys_index} += word_score (undef, $sys_word);
    }

#find the best path by incremental optimization through the ref transcription
    $prev_ref->{PATHS}{-1}{SCORE} = 0;
    for ($ref_index=0; $ref_index<@$ref_wds; $ref_index++) {
	$ref_word = $ref_wds->[$ref_index];
	next if defined $spkr and $ref_word->{SPKR} ne $spkr;

#find best score and compute pruning threshold
	$best_score = undef;
	foreach $index (keys %{$prev_ref->{PATHS}}) {
	    $path_score = $prev_ref->{PATHS}{$index}{SCORE} +
		$cum_insertion_score{@$sys_wds-1}-$cum_insertion_score{$index};
	    $best_score = $path_score if not defined $best_score or $best_score < $path_score;
	}
	$pruning_threshold = $best_score - $max_delta_score;
	
#extend paths with scores above pruning threshold
	foreach $index (keys %{$prev_ref->{PATHS}}) {
	    $path_score = $prev_ref->{PATHS}{$index}{SCORE} +
		$cum_insertion_score{@$sys_wds-1}-$cum_insertion_score{$index};
	    next unless $path_score > $pruning_threshold;
	    $ref_word->{PATHS}{$index}{PATHPTR} = $index;
	    $ref_word->{PATHS}{$index}{PREVREF} = $prev_ref;
	    $ref_word->{PATHS}{$index}{SCORE} = $prev_ref->{PATHS}{$index}{SCORE} +
		word_score ($ref_word, undef);
	}

#compare the current ref word to all sys words
	for ($sys_index=0; $sys_index<@$sys_wds; $sys_index++) {
	    $sys_word = $sys_wds->[$sys_index];
	    next unless word_overlap ($ref_word, $sys_word, $t_gap);
	    $word_score = word_score ($ref_word, $sys_word);

#update each path for this {ref, sys} match
	    foreach $index (sort {$a<=>$b} keys %{$prev_ref->{PATHS}}) {
		next unless $index < $sys_index;
		$path_score = $word_score + $prev_ref->{PATHS}{$index}{SCORE} +
		    $cum_insertion_score{$sys_index-1}-$cum_insertion_score{$index};
		if (not defined $ref_word->{PATHS}{$sys_index}
		    or $path_score > $ref_word->{PATHS}{$sys_index}{SCORE}) {
		    $ref_word->{PATHS}{$sys_index}{SCORE} = $path_score;
		    $ref_word->{PATHS}{$sys_index}{PREVREF} = $prev_ref;
		    $ref_word->{PATHS}{$sys_index}{PATHPTR} = $index;
		    $ref_word->{PATHS}{$sys_index}{MAP} = $sys_index;
		}
	    }
	}
	$prev_ref=$ref_word;
    }

#add insertion score for remaining unmapped STT output
    foreach $index (sort {$a<=>$b} keys %{$prev_ref->{PATHS}}) {
	$prev_ref->{PATHS}{$index}{SCORE} +=
	    $cum_insertion_score{@$sys_wds-1}-$cum_insertion_score{$index} if $index < @$sys_wds-1;
    }
}

#################################

sub word_score {

    my ($ref_word, $sys_word) = @_;
    my ($tbeg, $tend, $rw, $sw, $score);

#compute joint time coverage 
    unless ($opt_w) {
	return 0 unless defined $ref_word and defined $sys_word;

	$tbeg = max($ref_word->{TBEG}, $sys_word->{TBEG});
	$tend = min($ref_word->{TEND}, $sys_word->{TEND});
	return $tbeg < $tend+$t_gap ?
	    $ref_word->{TDUR} * ($tend+$t_gap-$tbeg)/($ref_word->{TDUR} + $t_gap) : 0;
    }

#compute joint word coverage
    if (defined $ref_word) {
	if (defined $sys_word) {
	    $score = 0;
	    foreach my $attribute ("MD_filler", "MD_filler", "MD_filler", "MD_su") {
		$score += 0.01 if defined $ref_word->{$attribute} and defined $sys_word->{$attribute};
	    }
	    return $score if                               #both word type and word spelling match
		((   $ref_word->{WORD} eq $sys_word->{WORD} and
		     $ref_word->{WTYP} eq $sys_word->{WTYP})

		 or ($ref_word->{WTYP} eq "lex" and 
		     $sys_word->{WTYP} eq "frag" and
		     ($sw = $sys_word->{WORD}, $sw =~ s/^-*|-*$//g, $sw) #make sure that $sw is non-null
		     and ($ref_word->{WORD} =~ /$sw/))

		 or ($ref_word->{WTYP} eq "frag" and 
		     $sys_word->{WTYP} eq "lex" and
		     ($rw = $ref_word->{WORD}, $rw =~ s/^-*|-*$//g, $rw) #make sure that $rw is non-null
		     and ($sys_word->{WORD} =~ /$rw/))

		 or ($ref_word->{WTYP} eq "fp" and 
		     $sys_word->{WTYP} eq "fp")

		 or ($ref_word->{WTYP} eq "frag" and 
		     $sys_word->{WTYP} eq "frag"));

	    return $score - 0.1*max(1,ref_count($ref_word)) if       #word type match, except for lex's
		((   $ref_word->{WTYP} eq $sys_word->{WTYP} and
		     $ref_word->{WTYP} ne "lex"));

	    return $score - max(1, ref_count($ref_word),ref_count($sys_word));
	}
	return -ref_count($ref_word) if $ref_word->{WTYP} eq "lex";
	return -0.2*max(1,ref_count($ref_word));
    }
    return 0 unless defined $sys_word;
    return -max(1,ref_count($sys_word)) if $sys_word->{WTYP} eq "lex";
    return -0.2*max(1,ref_count($sys_word));
}

#################################

sub wd_err_count {

    my ($ref_word, $sys_word) = @_;
    
    return (word_score($ref_word,$sys_word) > -0.5) ? 0 : 1;
}

#################################

sub ref_count {

    my ($word) = @_;

    return 0 unless defined $word;
    return 0 if $word->{WTYP} =~ /^(non-lex|misc)$/;

#hyphenated words get a count of 2 (except for mm-hmm, uh-huh and hm-hmm)
    my $WORD = $word->{WORD};
    $WORD =~ s/^-*|-*$//g;
    return $WORD =~ /^([^-]+|mm-hmm|uh-huh|um-hmm)$/ ? 1 : 2;
}

#################################

sub word_overlap {

    my ($ref_word, $sys_word, $tgap) = @_;
    my $tovl;
    
    $tgap = 0 unless defined $tgap;
    $tovl = (min($ref_word->{TEND}, $sys_word->{TEND}) -
	     max($ref_word->{TBEG}, $sys_word->{TBEG})) + $tgap;
    return $tovl > 0 ? $tovl/(1 + $tgap/$ref_word->{TDUR}) : undef;
}

#################################

sub map_metadata_to_words {

    my ($sys_mds, $sys_wds, $ref_mds, $ref_wds) = @_;
    my ($md, $wd, @ref_map);

#map system output metadata times to ref words
    if ($opt_w) { #create map between system output words and reference words
	my $i=0;
	foreach $wd (@$ref_wds) {
	    $ref_map[$wd->{MAP}] = $i if defined $wd->{MAP};
	    $i++;
	}
    }
    foreach $md (@$sys_mds) {
	if ($opt_w) { #adjust times/words to agree with ref-sys word alignment
	    $md->{RTBEG} = adjust_sys_time_to_ref ($md->{TBEG}, $sys_wds, $ref_wds, \@ref_map);
	    $md->{RTEND} = adjust_sys_time_to_ref ($md->{TEND}, $sys_wds, $ref_wds, \@ref_map);
	}
	else { #map system output metadata event to reference data normally
	    $md->{RTBEG} = $md->{TBEG};
	    $md->{RTEND} = $md->{TEND};
	}
	$md->{RTDUR} = $md->{RTEND} - $md->{RTBEG};
	$md->{RTMID} = $md->{RTBEG} + $md->{RTDUR}/2;
	($md->{RWBEG}, $md->{RWEND}) = md_ref_word_indices ($md, $ref_wds);
	$md->{RWDUR} = $md->{RWEND} - $md->{RWBEG} + 1;
    }

#map reference metadata times to ref words
    foreach $md (@$ref_mds) {
	($md->{WBEG}, $md->{WEND}) = md_word_indices ($md, $ref_wds);
	$md->{WDUR} = $md->{WEND} - $md->{WBEG} + 1;
	next if $md->{WDUR} > 0;
	next if $md->{TYPE} eq "ip";
	warn "\nWARNING:  reference metadata event subsumes no reference words\n"
	    ."    file='$md->{FILE}', chnl='$md->{CHNL}', tbeg='$md->{TBEG}',"
		." tend='$md->{TEND}', type='$md->{TYPE}', subtype='$md->{SUBT}'\n";
    }

#friendly (unused) check of system metadata times versus sys words
    foreach $md (@$sys_mds) {
	(my $wbeg, my $wend) = md_word_indices ($md, $sys_wds);
	next if $wend - $wbeg >= 0;
	next if $md->{TYPE} eq "ip";
	warn "\nWARNING:  system output metadata event subsumes no system output words\n"
	    ."    file='$md->{FILE}', chnl='$md->{CHNL}', tbeg='$md->{TBEG}',"
		." tend='$md->{TEND}', type='$md->{TYPE}', subtype='$md->{SUBT}'\n";
    }
}

#################################

sub adjust_sys_time_to_ref {

    my ($ts, $sys_wds, $ref_wds, $ref_map) = @_;
    my ($ts1, $ts2, $tr, $tr1, $tr2, $ws1, $ws2, $wr1, $wr2);

#given a time in the system output, find the time in the reference
#that harmonizes with the alignment of system output words

#find the nearest right reference anchor point
    $ws2 = 0;
    $ws2++ while ($ws2 < @$sys_wds and
		  ($sys_wds->[$ws2]{TEND} < $ts or
		   not defined $ref_map->[$ws2]));
    if ($ws2 < @$sys_wds) {
	$wr2 = $ref_map->[$ws2];
	($ts2 = $sys_wds->[$ws2]{TEND}, $tr2 = $ref_wds->[$wr2]{TEND});
	($ts2 = $sys_wds->[$ws2]{TBEG}, $tr2 = $ref_wds->[$wr2]{TBEG})
	    if $sys_wds->[$ws2]{TBEG} > $ts;
    }

#find the nearest left reference anchor point
    $ws1 = min($ws2, @$sys_wds-1);
    $ws1-- while ($ws1 >= 0 and 
		  ($sys_wds->[$ws1]{TBEG} > $ts or
		   not defined $ref_map->[$ws1]));
    if ($ws1 >= 0) {
	$wr1 = $ref_map->[$ws1];
	($ts1 = $sys_wds->[$ws1]{TBEG}, $tr1 = $ref_wds->[$wr1]{TBEG});
	($ts1 = $sys_wds->[$ws1]{TEND}, $tr1 = $ref_wds->[$wr1]{TEND})
	    if $sys_wds->[$ws1]{TEND} < $ts;
    }

#make adjustment
    $tr = (($ws1 < 0 and $ws2 >= @$sys_wds) ? $ts               : #no adjustment possible
	   ($ws1 < 0)                       ? $tr2 + ($ts-$ts2) : #extrapolate left without scale change
	   ($ws2 >= @$sys_wds)              ? $tr1 + ($ts-$ts1) : #extrapolate right without scale change
	   ($ts == $ts1)                    ? $tr1              : #no interpolation necessary
	   $tr1 + ($ts-$ts1)*($tr2-$tr1)/($ts2-$ts1));            #normal interpolation
    return $tr;
}

#################################

sub md_word_indices {

    my ($md, $wds) = @_;

#find the word indices of the first and last words with midpoints inside the metadata event
    my $i = 0;
    $i++ while ($i<@$wds and ($wds->[$i]{TMID}) < $md->{TBEG});
    my $j = max($i-1,0);
    $j++ while ($j<@$wds and ($wds->[$j]{TMID}) <= $md->{TEND});
    return ($i, --$j);
}


#################################

sub md_ref_word_indices {

    my ($md, $wds) = @_;

#find the word indices of the first and last words with midpoints inside the metadata event
    my $i = 0;
    $i++ while ($i<@$wds and ($wds->[$i]{TMID}) < $md->{RTBEG});
    my $j = max($i-1,0);
    $j++ while ($j<@$wds and ($wds->[$j]{TMID}) <= $md->{RTEND});
    return ($i, --$j);
}

#################################

sub align_metadata {

    my ($ref_mds, $sys_mds, $spkr) = @_;
    my ($ref_md, $sys_md, $prev_ref, $path, $ref_path);
    my ($ref_index, $sys_index, $index, $pruning_threshold);
    my ($md_score, $path_score, $best_score, %cum_insertion_score);

#compute cumulative insertion score for STT output
    $cum_insertion_score{-1} = 0;
    for ($sys_index=0; $sys_index<@$sys_mds; $sys_index++) {
	$sys_md = $sys_mds->[$sys_index];
	$cum_insertion_score{$sys_index} = $cum_insertion_score{$sys_index-1};
	$cum_insertion_score{$sys_index} += md_score (undef, $sys_md);
    }

#find the best path by incremental optimization through the ref transcription
    $prev_ref->{PATHS}{-1}{SCORE} = 0;
    for ($ref_index=0; $ref_index<@$ref_mds; $ref_index++) {
	$ref_md = $ref_mds->[$ref_index];
	next if defined $spkr and $ref_md->{SPKR} ne $spkr;

#find best score and compute pruning threshold
	$best_score = undef;
	foreach $index (keys %{$prev_ref->{PATHS}}) {
	    $path_score = $prev_ref->{PATHS}{$index}{SCORE} +
		$cum_insertion_score{@$sys_mds-1}-$cum_insertion_score{$index};
	    $best_score = $path_score if not defined $best_score or $best_score < $path_score;
	}
	$pruning_threshold = $best_score - $max_delta_score;
	
#extend paths with scores above pruning threshold
	foreach $index (keys %{$prev_ref->{PATHS}}) {
	    $path_score = $prev_ref->{PATHS}{$index}{SCORE} +
		$cum_insertion_score{@$sys_mds-1}-$cum_insertion_score{$index};
	    next unless $path_score > $pruning_threshold;
	    $ref_md->{PATHS}{$index}{PATHPTR} = $index;
	    $ref_md->{PATHS}{$index}{PREVREF} = $prev_ref;
	    $ref_md->{PATHS}{$index}{SCORE} = $prev_ref->{PATHS}{$index}{SCORE} +
		md_score ($ref_md, undef);
	}

#compare the current ref metadata event to all sys metadata
	for ($sys_index=0; $sys_index<@$sys_mds; $sys_index++) {
	    $sys_md = $sys_mds->[$sys_index];
	    $md_score = md_score ($ref_md, $sys_md);
	    next unless $md_score;

#update each path for this {ref, sys} match
	    foreach $index (sort {$a<=>$b} keys %{$prev_ref->{PATHS}}) {
		next unless $index < $sys_index;
		$path_score = $md_score + $prev_ref->{PATHS}{$index}{SCORE} +
		    $cum_insertion_score{$sys_index-1}-$cum_insertion_score{$index};
		if (not defined $ref_md->{PATHS}{$sys_index}
		    or $path_score > $ref_md->{PATHS}{$sys_index}{SCORE}) {
		    $ref_md->{PATHS}{$sys_index}{SCORE} = $path_score;
		    $ref_md->{PATHS}{$sys_index}{PREVREF} = $prev_ref;
		    $ref_md->{PATHS}{$sys_index}{PATHPTR} = $index;
		    $ref_md->{PATHS}{$sys_index}{MAP} = $sys_index;
		}
	    }
	}
	$prev_ref=$ref_md;
    }

#add insertion score for remaining unmapped metadata output
    foreach $index (sort {$a<=>$b} keys %{$prev_ref->{PATHS}}) {
	$prev_ref->{PATHS}{$index}{SCORE} +=
	    $cum_insertion_score{@$sys_mds-1}-$cum_insertion_score{$index} if $index < @$sys_mds-1;
    }
}

#################################

sub md_score {

    my ($ref_md, $sys_md, $gap) = @_;
    my ($beg, $end, $overlap, $ref_beg, $sys_beg, $diff, $md_dur);

    return 0 unless defined $ref_md and defined $sys_md;

    if ($opt_W) { #compute md mapping score as ref-sys overlap in (ref) words
	$gap = $W_gap unless defined $gap;
	$ref_beg = max($ref_md->{WBEG},  $ref_md->{WEND} -($su_word_limit-1));
	$sys_beg = max($sys_md->{RWBEG}, $sys_md->{RWEND}-($su_word_limit-1));
	$beg = max($ref_beg, $sys_beg);
	$end = min($ref_md->{WEND}, $sys_md->{RWEND});
	$overlap = $end - $beg + 1;
	$md_dur = $ref_md->{WEND} - $ref_beg + 1;
	$diff = abs($ref_md->{WEND} - $sys_md->{RWEND});
    }
    else { #compute md mapping score as ref-sys overlap in time
	$gap = $T_gap unless defined $gap;
	$ref_beg = max($ref_md->{TBEG},  $ref_md->{TEND} -$su_time_limit);
	$sys_beg = max($sys_md->{RTBEG}, $sys_md->{RTEND}-$su_time_limit);
	$beg = max($ref_beg, $sys_beg);
	$end = min($ref_md->{TEND}, $sys_md->{RTEND});
	$overlap = $end - $beg;
	$md_dur = $ref_md->{TEND} - $ref_beg;
	$diff = abs($ref_md->{TEND} - $sys_md->{RTEND});
    }
    $overlap += $gap;
    return 0 if $overlap <= 0;
    return $overlap * max($md_dur-$diff)/($md_dur + $gap);
}

#################################

sub trace_best_word_path {

    my ($ref_wds, $sys_wds, $spkr) = @_;
    my ($ref_word, $path, $pathptr, $best_score, $prev_ref, $ref_index, $index, $sys_word);

#find the last word for the selected channel and speaker
    return unless @$ref_wds and @$sys_wds;
    $ref_index = @$ref_wds-1;
    $ref_index-- while (defined $spkr and $ref_wds->[$ref_index]{SPKR} ne $spkr);
    $spkr = "ALL" unless defined $spkr;

#identify the best path for the selected ending word
    $ref_word = $ref_wds->[$ref_index];
    undef $best_score;
    foreach $index (sort {$a<=>$b} keys %{$ref_word->{PATHS}}) {
	$path = $ref_word->{PATHS}{$index};
	if (not defined $best_score or $path->{SCORE} > $best_score) {
	    $best_score = $path->{SCORE};
	    $pathptr = $path->{PATHPTR};
	    $prev_ref = $path->{PREVREF};
	    next unless defined $path->{MAP};
	    $ref_word->{MAP} = $path->{MAP};
	}
    }
    if (defined $ref_word->{MAP}) {
	$sys_word = $sys_wds->[$ref_word->{MAP}];
	$sys_word->{MAP}{$spkr}{REFPTR} = $ref_word;
    }

#trace the path back 
    while ($pathptr != -1) {
	$ref_word = $prev_ref;
	$path = $ref_word->{PATHS}{$pathptr};
	$pathptr = $path->{PATHPTR};
	$prev_ref = $path->{PREVREF};
	next unless defined $path->{MAP};
	$ref_word->{MAP} = $path->{MAP};
	$sys_word = $sys_wds->[$path->{MAP}];
	$sys_word->{MAP}{$spkr}{REFPTR} = $ref_word;
    }
}

#################################

sub trace_best_metadata_path {

    my ($ref_mds, $sys_mds, $spkr) = @_;
    my ($ref_md, $path, $pathptr, $best_score, $prev_ref, $ref_index, $index, $sys_md);

#find the last metadata event for the selected channel and speaker
    return unless @$ref_mds and @$sys_mds;
    $ref_index = @$ref_mds-1;
    $ref_index-- while (defined $spkr and $ref_mds->[$ref_index]{SPKR} ne $spkr);
    $spkr = "ALL" unless defined $spkr;

#identify the best path for the selected ending metadata event
    $ref_md = $ref_mds->[$ref_index];
    undef $best_score;
    foreach $index (sort {$a<=>$b} keys %{$ref_md->{PATHS}}) {
	$path = $ref_md->{PATHS}{$index};
	if (not defined $best_score or $path->{SCORE} > $best_score) {
	    $best_score = $path->{SCORE};
	    $pathptr = $path->{PATHPTR};
	    $prev_ref = $path->{PREVREF};
	    next unless defined $path->{MAP};
	    $ref_md->{MAP} = $path->{MAP};
	}
    }
    if (defined $ref_md->{MAP}) {
	$sys_md = $sys_mds->[$ref_md->{MAP}];
	$sys_md->{MAP}{$spkr}{REFPTR} = $ref_md;
    }

#trace the path back 
    while ($pathptr != -1) {
	$ref_md = $prev_ref;
	$path = $ref_md->{PATHS}{$pathptr};
	$pathptr = $path->{PATHPTR};
	$prev_ref = $path->{PREVREF};
	next unless defined $path->{MAP};
	$ref_md->{MAP} = $path->{MAP};
	$sys_md = $sys_mds->[$path->{MAP}];
	$sys_md->{MAP}{$spkr}{REFPTR} = $ref_md;
    }
}

#################################

sub metadata_ref_word {

    my ($wd) = @_;

#a (reference) word counts as a reference (denominator) metadata word
#  only if it is of type LEXEME

    return $wd->{TYPE} eq "LEXEME" ? 1 : 0;
}


#################################

sub metadata_error_word {

    my ($wd) = @_;

#a (reference) word counts as a metadata error word
#  only if it is of type LEXEME

    return ($wd->{TYPE} eq "LEXEME") ? 1 : 0;
}

#################################

sub delta_metadata_error_words {

#accumulates the number of metadata error words difference
#between ref beg/end point of metadata event and sys beg/end point of metadata event

    my ($location, $ref_index, $sys_index, $ref_wds) = @_;

    my $dw = 0;
    my $index = min($ref_index,$sys_index);
    my $istop = max($ref_index,$sys_index);
    while ($index != $istop) {
	$index++ if $location eq "END";
	$dw += metadata_error_word ($ref_wds->[$index]);
	$index++ if $location eq "BEG";
    }
    return $sys_index > $ref_index ? $dw : 0-$dw;
}

#################################

sub print_path_score {

    my ($ref, $sys, $ref_count, $err_count, $err_type) = @_;

#print header
    unless (defined $ref or defined $sys) {
	printf " ref del ins sub %16.16s %-7s%8s%8s %-12.12s", "REF:  token", "type",
	    "tbeg", "tend", "speaker";
	printf " %16.16s %-7s  %7s%8s %8s%8s %-12.12s\n", "SYS:  token", "type",
	    "Rtbeg", "Rtend", "tbeg", "tend", "sys-speaker" if $opt_w;
	printf " %16.16s %-7s%8s%8s %-12.12s\n", "SYS:  token", "type",
	    "tbeg", "tend", "speaker" unless $opt_w;
	return;
    }

#print ref
    my %errors = (REF=>"-", DEL=>"-", INS=>"-", SUB=>"-");
    $errors{REF} = $ref_count if defined $ref_count;
    $errors{$err_type} = $err_count if defined $err_type;
    printf "%4s%4s%4s%4s", $errors{REF}, $errors{DEL}, $errors{INS}, $errors{SUB};

    if (defined $ref) {
	printf " %16.16s %-7s%8.2f%8.2f %-12.12s", $ref->{TYPE} =~ /^(LEXEME|NON-LEX|NON-SPEECH)$/ ?
	    ($ref->{WORD}, $ref->{WTYP}) : ($ref->{SUBT}, $ref->{TYPE}), $ref->{TBEG}, $ref->{TEND}, $ref->{SPKR};
    }
    else {
	printf " %16.16s %-7s%8s%8s %-12.12s", "---", "---", "--- ", "--- ", "---";
    }

#print sys
    if ($opt_w) {
	if (defined $sys) {
	    printf " %16.16s %-7s (%7.2f%8.2f)%8.2f%8.2f %-12.12s\n", $sys->{TYPE} =~ /^(LEXEME|NON-LEX|NON-SPEECH)$/ ?
		($sys->{WORD}, $sys->{WTYP}) : ($sys->{SUBT}, $sys->{TYPE}), $sys->{RTBEG}, $sys->{RTEND}, $sys->{TBEG}, $sys->{TEND}, $sys->{SPKR};
	}
	else {
	    printf " %16.16s %-7s (%7s%8s)%8s%8s %-12.12s\n", "---", "---", "--- ", "--- ", "--- ", "--- ", "---";
	}
    }
    else {
	if (defined $sys) {
	    printf " %16.16s %-7s%8.2f%8.2f %-12.12s\n", defined $sys->{SUBT} ? $sys->{SUBT} : $sys->{WORD},
	        $sys->{TYPE}, $sys->{TBEG}, $sys->{TEND}, $sys->{SPKR};
	}
	else {
	    printf " %16.16s %-7s%8s%8s %-12.12s\n", "---", "---", "--- ", "--- ", "---";
	}
    }	
}

#################################

sub score_metadata_path {

    my ($type, $file, $chnl, $ref_mds, $sys_mds, $ref_wds, $details) = @_;
    my ($ref_index, $ref_md, $sys_index, $sys_md, $md, $spkr);
    my (%count, $ref_count, $err_count, $ref_wd, @ref_map, @endword, $dw);

    printf "\n%s alignment and scoring details for channel $chnl of file $file\n", uc $type if $details;

#discard unannotated SUs
    discard_unannotated_SUs ($ref_mds, $sys_mds);

#tabulate (exact) SU end-word boundary errors
    foreach $ref_md (@$ref_mds) { #tag the last ref word for each ref SU
	$endword[$ref_md->{WEND}]{REF} = 1 if defined $ref_md->{WEND} and
	    token_in_eval_partition ($ref_wds->[$ref_md->{WEND}]);
    }
    foreach $sys_md (@$sys_mds) { #tag the last ref word for each sys SU
	$endword[$sys_md->{RWEND}]{SYS} = 1 if defined $sys_md->{RWEND} and
	    token_in_eval_partition ($ref_wds->[$sys_md->{RWEND}]);
    }
    for (my $i=0; $i<@$ref_wds; $i++) {
	$ref_wd = $ref_wds->[$i];
	$count{END_WORDS}{REF}++ if $endword[$i]{REF} and metadata_ref_word ($ref_wd);
	next unless metadata_error_word ($ref_wd);
	$count{END_WORDS}{DEL}++ if $endword[$i]{REF} and not $endword[$i]{SYS};
	$count{END_WORDS}{INS}++ if $endword[$i]{SYS} and not $endword[$i]{REF};
    }

#tabulate beg/end word offset errors
    foreach $ref_md (@$ref_mds) {
	if (defined $ref_md->{MAP}) {
	    $sys_md = $sys_mds->[$ref_md->{MAP}];
	    $dw = delta_metadata_error_words ("BEG", $ref_md->{WBEG}, $sys_md->{RWBEG}, $ref_wds);
	    $count{WORD_OFFSET}{WBEG}{$dw}++;
	    $dw = delta_metadata_error_words ("END", $ref_md->{WEND}, $sys_md->{RWEND}, $ref_wds);
	    $count{WORD_OFFSET}{WEND}{$dw}++;
	}
    }

#create a map of sys mds to ref mds
    for (my $i=0; $i<@$ref_mds; $i++) {
	$ref_md = $ref_mds->[$i];
	$ref_map[$ref_md->{MAP}] = $i if defined $ref_md->{MAP};
    }

#tabulate errors
    $sys_index = 0;
    print_path_score () if $details;
    for ($ref_index=0; $ref_index<@$ref_mds; $ref_index++) {
	$ref_md = $ref_mds->[$ref_index];
	$spkr = $ref_md->{SPKR};
	$ref_count = md_err_count ($ref_md, undef);
	$count{REF}{$spkr}{$ref_md->{SUBT}} += $ref_count if defined $ref_count;
	if (defined $ref_md->{MAP}) {
	    while ($sys_index < $ref_md->{MAP}) {
		$sys_md = $sys_mds->[$sys_index++];
		if (defined $sys_md->{MAP}) {
		    printf "%sUNEXPECTED MD ORDER:   %16s %-7s%8.2f%8.2f %-16s\n", " "x48,
		        $sys_md->{SUBT}, $sys_md->{TYPE}, $sys_md->{TBEG}, $sys_md->{TEND},
		        $sys_md->{SPKR} if $details;
		}
		else {
		    $md = closest_ref_md($ref_mds, $sys_md);
		    $err_count = md_err_count (undef, $sys_md);
		    $count{INS}{$md->{SPKR}}{$sys_md->{SUBT}} += $err_count;
		    $count{REF}{$md->{SPKR}}{$sys_md->{SUBT}} = 0
			unless defined $count{REF}{$md->{SPKR}}{$sys_md->{SUBT}};
		    print_path_score (undef, $sys_md, 0, $err_count, "INS") if $details;
		}
	    }
	    $sys_index++;
	    $sys_md = $sys_mds->[$ref_md->{MAP}];
	    $err_count = md_err_count ($ref_md, $sys_md);
	    $count{SUB}{$spkr}{$ref_md->{SUBT}} += $err_count;
	    $count{CONFUSION}{$spkr}{$ref_md->{SUBT}}{$sys_md->{SUBT}} += $ref_count;
	    print_path_score ($ref_md, $sys_md, $ref_count, $err_count, "SUB") if $details;
	}
	else {
	    while ($sys_index < @$sys_mds and
		   not defined $ref_map[$sys_index] and
		   $sys_mds->[$sys_index]{RTBEG}< $ref_md->{TBEG}) {
		$sys_md = $sys_mds->[$sys_index++];
		$md = closest_ref_md($ref_mds, $sys_md);
		$err_count = md_err_count (undef, $sys_md);
		$count{INS}{$md->{SPKR}}{$sys_md->{SUBT}} += $err_count;
		$count{REF}{$md->{SPKR}}{$sys_md->{SUBT}} = 0
		    unless defined $count{REF}{$md->{SPKR}}{$sys_md->{SUBT}};
		print_path_score (undef, $sys_md, 0, $err_count, "INS") if $details;
	    }
	    $err_count = md_err_count ($ref_md, undef);
	    $count{DEL}{$spkr}{$ref_md->{SUBT}} += $err_count;
	    print_path_score ($ref_md, undef, $ref_count, $err_count, "DEL") if $details;
	}
    }
    while ($sys_index < @$sys_mds) {
	$sys_md = $sys_mds->[$sys_index++];
	$md = closest_ref_md($ref_mds, $sys_md);
	$err_count = md_err_count (undef, $sys_md);
	$count{INS}{$md->{SPKR}}{$sys_md->{SUBT}} += $err_count;
	$count{REF}{$md->{SPKR}}{$sys_md->{SUBT}} = 0
	    unless defined $count{REF}{$md->{SPKR}}{$sys_md->{SUBT}};
	print_path_score (undef, $sys_md, 0, $err_count, "INS") if $details;
    }
    return ({%count});
}

#################################

sub discard_unannotated_SUs {

    my ($ref_mds, $sys_mds) = @_;
    my ($index, $ref_md, $sys_md, $discard);

#discard all system SU's that map to unannotated ref SU's
#or that are unmapped and overlap with some unannotated ref SU
    for ($index=0; $index<@$sys_mds; $index++) {
	$sys_md = $sys_mds->[$index];
	undef $discard;
	if (defined $sys_md->{MAP}) {
	    $ref_md = $sys_md->{MAP}{ALL}{REFPTR};
	    $discard = 1 if defined $ref_md and $ref_md->{SUBT} eq "unannotated";
	}
	else {
	    foreach $ref_md (@$ref_mds) {
		$discard = 1 if $ref_md->{SUBT} eq "unannotated"
		    and md_overlap ($ref_md, $sys_md, -0.0001);
		last if $discard;
	    }
	}
	if ($discard) { #discard sys SU and adjust ref pointer indices
	    splice (@$sys_mds, $index, 1);
	    foreach $ref_md (@$ref_mds) {
		next unless defined $ref_md->{MAP};
		undef $ref_md->{MAP} if $ref_md->{MAP} == $index;
		$ref_md->{MAP}-- if defined $ref_md->{MAP} and $ref_md->{MAP} > $index;
	    }
	    $index--;
	}
    }

#discard all unannotated ref SU's
    for ($index=0; $index<@$ref_mds; $index++) {
	$discard = $ref_mds->[$index]{SUBT} eq "unannotated";
	splice (@$ref_mds, $index, 1) if $discard;
	$ref_md = $ref_mds->[$index];
	$sys_mds->[$ref_md->{MAP}]{MAP}{ALL}{REFPTR} = $ref_md if defined $ref_md->{MAP};
    }
}

#################################

sub md_overlap {

    my ($ref_md, $sys_md, $gap) = @_;
    my ($tbeg, $tend, $wbeg, $wend, $overlap, $ref_beg, $sys_beg);

    return undef unless defined $ref_md and defined $sys_md;

    $gap = 0 unless defined $gap;
    if ($opt_W) { #compute overlap in terms of (ref) words
	$wbeg = max($ref_md->{WBEG}, $sys_md->{RWBEG});
	$wend = min($ref_md->{WEND}, $sys_md->{RWEND});
	$overlap = $wend - $wbeg + 1 + $gap;
    }
    else { #compute overlap in terms of time
	$tbeg = max($ref_md->{TBEG}, $sys_md->{RTBEG});
	$tend = min($ref_md->{TEND}, $sys_md->{RTEND});
	$overlap = $tend - $tbeg + $gap;
    }
    return $overlap <= 0 ? undef : $overlap;
}

#################################

sub md_err_count {

    my ($ref_md, $sys_md) = @_;

    return 1 if (not defined $sys_md         or not defined $ref_md         or
		 not defined $sys_md->{TYPE} or not defined $ref_md->{TYPE} or
		 not defined $sys_md->{SUBT} or not defined $ref_md->{SUBT} or
		 $sys_md->{TYPE} ne $ref_md->{TYPE} or
		 $sys_md->{SUBT} ne $ref_md->{SUBT});
    return 0;
}

#################################

sub closest_ref_md {

    my ($ref_mds, $sys_md) = @_;
    my ($ref_md, $score, $max_score, $closest_md);

    $max_score = 0;
    foreach $ref_md (@$ref_mds) {
	$score = md_score ($ref_md, $sys_md);
	next unless $score > $max_score;
	$closest_md = $ref_md;
	$max_score = $score;
    }
    $closest_md = {SPKR => "unknown", OVERLAP => "NON-OVERLAPPING"}
        unless defined $closest_md;
    return $closest_md;
}

#################################

sub score_word_path {

    my ($file, $chnl, $ref_wds, $sys_wds, $details) = @_;
    my ($ref_index, $ref_word, $sys_index, $sys_word, $word, $spkr);
    my ($ref_count, $err_count, @ref_map);

    print "\nWord alignment and scoring details for channel $chnl of file $file\n" if $details;
    for (my $i=0; $i<@$ref_wds; $i++) {
	$ref_word = $ref_wds->[$i];
	$ref_map[$ref_word->{MAP}] = $i if defined $ref_word->{MAP};
    }

#tabulate errors
    $sys_index = 0;
    print_path_score () if $details;
    for ($ref_index=0; $ref_index<@$ref_wds; $ref_index++) {
	$ref_word = $ref_wds->[$ref_index];
	$spkr = $ref_word->{SPKR};
	$ref_count = ref_count($ref_word);
	
	if (defined $ref_word->{MAP}) {
	    while ($sys_index < $ref_word->{MAP}) {
		$sys_word = $sys_wds->[$sys_index++];
		if (defined $sys_word->{MAP}) {
		    printf "%sUNEXPECTED WORD ORDER: %16s %-7s%8.2f%5.2f %-16s\n", " "x48,
		        $sys_word->{WORD}, $sys_word->{WTYP}, $sys_word->{TBEG},
		        $sys_word->{TDUR}, $sys_word->{SPKR} if $details;
		}
		else {
		    $word = closest_ref_word($ref_wds, $sys_word);
		    $err_count = wd_err_count(undef, $sys_word);
		    print_path_score (undef, $sys_word, 0, $err_count, "INS") if $details;
		}
	    }
	    $sys_index++;
	    $sys_word = $sys_wds->[$ref_word->{MAP}];
	    $err_count = wd_err_count($ref_word, $sys_word);
	    print_path_score ($ref_word, $sys_word, $ref_count, $err_count, "SUB") if $details;
	}
	else {
	    while ($sys_index < @$sys_wds and
		   not defined $ref_map[$sys_index] and
		   $sys_wds->[$sys_index]{TBEG}< $ref_word->{TBEG}) {
		$sys_word = $sys_wds->[$sys_index++];
		$word = closest_ref_word($ref_wds, $sys_word);
		$err_count = wd_err_count(undef, $sys_word);
		print_path_score (undef, $sys_word, 0, $err_count, "INS") if $details;
	    }
	    $err_count = wd_err_count($ref_word, undef);
	    print_path_score ($ref_word, undef, $ref_count, $err_count, "DEL") if $details;
	}
    }
    while ($sys_index < @$sys_wds) {
	$sys_word = $sys_wds->[$sys_index++];
	$word = closest_ref_word($ref_wds, $sys_word);
	$err_count = wd_err_count(undef, $sys_word);
	print_path_score (undef, $sys_word, 0, $err_count, "INS") if $details;
    }
}

#################################

sub date_time_stamp {

    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();
    my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my ($date, $time);

    $time = sprintf "%2.2d:%2.2d:%2.2d", $hour, $min, $sec;
    $date = sprintf "%4.4s %3.3s %s", 1900+$year, $months[$mon], $mday;
    return ($date, $time);
}

#################################

sub max {

    my ($max, $next);

    return unless defined ($max=pop);
    while (defined ($next=pop)) {
	$max = $next if $next > $max;
    }
    return $max;
}

#################################

sub min {

    my ($min, $next);

    return unless defined ($min=pop);
    while (defined ($next=pop)) {
	$min = $next if $next < $min;
    }
    return $min;
}

#################################