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

#################################
# History:
#
# version 13: * word alignment tuned to include consideration of metadata
#               attributes in addition to word spelling and type/subtype.
#             * use of UEM data changed - rather than discard rttm data
#               in the UEM exclusion zones, the data are processed normally
#               and words in the exclusion zones are not counted during
#               DEPOD scoring.
#             * accommodate multiple hyphens when splitting hyphenated words
#
# version 12: * score frags, but noscore NON-LEX and NON-SPEECH
#             * modify word alignment to:
#                  - make fp match fp, ignoring orthography
#                  - make frag match frag, ignoring orthography
#
# version 11: * coded around an error in the Unix implementation of Perl
#
# version 10: * count all LEXEMEs in denominator of overall disfluency error
#               score (to conform with version 6 of the eval plan)
#             * fix bug in counting metadata error words
#             * add IP (exact) boundary detection statistics
#
# version 9:  * converted to run from RTTM input files
#
# version 8:  * cosmetic enhancement to print confusion statistics for all
#               used subtypes (rather than all subtypes with at least 1 error)
#
# version 7:  * disfluency subtypes updated by adding "simple" as an edit subtype
#               and "edit&filler" as an IP subtype
#             * conditional evaluation of complex edits added
#             * subtype confusion statistics added for IP's
#
# version 6:  * pads redefined as gaps
#             * a few bug fixes
#             * cosmetic improvements
#
# version 5:  * bug fix (in *_word_indices calculation)
#
# version 4:  * increase W_pad to allow non-adjacent sys and ref dfs to map when
#               using word-based overlap computations.
#             * modify word_score to induce sys and ref non-lex to map to each
#               other.
#             * add un-lex to word types that count in disfluency scoring.
#
# version 3:  * word_score modified to give yet better alignment of sys and ref
#               (by half-penalizing fps and frags that have spelling mismatches).
#             * limit word counts in disfluency scoring to lex, fp, and for-lex.
#
# version 2:  * word_score modified to give better alignment of sys and ref
#               (by reassessing fault for spurious system output of fps and frags).
#             * Miss/FA added to confusion matrices.
#             * better labelling of evaluation output.
#
# version 1:  adapted from stt-eval
#
#################################

######
# Intro
my ($date, $time) = date_time_stamp();
print "df-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:  df-eval computes EARS disfluency 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 disfluency 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 disfluency\n".
    "       output data being evaluated.\n".
    "  input options:\n".
    "    -c to include complex edits in the analysis and scoring.\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".
    "    -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 = (edit   => {repetition => 1, revision => 1, restart => 1, simple => 1, complex => 1},
		filler => {filled_pause => 1, discourse_marker => 1, explicit_editing_term => 1},
		ip     => {filler => 1, edit => 1, "edit&filler" => 1},
		su     => {statement => 1, question => 1, backchannel => 1, incomplete => 1,
			   clausal => 1, coordinating => 1, unannotated => 1});
my %df_types = (edit   => $md_types{edit},
		filler => $md_types{filler},
		ip     => $md_types{ip});
use vars qw ($opt_h $opt_w $opt_W $opt_d $opt_D $opt_r $opt_s $opt_c);
use vars qw ($opt_t $opt_T $opt_g $opt_p $opt_o $opt_a $opt_u $opt_e);
use Getopt::Std;
getopts ('hdDwWoecr:s:t:T:g:p:a:u:');
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 = 1.1;
my $max_delta_score = $opt_w ? 10 : 1;
$max_delta_score = $opt_p if defined $opt_p;
print "word-based disfluency alignment, max gap between matching words = $t_gap sec\n" if $opt_w;
$opt_W ? (print "word-optimized disfluency mapping, max gap between matching disfluencies = $W_gap words\n") :
         (print "time-optimized disfluency mapping, max gap between matching disfluencies = $T_gap 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} = "-"       if (not defined $word->{CONF} or $word->{CONF} eq "<NA>");
	    $word->{SPKR} = "unknown" if (not defined $word->{SPKR} or $word->{SPKR} eq "<NA>");
	    $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)$/) {
	    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->{filler}{$token->{FILE}}{$token->{CHNL}}}, $token if $token->{TYPE} eq "filler";
	    push @{$data->{edit}{$token->{FILE}}{$token->{CHNL}}}, $token if $token->{TYPE} eq "edit";
	    push @{$data->{ip}{$token->{FILE}}{$token->{CHNL}}}, $token if $token->{TYPE} eq "ip";
	}
    }
    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);

    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);
		    }
		    decide_who_spoke_the_words ($ref_wds, $sys_wds, $ref_data->{MDTM}{$file}{$chnl});
		}
		else {
		    align_words ($ref_wds, $sys_wds);
		    trace_best_word_path ($ref_wds, $sys_wds);
		}
	    }
	    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 %df_types) {
		$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);
		discard_complex_edits ($ref_mds, $sys_mds) if $opt_c and $type eq "edit";
		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 %df_types) {
	performance_analysis (uc $type, $counts{$type}, $df_types{$type}, $opt_a);
    }
}

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

sub discard_complex_edits {

    my ($ref_mds, $sys_mds) = @_;

    for (my $iref=0; $iref<@$ref_mds; $iref++) {
	next unless $ref_mds->[$iref]{SUBT} eq "complex";
	for (my $isys=0; $isys<@$sys_mds; $isys++) {
	    next unless md_overlap ($ref_mds->[$iref], $sys_mds->[$isys]) > 0;
	    splice (@$sys_mds, $isys--, 1);
	}
	splice (@$ref_mds, $iref--, 1);
    }
}

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

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 $type disfluencies integrated with reference words\n"
	."  for file $file, channel $chnl\n";
    print           "    --------- reference ------------- | --------- system output ---------\n";
    $opt_w ? (print "    REF wrds-dfs        beg/end_times | SYS wrds-dfs        adjusted_times     source_times\n") :
	      print "    REF wrds-dfs        beg/end_times |   SYS dfs           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}=~/2$/?0.0001:0) <=> $b->{TIME}+($b->{TYPE}=~/2$/?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 = $ref_md->{WBEG} <= $sys_md->{RWBEG} ? 
			delta_metadata_error_words ("BEG", $ref_md->{WBEG}, min(1+$ref_md->{WEND}, $sys_md->{RWBEG}), $ref_wds) :
			    delta_metadata_error_words ("BEG", min($ref_md->{WBEG}, 1+$sys_md->{RWEND}), $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 = $ref_md->{WEND} <= $sys_md->{RWEND} ? 
			delta_metadata_error_words ("END", max($ref_md->{WEND}, $sys_md->{RWBEG}-1), $sys_md->{RWEND}, $ref_wds) :
			    delta_metadata_error_words ("END", $ref_md->{WEND}, max($ref_md->{WBEG}-1, $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 (%nfile, %nchnl, %nspkr, %nall, %nwerr);
    my ($subtype, @sys_subtypes, $sys_subtype, %nsubt, %nconf, %offsets);

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

#initialize
    foreach $subtype (keys %$subtypes, "{FA}") {
	foreach $sys_subtype (keys %$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") {
		$nwerr{ALL}{$type} += $type_counts->{DEPOD_WORDS}{$type} if
		    defined $type_counts->{DEPOD_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 (keys %$subtypes) {
			next if $type eq "DEPOD_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";
			    $nfile{$file}{$type} += $type_counts->{$type}{$spkr}{$subtype};
			    $nchnl{$chnl}{$type} += $type_counts->{$type}{$spkr}{$subtype};
			    $nspkr{$spkr}{$type} += $type_counts->{$type}{$spkr}{$subtype};
			    $nsubt{$subtype}{$type} += $type_counts->{$type}{$spkr}{$subtype};
			    $nall{ALL}{$type}    += $type_counts->{$type}{$spkr}{$subtype};
			}
		    }
		}
	    }
	}
    }
    print_marginal_scores ($metadata_type, \%nall, \%nconf, \%offsets, \%nwerr);
}

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

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, $event_counts, $conf_counts, $offset_counts, $word_counts) = @_;
    my ($type, $nerr, $norm, $name, $ref, $sys, $category, $counts);
    my ($count, $min, $max, $i, @offsets, $nmiss, $nfa);

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

#event detection
    foreach $category (sort keys %$event_counts) {
	$counts = $event_counts->{$category};
	foreach $type ("REF", "DEL", "INS", "SUB") {
	    $counts->{$type} = 0 unless defined $counts->{$type};
	}
	print "\n$metadata_type detection statistics -- in terms of \# of $metadata_type\'s\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};
	$norm = 100/max($counts->{REF},1);
	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);
    }

#event classification
    foreach $category (sort keys %$conf_counts) {
	$counts = $conf_counts->{$category};
	print "\n$metadata_type detection confusion matrix -- in terms of \# of $metadata_type\'s\n";
	printf "%24.24s", "$category - ref\\sys";
	foreach $sys (sort keys %{$counts->{"{FA}"}}) {
	    next unless defined $counts->{"{FA}"}{$sys} or defined $counts->{$sys}{"{Miss}"} or $sys eq "{Miss}";
	    print "    " if $sys eq "{Miss}";
	    printf "%10.8s", $sys;
	}
	print "\n";
	foreach $ref (sort keys %$counts) {
	    next unless defined $counts->{"{FA}"}{$ref} or defined $counts->{$ref}{"{Miss}"} or $ref eq "{FA}";
	    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}";
		next unless defined $counts->{"{FA}"}{$sys} or defined $counts->{$sys}{"{Miss}"} or $sys eq "{Miss}";
		print "    " if $sys eq "{Miss}";
		printf "%8d  ", $counts->{$ref}{$sys};
	    }
	    print "\n";
	}
    }

#event offsets
    foreach $category (sort keys %$offset_counts) {
	print "\n$metadata_type word offset statistics for $category $metadata_type\'s\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 decide_who_spoke_the_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;
	}
    }
}

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

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
	   $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_overlap {

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

    return 0 unless defined $ref_md and defined $sys_md;

    if ($opt_W) { #compute md 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;
    }
    else { #compute md overlap in terms of time
	$tbeg = max($ref_md->{TBEG}, $sys_md->{RTBEG});
	$tend = min($ref_md->{TEND}, $sys_md->{RTEND});
	$overlap = $tend - $tbeg;
    }
    return $overlap;
}

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

sub md_score {

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

    return 0 unless defined $ref_md and defined $sys_md;

    if ($opt_W) { #compute md mapping score as ref-sys overlap in (ref) words
	$wbeg = max($ref_md->{WBEG}, $sys_md->{RWBEG});
	$wend = min($ref_md->{WEND}, $sys_md->{RWEND});
	$overlap = max($wend - $wbeg + 1 + $W_gap, 0);
	return $overlap * max($ref_md->{WDUR},0.000001) / ($ref_md->{WDUR} + $W_gap);
    }
    else { #compute md mapping score as ref-sys overlap in time
	$tbeg = max($ref_md->{TBEG}, $sys_md->{RTBEG});
	$tend = min($ref_md->{TEND}, $sys_md->{RTEND});
	$overlap = max($tend - $tbeg + $T_gap, 0);
	return $overlap * max($ref_md->{TDUR},0.000001) / ($ref_md->{TDUR} + $T_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;
	$sys_word->{MAP}{$spkr}{SCORE} = wd_err_count ($ref_word, $sys_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;
	$sys_word->{MAP}{$spkr}{SCORE} = wd_err_count ($ref_word, $sys_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;
	$sys_md->{MAP}{$spkr}{SCORE} = md_score ($ref_md, $sys_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;
	$sys_md->{MAP}{$spkr}{SCORE} = md_score ($ref_md, $sys_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 : -$dw+0;
}

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

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", $sys->{TYPE} =~ /^(LEXEME|NON-LEX|NON-SPEECH)$/ ?
		($sys->{WORD}, $sys->{WTYP}) : ($sys->{SUBT}, $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, @depod, $dw);

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

#tabulate depod errors
    foreach $ref_md (@$ref_mds) { #tag ref words that are true ("REF") depod words
	if ($type eq "ip") {
	    $depod[$ref_md->{WEND}]{REF} = 1 if
		defined $ref_md->{WEND} and $ref_md->{WEND} >= 0 and
		token_in_eval_partition ($ref_wds->[$ref_md->{WEND}]);
	}
	else {
	    for ($ref_wd=$ref_md->{WBEG}; $ref_wd<=$ref_md->{WEND}; $ref_wd++) {
		$depod[$ref_wd]{REF} = token_in_eval_partition ($ref_wds->[$ref_wd]);
	    }
	}
    }
    foreach $sys_md (@$sys_mds) { #tag ref words that were declared ("SYS") depod words
	if ($type eq "ip") {
	    $depod[$sys_md->{RWEND}]{SYS} = 1
		if defined $sys_md->{RWEND} and $sys_md->{RWEND} >= 0 and
		token_in_eval_partition ($ref_wds->[$sys_md->{RWEND}]);
	}
	else {
	    for ($ref_wd=$sys_md->{RWBEG}; $ref_wd<=$sys_md->{RWEND}; $ref_wd++) {
		$depod[$ref_wd]{SYS} = token_in_eval_partition ($ref_wds->[$ref_wd]);
	    }
	}
    }
    for (my $i=0; $i<@$ref_wds; $i++) {
	$ref_wd = $ref_wds->[$i];
	$count{DEPOD_WORDS}{REF}++ if $depod[$i]{REF} and metadata_ref_word ($ref_wd);
	next unless metadata_error_word ($ref_wd);
	$count{DEPOD_WORDS}{DEL}++ if $depod[$i]{REF} and not $depod[$i]{SYS};
	$count{DEPOD_WORDS}{INS}++ if $depod[$i]{SYS} and not $depod[$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%7.2f%7.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 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;
}

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