#!/usr/bin/perl -w
#
#    POINT TO PERL5 EXECUTABLE

#use strict;

##############################
# // REVISION HISTORY
# // Release v1.0  -  05/2000
#         Initial release, evaluation software code to meet the 
#         specifications of the 2000 Speaker Recognition Evaluation
#         of segmentation.  This algorithm uses the best match between
#         hypothesis states and reference states. 
#
#         NOTE TO CODE-READERS: For the original release a "state" was 
#         equivalent to "speaker", so variable names refer to variants 
#         of "speaker" not state.
#
#         Please read the 2000 Speaker Evaluation Plan for a detailed 
#         description of the segmentation algorithm:  
#               www.nist.gov/speech/tests/spk/2000
#
# // Release v2.0  -  06/2000
#         Reports segmentation ERROR
# 
# // Release v2.1  -  08/2000
#         Packaged with examples and documentation, released for public use.
#
##############################

my $usage = "\n\n$0 -i <index_file> -c <collar> -b <buffer>\n\n".
    "Description:  This Perl script performs segmentation scoring, first\n".
    "              used in the 2000 NIST speaker recognition evaluation.\n\n".
    "Required arguments:\n".
    "  -i <index_file> contains one or more pairs of hypothesis and \n".
    "      reference files to be scored, one pair per line, with the \n".
    "      hypothesis file listed first\n".
    "         The format for both the hypothesis and reference file is: \n".
    "             <START-TIME> <END-TIME> <STATE>\n".
    "              ...\n".
    "         NOTE: States may be different identifiers between \n".
    "               hyp and ref files, best match algorithm is applied. \n".
    "  -c <collar> a decimal number, defines the boundary around each \n".
    "      reference segment that is to be ignored in scoring.\n".
    "  -b <buffer> a decimal number, defines the size of gap that will \n".
    "      be close between two contigious segments in the same state\n".
    "\n".
    "Output is to STDOUT: \n".
    "     <W> :: Total time in a state to be segmented  (in seconds)\n".
    "     <X> :: Time in a correctly segmented state    (in seconds)\n".
    "     <Y> :: Time in an incorrectly segmented state (in seconds)\n".
    "     <Z> :: SEGMENTATION ERROR\n".
    "         where Z=Y/W\n".
    "\n";

# set the command line arguements
#
use vars qw ($opt_i $opt_c $opt_b);
require "getopts.pl";
&Getopts ('i:c:b:');
die "Error in command line $usage"
    unless (defined($opt_i) and defined($opt_c) and defined($opt_b));

my $mainNDXfile = $opt_i;
my $COLLAR = $opt_c;
my $INTERBUF = $opt_b;

sub load_SID{
    my ($file) = @_;
    my (%SID_struct) = ();
    my ($begin, $end, $spkr);

    open(REF,"<$file") || die "Error: Unable to open file '$file'";
    while(<REF>){
	($begin, $end, $spkr) = split;

	push @{ $SID_struct{$spkr} }, [ ($begin, $end) ];
    }
    close REF;
    
    %SID_struct;
}

sub array_load_SID{
    my ($file) = @_;
    my (@SID_struct) = ();
    my ($begin, $end, $spkr);

    open(REF,"<$file") || die "Error: Unable to open file '$file'";
    while(<REF>){
	($begin, $end, $spkr) = split;

	push (@SID_struct,join(" ",$begin, $end, $spkr));
   }
    close REF;
    
    @SID_struct;
}

sub transform_REF{
    my ($oldref) = @_;
    my (%SID_struct) = ();
    my ($begin, $end, $spkr);

    foreach (@$oldref) {
	($begin, $end, $spkr) = split;

	push @{ $SID_struct{$spkr} }, [ ($begin, $end) ];
    }
    
    %SID_struct;
}

sub score_spkrs{
    my ($refspkr, $hypspkr) = @_;
    my $rbta;
    my $hbta;

#    print "speakers ".$refspkr." ".$hypspkr."\n";
    my ($rbegin, $rend, $hbegin, $hend);
    my $retval = 0;
    foreach $rbta(@{$REF_sid{$refspkr}}){
        ($rbegin, $rend) = (@$rbta[0], @$rbta[1]);
        foreach $hbta(@{$HYP_sid{$hypspkr}}){
            ($hbegin, $hend) = (@$hbta[0], @$hbta[1]);
            $retval += match($rbegin, $rend, $hbegin, $hend);
        }
    }

    return $retval;

}

sub match{
    my ($rbegin, $rend, $hbegin, $hend) = @_;
    if ($rend <= $hbegin){
	return 0;
    }
    if ($hend <= $rbegin){
        return 0;
    }
    my $begin = $rbegin;
    my $end = $rend;
    $begin = $hbegin if ($hbegin > $begin);
    $end = $hend if ($hend < $rend);
#    print "hyp:  ".$rbegin." ".$rend."   ref:  ".$hbegin." ".$hend;
#    print "    out:  ".$begin." ".$end."\n";
    return $end - $begin;
    
}


$allsegdur = 0;
$allsegscore = 0;

# // READ IN THE MASTER INDEX into an array
open(INDEX,$mainNDXfile) ||
    die("Error opening the master index file\n");
@masterIndexData=<INDEX>;
close(INDEX);

foreach (@masterIndexData) {
    ($hypFile, $refFile) = split;
#    print "MIF entry:  ", $refFile, $hypFile, "\n";

#modifies the reference data to support ignored collars
#and the collapsing of continuous same speaker segments
    my @NEWREF_sid = array_load_SID($refFile);
    my @cleanref = clean_ref(\@NEWREF_sid);
    %REF_sid = transform_REF(\@cleanref);    
#   
    %HYP_sid = load_SID($hypFile);

my $bta;
my $spkr;
my $score;
my $hypspkr;
my $refspkr;
my %matrix;
my $numhyp = 0;
my $numref = 0;
my $scount;
my $maxscore;
my %duration;
use vars qw ($BEST_score);
use vars qw ($level);

#initialize BEST_score to large value
$BEST_score = 0;
$count = 0;
$level = 0;
$totdur = 0;

#print "\n\nREF speakers\n";
foreach $spkr(keys %REF_sid){
    $numref++;
    $duration{$spkr} = 0;
#    print "Spkr = $spkr\n";
    foreach $bta(@{ $REF_sid{$spkr} }){
        ($rbegin, $rend) = (@$bta[0], @$bta[1]);
	$duration{$spkr} += $rend - $rbegin;
#	print "    ".join(" ",@$bta)."\n";
    }
#    print "    speaker duration = ", $duration{$spkr}, "\n\n";
    $totdur += $duration{$spkr};
}

#print "\n\nHYP speakers\n";
foreach $spkr(keys %HYP_sid){
    $numhyp++;
#    print "Spkr = $spkr\n";
    foreach $bta(@{ $HYP_sid{$spkr} }){
#	print  "    ".join(" ",@$bta)."\n";
    }
}

#print "\n$numref reference speakers with total duration $totdur,  $numhyp hypothesized speakers\n";
for ($scount = $numhyp; $scount < $numref; $scount++){
	push @{ $HYP_sid{"HypNullSpk$scount"} }, [ (0, 0) ];
    }

#    print "\n\nScore Matrix   ";
foreach $refspkr(keys %REF_sid){
#    printf "%8s  ", $refspkr;
}
#printf "\n\n";
foreach $hypspkr(keys %HYP_sid){
#    printf "%12s  ", $hypspkr;
    foreach $refspkr(keys %REF_sid){
        $score = score_spkrs($refspkr, $hypspkr);
        $matrix{$hypspkr}{$refspkr} = $score;
	$hypspkr->{'MAP'} = $hypspkr;
	$refspkr->{'MAP'} = $refspkr;
	undef $hypspkr->{'MAP'};
	undef $refspkr->{'MAP'};
#        printf "%9.2f ", $matrix{$hypspkr}{$refspkr};
    }
#    print "\n";
}
#process score matrix for maximum
#print "calling findmax\n";
Find_Max_Score ($maxscore = 0, \%REF_sid, \%HYP_sid, \%matrix);
#$segscore = $BEST_score / $totdur;
#print "\n\$BEST_score = ", $BEST_score, "    segment score = ", $segscore, "\n\n";
#foreach $spkr(keys %REF_sid){
#    print "RefSpkr $spkr 'MAP'ped to HypSpkr $spkr->{'BEST'}\n";
#}
    $allsegdur += $totdur;
    $allsegscore += $BEST_score;
}

printf "%9.2f :: Total time in a state to be segmented  (in seconds)\n",$allsegdur;
printf "%9.2f :: Time in a correctly segmented state    (in seconds)\n",$allsegscore;
printf "%9.2f :: Time in an incorrectly segmented state (in seconds)\n",$allsegdur-$allsegscore;
printf "%9.2f :: SEGMENTATION ERROR\n\n",($allsegdur-$allsegscore)/$allsegdur;

sub Find_Max_Score{
    my ($prior_score, $REF, $HYP, $scores) = @_;
    my $entry;

#    print "Find_Max_Score:  prior_score = $prior_score, BEST_score = $BEST_score\n";

    $level++;
#    print "level = $level\n";

#find a ref speaker to 'MAP'
    foreach $refspkr(keys %$REF){
#	print "processing ref $refspkr, 'MAP' = $refspkr->{'MAP'}\n";
	if (!defined($refspkr->{'MAP'})){ 
	    foreach $hypspkr(keys %$HYP){
#		print "processing hyp $hypspkr,  'MAP' = $hypspkr->{'MAP'}\n";
		unless (defined $hypspkr->{'MAP'}){
#		    print "hyp $hypspkr found unmarked\n";
		    $refspkr->{'MAP'} = $hypspkr;
		    $hypspkr->{'MAP'} = $refspkr;
		    $entry = $scores->{$hypspkr}{$refspkr};
#		    print "inner loop:  entry = $entry  ";
#		    print "ref, hyp = $refspkr, $hypspkr\n";
		    Find_Max_Score($prior_score+$entry, $REF, $HYP, $scores);
		    undef $refspkr->{'MAP'};
		    undef $hypspkr->{'MAP'};
#		    print "unmarking ref $refspkr, hyp $hypspkr\n";
		}
	    }
	    $level--;
#	    print "end hyp loop, level = $level\n";
	    return;
	}
    }
#all ref speakers have been 'MAP'ped
    $count++;
#    print "count = $count\n";
    if ($prior_score > $BEST_score){
	$BEST_score = $prior_score;
#	print "new BEST_score = $BEST_score\n";
	foreach $refspkr(keys %$REF){
	    $refspkr->{'BEST'} = $refspkr->{'MAP'};
#	    print "RefSpkr $refspkr - BEST is $refspkr->{'BEST'}\n";
	}
    }
    $level--;
#    print "return to level $level\n";
}



sub clean_ref {
    my ($oldref) = @_;
    my (@newref) = ();
    my $first_flag = 0;

#miscellaneous variables
    my $dur;           # duration of segment    
    my $footmp;        # temp swap variable

#contents of oldref
    my $stim;  my $etim;  my $spkr;

#remember previous entry
    my $ostim;  my $oetim;  my $ospkr;


    foreach (@$oldref) {
        ($stim, $etim, $spkr) = split;
#        printf "#DEBUG: Before %5.2f %5.2f %s\n",$stim,$etim,$spkr;
        if ($first_flag == 0) {
#           printf "#debug: %s %s %s\n",$ostim,$stim,$COLLAR;
            $ostim = $stim + $COLLAR;
            $oetim=$etim;
            $ospkr=$spkr;
            $first_flag=1;
        } else {
            if ($spkr eq $ospkr) {
#   Check to combine
                if ( ($stim - $oetim) <= $INTERBUF ) {
#           COMBINE THEM
                    $oetim=$etim;
                } else {
                    $dur=$oetim - $COLLAR - $ostim;
                    if ($dur <= 0) {
#                       printf "#TOO SHORT: %f to %f\n",$ostim,($oetim-$COLLAR);
                    }else{
                        push (@newref,join(" ",$ostim, ($oetim-$COLLAR), $ospkr));
#                       printf "%5.2f %5.2f %s\n",$ostim,($oetim-$COLLAR),$ospkr;
                    }
                    $ostim=$stim+$COLLAR;
                    $oetim=$etim;
                    $ospkr=$spkr;
                }
            } else {
#           CHECK for OVERLAP
                if ($stim < $oetim) {
                     $footmp=$oetim;
                    $oetim=$stim;
                    $stim=$footmp;
                }
                $dur=$oetim - $COLLAR - $ostim;
                if ($dur <= 0) {
#                   printf "#TOO SHORT: %f to %f\n",$ostim,($oetim-$COLLAR);
                }else{
                    push (@newref,join(" ",$ostim, ($oetim-$COLLAR), $ospkr));
#                    printf "%5.2f %5.2f %s\n",$ostim,($oetim-$COLLAR),$ospkr;
                }
                $ostim=$stim+$COLLAR;
                $oetim=$etim;
                $ospkr=$spkr;
            }
        }
    }
    $dur=$oetim - $COLLAR - $ostim;
    if ($dur <= 0) {
#       printf "#TOO SHORT: %f to %f\n",$ostim,($oetim-$COLLAR);
    }else{
        push (@newref,join(" ",$ostim, ($oetim-$COLLAR), $ospkr));
#       printf "%5.2f %5.2f %s\n",$ostim,($oetim-$COLLAR),$ospkr;
    }
    @newref;
}
