[vector] add DER scripts to calculate Diarization Error Rate

utils/DER.py

@@ -4,11 +4,13 @@ False Alarm (FA), and Speaker Error Rate (SER) using md-eval-22.pl from NIST RT
 Authors
  * Neville Ryant 2018
  * Nauman Dawalatabad 2020
+ * Qingen Zhao 2021
 
 Credits
  This code is adapted from https://github.com/nryant/dscore
 """
-
+import argparse
+from distutils.util import strtobool
 import os
 import re
 import subprocess
@@ -84,7 +86,7 @@ def DER(
     """
 
     curr = os.path.abspath(os.path.dirname(__file__))
-    mdEval = os.path.join(curr, "../../tools/der_eval/md-eval.pl")
+    mdEval = os.path.join(curr, "./md-eval.pl")
 
     cmd = [
         mdEval,
@@ -150,3 +152,28 @@ def DER(
             return miss_speaker, fa_speaker, sers, ders
         else:
             return miss_speaker[-1], fa_speaker[-1], sers[-1], ders[-1]
+
+if __name__ == '__main__':
+
+    parser = argparse.ArgumentParser(description='Compute Diarization Error Rate')
+    parser.add_argument(
+        '--ref_rttm', required=True, help='the path of reference/groundtruth RTTM file')
+    parser.add_argument(
+        '--sys_rttm', required=True, help='the path of the system generated RTTM file')
+    parser.add_argument(
+        '--individual_file',
+        default=False,
+        type=strtobool,
+        help='if True, returns scores for each file in order')
+    parser.add_argument(
+        '--collar', default=0.25, type=float, help='forgiveness collar')
+    parser.add_argument(
+        '--ignore_overlap',
+        default=False,
+        type=strtobool,
+        help='if True, ignores overlapping speech during evaluation')
+    args = parser.parse_args()
+    print(args)
+
+    der = DER(args.ref_rttm, args.sys_rttm)
+    print("miss_speaker: %.3f%% fa_speaker: %.3f%% sers: %.3f%% ders: %.3f%%" % (der[0], der[1], der[2], der[-1]))
\ No newline at end of file

utils/md-eval.pl

+#!/usr/bin/perl -w
+#################################
+# NIST. (2009). The 2009 (RT-09) Rich Transcription Meeting Recognition Evaluation Plan.
+# https://web.archive.org/web/20100606041157if_/http://www.itl.nist.gov/iad/mig/tests/rt/2009/docs/rt09-meeting-eval-plan-v2.pdf
+# Source (dscore): https://github.com/nryant/dscore/blob/master/scorelib/md-eval-22.pl
+#################################
+# BSD 2-Clause License
+#
+# Copyright (c) 2018, Neville Ryant
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+# * Redistributions of source code must retain the above copyright notice, this
+#   list of conditions and the following disclaimer.
+#
+# * Redistributions in binary form must reproduce the above copyright notice,
+#   this list of conditions and the following disclaimer in the documentation
+#   and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#################################
+
+use strict;
+
+my $version = "22";
+
+#################################
+# History:
+#
+# version 22:  * JGF: added an option '-m FILE' to hold a CSV speaker map file.
+#
+# version 21:  * JGF: added a flag '-n' to not remove the directory paths from the source
+#                files in the UEM file.
+#
+# version 20:  * change metadata discard rule:  rather than discard if the midpoint
+#                (or endpoint) of the metadata object lies in a no-eval zone, discard
+#                if there is ANY overlap whatsoever between the metadata object and
+#                a no-eval zone.  This holds for system output objects only if the
+#                system output metadata object is not mapped to a ref object.
+#              * optimize IP and SU mapping by giving a secondary bonus mapping score
+#                to candidate ref-sys MD map pairs if the end-words of both coincide.
+#
+# version 19:  * bug fix in subroutine speakers_match
+#              * bug fix in tag_ref_words_with_metadata_info
+#
+# version 18:  * cosmetic fix to error message in eval_condition
+#              * added conditional output options for word coverage performance
+#              * added secondary MD word coverage optimization to word alignment
+#              * further optimize word alignment by considering MD subtypes
+#              * further optimize MD alignment by considering MD subtypes
+#              * add a new SU discard rule:  discard if TEND in no-eval zone
+#              * enforce legal values for su_extent_limit
+#
+# version 17:  create_speaker_segs modified to accommodate the same speaker
+#              having multiple overlapping speaker segments.  (This is an
+#              error and pathological condition, but the system must either
+#              disallow (abort on) the condition, or perform properly under
+#              the pathological condition.  The second option is chosen.)
+#
+# version 16:  * If neither -w nor -W is specified, suppress warnings about
+#                ref SPEAKER records subsuming no lexemes.
+#              * Output the overall speaker diarization stats after the
+#                stats for the individual files
+#              * Do not alter the case of alphabetic characters in the filename
+#                field from the ref rttm file
+#              * Made the format of the overall speaker error line more similar to
+#                the corresponding line of output from SpkrSegEval, to facilitate
+#                use of existing "grep" commands in existing scripts.
+#
+# version 15:  * bug fix in create_speaker_segs to accommodate
+#                contiguous same-speaker segments
+#              * added conditional file/channel scoring to
+#                speaker diarization evaluation
+#
+# version 14:  bug fix in md_score
+#
+# version 13:  add DISCOURSE_RESPONSE as a FILLER subtype
+#
+# version 12:  make REF LEXEMES optional if they aren't required
+#
+# version 11:  change default for noscore MD regions
+#
+# version 10:  bug fix
+#
+# version 09:
+#    * avoid crash when metadata discard yields no metadata
+#    * make evaluated ref_wds sensitive to metadata type
+#    * defer discarding of system output metadata until after
+#      metadata mapping, then discard only unmapped events.
+#    * extend 1-speaker scoring inhibition to metadata
+#    * eliminate demand for SPKR-INFO subtype for speakers
+#    * correct ref count of IP and SU exact boundary words
+#    * add official RT-04F scores
+#    * add conditional analyses for file/chnl/spkr/gender
+#
+# version 08:
+#    * bug fixes speaker diarization scoring
+#      - count of EVAL_WORDS corrected
+#      - no-score extended to nearest SPEAKER boundary
+#
+# version 07:
+#    * warning issued when discarding metadata events
+#      that cover LEXEMEs in the evaluation region
+#
+# version 06:
+#    * eliminated unused speakers from speaker scoring
+#    * changed discard algorithm for unannotated SU's and
+#      complex EDIT's to discard sys SU's and EDIT's when
+#      their midpoints overlap (rather than ANY overlap).
+#    * fixed display_metadata_mapping
+#
+# version 05:
+#    * upgraded display_metadata_mapping
+#
+# version 04:
+#    * diagnostic metadata mapping output added
+#    * uem_from_rttm bug fix
+#
+# version 03:
+#    * adjusted times used for speaker diarization
+#    * changed usage of max_extend to agree with cookbook
+#
+# version 02: speaker diarization evaluation added
+#
+# version 01: a merged version of df-eval-v14 and su-eval-v16
+#
+#################################
+
+#global data
+my $epsilon = 1E-8;
+my $miss_name = "  MISS";
+my $fa_name = "  FALSE ALARM";
+my %rttm_datatypes = (SEGMENT        => {eval => 1, "<na>" => 1},
+		      NOSCORE        => {"<na>" => 1},
+		      NO_RT_METADATA => {"<na>" => 1},
+		      LEXEME         => {lex => 1, fp => 1, frag => 1, "un-lex" => 1,
+					 "for-lex" => 1, alpha => 1, acronym => 1,
+					 interjection => 1, propernoun => 1, other => 1},
+		      "NON-LEX"      => {laugh => 1, breath => 1, lipsmack => 1,
+					 cough => 1, sneeze => 1, other => 1},
+		      "NON-SPEECH"   => {noise => 1, music => 1, other => 1},
+		      FILLER         => {filled_pause => 1, discourse_marker => 1,
+					 discourse_response => 1, explicit_editing_term => 1,
+					 other => 1},
+		      EDIT           => {repetition => 1, restart => 1, revision => 1,
+					 simple => 1, complex => 1, other => 1},
+		      IP             => {edit => 1, filler => 1, "edit&filler" => 1,
+					 other => 1},
+		      SU             => {statement => 1, backchannel => 1, question => 1,
+					 incomplete => 1, unannotated => 1, other => 1},
+		      CB             => {coordinating => 1, clausal => 1, other => 1},
+		      "A/P"          => {"<na>" => 1},
+		      SPEAKER        => {"<na>" => 1},
+		      "SPKR-INFO"    => {adult_male => 1, adult_female => 1, child => 1, unknown => 1});
+my %md_subtypes = (FILLER => $rttm_datatypes{FILLER},
+		   EDIT   => $rttm_datatypes{EDIT},
+		   IP     => $rttm_datatypes{IP},
+		   SU     => $rttm_datatypes{SU});
+my %spkr_subtypes = (adult_male => 1, adult_female => 1, child => 1, unknown => 1);
+
+my $noeval_mds = {
+    DEFAULT => {
+	NOSCORE        => {"<na>" => 1},
+	NO_RT_METADATA => {"<na>" => 1},
+    },
+};
+my $noscore_mds = {
+    DEFAULT => {
+	NOSCORE        => {"<na>" => 1},
+	LEXEME         => {"un-lex" => 1},
+	SU             => {unannotated => 1},
+    },
+    MIN => {
+	NOSCORE        => {"<na>" => 1},
+	SU             => {unannotated => 1},
+    },
+    FRAG_UNLEX => {
+	NOSCORE        => {"<na>" => 1},
+	LEXEME         => {frag => 1, "un-lex" => 1},
+	SU             => {unannotated => 1},
+    },
+    FRAG => {
+	NOSCORE        => {"<na>" => 1},
+	LEXEME         => {frag => 1},
+	SU             => {unannotated => 1},
+    },
+    NONE => {
+    },
+};
+my $noeval_sds = {
+    DEFAULT => {
+	NOSCORE        => {"<na>" => 1},
+    },
+};
+my $noscore_sds = {
+    DEFAULT => {
+	NOSCORE        => {"<na>" => 1},
+	"NON-LEX"      => {laugh => 1, breath => 1, lipsmack => 1,
+			   cough => 1, sneeze => 1, other => 1},
+    },
+};
+
+my %speaker_map;
+
+my $default_extend = 0.50; #the maximum time (in seconds) to extend a no-score zone
+my $default_collar = 0.00; #the no-score collar (in +/- seconds) to attach to SPEAKER boundaries
+my $default_tgap = 1.00; #the max gap (in seconds) between matching ref/sys words
+my $default_Tgap = 1.00; #the max gap (in seconds) between matching ref/sys metadata events
+my $default_Wgap = 0.10; #the max gap (in words) between matching ref/sys metadata events
+my $default_su_time_limit = 0.50; #the max extent (in seconds) to match for SU's
+my $default_su_word_limit = 2.00; #the max extent (in words) to match for SU's
+my $default_word_delta_score = 10.0; #the max delta score for word-based DP alignment of ref/sys words
+my $default_time_delta_score = 1.00; #the max delta score for time-based DP alignment of ref/sys words
+
+my $usage = "\n\nUsage: $0 [-h] -r <ref_file> -s <src_file>\n\n".
+    "Description:  md-eval evaluates EARS metadata detection performance\n".
+    "      by comparing system metadata output data with reference data\n".
+    "INPUT:\n".
+    "  -R <ref-list>  A file containing a list of the reference metadata files\n".
+    "       being evaluated, in RTTM format.  If the word-mediated alignment\n".
+    "       option is used then this data must include reference STT data\n".
+    "       in addition to the metadata being evaluated.\n".
+    "  OR\n".
+    "  -r <ref-file>  A file containing reference metadata, in RTTM format\n\n".
+    "  -S <sys-list>  A file containing a list of the system output metadata\n".
+    "       files to be evaluated, in RTTM format.  If the word-mediated\n".
+    "       alignment option is used then this data must include system STT\n".
+    "       output data in addition to the metadata to be evaluated.\n".
+    "  OR\n".
+    "  -s <sys-file>  A file containing system output metadata, in RTTM format\n\n".
+    "  input options:\n".
+    "    -x 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".
+    "    -a <cfgs> Conditional analysis options for metadata detection performance:\n".
+    "         c for performance versus channel,\n".
+    "         f for performance versus file,\n".
+    "         g for performance versus gender, and\n".
+    "         s for performance versus speaker.\n".
+    "    -A <cf> Conditional analysis options for word coverage performance:\n".
+    "         c for performance versus channel,\n".
+    "         f for performance versus file,\n".
+    "    -t <time gap> The maximum time gap allowed between matching reference\n".
+    "       and system output words (in seconds).  Default value is $default_tgap.\n".
+    "    -T <time gap> The maximum time gap allowed between matching reference\n".
+    "       and system output metadata (in seconds).  Default value is $default_Tgap.\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. Default value is\n".
+    "       $default_su_time_limit for time-optimized mapping, $default_su_word_limit for word-optimized mapping.\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 include overlapping speech in MD evaluation.  With this option,\n".
+    "       separate recognition passes are made for each reference speaker.\n".
+    "    -c <collar> is the no-score zone around reference speaker segment\n".
+    "       boundaries.  (Speaker Diarization output is not evaluated within\n".
+    "       +/- collar seconds of a reference speaker segment boundary.)\n".
+    "       Default value is $default_collar seconds.\n".
+    "    -1 to limit scoring to those time regions in which only a single\n".
+    "       speaker is speaking\n".
+    "    -y <name> to select named no-eval conditions for metadata\n".
+    "    -Y <name> to select named no-score conditions for metadata\n".
+    "    -z <name> to select named no-eval conditions for speaker diarization\n".
+    "    -Z <name> to select named no-score conditions for speaker diarization\n".
+    "    -e to examine metadata mapping\n".
+    "    -d to print word alignment and error calculation details\n".
+    "    -D to print metadata event alignment and error calculation details\n".
+    "    -m to print speaker mapping details for speaker diarization\n".
+    "    -M FILE to print speaker mapping details for speaker diarization to a CSV file called 'FILE'\n".
+    "    -v to print the event sequence for each diarization source file\n".
+    "    -n to keep the directory names of the UEM source file entries\n".
+    "OUTPUT:\n".
+    "  Performance statistics are written to STDOUT.\n".
+    "\n";
+
+######
+# Intro
+my ($date, $time) = date_time_stamp();
+print "command line (run on $date at $time) Version: $version  ", $0, " ", join(" ", @ARGV), "\n";
+
+use vars qw ($opt_h $opt_w $opt_W $opt_d $opt_D $opt_R $opt_r $opt_S $opt_s $opt_l $opt_c $opt_x);
+use vars qw ($opt_t $opt_T $opt_g $opt_p $opt_P $opt_o $opt_a $opt_A $opt_u $opt_1 $opt_m $opt_v $opt_e);
+use vars qw ($opt_y $opt_Y $opt_z $opt_Z $opt_n $opt_M);
+$opt_y = $opt_Y = $opt_z = $opt_Z = "DEFAULT";
+use Getopt::Std;
+getopts ('nhdDwWox1mvec:R:r:S:s:t:T:g:p:P:a:A:u:l:y:Y:z:Z:M:');
+not defined $opt_h or die
+    "\n$usage";
+defined $opt_r or defined $opt_R or die
+    "\nCOMMAND LINE ERROR:  no reference data specified$usage";
+not defined $opt_r or not defined $opt_R or die
+    "\nCOMMAND LINE ERROR:  both reference file list and reference file specified$usage";
+defined $opt_s or defined $opt_S or die
+    "\nCOMMAND LINE ERROR:  no system output data specified$usage";
+not defined $opt_s or not defined $opt_S or die
+    "\nCOMMAND LINE ERROR:  both system output file list and system output file specified$usage";
+my $word_gap = defined $opt_t ? $opt_t : $default_tgap;
+my $md_gap = $opt_W ? $default_Wgap : (defined $opt_T ? $opt_T : $default_Tgap);
+my $su_extent_limit = defined $opt_l ? $opt_l :
+    ($opt_W ? $default_su_word_limit : $default_su_time_limit);
+$opt_W ? ($su_extent_limit >= 1 or die "\nCOMMAND LINE ERROR:  SU extent limit must be at least 1 for word-based MD alignment$usage") :
+         ($su_extent_limit > 0 or die "\nCOMMAND LINE ERROR:  SU extent limit must be positive for time-based MD alignment$usage");
+my $max_wd_delta_score = $opt_w ? $default_word_delta_score : $default_time_delta_score;
+$max_wd_delta_score = $opt_p if defined $opt_p;
+my $max_md_delta_score = $opt_W ? $default_word_delta_score : $default_time_delta_score;
+$max_md_delta_score = $opt_P if defined $opt_P;
+my $collar = defined($opt_c) ? $opt_c : $default_collar;
+$collar >= 0 or die
+    "\nCOMMAND LINE ERROR:  Speaker Diarization scoring collar ('$collar') must be non-negative$usage";
+my $max_extend = $default_extend;
+$opt_a = "" unless defined $opt_a;
+$opt_A = "" unless defined $opt_A;
+start_speaker_map_file($opt_M) if $opt_M;
+
+my $noeval_md = eval_condition ($opt_y, $noeval_mds, "no-eval", "metadata");
+my $noscore_md = eval_condition ($opt_Y, $noscore_mds, "no-score", "metadata");
+my $noeval_sd = eval_condition ($opt_z, $noeval_sds, "no-score", "speaker diarization");
+my $noscore_sd = eval_condition ($opt_Z, $noscore_sds, "no-score", "speaker diarization");
+
+my %type_order = (NOSCORE        => 0,
+		  NO_RT_METADATA => 1,
+		  SEGMENT        => 2,
+		  SPEAKER        => 3,
+		  SU             => 4,
+		  "A/P"          => 5,
+		  "NON-SPEECH"   => 6,
+		  EDIT           => 7,
+		  FILLER         => 8,
+		  IP             => 9,
+		  CB             => 10,
+		  "NON-LEX"      => 11,
+		  LEXEME         => 12);
+my %event_order = (END => 0,
+		   MID => 1,
+		   BEG => 2);
+my %source_order = (REF => 0,
+		    SYS => 1);
+
+{
+    my (%ref, %sys, $glm, $uem);
+
+    print_parameters ();
+    ($glm) = get_glm_data ($opt_g);
+    get_rttm_file (\%ref, $opt_r, $glm);
+    get_rttm_data (\%ref, $opt_R, $glm);
+    get_rttm_file (\%sys, $opt_s, $glm);
+    get_rttm_data (\%sys, $opt_S, $glm);
+
+    ($uem) = get_uem_data ($opt_u, $opt_n);
+    evaluate (\%ref, \%sys, $uem);
+}
+
+exit 0;
+
+#################################
+
+sub eval_condition {
+
+    my ($name, $conditions, $exclusion, $evaluation) = @_;
+
+    $name = "DEFAULT" unless $name;
+    return $conditions->{$name} if defined $conditions->{$name};
+    print STDERR "\nCOMMAND LINE ERROR:  unknown name ($name) of $exclusion conditions for $evaluation\n".
+	"    available $exclusion conditions for $evaluation are:\n\n";
+    foreach $name (sort keys %$conditions) {
+	printf STDERR "%-24stype    subtype\n", "    for \"$name\":";
+	foreach my $type (sort keys %{$conditions->{$name}}) {
+	    foreach my $subt (sort keys %{$conditions->{$name}{$type}}) {
+		printf STDERR "%28s    %s\n", $type, $subt;
+	    }
+	}
+	print "\n";
+    }
+    die "$usage";
+}
+
+#################################
+
+sub print_parameters {
+
+    print $opt_w ? "\nWord-based metadata alignment, max gap between matching words = $word_gap sec\n" :
+	"\nTime-based metadata alignment\n";
+    print "\nMetadata evaluation parameters:\n";
+    $opt_W ? (print "    word-optimized metadata mapping\n".
+	            "        max gap between matching metadata events = $md_gap words\n".
+	            "        max extent to match for SU's = $su_extent_limit words\n") :
+	     (print "    time-optimized metadata mapping\n".
+		    "        max gap between matching metadata events = $md_gap sec\n".
+		    "        max extent to match for SU's = $su_extent_limit sec\n");
+    print "\nSpeaker Diarization evaluation parameters:\n".
+	  "    The max time to extend no-score zones for NON-LEX exclusions is $max_extend sec\n".
+	  "    The no-score collar at SPEAKER boundaries is $collar sec\n";
+    printf "\nExclusion zones for evaluation and scoring are:\n".
+	   "                             -----MetaData-----        -----SpkrData-----\n".
+	   "     exclusion set name:%12s%11s%15s%11s\n".
+	   "     token type/subtype      no-eval   no-score        no-eval   no-score\n",
+	       $opt_y, $opt_Y, $opt_z, $opt_Z;
+    print  "             (UEM)              X                         X\n";
+    foreach my $type (sort keys %rttm_datatypes) {
+	foreach my $subt (sort keys %{$rttm_datatypes{$type}}) {
+	    next unless ($noeval_md->{$type}{$subt} or
+			 $noscore_md->{$type}{$subt} or
+			 $noeval_sd->{$type}{$subt} or
+			 $noscore_sd->{$type}{$subt});
+	    printf "%15s/%-14s", $type, $subt;
+	    printf "%3s", $noeval_md->{$type}{$subt} ? "X" : "";
+	    printf "%10s", $noscore_md->{$type}{$subt} ? "X" : "";
+	    printf "%16s", $noeval_sd->{$type}{$subt} ? "X" : "";
+	    printf "%10s\n", $noscore_sd->{$type}{$subt} ? "X" : "";
+	}
+    }
+}
+
+#################################
+
+sub get_glm_data {
+
+    my ($file) = @_;
+    my ($record, @fields, $word, %words, %data);
+
+    return unless defined $file;
+    open DATA, $file or die
+	"\nCOMMAND LINE ERROR:  unable to open glm file '$file'$usage";
+    while ($record = <DATA>) {
+	next if $record =~ /^\s*$/;
+	next if $record =~ /^\s*(\[|\*|\%|\;)/;
+        @fields = split /\s+=>\s+/, lc $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;
+    return {%data};
+}
+
+#################################
+
+sub get_uem_data {
+
+    my ($file, $keepDirectoryPath) = @_;
+    my ($record, @fields, $seg, $chnl, %data);
+
+    return unless defined $file;
+    open DATA, $file or die
+	"\nCOMMAND LINE ERROR:  unable to open uem file '$file'$usage";
+    while ($record = <DATA>) {
+	next if $record =~ /^\s*[\#;]|^\s*$/;
+	@fields = split /\s+/, $record;
+	shift @fields if $fields[0] eq "";
+	@fields >= 4 or die
+	    ("\n\nFATAL ERROR:  insufficient number of fields in UEM record\n".
+	     "    record is: '$record'\n\n");
+	undef $seg;
+	$seg->{FILE} = shift @fields;
+	$seg->{CHNL} = lc shift @fields;
+	$seg->{TBEG} = lc shift @fields;
+	$seg->{TEND} = lc shift @fields;
+        $seg->{FILE} =~ s/.*\/// if (! $keepDirectoryPath);      #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;
+
+#sort and check data
+    foreach $file (keys %data) {
+	foreach $chnl (keys %{$data{$file}}) {
+	    @{$data{$file}{$chnl}} =
+		sort {$a->{TBEG} <=> $b->{TBEG}} @{$data{$file}{$chnl}};
+	    my $prev_seg;
+	    foreach $seg (@{$data{$file}{$chnl}}) {
+		$seg->{TEND} > $seg->{TBEG} or die
+		    "\n\nFATAL ERROR:  non-positive evaluation segment length in UEM data for file $file, channel $chnl\n\n";
+		not defined $prev_seg or $seg->{TBEG} >= $prev_seg->{TEND} or die
+		    ("\n\nFATAL ERROR:  UEM file has overlapping evaluation segments\n".
+		     "    file $file, channel $chnl:  ($prev_seg->{TBEG},$prev_seg->{TEND}),".
+		     " ($seg->{TBEG},$seg->{TEND})\n\n");
+		$prev_seg = $seg;
+	    }
+	}
+    }
+    return {%data};
+}
+
+#################################
+
+sub get_rttm_data {
+
+    my ($data, $list, $glm) = @_;
+
+    return unless defined $list;
+    open LIST, $list or die
+	"\nCOMMAND LINE ERROR:  unable to open file list '$list'$usage";
+    while (my $file = <LIST>) {
+	get_rttm_file ($data, $file, $glm);
+    }
+    close LIST;
+}
+
+#################################
+
+sub get_rttm_file {
+
+    my ($data, $rttm_file, $glm) = @_;
+    my ($record, @fields, $data_type, $file, $chnl, $word, @words, $token);
+
+    return unless defined $rttm_file;
+    open DATA, $rttm_file or die
+	"\nCOMMAND LINE ERROR:  unable to open RTTM file '$rttm_file'$usage";
+    while ($record = <DATA>) {
+	next if $record =~ /^\s*[\#;]|^\s*$/;
+	@fields = split /\s+/, $record;
+	shift @fields if $fields[0] eq "";
+	@fields >= 9 or die
+	    ("\n\nFATAL ERROR:  insufficient number of fields in RTTM file '$rttm_file'\n".
+	     "    input RTTM record is: '$record'\n\n");
+	$data_type = uc shift @fields;
+	undef $token;
+	$token->{TYPE} = $data_type;
+	$token->{FILE} = $file = shift @fields;
+	$token->{CHNL} = $chnl = lc shift @fields;
+	$token->{TBEG} = lc shift @fields;
+	$token->{TBEG} =~ s/\*//;
+	$token->{TDUR} = lc shift @fields;
+	$token->{TDUR} =~ s/\*//;
+	$token->{TDUR} = 0 if $token->{TDUR} eq "<na>";
+	$token->{TDUR} >= 0 or die
+	    ("\n\nFATAL ERROR -- negative metadata duration in file $file,'\n".
+	     "    input RTTM record is: '$record'\n\n");
+	$token->{WORD} = lc shift @fields;
+	$token->{SUBT} = lc shift @fields;
+	$rttm_datatypes{$token->{TYPE}}{$token->{SUBT}} or die
+	    ("\n\nFATAL ERROR:  unknown RTTM data type/subtype ('$token->{TYPE}'/'$token->{SUBT}') in file $rttm_file\n".
+	     "    input RTTM record is: '$record'\n\n");
+	$token->{SPKR} = shift @fields;
+	$token->{CONF} = lc shift @fields;
+	$token->{CONF} = "-"       unless defined $token->{CONF};
+	$token->{SPKR} = "<na>" unless defined $token->{SPKR};
+	if ($data_type eq "SPKR-INFO") {
+	    not defined $data->{$file}{$chnl}{$data_type}{$token->{SPKR}} or die
+		("\n\nFATAL ERROR:  multiple $data_type records for speaker $token->{SPKR} in file $file\n".
+		 "    input RTTM record is: '$record'\n\n");
+	    defined $spkr_subtypes{$token->{SUBT}} or die
+		("\n\nFATAL ERROR:  unknown $data_type subtype ($token->{SUBT}) in file '$file'\n".
+		 "    input RTTM record is: '$record'\n\n");
+	    $data->{$file}{$chnl}{$data_type}{$token->{SPKR}}{GENDER} = $token->{SUBT};
+	}
+	else {
+	    $token->{TEND} = $token->{TBEG}+$token->{TDUR};
+	    $token->{TMID} = $token->{TBEG}+$token->{TDUR}/2;
+	}
+
+	if ($data_type eq "LEXEME") {
+	    $token->{WTYP} = ($token->{SUBT} =~ /^fp$/         ? "fp"      :
+			      ($token->{SUBT} =~ /^frag$/      ? "frag"    :
+			       ($token->{SUBT} =~ /^un-lex$/   ? "un-lex"  :
+				($token->{SUBT} =~ /^for-lex$/ ? "for-lex" : "lex"))));
+	    @words = standardize_word ($token, $glm);
+	    foreach $word (@words) {
+		push @{$data->{$file}{$chnl}{LEXEME}}, $word;
+		push @{$data->{$file}{$chnl}{RTTM}}, $word;
+	    }
+	}
+	elsif ($data_type eq "SPEAKER") {
+	    push @{$data->{$file}{$chnl}{SPEAKER}{$token->{SPKR}}}, $token;
+	    push @{$data->{$file}{$chnl}{RTTM}}, $token;
+	}
+	elsif ($md_subtypes{$token->{TYPE}}) {
+	    defined $md_subtypes{$token->{TYPE}}{$token->{SUBT}} or die
+		("\n\nFATAL ERROR:  unknown $data_type subtype ($token->{SUBT}) in file '$file'\n".
+		 "    input RTTM record is: '$record'\n\n");
+	    push @{$data->{$file}{$chnl}{$data_type}}, $token;
+	    push @{$data->{$file}{$chnl}{RTTM}}, $token;
+	}
+	elsif ($data_type ne "SPKR-INFO") {
+	    push @{$data->{$file}{$chnl}{RTTM}}, $token;
+	}
+    }
+    close DATA;
+
+#sort and check data
+    foreach $file (keys %$data) {
+	foreach $chnl (keys %{$data->{$file}}) {
+	    foreach $data_type (keys %{$data->{$file}{$chnl}}) {
+		next if $data_type eq "SPKR-INFO";
+		if ($data_type eq "SPEAKER") {
+		    foreach my $spkr (keys %{$data->{$file}{$chnl}{$data_type}}) {
+			my $gender = $data->{$file}{$chnl}{"SPKR-INFO"}{$spkr}{GENDER};
+			$gender = $data->{$file}{$chnl}{"SPKR-INFO"}{$spkr}{GENDER} = "unknown" if not $gender;
+			@{$data->{$file}{$chnl}{$data_type}{$spkr}} =
+			    sort {$a->{TMID}<=>$b->{TMID}} @{$data->{$file}{$chnl}{$data_type}{$spkr}};
+			my $prev_token;
+			foreach $token (@{$data->{$file}{$chnl}{$data_type}{$spkr}}) {
+			    $token->{SUBT} = $gender;
+			    next unless $prev_token;
+			    not $prev_token or $token->{TBEG} >= $prev_token->{TEND}-$epsilon or die
+				("\n\nFATAL ERROR:  RTTM file has overlapping $data_type tokens for speaker $spkr\n".
+				 "    in file $file, channel $chnl:  ($prev_token->{TBEG},$prev_token->{TEND}),".
+				 " ($token->{TBEG},$token->{TEND})\n\n");
+			    $prev_token = $token;
+			}
+		    }
+		}
+		else {
+		    @{$data->{$file}{$chnl}{$data_type}} =
+			sort {$a->{TMID} <=> $b->{TMID}} @{$data->{$file}{$chnl}{$data_type}};
+		}
+	    }
+	}
+    }
+}
+
+#################################
+
+sub evaluate {
+
+    my ($ref_data, $sys_data, $uem_data) = @_;
+    my ($uem, $uem_sd_eval, $uem_sd_score, $uem_md_eval, $uem_md_score);
+    my ($ref_wds, $sys_wds, $ref_mds, $sys_mds, $type, %scores, $ref_rttm, $sys_rttm);
+
+    foreach my $file (sort keys %$ref_data) {
+	foreach my $chnl (sort keys %{$ref_data->{$file}}) {
+	    $ref_rttm = $ref_data->{$file}{$chnl}{RTTM};
+	    $sys_rttm = $sys_data->{$file}{$chnl}{RTTM};
+	    $ref_wds = $ref_data->{$file}{$chnl}{LEXEME} ? $ref_data->{$file}{$chnl}{LEXEME} : [];
+	    $sys_wds = $sys_data->{$file}{$chnl}{LEXEME} ? $sys_data->{$file}{$chnl}{LEXEME} : [];
+	    $uem = $uem_data->{$file}{$chnl};
+	    $uem = uem_from_rttm ($ref_rttm) if not defined $uem;
+	    @$ref_wds > 0 or not $opt_w or die
+		"\n\nFATAL ERROR:  no reference words for file '$file' and channel '$chnl'\n\n";
+	    @$sys_wds > 0 or not $opt_w or die
+		"\n\nFATAL ERROR:  no system output words for file '$file' and channel '$chnl'\n".
+		    "              Words are required for word-mediated alignment\n\n";
+	    if ($ref_wds and ($opt_w or $opt_e)) {
+	        tag_words_with_metadata_attributes ($ref_rttm, $ref_wds);
+	        tag_words_with_metadata_attributes ($sys_rttm, $sys_wds);
+	        perform_word_alignment ($file, $chnl, $ref_wds, $sys_wds, $uem);
+	    }
+	    $uem_md_eval = add_exclusion_zones_to_uem ($noeval_md, $uem, $ref_rttm);
+	    $uem_md_score = add_exclusion_zones_to_uem ($noscore_md, $uem_md_eval, $ref_rttm);
+	    $uem_md_score = exclude_overlapping_speech_from_uem ($uem_md_score, $ref_rttm) if $opt_1;
+ 	    tag_scoreable_words ($ref_wds, $uem_md_score);
+	    foreach $type (sort keys %md_subtypes) {
+		$ref_mds = $ref_data->{$file}{$chnl}{$type};
+		next unless defined $ref_mds;
+		@$ref_wds > 0 or die
+		    "\n\nFATAL ERROR:  no reference words for file '$file' and channel '$chnl'\n\n";
+		$sys_mds = $sys_data->{$file}{$chnl}{$type};
+		$sys_mds = $sys_data->{$file}{$chnl}{$type} = [] unless defined $sys_mds;
+		map_metadata_to_words ($sys_mds, $sys_wds, $ref_mds, $ref_wds);
+		discard_unevaluated_metadata ($uem_md_eval, $type, $ref_mds, $ref_wds, "REF");
+		next if @$ref_mds == 0;
+		align_data ($ref_mds, $sys_mds, "", \&md_score, $max_md_delta_score);
+		trace_best_path ($ref_mds, $sys_mds);
+		discard_metadata_subtype ("EDIT", "complex", $ref_mds, $sys_mds) if $type eq "EDIT" and $opt_x;
+		discard_metadata_subtype ("SU", "unannotated", $ref_mds, $sys_mds) if $type eq "SU";
+		discard_unevaluated_metadata ($uem_md_eval, $type, $sys_mds, $ref_wds, "SYS");
+		($scores{$type}{$file}{$chnl}) = score_metadata_path
+		    ($type, $file, $chnl, $ref_mds, $sys_mds, $ref_wds);
+	    }
+
+	    $ref_mds = $ref_data->{$file}{$chnl}{SPEAKER};
+	    if (defined $ref_mds) {
+		@$ref_wds > 0 or not $opt_W or die
+		    "\n\nFATAL ERROR:  no reference words for file '$file' and channel '$chnl'\n\n";
+		$uem_sd_eval = add_exclusion_zones_to_uem ($noeval_sd, $uem, $ref_rttm);
+		$sys_mds = $sys_data->{$file}{$chnl}{SPEAKER};
+		$sys_mds = $sys_data->{$file}{$chnl}{SPEAKER} = {} unless defined $sys_mds;
+		map_spkrdata_to_words ($sys_mds, $sys_wds, $ref_mds, $ref_wds);
+		($scores{SPEAKER}{$file}{$chnl}) = score_speaker_diarization
+		    ($file, $chnl, $ref_mds, $sys_mds, $ref_wds, $uem_sd_eval, $ref_rttm);
+	    }
+
+	    if ($opt_e) {
+		discard_unevaluated_metadata ($uem, "LEXEME", $ref_rttm);
+		discard_unevaluated_metadata ($uem, "LEXEME", $sys_rttm);
+		discard_unevaluated_metadata ($uem_md_eval, "", $ref_rttm);
+		discard_metadata_subtype ("EDIT", "complex", $ref_rttm, $sys_rttm) if $opt_x;
+		discard_metadata_subtype ("SU", "unannotated", $ref_rttm, $sys_rttm);
+		discard_unevaluated_metadata ($uem_md_eval, "", $sys_rttm);
+		display_metadata_mapping ($file, $chnl, $ref_rttm, $sys_rttm, $ref_wds);
+	    }
+	}
+    }
+
+    foreach $type (sort keys %md_subtypes) {
+	md_performance_analysis ($type, $scores{$type}, $md_subtypes{$type}, $ref_data)
+	    if $scores{$type};
+    }
+    sd_performance_analysis ($scores{SPEAKER}, \%spkr_subtypes)
+	if $scores{SPEAKER};
+}
+
+#################################
+
+sub perform_word_alignment {
+
+    my ($file, $chnl, $ref_wds, $sys_wds, $uem) = @_;
+
+    my @ref_wds = @$ref_wds;
+    my @sys_wds = @$sys_wds;
+    discard_unevaluated_words ($uem, \@ref_wds);
+    discard_unevaluated_words ($uem, \@sys_wds);
+    @ref_wds > 0 or die
+	"\n\nFATAL ERROR:  no reference words in UEM portion of file '$file' and channel '$chnl'\n\n";
+    @sys_wds > 0 or not $opt_w or die
+	"\n\nFATAL ERROR:  no system output words in UEM portion of file '$file' and channel '$chnl'\n".
+	    "              Words are required for word-mediated alignment\n\n";
+    return unless @sys_wds > 0;
+
+    if ($opt_o) {
+	foreach my $spkr (word_kinds ($ref_wds, "SPKR")) {
+	    align_data ($ref_wds, $sys_wds, $spkr, \&word_score, $max_wd_delta_score);
+	    trace_best_path ($ref_wds, $sys_wds, $spkr);
+	}
+	decide_who_spoke_the_words ($ref_wds, $sys_wds);
+    }
+    else {
+	align_data ($ref_wds, $sys_wds, "", \&word_score, $max_wd_delta_score);
+	trace_best_path ($ref_wds, $sys_wds);
+    }
+
+#map system output word times to ref words
+    foreach my $wd (@$sys_wds) {
+	$wd->{RTBEG} = adjust_sys_time_to_ref ($wd->{TBEG}, $sys_wds);
+	$wd->{RTEND} = adjust_sys_time_to_ref ($wd->{TEND}, $sys_wds);
+	$wd->{RTDUR} = $wd->{RTEND} - $wd->{RTBEG};
+	$wd->{RTMID} = $wd->{RTBEG} + $wd->{RTDUR}/2;
+    }
+    score_word_path ($file, $chnl, $ref_wds, $sys_wds) if $opt_d;
+}
+
+################################
+
+sub time_in_eval_partition {
+
+    my ($time, $uem_eval) = @_;
+
+    return 1 unless defined $uem_eval; #not using UEM partition specification
+    foreach my $partition (@$uem_eval) {
+	return 1 if event_covers_time ($partition, $time);
+    }
+    return 0;
+}
+
+#################################
+
+sub discard_unevaluated_words {
+
+    my ($uem, $wds) = @_;
+
+    for (my $index=0; $index<@$wds; $index++) {
+	splice (@$wds, $index--, 1)
+	    if ($wds->[$index]{TYPE} eq "LEXEME" and
+		not time_in_eval_partition ($wds->[$index]{TMID}, $uem));
+    }
+}
+
+#################################
+
+sub discard_unevaluated_metadata {
+
+    my ($uem_eval, $type, $mds, $ref_wds, $src) = @_;
+
+    for (my $index=0; $index<@$mds; $index++) {
+	my $md = $mds->[$index];
+	next if (($type and $md->{TYPE} ne $type) or
+		 (not $type and not $md_subtypes{$md->{TYPE}}) or
+		 $md->{MAPPTR} or
+		 md_in_uem ($md, $uem_eval));
+	warn_if_discarded_md_covers_scored_lexemes ($md, $ref_wds, $uem_eval, $src) if $ref_wds;
+	splice (@$mds, $index--, 1);
+    }
+}
+
+#################################
+
+sub warn_if_discarded_md_covers_scored_lexemes {
+
+    my ($md, $ref_wds, $uem, $source) = @_;
+    my ($wbeg, $wend, $index);
+
+    ($wbeg, $wend) = md_word_indices ($md, $ref_wds);
+
+    for ($index=$wbeg; $index<=$wend; $index++) {
+	next unless ($ref_wds->[$index]{SCOREABLE} and
+		     time_in_eval_partition ($ref_wds->[$index]{TMID}, $uem));
+	warn "\nWARNING:  A $source metadata event is being deleted that covers evaluated reference LEXEMEs\n".
+	    "    (type=$md->{TYPE}, subtype=$md->{SUBT}, spkr=$md->{SPKR}, TBEG=$md->{TBEG}, TEND=$md->{TEND})\n";
+	last;
+    }
+}
+
+#################################
+
+sub discard_metadata_subtype {
+
+    my ($type, $subtype, $ref_mds, $sys_mds) = @_;
+    my ($iref, $isys, $ref_md, $sys_md);
+
+#discard all sys $type events that map to a ref event with subtype = $subtype
+#or that are unmapped and have midpoints that lie within a ref event with subtype = $subtype
+    for ($iref=0; $iref<@$ref_mds; $iref++) {
+	$ref_md = $ref_mds->[$iref];
+	next unless ($ref_md->{TYPE} eq $type and
+		     $ref_md->{SUBT} eq $subtype);
+	for ($isys=0; $isys<@$sys_mds; $isys++) {
+	    $sys_md = $sys_mds->[$isys];
+	    splice (@$sys_mds, $isys--, 1)
+		if ($sys_md->{TYPE} eq $type and
+		    (($sys_md->{MAPPTR} and $sys_md->{MAPPTR}{SUBT} eq $subtype) or
+		     (not $sys_md->{MAPPTR} and event_covers_time ($ref_md, $sys_md->{RTMID}))));
+	}
+
+#discard all ref $type/$subtype events
+	splice (@$ref_mds, $iref--, 1);
+    }
+}
+
+#################################
+
+sub tag_scoreable_words {
+
+    my ($wds, $uem_eval) = @_;
+
+    foreach my $wd (@$wds) {
+	$wd->{SCOREABLE} = time_in_eval_partition ($wd->{TMID}, $uem_eval);
+    }
+}
+
+#################################
+
+sub tag_words_with_metadata_attributes {
+
+    my ($mds, $wds) = @_;
+    my ($md, $iwbeg, $iwend, $iw, $wd, $type);
+
+    foreach $md (@$mds) {
+	$type = $md->{TYPE};
+	next unless $type =~ /^(FILLER|EDIT|SU|IP)$/;
+	($iwbeg, $iwend) = md_word_indices ($md, $wds);
+	if ($type =~ /^(FILLER|EDIT)$/) {
+	    for ($iw=$iwbeg; $iw<=$iwend; $iw++) {
+		$wds->[$iw]{ATTRIBUTES}{$md->{TYPE}} = $md->{SUBT};
+	    }
+	}
+	elsif ($type =~ /^(SU|IP)$/) {
+	    $wds->[$iwend]{ATTRIBUTES}{$md->{TYPE}} = $md->{SUBT};
+	}
+    }
+    return;
+}
+
+#################################
+
+sub tag_ref_words_with_metadata_info {
+
+    my ($mds, $wds, $src) = @_;
+    my ($md, $iwbeg, $iwend, $iw, $type);
+
+    foreach $md (@$mds) {
+	$type = $md->{TYPE};
+	($iwbeg, $iwend) = $src eq "REF" ?
+	    ($md->{WBEG}, $md->{WEND}) : ($md->{RWBEG}, $md->{RWEND}) ;
+	if ($type =~ /^(FILLER|EDIT)$/) {
+	    for ($iw=max($iwbeg,0); $iw<=min($iwend,@$wds-1); $iw++) {
+		$wds->[$iw]{"$src-$type"}{$md->{SUBT}}{MAP}++;
+	    }
+	}
+	elsif ($type =~ /^(SU|IP)$/) {
+	    $iwend = min(max($iwend,0),@$wds-1);
+	    $wds->[$iwend]{"$src-$type"}{$md->{SUBT}}{defined $md->{MAPPTR} ? "MAP" : "NOT"}++;
+	}
+    }
+    return;
+}
+
+#################################
+
+sub md_performance_analysis {
+
+    my ($metadata_type, $counts, $subtypes, $ref_data) = @_;
+    my ($file, $chnl, $spkr, $word, $type, $type_counts, $key);
+    my (@files, @chnls, @spkrs, @types, %nevent, %nwerr);
+    my ($subtype, $sys_subtype, %nconf, %offsets);
+
+#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", "SUB") {
+	        next unless defined $type_counts->{WORDS}{$type};
+		$nwerr{ALL}{$type} += $type_counts->{WORDS}{$type};
+		$nwerr{"c=$chnl f=$file"}{$type} += $type_counts->{WORDS}{$type} if $opt_A =~ /c/i and $opt_A =~ /f/i;
+		$nwerr{"c=$chnl"}{$type} += $type_counts->{WORDS}{$type} if $opt_A =~ /c/i and not $opt_A =~ /f/i;
+		$nwerr{"f=$file"}{$type} += $type_counts->{WORDS}{$type} if $opt_A =~ /f/i and not $opt_A =~ /c/i;
+	    }
+	    foreach $type ("WBEG", "WEND") {
+		foreach $key (keys %{$type_counts->{WORD_OFFSET}{$type}}) {
+		    $offsets{ALL}{$type}{$key} += $type_counts->{WORD_OFFSET}{$type}{$key};
+		}
+	    }
+	    my $spkr_info = $ref_data->{$file}{$chnl}{"SPKR-INFO"};
+	    $spkr_info->{unknown}{GENDER} = "unknown" unless defined $spkr_info->{unknown};
+	    foreach $type (keys %$type_counts) {
+		next unless $type =~ /^(REF|DEL|INS|SUB|CONFUSION)$/;
+		@spkrs = keys %{$type_counts->{$type}};
+		foreach $spkr (@spkrs) {
+		    my $gndr = $spkr_info->{$spkr}{GENDER};
+		    foreach $subtype (keys %$subtypes) {
+			my $count = $type_counts->{$type}{$spkr}{$subtype};
+			next unless $count;
+			if ($type eq "CONFUSION") {
+			    foreach $sys_subtype (keys%$count) {
+				$nconf{ALL}{$subtype}{$sys_subtype} += $count->{$sys_subtype};
+				$nconf{ALL}{$subtype}{$sys_subtype} = 0 if not $nconf{ALL}{$subtype}{$sys_subtype};
+				$nconf{ALL}{$sys_subtype}{$subtype} = 0 if not $nconf{ALL}{$sys_subtype}{$subtype};
+			    }
+			    next;
+			}
+			$nconf{ALL}{$subtype}{"{Miss}"} += $count if $type eq "DEL";
+			$nconf{ALL}{"{FA}"}{$subtype} += $count if $type eq "INS";
+			$nconf{ALL}{$subtype}{"{Miss}"} = 0 unless defined $nconf{ALL}{$subtype}{"{Miss}"};
+			$nconf{ALL}{"{FA}"}{$subtype} = 0 unless defined $nconf{ALL}{"{FA}"}{$subtype};
+			$nevent{ALL}{$type} += $count;
+			$nevent{"c=$chnl f=$file"}{$type} += $count if $opt_a =~ /c/i and $opt_a =~ /f/i;
+			$nevent{"c=$chnl"}{$type} += $count if $opt_a =~ /c/i and not $opt_a =~ /f/i;
+			$nevent{"f=$file"}{$type} += $count if $opt_a =~ /f/i and not $opt_a =~ /c/i;
+			$nevent{"s=$spkr"}{$type} += $count if $opt_a =~ /s/i;
+			$nevent{"g=$gndr"}{$type} += $count if $opt_a =~ /g/i;
+		    }
+		}
+	    }
+	}
+    }
+    print_md_scores ($metadata_type, \%nevent, \%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_md_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);
+    my $head_format = "%36s   %5s %5s %5s   %6s %6s %6s   %6s %6s\n";
+    my $data_format = "%-28.28s   %5d   %5d %5d %5s   %6.2f %6.2f %6.2f   %6.2f %6.2f\n";
+    my @header = ("Nref", "Ndel", "Nins", "Nsub", "%Del", "%Ins", "%Sub", "%D+I", "%Tot");
+
+    $counts = $word_counts->{ALL};
+    $nerr = $counts->{DEL} + $counts->{INS};
+    $nerr += $counts->{SUB} if $metadata_type =~ /^(SU|FILLER)$/;
+    printf "\n*** Performance analysis for %ss ***  overall error SCORE = %.2f%s\n",
+        $metadata_type,	100*$nerr/max($counts->{REF},$epsilon), "%";
+
+#metadata word detection
+    print "\nSU (exact) end detection statistics" if $metadata_type eq "SU";
+    print "\nIP (exact) detection statistics" if $metadata_type eq "IP";
+    print "\n$metadata_type word coverage statistics" unless $metadata_type =~ /^(SU|IP)$/;
+    print " -- in terms of reference words\n";
+    printf $head_format, @header;
+    foreach $category (sort keys %$word_counts) {
+	printf $data_format, ($category ne "ALL" ? $category : " "x17 ."ALL",
+			      error_output ($word_counts->{$category}));
+    }
+
+#metadata event detection
+    print "\n$metadata_type detection statistics -- in terms of \# of $metadata_type"."s\n";
+    printf $head_format, @header;
+    foreach $category (sort keys %$event_counts) {
+	printf $data_format, ($category ne "ALL" ? $category : " "x17 ."ALL",
+			      error_output ($event_counts->{$category}));
+    }
+
+#metadata event classification
+    print "\n$metadata_type detection confusion matrix -- in terms of \# of $metadata_type"."s\n";
+    foreach $category (sort keys %$conf_counts) {
+	$counts = $conf_counts->{$category};
+	printf "%24.24s", "$category - ref\\sys";
+	foreach $name (sort keys %$counts, "{Miss}") {
+	    next if $name eq "{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, "{Miss}") {
+		next if $sys eq "{FA}" or ($ref eq "{FA}" and $sys eq "{Miss}");
+		print "    " if $sys eq "{Miss}";
+		printf "%8d  ", $counts->{$ref}{$sys} ? $counts->{$ref}{$sys} : 0;
+	    }
+	    print "\n";
+	}
+    }
+
+#offsets
+    foreach $category (sort keys %$offset_counts) {
+	print "\n$metadata_type word offset statistics for $category data\n";
+	print_offset_stats ($offset_counts->{$category});
+    }
+}
+
+#################################
+
+sub error_output {
+
+    my ($counts) = @_;
+    my (@output, $item, $nerr);
+
+    foreach $item ("REF", "DEL", "INS", "SUB") {
+	$counts->{$item} = 0 unless defined $counts->{$item};
+	push @output, $counts->{$item};
+	$nerr += $counts->{$item} unless $item eq "REF";
+    }
+
+    my $norm = 100/max($counts->{REF},$epsilon);
+    foreach my $item ("DEL", "INS", "SUB") {
+	push @output, min(999.99,$norm*$counts->{$item});
+    }
+    my $dpi = $counts->{"DEL"}+$counts->{"INS"};
+    my $tot = $dpi+$counts->{"SUB"};
+    push @output, min(999.99,$norm*$dpi), min(999.99,$norm*$tot);
+    return @output;
+}
+
+#################################
+
+sub word_kinds {
+
+    my ($words, $kind) = @_;
+    my ($word, %count);
+
+    foreach $word (@$words) {
+	$count{$word->{$kind}}++;
+    }
+    return sort keys %count;
+}
+
+#################################
+
+sub standardize_word {
+
+    my ($word, $glm) = @_;
+    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) = @_;
+    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->{SPKRS};
+	undef $best_score;
+	@speakers = sort keys %{$sys_word->{SPKRS}};
+	next unless @speakers > 1;
+	foreach $spkr (@speakers) {
+	    next unless defined $sys_word->{SPKRS}{$spkr};
+	    $ref_word = $sys_word->{SPKRS}{$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->{SPKRS}{$spkr} = undef;
+	    $ref_word = $sys_word->{SPKRS}{$best_spkr}{REFPTR};
+	}
+    }
+}
+
+#################################
+
+sub event_covers_time {
+
+    my ($event, $time) = @_;
+
+    return ($time < $event->{TBEG} or
+	    $time > $event->{TEND}) ? 0 : 1;
+}
+
+#################################
+
+sub word_score {
+
+    my ($ref_word, $sys_word) = @_;
+    my ($tbeg, $tend, $rw, $sw, $score, $word);
+    my ($attribute, $attributes, $ref_attributes, $sys_attributes);
+
+#compute joint word coverage
+    $score = 0;
+    if (defined $ref_word and defined $sys_word) {
+	return undef unless overlap ($ref_word, $sys_word, $word_gap);
+	if (($ref_attributes = $ref_word->{ATTRIBUTES}) and
+	    ($sys_attributes = $sys_word->{ATTRIBUTES})) {
+	    foreach $attribute ("EDIT", "FILLER", "IP", "SU") {
+	        next unless (defined $ref_attributes->{$attribute} and
+			     defined $sys_attributes->{$attribute});
+		$score += ($ref_attributes->{$attribute} eq
+			   $sys_attributes->{$attribute}) ? 0.02 : 0.01;
+	    }
+	}
+	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));
+    }
+    $word = defined $ref_word ? $ref_word : $sys_word;
+    return 0 unless defined $word;
+    $score = $word->{WTYP} eq "lex" ? -ref_count($word) : -0.2*max(1,ref_count($word));
+    $attributes = $word->{ATTRIBUTES};
+    if (defined $attributes) {
+	foreach $attribute ("EDIT", "FILLER", "IP", "SU") {
+	    $score += 0.005 if defined $word->{$attribute};
+	}
+    }
+    return $score;
+}
+
+#################################
+
+sub wd_err_count {
+
+    my ($ref_word, $sys_word) = @_;
+
+    my $word_score = word_score($ref_word,$sys_word);
+    return (defined $word_score and $word_score > -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 overlap {
+
+    my ($ref, $sys, $tgap) = @_;
+
+    return 0 unless $ref and $sys;
+    $tgap = 0 unless defined $tgap;
+    my $tovl = (min($ref->{TEND}, $sys->{TEND}) -
+		max($ref->{TBEG}, $sys->{TBEG})) + $tgap;
+    return $tovl > 0 ? $tovl/(1 + $tgap/max($ref->{TDUR},$epsilon)) : 0;
+}
+
+################################
+
+sub md_in_uem {
+
+    my ($md, $uem_eval) = @_;
+
+    return 1 unless defined $uem_eval; #not using UEM partition specification
+    foreach my $partition (@$uem_eval) {
+        return 1 if ($md->{TEND} <= $partition->{TEND}+$epsilon and
+		     $md->{TBEG} >= $partition->{TBEG}-$epsilon);
+    }
+    return 0;
+}
+
+#################################
+
+sub map_spkrdata_to_words {
+
+    my ($sys_mds, $sys_wds, $ref_mds, $ref_wds) = @_;
+    my ($spkr, $md, @ref_spkr_mds, @sys_spkr_mds);
+
+    foreach $spkr (keys %$ref_mds) {
+	foreach $md (@{$ref_mds->{$spkr}}) {
+	    push @ref_spkr_mds, $md;
+	}
+    }
+
+    foreach $spkr (keys %$sys_mds) {
+	foreach $md (@{$sys_mds->{$spkr}}) {
+	    push @sys_spkr_mds, $md;
+	}
+    }
+
+    map_metadata_to_words (\@sys_spkr_mds, $sys_wds, \@ref_spkr_mds, $ref_wds);
+}
+
+#################################
+
+sub map_metadata_to_words {
+
+    my ($sys_mds, $sys_wds, $ref_mds, $ref_wds) = @_;
+
+#map system output metadata times to ref words
+    foreach my $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);
+	    $md->{RTEND} = adjust_sys_time_to_ref ($md->{TEND}, $sys_wds);
+	}
+	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 my $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 or
+		 $md->{TYPE} =~ /^(IP|CB)$/);
+        next if (not $opt_W and not $opt_w and $md->{TYPE} eq "SPEAKER");
+	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
+    return unless $opt_w;
+    foreach my $md (@$sys_mds) {
+	(my $wbeg, my $wend) = md_word_indices ($md, $sys_wds);
+	next if ($wend - $wbeg >= 0 or
+		 $md->{TYPE} =~ /^(IP|CB)$/);
+	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) = @_;
+    my ($ts1, $ts2, $tr, $tr1, $tr2, $ws1, $ws2, $ref_wd);
+
+#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 $sys_wds->[$ws2]{MAPPTR}));
+    if ($ws2 < @$sys_wds) {
+	$ref_wd = $sys_wds->[$ws2]{MAPPTR};
+	($ts2, $tr2) = $sys_wds->[$ws2]{TBEG} < $ts ?
+	    ($sys_wds->[$ws2]{TEND}, $ref_wd->{TEND}) :
+	    ($sys_wds->[$ws2]{TBEG}, $ref_wd->{TBEG});
+    }
+
+#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 $sys_wds->[$ws1]{MAPPTR}));
+    if ($ws1 >= 0) {
+	$ref_wd = $sys_wds->[$ws1]{MAPPTR};
+	($ts1, $tr1) = $sys_wds->[$ws1]{TEND} > $ts ?
+	    ($sys_wds->[$ws1]{TBEG}, $ref_wd->{TBEG}) :
+	    ($sys_wds->[$ws1]{TEND}, $ref_wd->{TEND});
+    }
+
+#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_data {
+
+    my ($refs, $syss, $spkr, $scorer, $max_delta_score) = @_;
+    my ($ref, $sys, $prev_ref, $path, $ref_path);
+    my ($ref_index, $sys_index, $index, $pruning_threshold);
+    my ($score, $path_score, $best_score, %cum_insertion_score);
+
+#compute cumulative insertion score for sys output
+    $cum_insertion_score{-1} = 0;
+    for ($sys_index=0; $sys_index<@$syss; $sys_index++) {
+	$sys = $syss->[$sys_index];
+	$cum_insertion_score{$sys_index} = $cum_insertion_score{$sys_index-1};
+	$cum_insertion_score{$sys_index} += &$scorer (undef, $sys);
+    }
+
+#find the best path by incremental optimization through the ref transcription
+    $prev_ref->{PATHS}{-1}{SCORE} = 0;
+    for ($ref_index=0; $ref_index<@$refs; $ref_index++) {
+	$ref = $refs->[$ref_index];
+	next if $spkr and $ref->{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{@$syss-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{@$syss-1}-$cum_insertion_score{$index};
+	    next unless $path_score > $pruning_threshold;
+	    $ref->{PATHS}{$index}{PATHPTR} = $index;
+	    $ref->{PATHS}{$index}{PREVREF} = $prev_ref;
+	    $ref->{PATHS}{$index}{SCORE} = $prev_ref->{PATHS}{$index}{SCORE} +
+		&$scorer ($ref, undef);
+	}
+
+#compare the current ref event to all sys events
+	for ($sys_index=0; $sys_index<@$syss; $sys_index++) {
+	    $sys = $syss->[$sys_index];
+	    $score = &$scorer ($ref, $sys);
+	    next unless defined $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 = $score + $prev_ref->{PATHS}{$index}{SCORE} +
+		    $cum_insertion_score{$sys_index-1}-$cum_insertion_score{$index};
+		if (not defined $ref->{PATHS}{$sys_index}
+		    or $path_score > $ref->{PATHS}{$sys_index}{SCORE}) {
+		    $ref->{PATHS}{$sys_index}{SCORE} = $path_score;
+		    $ref->{PATHS}{$sys_index}{PREVREF} = $prev_ref;
+		    $ref->{PATHS}{$sys_index}{PATHPTR} = $index;
+		    $ref->{PATHS}{$sys_index}{SYSPTR} = $sys;
+		}
+	    }
+	}
+	$prev_ref=$ref;
+    }
+
+#add insertion score for remaining unmapped sys events
+    foreach $index (sort {$a<=>$b} keys %{$prev_ref->{PATHS}}) {
+	$prev_ref->{PATHS}{$index}{SCORE} +=
+	    $cum_insertion_score{@$syss-1}-$cum_insertion_score{$index} if $index < @$syss-1;
+    }
+}
+
+#################################
+
+sub md_score {
+
+    my ($ref_md, $sys_md) = @_;
+    my ($beg, $end, $overlap, $ref_beg, $sys_beg, $md_dur);
+    my $subtype_bonus = 1.1; #multiplicative bonus for matching subtypes
+    my $endword_bonus = 1.001; #multiplicative bonus for matching boundaries
+
+    return 0 unless defined $ref_md and defined $sys_md;
+
+    if ($opt_W) { #compute md mapping score as ref-sys overlap in (ref) words
+	$ref_beg = $ref_md->{WBEG};
+	$sys_beg = $sys_md->{RWBEG};
+	if ($ref_md->{TYPE} eq "SU") {
+	    $ref_beg = max($ref_beg, $ref_md->{WEND}-($su_extent_limit-1));
+	    $sys_beg = max($sys_beg, $sys_md->{RWEND}-($su_extent_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;
+    }
+    else { #compute md mapping score as ref-sys overlap in time
+	$ref_beg = $ref_md->{TBEG};
+	$sys_beg = $sys_md->{RTBEG};
+	if ($ref_md->{TYPE} eq "SU") {
+	    $ref_beg = max($ref_beg, $ref_md->{TEND}-$su_extent_limit);
+	    $sys_beg = max($sys_beg, $sys_md->{RTEND}-$su_extent_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;
+    }
+    $overlap += $epsilon if $ref_md->{TYPE} =~ /^(IP|CB)$/;
+    $overlap += $md_gap;
+    return undef if $overlap < 0;
+    $overlap *= $subtype_bonus if $ref_md->{SUBT} eq $sys_md->{SUBT};
+    $overlap *= $endword_bonus if $ref_md->{WEND} eq $sys_md->{RWEND};
+    return $overlap if $md_dur+$md_gap < max($md_dur,$epsilon);
+    return $overlap * max($md_dur,$epsilon)/($md_dur+$md_gap);
+}
+
+#################################
+
+sub trace_best_path {
+
+    my ($refs, $syss, $spkr) = @_;
+    my ($ref, $path, $pathptr, $best_score, $prev_ref, $ref_index, $index, $sys);
+
+#find the last word for the selected channel and speaker
+    return unless @$refs and @$syss;
+    $ref_index = @$refs-1;
+    $ref_index-- while (defined $spkr and $refs->[$ref_index]{SPKR} ne $spkr);
+    $spkr = "ALL" unless defined $spkr;
+
+#identify the best path for the selected ending word
+    $ref = $refs->[$ref_index];
+    undef $best_score;
+    foreach $index (sort {$a<=>$b} keys %{$ref->{PATHS}}) {
+	$path = $ref->{PATHS}{$index};
+	if (not defined $best_score or $path->{SCORE} > $best_score) {
+	    $best_score = $path->{SCORE};
+	    $pathptr = $path->{PATHPTR};
+	    $prev_ref = $path->{PREVREF};
+	    $sys = $path->{SYSPTR};
+	}
+    }
+    if (defined $sys) {
+	$sys->{SPKRS}{$spkr}{REFPTR} = $ref;
+	$sys->{MAPPTR} = $ref;
+	$ref->{MAPPTR} = $sys;
+    }
+
+#trace the path back
+    while ($pathptr != -1) {
+	$ref = $prev_ref;
+	$path = $ref->{PATHS}{$pathptr};
+	$pathptr = $path->{PATHPTR};
+	$prev_ref = $path->{PREVREF};
+	next unless defined $path->{SYSPTR};
+	$sys = $path->{SYSPTR};
+	$sys->{SPKRS}{$spkr}{REFPTR} = $ref;
+	$sys->{MAPPTR} = $ref;
+	$ref->{MAPPTR} = $sys;
+    }
+}
+
+#################################
+
+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++ if $index >= 0 and $index < @$ref_wds and $ref_wds->[$index]{SCOREABLE};
+	$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", $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) = @_;
+    my ($ref_md, @sys_mds, $sys_index, $sys_md, $md, $spkr, $iw);
+    my (%count, $ref_count, $err_count, $ref_wd, $dw);
+
+    print "\n$type alignment and scoring details for channel $chnl of file $file\n" if $opt_D;
+    print_path_score () if $opt_D;
+
+#tabulate boundary/depod errors
+    tag_ref_words_with_metadata_info ($ref_mds, $ref_wds, "REF");
+    tag_ref_words_with_metadata_info ($sys_mds, $ref_wds, "SYS");
+    for ($iw=0; $iw<@$ref_wds; $iw++) {
+	$ref_wd = $ref_wds->[$iw];
+	next unless $ref_wd->{SCOREABLE} or $type =~ /^(IP|SU)$/;
+	my $nref = my $nsys = my $nins = my $ncor = 0;
+	foreach my $subtype (keys %{$md_subtypes{$type}}) {
+	    my $nr = $ref_wd->{"REF-$type"}{$subtype}{MAP};
+	    my $nm = $ref_wd->{"REF-$type"}{$subtype}{NOT};
+	    my $ns = $ref_wd->{"SYS-$type"}{$subtype}{MAP};
+	    my $ni = $ref_wd->{"SYS-$type"}{$subtype}{NOT};
+	    $nref += $nr if $nr;
+	    $nref += $nm if $nm;
+	    $nsys += $ns if $ns;
+	    $nins += $ni if $ni;
+	    $ncor += min($nr,$ns) if $nr and $ns;
+	}
+	$count{WORDS}{REF} += $nref;
+	$count{WORDS}{DEL} += max($nref-$nsys,0);
+	$count{WORDS}{INS} += max($nsys-$nref,0) + ($nins ? $nins : 0);
+	$count{WORDS}{SUB} += min($nref,$nsys) - $ncor;
+    }
+
+#tabulate beg/end word offset errors
+    foreach $ref_md (@$ref_mds) {
+	next unless ($sys_md = $ref_md->{MAPPTR});
+	$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}++;
+    }
+
+#tabulate detection errors
+    @sys_mds = @$sys_mds;
+    $sys_md = shift @sys_mds;
+    foreach $ref_md (@$ref_mds) {
+	$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 ($ref_md->{MAPPTR}) {
+	    while ($sys_md and
+		   $sys_md ne $ref_md->{MAPPTR}) {
+		printf "%sUNEXPECTED MAPPED SYS MD:  %16s %-7s%8.2f%8.2f %-16s\n",
+		    " "x44, $sys_md->{SUBT}, $sys_md->{TYPE}, $sys_md->{TBEG},
+		    $sys_md->{TEND}, $sys_md->{SPKR} if $sys_md->{MAPPTR};
+		$err_count = md_err_count (undef, $sys_md);
+		$count{INS}{ref_spkr_of_md($sys_md,$ref_wds)}{$sys_md->{SUBT}} += $err_count;
+		print_path_score (undef, $sys_md, 0, $err_count, "INS") if $opt_D;
+		$sys_md = shift @sys_mds;
+	    }
+	    if ($sys_md) {
+		$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 $opt_D;
+		$sys_md = shift @sys_mds;
+	    }
+	    else {
+		printf "%sSYS MD NOT FOUND FOR REF MD:   %16s %-7s%8.2f%8.2f %-16s\n",
+		    " "x40, $ref_md->{SUBT}, $ref_md->{TYPE}, $ref_md->{TBEG},
+		    $ref_md->{TEND}, $ref_md->{SPKR} if $ref_md->{MAPPTR};
+	    }
+	}
+	else {
+	    $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 $opt_D;
+	}
+    }
+    while ($sys_md) {
+	printf "%sUNEXPECTED MAPPED SYS MD:  %16s %-7s%8.2f%8.2f %-16s\n",
+	    " "x44, $sys_md->{SUBT}, $sys_md->{TYPE}, $sys_md->{TBEG},
+	    $sys_md->{TEND}, $sys_md->{SPKR} if $sys_md->{MAPPTR};
+	$err_count = md_err_count (undef, $sys_md);
+	$count{INS}{ref_spkr_of_md($sys_md,$ref_wds)}{$sys_md->{SUBT}} += $err_count;
+	print_path_score (undef, $sys_md, 0, $err_count, "INS") if $opt_D;
+	$sys_md = shift @sys_mds;
+    }
+    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 ref_spkr_of_md {
+
+    my ($md, $ref_wds) = @_;
+    my $spkr;
+
+    for (my $index =min($md->{RWBEG},$md->{RWEND});
+	    $index<=max($md->{RWBEG},$md->{RWEND}); $index++) {
+	next unless $index >= 0 and $index < @$ref_wds;
+	$spkr = $ref_wds->[$index]{SPKR} unless $spkr;
+	return "unknown" unless $ref_wds->[$index]{SPKR} eq $spkr;
+    }
+    return defined $spkr ? $spkr : "unknown";
+}
+
+#################################
+
+sub score_word_path {
+
+    my ($file, $chnl, $ref_wds, $sys_wds) = @_;
+    my ($ref_wrd, @sys_wds, $sys_wrd);
+    my ($ref_count, $err_count);
+
+    print "\nWord alignment and scoring details for channel $chnl of file $file\n";
+    print_path_score ();
+
+#tabulate errors
+    @sys_wds = @$sys_wds;
+    $sys_wrd = shift @sys_wds;
+    foreach $ref_wrd (@$ref_wds) {
+	$ref_count = ref_count($ref_wrd);
+	if ($ref_wrd->{MAPPTR}) {
+	    while ($sys_wrd and
+		   $sys_wrd ne $ref_wrd->{MAPPTR}) {
+		printf "%71s%16s %-7s%s%8.2f%8.2f %-16s\n", "UNEXPECTED MAPPED SYS WORD:",
+		    $sys_wrd->{WORD}, $sys_wrd->{WTYP}, " "x18, $sys_wrd->{TBEG},
+		    $sys_wrd->{TDUR}, $sys_wrd->{SPKR} if $sys_wrd->{MAPPTR};
+		$err_count = wd_err_count(undef, $sys_wrd);
+		print_path_score (undef, $sys_wrd, 0, $err_count, "INS");
+		$sys_wrd = shift @sys_wds;
+	    }
+	    if ($sys_wrd) {
+		$err_count = wd_err_count($ref_wrd, $sys_wrd);
+		print_path_score ($ref_wrd, $sys_wrd, $ref_count, $err_count, "SUB");
+		$sys_wrd = shift @sys_wds;
+	    }
+	    else {
+		printf "%71s%16s %-7s%s%8.2f%8.2f %-16s\n", "SYS WRD NOT FOUND FOR REF WRD:",
+		    $ref_wrd->{WORD}, $ref_wrd->{WTYP}, " "x18, $ref_wrd->{TBEG},
+		    $ref_wrd->{TDUR}, $ref_wrd->{SPKR} if $ref_wrd->{MAPPTR};
+	    }
+	}
+	else {
+	    $err_count = wd_err_count($ref_wrd, undef);
+	    print_path_score ($ref_wrd, undef, $ref_count, $err_count, "DEL");
+	}
+    }
+    while ($sys_wrd) {
+	printf "%71s%16s %-7s%8.2f%8.2f %-16s\n", "UNEXPECTED MAPPED SYS WORD:",
+	    $sys_wrd->{WORD}, $sys_wrd->{WTYP}, $sys_wrd->{TBEG},
+	    $sys_wrd->{TDUR}, $sys_wrd->{SPKR} if $sys_wrd->{MAPPTR};
+	$err_count = wd_err_count(undef, $sys_wrd);
+	print_path_score (undef, $sys_wrd, 0, $err_count, "INS");
+	$sys_wrd = shift @sys_wds;
+    }
+}
+
+#################################
+
+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;
+}
+
+#################################
+
+sub score_speaker_diarization {
+
+    my ($file, $chnl, $ref_spkr_data, $sys_spkr_data, $ref_wds, $uem_eval, $rttm_data) = @_;
+    my ($uem_score, $ref_eval, $sys_eval, $spkr_overlap, $spkr_map);
+    my ($eval_segs, $score_segs, %stats, @ref_wds, $wrd, $ref_spkr, $sys_spkr);
+    my ($nref, $nsys, $nmap, $spkr, $seg, $type, $spkr_info, $noscore_nl);
+
+    $stats{EVAL_WORDS} = $stats{SCORED_WORDS} =	$stats{MISSED_WORDS} = $stats{ERROR_WORDS} = $epsilon;
+    @ref_wds = @$ref_wds;
+    $wrd = shift @ref_wds;
+    foreach $seg (@$uem_eval) {
+	$stats{EVAL_TIME} += $seg->{TEND}-$seg->{TBEG};
+	$wrd = shift @ref_wds while ($wrd and $wrd->{TMID} < $seg->{TBEG});
+	while ($wrd and $wrd->{TMID} <= $seg->{TEND}) {
+	    $stats{EVAL_WORDS}++;
+	    $wrd = shift @ref_wds;
+	}
+    }
+
+    $eval_segs = create_speaker_segs ($uem_eval, $ref_spkr_data, $sys_spkr_data);
+    foreach $seg (@$eval_segs) {
+	foreach $ref_spkr (keys %{$seg->{REF}}) {
+	    $spkr_info->{REF}{$ref_spkr}{TIME} += $seg->{TDUR};
+	    $spkr_info->{REF}{$ref_spkr}{TYPE} = $ref_spkr_data->{$ref_spkr}[0]{SUBT};
+	}
+	foreach $sys_spkr (keys %{$seg->{SYS}}) {
+	    $spkr_info->{SYS}{$sys_spkr}{TIME} += $seg->{TDUR};
+	    $spkr_info->{SYS}{$sys_spkr}{TYPE} = $sys_spkr_data->{$sys_spkr}[0]{SUBT};
+	}
+	next unless keys %{$seg->{REF}} > 0;
+	$stats{EVAL_SPEECH} += $seg->{TDUR};
+	foreach $ref_spkr (keys %{$seg->{REF}}) {
+	    foreach $sys_spkr (keys %{$seg->{SYS}}) {
+		$spkr_overlap->{$ref_spkr}{$sys_spkr} += $seg->{TDUR};
+	    }
+	}
+    }
+    $speaker_map{$file}{$chnl} = $spkr_map = map_speakers ($spkr_overlap)
+	if defined $spkr_overlap;
+    print_speaker_map ($spkr_map, $spkr_overlap) if $opt_m;
+    update_speaker_map_file ($spkr_map, $spkr_overlap, $file, $chnl, $opt_M) if $opt_M;
+
+    $uem_score = $collar > 0 ? add_collars_to_uem ($uem_eval, $ref_spkr_data) : $uem_eval;
+    $uem_score = add_exclusion_zones_to_uem ($noscore_sd, $uem_score, $rttm_data);
+    $noscore_nl->{"NON-LEX"} = $noscore_sd->{"NON-LEX"};
+    $uem_score = add_exclusion_zones_to_uem ($noscore_nl, $uem_score, $rttm_data, $max_extend);
+    $uem_score = exclude_overlapping_speech_from_uem ($uem_score, $rttm_data) if $opt_1;
+    tag_scoreable_words ($ref_wds, $uem_score);
+    $score_segs = create_speaker_segs ($uem_score, $ref_spkr_data, $sys_spkr_data);
+    print_speaker_segs ($score_segs, $file, $chnl) if $opt_v;
+    ($stats{TYPE}{NSPK}) = speaker_mapping_scores ($spkr_map, $spkr_info);
+    score_speaker_segments (\%stats, $score_segs, $ref_wds, $spkr_map, $spkr_info);
+    return {%stats};
+}
+
+#################################
+
+sub speaker_mapping_scores {
+
+    my ($spkr_map, $spkr_info) = @_;
+    my ($ref_spkr, $ref_type, $sys_spkr, $sys_type, %imap, %stats);
+
+    foreach $ref_spkr (keys %{$spkr_info->{REF}}) {
+	next unless $spkr_info->{REF}{$ref_spkr}{TIME};
+	$ref_type = $spkr_info->{REF}{$ref_spkr}{TYPE};
+	$stats{REF}{$ref_type}++;
+	$sys_spkr = $spkr_map->{$ref_spkr};
+	$sys_type = defined $sys_spkr ? $spkr_info->{SYS}{$sys_spkr}{TYPE} : $miss_name;
+	$stats{JOINT}{$ref_type}{$sys_type}++;
+	$imap{$sys_spkr} = $ref_spkr if defined $sys_spkr;
+    }
+    foreach $sys_spkr (keys %{$spkr_info->{SYS}}) {
+	next unless $spkr_info->{SYS}{$sys_spkr}{TIME};
+	$sys_type = $spkr_info->{SYS}{$sys_spkr}{TYPE};
+	$stats{SYS}{$sys_type}++;
+	$stats{JOINT}{$fa_name}{$sys_type}++
+	    unless defined $imap{$sys_spkr};
+    }
+    return {%stats};
+}
+
+#################################
+
+sub score_speaker_segments {
+
+    my ($stats, $score_segs, $ref_wds, $spkr_map, $spkr_info) = @_;
+    my ($ref_spkr, $ref_type, $sys_spkr, $sys_type, %type_stats);
+    my (@ref_wds, $wrd, $seg, $seg_dur, $nref, $nsys);
+
+    @ref_wds = @$ref_wds;
+    $wrd = shift @ref_wds;
+    foreach $seg (@$score_segs) {
+	$seg_dur = $seg->{TDUR};
+	$stats->{SCORED_TIME} += $seg_dur;
+	$nref = keys %{$seg->{REF}};
+	$nsys = keys %{$seg->{SYS}};
+	$stats->{SCORED_SPEECH} += $nref ? $seg_dur : 0;
+	$stats->{MISSED_SPEECH} += ($nref and not $nsys) ? $seg_dur : 0;
+	$stats->{FALARM_SPEECH} += ($nsys and not $nref) ? $seg_dur : 0;
+	$stats->{SCORED_SPEAKER} += $seg_dur*$nref;
+	$stats->{MISSED_SPEAKER} += $seg_dur*max($nref-$nsys,0);
+	$stats->{FALARM_SPEAKER} += $seg_dur*max($nsys-$nref,0);
+
+	my $scored_wrds = my $missed_wrds = my $error_wrds = 0;
+	$wrd = shift @ref_wds while ($wrd and $wrd->{TMID} < $seg->{TBEG});
+	while ($wrd and $wrd->{TMID} <= $seg->{TEND}) {
+	    next unless $wrd->{SCOREABLE};
+	    $scored_wrds++;
+	    $missed_wrds++ if not $nsys;
+	    $error_wrds++ unless speakers_match ($seg->{REF}, $seg->{SYS}, $spkr_map);
+	    $wrd = shift @ref_wds;
+	}
+	$stats->{SCORED_WORDS} += $scored_wrds;
+	$stats->{MISSED_WORDS} += $missed_wrds;
+	$stats->{ERROR_WORDS} += $error_wrds;
+
+	my $nmap = 0, my %num_types;
+	foreach $ref_spkr (keys %{$seg->{REF}}) {
+	    $ref_type = $spkr_info->{REF}{$ref_spkr}{TYPE};
+	    $num_types{REF}{$ref_type}++;
+	    $sys_spkr = $spkr_map->{$ref_spkr};
+	    $nmap++ if defined $sys_spkr and defined $seg->{SYS}{$sys_spkr};
+	}
+	$stats->{SPEAKER_ERROR} += $seg_dur*(min($nref,$nsys) - $nmap);
+
+	foreach $sys_spkr (keys %{$seg->{SYS}}) {
+	    $sys_type = $spkr_info->{SYS}{$sys_spkr}{TYPE};
+	    $num_types{SYS}{$sys_type}++;
+	}
+	foreach $ref_type (keys %{$num_types{REF}}) {
+	    $nref = $num_types{REF}{$ref_type};
+	    $type_stats{REF}{$ref_type} += $nref*$seg_dur;
+	    foreach $sys_type (keys %{$num_types{SYS}}) {
+		$nsys = $num_types{SYS}{$sys_type};
+		$type_stats{JOINT}{$ref_type}{$sys_type} += min($nref,$nsys)*$seg_dur;
+	    }
+	    $type_stats{JOINT}{$ref_type}{$miss_name} += max($nref-$nsys,0)*$seg_dur;
+	}
+	foreach $sys_type (keys %{$num_types{SYS}}) {
+	    $nsys = $num_types{SYS}{$sys_type};
+	    $type_stats{SYS}{$sys_type} += $nsys*$seg_dur;
+	    $type_stats{JOINT}{$fa_name}{$sys_type} += max($nsys-$nref,0)*$seg_dur;
+	}
+    }
+    $stats->{TYPE}{TIME} = {%type_stats};
+}
+
+#################################
+
+sub speakers_match {
+
+    my ($ref_spkrs, $sys_spkrs, $spkr_map) = @_;
+
+    return 0 unless keys %$ref_spkrs == keys %$sys_spkrs;
+    foreach my $ref_spkr (keys %$ref_spkrs) {
+	return 0 unless (defined $spkr_map->{$ref_spkr} and
+			 defined $sys_spkrs->{$spkr_map->{$ref_spkr}});
+    }
+    return 1;
+}
+
+#################################
+
+sub add_collars_to_uem {
+
+    my ($uem_eval, $ref_data) = @_;
+    my (@events, $event, $uem, $uem_score, $spkr, $spkr_seg, $tbeg, $evaluate);
+
+    foreach $uem (@$uem_eval) {
+	push @events, {EVENT => "BEG", TIME => $uem->{TBEG}};
+	push @events, {EVENT => "END", TIME => $uem->{TEND}};
+    }
+#add no-score collars
+    foreach $spkr (keys %$ref_data) {
+	foreach $spkr_seg (@{$ref_data->{$spkr}}) {
+	    push @events, {EVENT => "END", TIME => $spkr_seg->{TBEG}-$collar};
+	    push @events, {EVENT => "BEG", TIME => $spkr_seg->{TBEG}+$collar};
+	    push @events, {EVENT => "END", TIME => $spkr_seg->{TEND}-$collar};
+	    push @events, {EVENT => "BEG", TIME => $spkr_seg->{TEND}+$collar};
+	}
+    }
+    @events = sort {($a->{TIME} < $b->{TIME} ? -1 :
+		     ($a->{TIME} > $b->{TIME} ? 1 :
+		      $a->{EVENT} eq "END"))} @events;
+    $evaluate = 0;
+    foreach $event (@events) {
+	if ($event->{EVENT} eq "BEG") {
+	    $evaluate++;
+	    $tbeg = $event->{TIME} if $evaluate == 1;
+	}
+	else {
+	    $evaluate--;
+	    push @$uem_score, {TBEG => $tbeg, TEND => $event->{TIME}}
+	        if $evaluate == 0 and $event->{TIME} > $tbeg;
+	}
+    }
+    return $uem_score;
+}
+
+#################################
+
+sub exclude_overlapping_speech_from_uem {
+
+    my ($uem_data, $rttm_data) = @_;
+    my ($token, @spkr_events, $event, $spkr_cnt, $tbeg_overlap, $uem, @events, $uem_ex);
+
+#overlapping speech computed from SPEAKER data
+    foreach $token (@$rttm_data) {
+	next unless ($token->{TYPE} eq "SPEAKER" and
+		     $token->{TDUR} > 0);
+	push @spkr_events, {EVENT => "BEG", TIME => $token->{TBEG}, SPKR => $token->{SPKR}};
+	push @spkr_events, {EVENT => "END", TIME => $token->{TEND}, SPKR => $token->{SPKR}};
+    }
+    @spkr_events = sort {($a->{TIME} < $b->{TIME} ? -1 :
+			  ($a->{TIME} > $b->{TIME} ? 1 :
+			   $a->{EVENT} eq "BEG"))} @spkr_events;
+
+#create noscore zones
+    foreach $event (@spkr_events) {
+	if ($event->{EVENT} eq "BEG") {
+	    next unless ++$spkr_cnt == 2;
+	    $tbeg_overlap = $event->{TIME};
+	}
+	else {
+	    next unless --$spkr_cnt == 1;
+	    push @events, {TYPE => "NSZ", EVENT => "BEG", TIME => $tbeg_overlap};
+	    push @events, {TYPE => "NSZ", EVENT => "END", TIME => $event->{TIME}};
+	}
+    }
+
+#merge noscore zones with UEM data
+    foreach $uem (@$uem_data) {
+	next unless $uem->{TEND}-$uem->{TBEG} > 0;
+	push @events, {TYPE => "UEM", EVENT => "BEG", TIME => $uem->{TBEG}};
+	push @events, {TYPE => "UEM", EVENT => "END", TIME => $uem->{TEND}};
+    }
+    @events = sort {($a->{TIME} < $b->{TIME} ? -1 :
+		     ($a->{TIME} > $b->{TIME} ? 1 :
+		      $a->{EVENT} eq "BEG"))} @events;
+
+    my $tbeg = my $evl_cnt = my $nsz_cnt = my $evaluating = 0;
+    foreach $event (@events) {
+	$evl_cnt += $event->{EVENT} eq "BEG" ? 1 : -1 if $event->{TYPE} eq "UEM";
+	$nsz_cnt += $event->{EVENT} eq "BEG" ? 1 : -1 if $event->{TYPE} eq "NSZ";
+	if ($evaluating and
+	    ($evl_cnt == 0 or $nsz_cnt > 0) and
+	    $event->{TIME} > $tbeg) {
+	    push @$uem_ex, {TBEG => $tbeg, TEND => $event->{TIME}};
+	    $evaluating = 0;
+	}
+	elsif ($evl_cnt > 0 and $nsz_cnt == 0) {
+	    $tbeg = $event->{TIME};
+	    $evaluating = 1;
+	}
+    }
+
+    return $uem_ex;
+}
+
+#################################
+
+sub add_exclusion_zones_to_uem {
+
+    my ($excluded_tokens, $uem_score, $rttm_data, $max_extend) = @_;
+    my (@events, $event, $uem, $uem_ex, $spkr, $spkr_seg, $tbeg, $evaluating, $token);
+    my (@ns_events, $evl_cnt, $lex_cnt, $nsz_cnt, $tstart, $tstop);
+    my ($tbeg_lex, $tbeg_nsz, $tend_lex, $tend_nsz, $tseg);
+
+    return $uem_score unless defined $excluded_tokens and (keys %$excluded_tokens) > 0;
+
+#gather data needed to create noscore zones
+    foreach $token (@$rttm_data) {
+	if ($token->{TYPE} eq "LEXEME" and
+	    not defined $excluded_tokens->{LEXEME}{$token->{SUBT}} and
+	    $token->{TDUR} > 0) {
+	    push @ns_events, {TYPE => "LEX", EVENT => "BEG", TIME => $token->{TBEG}};
+	    push @ns_events, {TYPE => "LEX", EVENT => "END", TIME => $token->{TEND}};
+	}
+	elsif ($token->{TYPE} eq "SPEAKER" and
+	       $token->{TDUR} > 0) {
+	    push @ns_events, {TYPE => "SEG", EVENT => "BEG", TIME => $token->{TBEG}};
+	    push @ns_events, {TYPE => "SEG", EVENT => "END", TIME => $token->{TEND}};
+	}
+	elsif (defined $excluded_tokens->{$token->{TYPE}}{$token->{SUBT}} and
+	       $token->{TDUR} > 0) {
+	    push @ns_events, {TYPE => "NSZ", EVENT => "BEG", TIME => $token->{TBEG}};
+	    push @ns_events, {TYPE => "NSZ", EVENT => "END", TIME => $token->{TEND}};
+	}
+    }
+    @ns_events = sort {($a->{TIME} < $b->{TIME} ? -1 :
+			($a->{TIME} > $b->{TIME} ? 1 :
+			 $a->{EVENT} eq "BEG"))} @ns_events;
+
+#create noscore zones
+    $evaluating = 1;
+    $max_extend = $epsilon if not $max_extend or $max_extend < $epsilon;
+    $tseg = $tbeg_nsz = $tbeg_lex = $tend_nsz = $tend_lex = 0;
+    $lex_cnt = $nsz_cnt = 0;
+    foreach $event (@ns_events) {
+	if ($event->{TYPE} eq "LEX") {
+	    if ($event->{EVENT} eq "BEG") {
+		$tbeg_lex = $event->{TIME} if $lex_cnt++ == 0;
+	    }
+	    else {
+		$tend_lex = $event->{TIME} if $lex_cnt-- == 1;
+	    }
+	}
+	elsif ($event->{TYPE} eq "NSZ") {
+	    if ($event->{EVENT} eq "BEG") {
+		$tbeg_nsz = $event->{TIME} if $nsz_cnt++ == 0;
+	    }
+	    else {
+		$tend_nsz = $event->{TIME} if $nsz_cnt-- == 1;
+	    }
+	}
+	elsif ($event->{TYPE} eq "SEG") {
+	    $tseg = $event->{TIME};
+	}
+
+	if ($evaluating) {
+	    next if ($nsz_cnt == 0 or
+		     $event->{TYPE} ne "NSZ");
+	    $tstop = ($lex_cnt > 0 ? $event->{TIME} :
+		      max($tend_lex, $tseg, $event->{TIME}-$max_extend));
+	    push @events, {TYPE => "NSZ", EVENT => "BEG", TIME => $tstop};
+	    $evaluating = 0;
+	}
+	elsif ($nsz_cnt == 0 and
+	       ($lex_cnt > 0 or
+		$event->{TYPE} eq "SEG")) {
+	    $tstart = min($tend_nsz+$max_extend, $event->{TIME});
+	    push @events, {TYPE => "NSZ", EVENT => "END", TIME => $tstart};
+	    $evaluating = 1;
+	}
+	elsif ($nsz_cnt == 1 and
+	       $event->{TYPE} eq "NSZ" and
+	       $event->{EVENT} eq "BEG" and
+	       $event->{TIME} > $tend_nsz+2*$max_extend) {
+	    push @events, {TYPE => "NSZ", EVENT => "END", TIME => $tend_nsz+$max_extend};
+	    push @events, {TYPE => "NSZ", EVENT => "BEG", TIME => $event->{TIME}-$max_extend};
+	    $evaluating = 0;
+	}
+    }
+
+#merge noscore zones with UEM data
+    foreach $uem (@$uem_score) {
+	next unless $uem->{TEND}-$uem->{TBEG} > 0;
+	push @events, {TYPE => "UEM", EVENT => "BEG", TIME => $uem->{TBEG}};
+	push @events, {TYPE => "UEM", EVENT => "END", TIME => $uem->{TEND}};
+    }
+    @events = sort {($a->{TIME} < $b->{TIME} ? -1 :
+		     ($a->{TIME} > $b->{TIME} ? 1 :
+		      $a->{EVENT} eq "BEG"))} @events;
+    $evl_cnt = $evaluating = 0;
+    foreach $event (@events) {
+	$evl_cnt += $event->{EVENT} eq "BEG" ? 1 : -1 if $event->{TYPE} eq "UEM";
+	$nsz_cnt += $event->{EVENT} eq "BEG" ? 1 : -1 if $event->{TYPE} eq "NSZ";
+	if ($evaluating and
+	    ($evl_cnt == 0 or $nsz_cnt > 0) and
+	    $event->{TIME} > $tbeg) {
+	    push @$uem_ex, {TBEG => $tbeg, TEND => $event->{TIME}};
+	    $evaluating = 0;
+	}
+	elsif ($evl_cnt > 0 and $nsz_cnt == 0) {
+	    $tbeg = $event->{TIME};
+	    $evaluating = 1;
+	}
+    }
+
+    return $uem_ex;
+}
+
+#################################
+
+sub uem_from_rttm {
+
+    my ($rttm_data) = @_;
+    my ($token, $tbeg, $tend);
+
+    ($tbeg, $tend) = (1E30, 0);
+    foreach $token (@$rttm_data) {
+	($tbeg, $tend) = (min($tbeg,$token->{TBEG}), max($tend,$token->{TEND})) if
+	    $token->{TYPE} =~ /^(SEGMENT|SPEAKER|SU|EDIT|FILLER|IP|CB|A\/P|LEXEME|NON-LEX)$/;
+    }
+
+    return [{TBEG => $tbeg, TEND => $tend}];
+}
+
+#################################
+
+sub create_speaker_segs {
+
+    my ($uem_score, $ref_data, $sys_data) = @_;
+    my ($spkr, $seg, @events, $event, $uem, $segments, $tbeg, $tend);
+    my ($evaluate, %ref_spkrs, %sys_spkrs, $spkrs);
+
+    foreach $uem (@$uem_score) {
+	next unless $uem->{TEND} > $uem->{TBEG}+$epsilon;
+	push @events, {TYPE => "UEM", EVENT => "BEG", TIME => $uem->{TBEG}};
+	push @events, {TYPE => "UEM", EVENT => "END", TIME => $uem->{TEND}};
+    }
+    foreach $spkr (keys %$ref_data) {
+	foreach $seg (@{$ref_data->{$spkr}}) {
+	    next unless $seg->{TDUR} > 0;
+	    push @events, {TYPE => "REF", SPKR => $spkr, EVENT => "BEG", TIME => $seg->{TBEG}};
+	    push @events, {TYPE => "REF", SPKR => $spkr, EVENT => "END", TIME => $seg->{TEND}};
+	}
+    }
+    foreach $spkr (keys %$sys_data) {
+	foreach $seg (@{$sys_data->{$spkr}}) {
+	    next unless $seg->{TDUR} > 0;
+	    push @events, {TYPE => "SYS", SPKR => $spkr, EVENT => "BEG", TIME => $seg->{RTBEG}};
+	    push @events, {TYPE => "SYS", SPKR => $spkr, EVENT => "END", TIME => $seg->{RTEND}};
+	}
+    }
+    @events = sort {($a->{TIME} < $b->{TIME}-$epsilon  ? -1 :
+		     ($a->{TIME} > $b->{TIME}+$epsilon ?  1 :
+		      ($a->{EVENT} eq "END"        ? -1 : 1)))} @events;
+    $evaluate = 0;
+    foreach $event (@events) {
+	if ($evaluate and $tbeg<$event->{TIME}) {
+	    $tend = $event->{TIME};
+	    push @$segments, {REF => {%ref_spkrs},
+			      SYS => {%sys_spkrs},
+			      TBEG => $tbeg,
+			      TEND => $tend,
+			      TDUR => $tend-$tbeg};
+	    $tbeg = $tend;
+	}
+	if ($event->{TYPE} eq "UEM") {
+	    $evaluate = $event->{EVENT} eq "BEG";
+	    $tbeg = $event->{TIME} if $evaluate;
+	}
+	else {
+	    $spkrs = $event->{TYPE} eq "REF" ? \%ref_spkrs : \%sys_spkrs;
+	    ($event->{EVENT} eq "BEG") ? $spkrs->{$event->{SPKR}}++ : $spkrs->{$event->{SPKR}}--;
+	    $spkrs->{$event->{SPKR}} <= 1 or warn
+	        "WARNING:  speaker $event->{SPKR} speaking more than once at time $event->{TIME}\n";
+	    delete $spkrs->{$event->{SPKR}} unless $spkrs->{$event->{SPKR}};
+	}
+    }
+    return $segments;
+}
+
+#################################
+
+sub sd_performance_analysis {
+
+    my ($scores, $subtypes) = @_;
+    my ($file, $chnl, $class, $kind, $ref_type, $sys_type);
+    my ($xscores, %cum_scores, $count);
+
+#accumulate statistics
+    foreach $file (keys %$scores) {
+	foreach $chnl (keys %{$scores->{$file}}) {
+	    $xscores = $scores->{$file}{$chnl};
+	    foreach $ref_type (keys %$xscores) {
+		next if $ref_type eq "TYPE";
+		$count = $xscores->{$ref_type};
+		$cum_scores{ALL}{$ref_type} += $count;
+		$cum_scores{"c=$chnl f=$file"}{$ref_type} += $xscores->{$ref_type} if $opt_a =~ /c/i and $opt_a =~ /f/i;
+		$cum_scores{"c=$chnl"}{$ref_type} += $xscores->{$ref_type} if $opt_a =~ /c/i and not $opt_a =~ /f/i;
+		$cum_scores{"f=$file"}{$ref_type} += $xscores->{$ref_type} if $opt_a =~ /f/i and not $opt_a =~ /c/i;
+	    }
+	    $xscores = $xscores->{TYPE};
+	    foreach my $class ("TIME", "NSPK") {
+		foreach my $kind ("REF", "SYS") {
+		    foreach $ref_type (keys %{$xscores->{$class}{$kind}}) {
+			$count = $xscores->{$class}{$kind}{$ref_type};
+			$cum_scores{ALL}{TYPE}{$class}{$kind}{$ref_type} += $count;
+			$cum_scores{"c=$chnl f=$file"}{TYPE}{$class}{$kind}{$ref_type} += $count if $opt_a =~ /c/i and $opt_a =~ /f/i;
+			$cum_scores{"c=$chnl"}{TYPE}{$class}{$kind}{$ref_type} += $count if $opt_a =~ /c/i and not $opt_a =~ /f/i;
+			$cum_scores{"f=$file"}{TYPE}{$class}{$kind}{$ref_type} += $count if $opt_a =~ /f/i and not $opt_a =~ /c/i;
+		    }
+		}
+		foreach $ref_type (keys %{$xscores->{$class}{JOINT}}) {
+		    foreach $sys_type (keys %{$xscores->{$class}{JOINT}{$ref_type}}) {
+			$count = $xscores->{$class}{JOINT}{$ref_type}{$sys_type};
+			$cum_scores{ALL}{TYPE}{$class}{JOINT}{$ref_type}{$sys_type} += $count;
+			$cum_scores{"c=$chnl f=$file"}{TYPE}{$class}{JOINT}{$ref_type}{$sys_type} += $count if $opt_a =~ /c/i and $opt_a =~ /f/i;
+			$cum_scores{"c=$chnl"}{TYPE}{$class}{JOINT}{$ref_type}{$sys_type} += $count if $opt_a =~ /c/i and not $opt_a =~ /f/i;
+			$cum_scores{"f=$file"}{TYPE}{$class}{JOINT}{$ref_type}{$sys_type} += $count if $opt_a =~ /f/i and not $opt_a =~ /c/i;
+		    }
+		}
+	    }
+	}
+    }
+
+    foreach my $condition (sort keys %cum_scores) {
+	print_sd_scores ($condition, $cum_scores{$condition}) if $condition !~ /ALL/;
+    }
+    print_sd_scores ("ALL", $cum_scores{ALL});
+}
+
+#################################
+
+sub print_sd_scores {
+
+    my ($condition, $scores) = @_;
+
+    printf "\n*** Performance analysis for Speaker Diarization for $condition ***\n\n";
+
+    #printf "    EVAL TIME =%10.2f secs\n", $scores->{EVAL_TIME};
+    #printf "  EVAL SPEECH =%10.2f secs (%5.1f percent of evaluated time)\n", $scores->{EVAL_SPEECH},
+    #    100*$scores->{EVAL_SPEECH}/$scores->{EVAL_TIME};
+    #printf "  SCORED TIME =%10.2f secs (%5.1f percent of evaluated time)\n",
+    #    $scores->{SCORED_TIME}, 100*$scores->{SCORED_TIME}/$scores->{EVAL_TIME};
+    #printf "SCORED SPEECH =%10.2f secs (%5.1f percent of scored time)\n",
+    #    $scores->{SCORED_SPEECH}, 100*$scores->{SCORED_SPEECH}/$scores->{SCORED_TIME};
+    #printf "   EVAL WORDS =%7d        \n", $scores->{EVAL_WORDS};
+    #printf " SCORED WORDS =%7d         (%5.1f percent of evaluated words)\n",
+    #    $scores->{SCORED_WORDS}, 100*$scores->{SCORED_WORDS}/$scores->{EVAL_WORDS};
+    #print "---------------------------------------------\n";
+    #printf "MISSED SPEECH =%10.2f secs (%5.1f percent of scored time)\n",
+    ##    $scores->{MISSED_SPEECH}, 100*$scores->{MISSED_SPEECH}/$scores->{SCORED_TIME};
+    #printf "FALARM SPEECH =%10.2f secs (%5.1f percent of scored time)\n",
+    #    $scores->{FALARM_SPEECH}, 100*$scores->{FALARM_SPEECH}/$scores->{SCORED_TIME};
+    #printf " MISSED WORDS =%7d         (%5.1f percent of scored words)\n",
+    #    $scores->{MISSED_WORDS}, 100*$scores->{MISSED_WORDS}/$scores->{SCORED_WORDS};
+    #print "---------------------------------------------\n";
+    #printf "SCORED SPEAKER TIME =%10.2f secs (%5.1f percent of scored speech)\n",
+    #    $scores->{SCORED_SPEAKER}, 100*$scores->{SCORED_SPEAKER}/$scores->{SCORED_SPEECH};
+    #printf "MISSED SPEAKER TIME =%10.2f secs (%5.1f percent of scored speaker time)\n",
+    #    $scores->{MISSED_SPEAKER}, 100*$scores->{MISSED_SPEAKER}/$scores->{SCORED_SPEAKER};
+    #printf "FALARM SPEAKER TIME =%10.2f secs (%5.1f percent of scored speaker time)\n",
+    #    $scores->{FALARM_SPEAKER}, 100*$scores->{FALARM_SPEAKER}/$scores->{SCORED_SPEAKER};
+    #printf " SPEAKER ERROR TIME =%10.2f secs (%5.1f percent of scored speaker time)\n",
+    #    $scores->{SPEAKER_ERROR}, 100*$scores->{SPEAKER_ERROR}/$scores->{SCORED_SPEAKER};
+    #printf "SPEAKER ERROR WORDS =%7d         (%5.1f percent of scored speaker words)\n",
+    #    $scores->{ERROR_WORDS}, 100*$scores->{ERROR_WORDS}/$scores->{SCORED_WORDS};
+    #print "---------------------------------------------\n";
+    #
+    #
+    #
+    printf "SCORED SPEAKER TIME =%f secs\n", $scores->{SCORED_SPEAKER};
+    printf "MISSED SPEAKER TIME =%f secs\n", $scores->{MISSED_SPEAKER};
+    printf "FALARM SPEAKER TIME =%f secs\n", $scores->{FALARM_SPEAKER};
+    printf "SPEAKER ERROR TIME =%f secs\n", $scores->{SPEAKER_ERROR};
+#    if ($condition eq "ALL") {
+#      printf " OVERALL SPEAKER DIARIZATION ERROR = %.2f percent of scored speaker time\n",
+#         100*($scores->{MISSED_SPEAKER} + $scores->{FALARM_SPEAKER} + $scores->{SPEAKER_ERROR})/
+#	    $scores->{SCORED_SPEAKER};
+#    } else {
+      printf " OVERALL SPEAKER DIARIZATION ERROR = %.2f percent of scored speaker time  %s\n",
+         100*($scores->{MISSED_SPEAKER} + $scores->{FALARM_SPEAKER} + $scores->{SPEAKER_ERROR})/
+    	    $scores->{SCORED_SPEAKER}, "`($condition)";
+#    }
+    print "---------------------------------------------\n";
+    printf " Speaker type confusion matrix -- speaker weighted\n";
+    summarize_speaker_type_performance ("NSPK", $scores->{TYPE}{NSPK});
+    print "---------------------------------------------\n";
+    printf " Speaker type confusion matrix -- time weighted\n";
+    summarize_speaker_type_performance ("TIME", $scores->{TYPE}{TIME});
+    print "---------------------------------------------\n";
+}
+
+#################################
+
+sub summarize_speaker_type_performance {
+
+    my ($class, $stats) = @_;
+    my ($ref_type, $sys_type, $sys_stat);
+
+    print "  REF\\SYS (count)      " if $class eq "NSPK";
+    print "  REF\\SYS (seconds)    " if $class eq "TIME";
+    foreach $sys_type ((sort keys %{$stats->{SYS}}), $miss_name) {
+	printf "%-20s", $sys_type;
+    }
+    print "\n";
+
+    my $ref_tot = 0;
+    foreach $ref_type (keys %{$stats->{REF}}) {
+	$ref_tot += $stats->{REF}{$ref_type};
+    }
+
+    foreach $ref_type ((sort keys %{$stats->{REF}}), $fa_name) {
+	printf "%-16s", $ref_type;
+	foreach $sys_type ((sort keys %{$stats->{SYS}}), $miss_name) {
+	    next if $ref_type eq $fa_name and $sys_type eq $miss_name;
+	    $sys_stat = $stats->{JOINT}{$ref_type}{$sys_type};
+	    $sys_stat = 0 unless defined $sys_stat;
+	    printf "%11d /%6.1f",   $sys_stat, min(999.9,$ref_tot ? 100*$sys_stat/$ref_tot : 9E9) if $class eq "NSPK";
+	    printf "%11.2f /%6.1f", $sys_stat, min(999.9,$ref_tot ? 100*$sys_stat/$ref_tot : 9E9) if $class eq "TIME";
+	    print "%";
+	}
+	print "\n";
+    }
+}
+
+#################################
+
+sub map_speakers {
+
+    my ($spkr_overlap) = @_;
+
+#compute the costs
+    my $cost = {};
+    foreach my $ref_spkr (keys %$spkr_overlap) {
+	foreach my $sys_spkr (keys %{$spkr_overlap->{$ref_spkr}}) {
+	    $cost->{$ref_spkr}{$sys_spkr} = -$spkr_overlap->{$ref_spkr}{$sys_spkr};
+	}
+    }
+
+#find the mapping that maximizes the cumulative match time between ref and sys spkrs
+    my $map = weighted_bipartite_graph_match ($cost);
+    return $map;
+}
+
+#################################
+
+sub inverse_speaker_map {
+
+    my ($speaker_map) = @_;
+    my ($speaker, $inverse_speaker_map);
+
+    foreach $speaker (keys %$speaker_map) {
+	$inverse_speaker_map->{$speaker_map->{$speaker}} = $speaker;
+    }
+    return $inverse_speaker_map;
+}
+
+#################################
+
+sub print_speaker_map {
+
+    my ($spkr_map, $time_overlap) = @_;
+    my ($ref_spkr, $sys_spkr);
+
+    foreach $ref_spkr (sort keys %$time_overlap) {
+	$sys_spkr = $spkr_map->{$ref_spkr};
+	print "'$ref_spkr' => ", defined $sys_spkr ? "'$sys_spkr'\n" : "<nil>\n";
+	foreach $sys_spkr (sort keys %{$time_overlap->{$ref_spkr}}) {
+	    my $time = $time_overlap->{$ref_spkr}{$sys_spkr};
+	    printf "%9.2f secs matched to '$sys_spkr'\n", defined $time ? $time : 0;
+	}
+    }
+}
+
+#################################
+
+sub start_speaker_map_file {
+    my ($outFile) = @_;
+    open (FILE, ">$outFile") || die "Error: Unable to open speaker map CSV file '$outFile' for write";
+    print FILE "File,Channel,RefSpeaker,SysSpeaker,isMapped,timeOverlap\n";
+    close FILE;
+}
+
+#################################
+
+sub update_speaker_map_file {
+
+    my ($spkr_map, $time_overlap, $file, $chnl, $outFile) = @_;
+
+    open (FILE, ">>$outFile") || die "Error: Failed to open speaker map CSV file '$outFile' for append";
+    foreach my $ref_spkr (sort keys %$time_overlap) {
+	foreach my $sys_spkr (sort keys %{$time_overlap->{$ref_spkr}}) {
+	    my $time = sprintf("%.4f",$time_overlap->{$ref_spkr}{$sys_spkr});
+	    print FILE "$file,$chnl,$ref_spkr,$sys_spkr";
+	    print FILE ",".((defined($spkr_map->{$ref_spkr}) && $sys_spkr eq $spkr_map->{$ref_spkr}) ? "mapped" : "notmapped");
+	    print FILE ",$time\n";
+	}
+    }
+    close FILE,
+}
+
+#################################
+
+sub print_speaker_segs {
+
+    my ($segs, $file, $chnl) = @_;
+    my ($seg, @segs, $spkr, $sep);
+
+    @segs = @$segs;
+    while ($seg = shift @segs) {
+	printf "beg/dur/end = %7.3f/%7.3f/%7.3f; REF = (", $seg->{TBEG}, $seg->{TDUR}, $seg->{TEND};
+	print "<none>" unless defined keys %{$seg->{REF}};
+	$sep = "";
+	foreach $spkr (sort keys %{$seg->{REF}}) {
+	    print "$sep$spkr";
+	    $sep = ", ";
+	}
+	print "); SYS = (";
+	$sep = "";
+	print "<none>" unless defined keys %{$seg->{SYS}};
+	foreach $spkr (sort keys %{$seg->{SYS}}) {
+	    print "$sep$spkr";
+	    $sep = ", ";
+	}
+	print "); file = $file; chnl = $chnl\n";
+    }
+}
+
+#################################
+
+sub sort_time {
+
+    my ($token, $key) = @_;
+
+    my $time = $token->{"R$key"};
+    $time = $token->{$key} if not defined $time;
+    return int(100*$time+0.5)/100
+}
+
+#################################
+
+sub display_metadata_mapping {
+
+    my ($file, $chnl, $ref_rttm, $sys_rttm, $ref_wds) = @_;
+    my ($type, $sys_token, @events, $event, %type_cnt);
+    my ($mapped, $beg_mapped, $end_mapped, $whole, $spkr_map, $sys_speaker_field);
+    my %ref_tag = (NOSCORE        => "XS", NO_RT_METADATA => "NM", SEGMENT        => "SG", SPEAKER        => "SP",
+		   SU             => "SU", "A/P"          => "AP", "NON-SPEECH"   => "NS", EDIT           => "ED",
+		   FILLER         => "FL", IP             => "IP", CB             => "CB", "NON-LEX"      => "NL",
+		   LEXEME         => "LX");
+    my %sys_tag = (SPEAKER        => "SP", SU             => "SU", EDIT           => "ED", FILLER         => "FL",
+		   IP             => "IP", LEXEME         => "LX");
+
+#create a vector of rttm events
+    foreach my $token (@$ref_rttm) {
+	next unless defined $ref_tag{$token->{TYPE}};
+	push @events, {EVENT => "BEG", TIME => sort_time ($token, "TBEG"), TYPE => $token->{TYPE}, SRC => "REF", TOKEN => $token};
+	push @events, {EVENT => "END", TIME => sort_time ($token, "TEND"), TYPE => $token->{TYPE}, SRC => "REF", TOKEN => $token}
+	    unless $token->{TYPE} =~ /^(IP|CB)$/;
+	$token->{COUNT} = ++$type_cnt{$token->{TYPE}};
+    }
+    foreach my $token (@$sys_rttm) {
+	next unless defined $sys_tag{$token->{TYPE}};
+	push @events, {EVENT => "BEG", TIME => sort_time ($token, "TBEG"), TYPE => $token->{TYPE}, SRC => "SYS", TOKEN => $token};
+	push @events, {EVENT => "END", TIME => sort_time ($token, "TEND"), TYPE => $token->{TYPE}, SRC => "SYS", TOKEN => $token}
+	    unless $token->{TYPE} =~ /^(IP|CB)$/;
+    }
+
+    @events = sort sort_events @events;
+
+    $spkr_map = inverse_speaker_map ($speaker_map{$file}{$chnl});
+
+    print "\nChronological display of sys data aligned with ref data for file '$file', channel '$chnl'\n";
+    print "----------------------- reference ----------------------- | mapped | --------------------- system output ---------------------\n";
+    print "    --type-- -subtyp- -----word/spkr-----  -tbeg-  -tend- | ref_ID |     --type-- -subtyp- -----word/spkr-----  -tbeg-  -tend-\n";
+
+    while (@events) {
+        my ($token, $ref, $ref_beg, $ref_end, $sys, $sys_beg, $sys_end);
+	while (@events and
+	       (not $token or
+		$token eq $events[0]->{TOKEN} or
+		($events[0]->{TOKEN}{MAPPTR} and
+		 $token eq $events[0]->{TOKEN}{MAPPTR}))) { # collect events to display on the same line
+	    $event = shift @events;
+	    $token = $event->{TOKEN};
+	    $event->{SRC} eq "REF" ? ($ref = $token, ($event->{EVENT} eq "BEG" ? $ref_beg : $ref_end) = 1) :
+	                             ($sys = $token, ($event->{EVENT} eq "BEG" ? $sys_beg : $sys_end) = 1);
+	}
+	if ($ref) {
+	    printf "%-3.3s %-8.8s %-8.8s %-19.19s%8s%8s | %-6.6s |",
+	    (($ref->{TYPE} =~ /^(IP|CB)$/ or ($ref_beg and $ref_end)) ? "" : ($ref_beg ? "beg" : "end")),
+	    $ref->{TYPE}, $ref->{SUBT},
+	    $ref->{WORD} ne "<na>" ? uc $ref->{WORD} : $ref->{SPKR},
+	    $ref_beg ? (sprintf "%8.2f", $ref->{TBEG}) : "",
+	    $ref_end ? (sprintf "%8.2f", $ref->{TEND}) : "",
+	    $ref->{MAPPTR} ? (sprintf "%s%d", $ref_tag{$ref->{TYPE}}, $ref->{COUNT}) :
+		($md_subtypes{$ref->{TYPE}} ? "*Miss*" : "");
+	} elsif ($sys) {
+	    $ref = $sys->{MAPPTR};
+	    printf "%s%8s%8s | %-6.6s |", " "x41,
+	    $sys_beg ? (sprintf "%8.2f", defined $sys->{RTBEG} ? $sys->{RTBEG} : $sys->{TBEG}) : "",
+	    $sys_end ? (sprintf "%8.2f", defined $sys->{RTEND} ? $sys->{RTEND} : $sys->{TEND}) : "",
+	    $ref ? (sprintf "%s%d", $sys_tag{$ref->{TYPE}}, $ref->{COUNT}) :
+		($md_subtypes{$sys->{TYPE}} ? "**FA**" : "");
+	}
+	if ($sys) {
+	    $sys_speaker_field = $sys ? $sys->{SPKR} : "";
+	    $sys_speaker_field .= "=>$spkr_map->{$sys->{SPKR}}" if $spkr_map->{$sys->{SPKR}};
+	    printf "%3.3s %-8.8s %-8.8s %-19.19s%8s%8s",
+	    (($sys->{TYPE} =~ /^(IP|CB)$/ or ($sys_beg and $sys_end)) ? "" : ($sys_beg ? "beg" : "end")),
+	    $sys->{TYPE}, $sys->{SUBT},
+	    $sys->{WORD} ne "<na>" ? uc $sys->{WORD} : $sys_speaker_field,
+	    $sys_beg ? (sprintf "%8.2f", $sys->{TBEG}) : "",
+	    $sys_end ? (sprintf "%8.2f", $sys->{TEND}) : "";
+	    if ($md_subtypes{$sys->{TYPE}} and $ref = $sys->{MAPPTR}) {
+		my $dw = $sys_end ?
+		    ($ref->{WEND} <= $sys->{RWEND} ?
+		     delta_metadata_error_words ("END", max($ref->{WEND}, $sys->{RWBEG}-1), $sys->{RWEND}, $ref_wds) :
+		     delta_metadata_error_words ("END", $ref->{WEND}, max($ref->{WBEG}-1, $sys->{RWEND}), $ref_wds)) :
+		    ($ref->{WBEG} <= $sys->{RWBEG} ?
+		     delta_metadata_error_words ("BEG", $ref->{WBEG}, min(1+$ref->{WEND}, $sys->{RWBEG}), $ref_wds) :
+		     delta_metadata_error_words ("BEG", min($ref->{WBEG}, 1+$sys->{RWEND}), $sys->{RWBEG}, $ref_wds));
+		print " dw=$dw" if abs ($dw) > 0;
+	    }
+	}
+	print "\n";
+    }
+}
+
+#################################
+
+sub sort_events {
+
+    return ($a->{TIME} <=> $b->{TIME} or
+	    $event_order{$a->{EVENT}} <=> $event_order{$b->{EVENT}} or
+	    (($type_order{$a->{TYPE}} <=> $type_order{$b->{TYPE}})*($a->{EVENT} eq "END" ? -1 : 1)) or
+	    $source_order{$a->{SRC}} <=> $source_order{$b->{SRC}});
+}
+
+#################################
+
+sub weighted_bipartite_graph_match {
+    my ($score) = @_;
+
+    my $required_precision = 1E-12;
+    my $INF = 1E30;
+    my (@row_mate, @col_mate, @row_dec, @col_inc);
+    my (@parent_row, @unchosen_row, @slack_row, @slack);
+    my ($k, $l, $row, $col, @col_min, $cost, %cost);
+    my $t = 0;
+
+    unless (defined $score) {
+	warn "input to BGM is undefined\n";
+	return undef;
+    }
+    return {} if (keys %$score) == 0;
+
+    my @rows = sort keys %{$score};
+    my $miss = "miss";
+    $miss .= "0" while exists $score->{$miss};
+    my (@cols, %cols);
+    my $min_score = $INF;
+    foreach $row (@rows) {
+	foreach $col (keys %{$score->{$row}}) {
+	    $min_score = min($min_score,$score->{$row}{$col});
+	    $cols{$col} = $col;
+	}
+    }
+    @cols = sort keys %cols;
+    my $fa = "fa";
+    $fa .= "0" while exists $cols{$fa};
+    my $reverse_search = @rows < @cols; # search is faster when ncols <= nrows
+    foreach $row (@rows) {
+	foreach $col (keys %{$score->{$row}}) {
+	    ($reverse_search ? $cost{$col}{$row} : $cost{$row}{$col})
+		= $score->{$row}{$col} - $min_score;
+	}
+    }
+    push @rows, $miss;
+    push @cols, $fa;
+    if ($reverse_search) {
+	my @xr = @rows;
+	@rows = @cols;
+	@cols = @xr;
+    }
+
+    my $nrows = @rows;
+    my $ncols = @cols;
+    my $nmax = max($nrows,$ncols);
+    my $no_match_cost = -$min_score*(1+$required_precision);
+
+    # subtract the column minimas
+    for ($l=0; $l<$nmax; $l++) {
+	$col_min[$l] = $no_match_cost;
+	next unless $l < $ncols;
+	$col = $cols[$l];
+	foreach $row (keys %cost) {
+	    next unless defined $cost{$row}{$col};
+	    my $val = $cost{$row}{$col};
+	    $col_min[$l] = $val if $val < $col_min[$l];
+	}
+    }
+
+    # initial stage
+    for ($l=0; $l<$nmax; $l++) {
+	$col_inc[$l] = 0;
+	$slack[$l] = $INF;
+    }
+
+  ROW:
+    for ($k=0; $k<$nmax; $k++) {
+	$row = $k < $nrows ? $rows[$k] : undef;
+	my $row_min = $no_match_cost;
+	for (my $l=0; $l<$ncols; $l++) {
+	    my $col = $cols[$l];
+	    my $val = ((defined $row and defined $cost{$row}{$col}) ? $cost{$row}{$col}: $no_match_cost) - $col_min[$l];
+	    $row_min = $val if $val < $row_min;
+	}
+	$row_dec[$k] = $row_min;
+	for ($l=0; $l<$nmax; $l++) {
+	    $col = $l < $ncols ? $cols[$l]: undef;
+	    $cost = ((defined $row and defined $col and defined $cost{$row}{$col}) ?
+		     $cost{$row}{$col} : $no_match_cost) - $col_min[$l];
+	    if ($cost==$row_min and not defined $row_mate[$l]) {
+		$col_mate[$k] = $l;
+		$row_mate[$l] = $k;
+                # matching row $k with column $l
+		next ROW;
+	    }
+	}
+	$col_mate[$k] = -1;
+	$unchosen_row[$t++] = $k;
+    }
+
+    goto CHECK_RESULT if $t == 0;
+
+    my $s;
+    my $unmatched = $t;
+    # start stages to get the rest of the matching
+    while (1) {
+	my $q = 0;
+
+	while (1) {
+	    while ($q < $t) {
+		# explore node q of forest; if matching can be increased, update matching
+		$k = $unchosen_row[$q];
+		$row = $k < $nrows ? $rows[$k] : undef;
+		$s = $row_dec[$k];
+		for ($l=0; $l<$nmax; $l++) {
+		    if ($slack[$l]>0) {
+			$col = $l < $ncols ? $cols[$l]: undef;
+			$cost = ((defined $row and defined $col and defined $cost{$row}{$col}) ?
+				 $cost{$row}{$col} : $no_match_cost) - $col_min[$l];
+			my $del = $cost - $s + $col_inc[$l];
+			if ($del < $slack[$l]) {
+			    if ($del == 0) {
+				goto UPDATE_MATCHING unless defined $row_mate[$l];
+				$slack[$l] = 0;
+				$parent_row[$l] = $k;
+				$unchosen_row[$t++] = $row_mate[$l];
+			    }
+			    else {
+				$slack[$l] = $del;
+				$slack_row[$l] = $k;
+			    }
+			}
+		    }
+		}
+
+		$q++;
+	    }
+
+	    # introduce a new zero into the matrix by modifying row_dec and col_inc
+	    # if the matching can be increased update matching
+	    $s = $INF;
+	    for ($l=0; $l<$nmax; $l++) {
+		if ($slack[$l] and ($slack[$l]<$s)) {
+		    $s = $slack[$l];
+		}
+	    }
+	    for ($q = 0; $q<$t; $q++) {
+		$row_dec[$unchosen_row[$q]] += $s;
+	    }
+
+	    for ($l=0; $l<$nmax; $l++) {
+		if ($slack[$l]) {
+		    $slack[$l] -= $s;
+		    if ($slack[$l]==0) {
+			# look at a new zero and update matching with col_inc uptodate if there's a breakthrough
+			$k = $slack_row[$l];
+			unless (defined $row_mate[$l]) {
+			    for (my $j=$l+1; $j<$nmax; $j++) {
+				if ($slack[$j]==0) {
+				    $col_inc[$j] += $s;
+				}
+			    }
+			    goto UPDATE_MATCHING;
+			}
+			else {
+			    $parent_row[$l] = $k;
+			    $unchosen_row[$t++] = $row_mate[$l];
+			}
+		    }
+		}
+		else {
+		    $col_inc[$l] += $s;
+		}
+	    }
+	}
+
+      UPDATE_MATCHING:  # update the matching by pairing row k with column l
+	while (1) {
+	    my $j = $col_mate[$k];
+	    $col_mate[$k] = $l;
+	    $row_mate[$l] = $k;
+            # matching row $k with column $l
+	    last UPDATE_MATCHING if $j < 0;
+	    $k = $parent_row[$j];
+	    $l = $j;
+	}
+
+	$unmatched--;
+	goto CHECK_RESULT if $unmatched == 0;
+
+	$t = 0;  # get ready for another stage
+	for ($l=0; $l<$nmax; $l++) {
+	    $parent_row[$l] = -1;
+	    $slack[$l] = $INF;
+	}
+	for ($k=0; $k<$nmax; $k++) {
+	    $unchosen_row[$t++] = $k if $col_mate[$k] < 0;
+	}
+    }  # next stage
+
+  CHECK_RESULT:  # rigorously check results before handing them back
+    for ($k=0; $k<$nmax; $k++) {
+	$row = $k < $nrows ? $rows[$k] : undef;
+	for ($l=0; $l<$nmax; $l++) {
+	    $col = $l < $ncols ? $cols[$l]: undef;
+	    $cost = ((defined $row and defined $col and defined $cost{$row}{$col}) ?
+		     $cost{$row}{$col} : $no_match_cost) - $col_min[$l];
+	    if ($cost < ($row_dec[$k] - $col_inc[$l])) {
+		next unless $cost < ($row_dec[$k] - $col_inc[$l]) - $required_precision*max(abs($row_dec[$k]),abs($col_inc[$l]));
+		warn "BGM: this cannot happen: cost{$row}{$col} ($cost) cannot be less than row_dec{$row} ($row_dec[$k]) - col_inc{$col} ($col_inc[$l])\n";
+		return undef;
+	    }
+	}
+    }
+
+    for ($k=0; $k<$nmax; $k++) {
+	$row = $k < $nrows ? $rows[$k] : undef;
+	$l = $col_mate[$k];
+	$col = $l < $ncols ? $cols[$l]: undef;
+	$cost = ((defined $row and defined $col and defined $cost{$row}{$col}) ?
+		 $cost{$row}{$col} : $no_match_cost) - $col_min[$l];
+	if (($l<0) or ($cost != ($row_dec[$k] - $col_inc[$l]))) {
+	    next unless $l<0 or abs($cost - ($row_dec[$k] - $col_inc[$l])) > $required_precision*max(abs($row_dec[$k]),abs($col_inc[$l]));
+	    warn "BGM: every row should have a column mate: row $row doesn't, col: $col\n";
+	    return undef;
+	}
+    }
+
+    my %map;
+    for ($l=0; $l<@row_mate; $l++) {
+	$k = $row_mate[$l];
+	$row = $k < $nrows ? $rows[$k] : undef;
+	$col = $l < $ncols ? $cols[$l]: undef;
+	next unless defined $row and defined $col and defined $cost{$row}{$col};
+	$reverse_search ? ($map{$col} = $row) : ($map{$row} = $col);
+    }
+    return {%map};
+}
\ No newline at end of file