#! /usr/bin/perl
#
# Special purpose program for Unix/Linux:
# Read all arguments as aligned praat label files with only a phoneme tier
# Calculates Mean Absolute Difference statistics for all files
#
# Use:
# The aligned label files are in ./Labels/validation/<SpeakerID>/ASPEX
#
# Call:
# ./ValidateSegmentation.pl ./Labels/validation/F28G/ASPEX/F28G1FPA*
#
# This will check all files in F28G whose names start with 'F28G1FPA'
#
#    Copyright (C) 2000, 2001  R.J.J.H. van Son
# 
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
# 
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
# 
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
require 'dtw_phonemes.pl';
require 'SentenceLabel.pl';

# Define the sonority of phonemes
my %Sonority = (
'p' => '1',
'b' => '2',
't' => '1',
'd' => '2',
'k' => '1',
'g' => '2',
'f' => '3',
'v' => '4',
's' => '0',
'z' => '4',
'S' => '3',
'Z' => '4',
'x' => '3',
'G' => '4',
'h' => '1',
'N' => '5',
'm' => '5',
'n' => '5',
'J' => '6',
'l' => '6',
'r' => '6',
'w' => '7',
'j' => '7',
'I' => '8',
'E' => '8',
'A' => '8',
'O' => '8',
'Y' => '7',
'i' => '7',
'y' => '7',
'e' => '8',
'2' => '8',
'a' => '9',
'o' => '8',
'u' => '7',
'@' => '6',
'9' => '8',
'E+' => '8',
'9+' => '8',
'O+' => '8',
'E:' => '8',
'9:' => '7',
'O:' => '8',
'E~' => '8',
'A~' => '8',
'O~' => '8',
'Y~' => '7',

'I:' => '8',
'A:' => '8',
'Y:' => '7',
'i:' => '7',
'y:' => '7',
'e:' => '8',
'2:' => '8',
'a:' => '9',
'o:' => '8',
'u:' => '7',
'@:' => '6'
);

#
# Split fused items
sub splitItems	# ($Label, $Tier) -> Number of fused items
{
    my $Label = shift || die "No sentenceLabel\n";
    my $Tier = shift || die "No Tier\n";
    
    my $FusedItems = 0;
    
    $Label->presetItem($Tier);
    while($Label->nextItem($Tier) > -1)
    {
	# Handle fused items
	my @ItemList = split(/[\-\_\s]/, $Label->currentValue($Tier));
	@ItemList = ("") if scalar(@ItemList) < 1;
	
	next unless scalar(@ItemList) > 1;
	
	# Store Times
	my $MasterStart = $Label->currentStart($Tier);
	my $MasterEnd = $Label->currentEnd($Tier);
	my $DeltaTime = ($MasterEnd - $MasterStart)/scalar(@ItemList);

	# Write first item
	$Label->currentValue($Tier, shift(@ItemList));
	$Label->nextItem($Tier);
	
	# Iterate over the Items
	my $CurrentItem;
	my $CurrentStart = $MasterStart;
	my $CurrentEnd = $MasterStart + $DeltaTime;
	foreach $CurrentItem (@ItemList)
	{ 
		$Label->insertItemBefore($Tier, $CurrentItem, '', $CurrentEnd);
		$CurrentEnd = $CurrentEnd + $DeltaTime;
		++$FusedItems;
	};
    	
    };
    
    return $FusedItems;
	
}
#
# The DTW parts
#
# Make a diff of two labelfiles
sub diffPhonemeTiers # ($RefLabel, $PattLabel [, \@path, \@distmatr]) -> @diff
{
    my $RefLabel = shift || die "No reference sentenceLabel\n";
    my $PattLabel = shift || die "No pattern sentenceLabel\n";
    my $path      = shift || [];  # Optional
    my $distmatr  = shift || [];  # Optional
    #
    my @reference = @{$RefLabel->{TIER}{PHONEMES}};
    my @pattern = @{$PattLabel->{TIER}{PHONEMES}};
    #
    # Expand fused phonemes
    @reference = map {split(/[\-\_\s]/, $_);} @reference;
    @pattern = map {split(/[\-\_\s]/, $_);} @pattern;
    #
    # Return the DIFF
    return warpFind(\@reference, \@pattern, $path, $distmatr);
}

#
# Print the best path
sub warpPhonemePrint # ($RefLabel, $PattLabel, \@path)
{
    my $RefLabel = shift || die "No reference sentenceLabel\n";
    my $PattLabel = shift || die "No pattern sentenceLabel\n";
    my $path      = shift || die "No path to print\n";
    #
    # Extract phoneme strings
    my @reference = @{$RefLabel->{TIER}{PHONEMES}};
    my @pattern = @{$PattLabel->{TIER}{PHONEMES}};
    #
    # Expand fused phonemes
    @reference = map {split(/[\-\_\s]/, $_);} @reference;
    @pattern = map {split(/[\-\_\s]/, $_);} @pattern;
    #
    # Print path
    warpPrint(\@reference, \@pattern, $path);
    
    #
    return 1;
}

# Define and initialize
my @GlobFileList = @ARGV;

my $FilePattern;
my %IDlist = ();
my %CombinedDiffStats = ();
my %IntraSpeakerStat = ();

foreach $FilePattern (@GlobFileList)
{
    # Get the real filenames (expand * and ?)
    my @FileList = sort(glob("$FilePattern"));
    
    my $FileName;
    my $FusedItems = 0;
    
    # Sort out the duplicates
    foreach $FileName (@FileList)
    {
        $FileName =~ m@[^/]+$@i;
    	my $IDcode = $&;
	$IDcode =~ /\_/;
	$IDcode = $`;
	push(@{$IDlist{$IDcode}}, $FileName);
    };
};
    
# Handle All files
my $IDcode;
foreach $IDcode (keys(%IDlist))
{

    my @IDfiles = @{$IDlist{$IDcode}};
    my $LabelError = "";

    while(($FileName = shift(@IDfiles)))
    {
	    # Read the file
	    my $SourceLabel = new SentenceLabel;
	    next unless $SourceLabel->ReadLabelFile("$FileName");

	    # Normalize labels
	    $SourceLabel->map('PHONEMES', '$_ =~ s/sil/\*/g');
	    $SourceLabel->map('PHONEMES', '$_ =~ s/^\s*[0]\s*$/\*/ig');
	    $SourceLabel->map('PHONEMES', '$_ = (/\S/ ? $_ : "\*");');
	    $SourceLabel->map('PHONEMES', '$_ =~ s/\://ig');
	    $SourceLabel->map('PHONEMES', '$_ =~ s/Ei/E+/ig');
	    $SourceLabel->map('PHONEMES', '$_ =~ s/9y/9+/ig');
	    $SourceLabel->map('PHONEMES', '$_ =~ s/Y[\+]/9+/ig');
	    $SourceLabel->map('PHONEMES', '$_ =~ s/Ou/O+/ig');
	    $SourceLabel->map('PHONEMES', '$_ =~ s/Au/O+/ig');
	    # Expand fused phonemes
	    $SourceLabel->map('PHONEMES', '$_ =~ s/([A-Z0-9\@][\+\:\~]?)(?=[A-Z0-9\@])/\1 /ig');

	    # Remove double silences
	    $SourceLabel->presetItem('PHONEMES');
	    while($SourceLabel->nextItem('PHONEMES') > -1)
	    {
		next unless $SourceLabel->currentValue('PHONEMES') =~ /^([\*\#]+|sil)$/;

		# Remove double silences
		$SourceLabel->removeItem('PHONEMES')
		if $SourceLabel->readNextValue('PHONEMES') =~ /^([\*\#]+|sil)$/;
	    };

	    #
	    # Split fused items
	    $FusedItems += splitItems($SourceLabel, 'PHONEMES');
	    
	    #
	    # Get the same file from the Labels
	    $OrigFileName = $FileName;
	    $OrigFileName =~ s/validation/sentences/ig;
	    if(-e $OrigFileName)
	    {
		    # Read the Aligned labelfile
		    my $CurrentLabel = new SentenceLabel;
		    next unless $CurrentLabel->ReadLabelFile("$OrigFileName");

		    # Normalize labels
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/sil/\*/g');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/^\s*[0]\s*$/\*/ig');
		    $CurrentLabel->map('PHONEMES', '$_ = (/\S/ ? $_ : "\*");');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/\://ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Ei/E+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/9y/9+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Y[\+]/9+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Ou/O+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Au/O+/ig');
		    # Expand fused phonemes
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/([A-Z0-9\@][\+\:\~]?)(?=[A-Z0-9\@])/\1 /ig');

		    # Remove double silences
		    $CurrentLabel->presetItem('PHONEMES');
		    while($CurrentLabel->nextItem('PHONEMES') > -1)
		    {
			next unless $CurrentLabel->currentValue('PHONEMES') =~ /^([\*\#]+|sil)$/;

			# Remove double silences
			$CurrentLabel->removeItem('PHONEMES')
			if $CurrentLabel->readNextValue('PHONEMES') =~ /^([\*\#]+|sil)$/;
		    };

		    #
		    # Split fused items
		    splitItems($CurrentLabel, 'PHONEMES');

		    #
		    # Get diff list
		    my @path = ();
		    my @diff = diffPhonemeTiers($CurrentLabel, $SourceLabel, \@path);
		    my $diffStats = $CurrentLabel->diffTimeTier('PHONEMES', $SourceLabel, \@diff);
		    my $i;
		    foreach $i (keys(%$diffStats))
		    {
		    	    if($i eq 'AbsList')
			    {
			    	my @AbsList = @{$$diffStats{$i}};
			    	push(@{$IntraSpeakerStats{$i}}, @AbsList);
			    }
			    else
			    {
			    	$IntraSpeakerStats{$i} += $$diffStats{$i};
			    };
		    };

		    # Use for test prints for best path
		    # warpPhonemePrint($TargetLabelFile, $CurrentLabel, \@path);
	    	
	    };

	    # Iterate over the other files
	    my $CurrentFileName;
	    foreach $CurrentFileName (@IDfiles)
	    {
		    # Read the Aligned labelfile
		    my $CurrentLabel = new SentenceLabel;
		    next unless $CurrentLabel->ReadLabelFile("$CurrentFileName");

		    # Normalize labels
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/sil/\*/g');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/^\s*[0]\s*$/\*/ig');
		    $CurrentLabel->map('PHONEMES', '$_ = (/\S/ ? $_ : "\*");');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/\://ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Ei/E+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/9y/9+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Y[\+]/9+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Ou/O+/ig');
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/Au/O+/ig');
		    # Expand fused phonemes
		    $CurrentLabel->map('PHONEMES', '$_ =~ s/([A-Z0-9\@][\+\:\~]?)(?=[A-Z0-9\@])/\1 /ig');

		    # Remove double silences
		    $CurrentLabel->presetItem('PHONEMES');
		    while($CurrentLabel->nextItem('PHONEMES') > -1)
		    {
			next unless $CurrentLabel->currentValue('PHONEMES') =~ /^([\*\#]+|sil)$/;

			# Remove double silences
			$CurrentLabel->removeItem('PHONEMES')
			if $CurrentLabel->readNextValue('PHONEMES') =~ /^([\*\#]+|sil)$/;
		    };

		    #
		    # Split fused items
		    splitItems($CurrentLabel, 'PHONEMES');

		    #
		    # Get diff list
		    my @path = ();
		    my @diff = diffPhonemeTiers($CurrentLabel, $SourceLabel, \@path);
		    my $diffStats = $CurrentLabel->diffTimeTier('PHONEMES', $SourceLabel, \@diff);
		    my $i;
		    foreach $i (keys(%$diffStats))
		    {
		    	    if($i eq 'AbsList')
			    {
			    	my @AbsList = @{$$diffStats{$i}};
			    	push(@{$CombinedDiffStats{$i}}, @AbsList);
			    }
			    else
			    {
			    	$CombinedDiffStats{$i} += $$diffStats{$i};
			    };
		    };

		    # Use for test prints for best path
		    # warpPhonemePrint($TargetLabelFile, $CurrentLabel, \@path);
	    };
    };
};

# Intra-Speaker
my $DiffCount = $IntraSpeakerStats{DiffCount};
$DiffCount = 1 unless $DiffCount > 1;
my $MAD = $IntraSpeakerStats{AbsoluteDiff}/$DiffCount;
my $SumDiff = $IntraSpeakerStats{SumDiff};
my $SumSquareDiff = $IntraSpeakerStats{SumSquareDiff};
my $DiffVar = $DiffCount > 1 ? ($SumSquareDiff - $SumDiff * $SumDiff / $DiffCount)/($DiffCount - 1) : 0;
my $DiffSD = $DiffVar > 0 ? sqrt($DiffVar) : -1;
my $CountSubstitution = $IntraSpeakerStats{CountSubstitution}/$DiffCount;
my $CountInsDel = $IntraSpeakerStats{CountInsDel}/$DiffCount;
my @AbsList = sort {$a <=> $b} @{$IntraSpeakerStats{AbsList}};
my $Median = $AbsList[$#AbsList/2];
my $SeventyFivePercentil = $AbsList[0.75*$#AbsList];
my $NinetyFivePercentil = $AbsList[0.95*$#AbsList];
my $TwentyFivePercentil = $AbsList[0.25*$#AbsList];
print << "STATISTICS";
MAD: $MAD
SDev: $DiffSD
Inserts/Deletions: $CountInsDel
Substitutions: $CountSubstitution
N: $DiffCount
$#AbsList
Median: $Median
25%: $TwentyFivePercentil
75%: $SeventyFivePercentil
95%: $NinetyFivePercentil
$FusedItems
STATISTICS

# Inter-Speaker
$DiffCount = $CombinedDiffStats{DiffCount};
$DiffCount = 1 unless $DiffCount > 1;
$MAD = $CombinedDiffStats{AbsoluteDiff}/$DiffCount;
$SumDiff = $CombinedDiffStats{SumDiff};
$SumSquareDiff = $CombinedDiffStats{SumSquareDiff};
$DiffVar = $DiffCount > 1 ? ($SumSquareDiff - $SumDiff * $SumDiff / $DiffCount)/($DiffCount - 1) : 0;
$DiffSD = $DiffVar > 0 ? sqrt($DiffVar) : -1;
$CountSubstitution = $CombinedDiffStats{CountSubstitution}/$DiffCount;
$CountInsDel = $CombinedDiffStats{CountInsDel}/$DiffCount;
@AbsList = sort {$a <=> $b} @{$CombinedDiffStats{AbsList}};
$Median = $AbsList[$#AbsList/2];
$SeventyFivePercentil = $AbsList[0.75*$#AbsList];
$NinetyFivePercentil = $AbsList[0.95*$#AbsList];
$TwentyFivePercentil = $AbsList[0.25*$#AbsList];
print << "STATISTICS1";
INTER-SPEAKER
MAD: $MAD
SDev: $DiffSD
Inserts/Deletions: $CountInsDel
Substitutions: $CountSubstitution
N: $DiffCount
$#AbsList
Median: $Median
25%: $TwentyFivePercentil
75%: $SeventyFivePercentil
95%: $NinetyFivePercentil
$FusedItems
STATISTICS1

