#! /usr/bin/perl
#
# Special purpose program for Unix/Linux:
# Read all arguments as aligned praat label files with only a phoneme tier
# and align the original label file with it
# Skips all files that already exist in the target directory
#
# Use:
# The aligned label files are in ./Labels/<SpeakerID>/ASPEX
# The original label files are in ./Labels/<SpeakerID>/prephoneme
# The results will be placed in: ./Labels/<SpeakerID>/phoneme
#
# Call:
# ./AlignAutomaticLabeling.pl ./Labels/F28G/ASPEX/F28G1FPA*
#
# This will convert all files in F28G whose names start with 'F28G1FPA'
#
#
###############################################################################
#
# Copyright R.J.J.H. van Son © 2000, 2001
#
# Author Rob van Son
# Institute of Phonetic Sciences & ACLC
# University of Amsterdam
# Herengracht 338
# NL-1016CG Amsterdam, The Netherlands
# Email: Rob.van.Son@hum.uva.nl
#        rob.van.son@workmail.com
# WWW  : http://www.fon.hum.uva.nl/rob/
# mail:  Institute of Phonetic Sciences
#        University of Amsterdam
#        Herengracht 338
#        NL-1016CG Amsterdam
#        The Netherlands
#        tel +31 205252183
#        fax +31 205252197
#
# License for use and disclaimers
#
# 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'
);

# 
# A function to indicate whether an inserted phoneme
# is more likely to be syllable/word initial or final
sub InitialInsert   # ($Insert, $Previous, $Next)
{
    my $Insert = shift || return -1;
    my $Previous = shift || return -1;
    my $Current = shift || return -1;
   
    # Nothing sticks to a pause
    return 0 if $Current eq '*';
    return 1 if $Previous eq '*';
    #
    # Final inserts
    #
    # Final /n/ of /@n/
    return 0 if $Insert eq 'n' && $Previous eq '@';
    #
    # Insert a N alway final
    return 0 if $Insert eq 'N';
    #
    # Funny combinations
    $InsertClass = $CGN_phonemes{$Insert}[0];
    $PreviousClass = $CGN_phonemes{$Previous}[0];
    $NextClass = $CGN_phonemes{$Current}[0];
    # Spurious vowels stick to the preceding segment
    return 0 if $InsertClass eq 'V';
    # Nasal-Glide
    return 0 if $InsertClass eq 'N' && $NextClass eq 'G';
    # Glide-Nasal
    return 0 if $InsertClass eq 'G' && $NextClass eq 'N';
    # Stop-m
    return 0 if $InsertClass eq 'S' && $Next eq 'm';
    # [xGfv]-Nasal
    return 0 if $Insert =~ /[xGfv]/ && $NextClass eq 'N';
    
    #
    # Inital inserts
    #
    # Next has higher sonority
    return 1 if $Sonority{$Insert} <= $Sonority{$Current};
    #
    # Previous has a lower sonority
    return 1 if $Sonority{$Insert} >= $Sonority{$Previous};
    
    # Default, use initial 
    return 1;
}

# Which phonemes glue to syllparts
sub SyllPartsGlue	# ($CurrentItem, $NextItem) -> 0 (Don't combine), 1 (Combine)
{
	my $CurrentItem = shift || return 0;
	my $NextItem = shift || return 0;
	
	#
	# Vowels and Pauses don't stick
	return 0 if $CGN_phonemes{$CurrentItem}[0] eq 'V' 
	            || $CGN_phonemes{$NextItem}[0] eq 'V';
	# Other is pauses
	return 0 if $CurrentItem eq '*' 
	            || $NextItem eq '*';
		    
	# Consonants just stick
	return 1;
}

# Handle invallid syllables, i.e., those with TWO vowels
sub SyllableSplitter  # (@ItemList) -> @SplitOffItems
{
	my @ItemList = @_;

	return () unless scalar(grep(/^V$/, map {$CGN_phonemes{$_}[0];}  @ItemList) ) > 1;

	# Remove Everything upto the first vowel
	while($CGN_phonemes{shift(@ItemList)}[0] ne 'V'){};
	# Remove first coda
	while($CGN_phonemes{$ItemList[0]}[0] ne 'V' 
	&& $CGN_phonemes{$ItemList[1]}[0] ne 'V'
	&& $Sonority{$ItemList[0]} > $Sonority{$ItemList[1]})
	{
	    shift(@ItemList);
	};
	
	# Return what is left
	return @ItemList;
}

#
# Copy all interval-times from another SentenceLabel.
# Both files MUST have the source-tier and equal numbers of
# items in it.
sub copyTimes # ($TargetLabel, $SourceLabel, $Tier)
{
    my $TargetLabel = shift;
    my $SourceLabel = shift || return -1;
    my $Tier = shift || $Target->{CURRENTTIER} || return -1;
    
    my $Fusedmarker = '=';
    
    my %TierStartPosition = ();
    my %TierEndPosition = ();
    
    # Initialize positions
    $TargetLabel->firstItem($Tier);
    $SourceLabel->presetItem($Tier);
    
    # Get the list of all tiers
    my @TierList = @{$TargetLabel->{TIERORDER}};
    
    # Iterate over the Target Tier
    while($TargetLabel->currentItem($Tier) > -1)
    {
        $SourceLabel->nextItem($Tier);
        my $MasterStart = $SourceLabel->currentStart($Tier);
	my $MasterEnd = $SourceLabel->currentEnd($Tier);
	# Handle fused items
	my @ItemList = split(/[\-\_\s]/, $SourceLabel->currentValue($Tier));
	@ItemList = ("") if scalar(@ItemList) < 1;
	my $DeltaTime = ($MasterEnd - $MasterStart)/scalar(@ItemList);
	
	# Iterate over the Items in the other Sentence Label
	my $CurrentItem;
	my $CurrentStart = $MasterStart;
	my $CurrentEnd = $MasterStart + $DeltaTime;
	foreach $CurrentItem (@ItemList)
	{ 
            # Link to all OTHER tiers (this goes AWEFULLY wrong when this is not the
	    # "innermost" tier)
            my $OtherTier = "";
    	    foreach $OtherTier (@TierList)
	    {
	        # Skip the source tier
	        next if $OtherTier eq $Tier;

		# Align Start
	        my $LinkedItem = $TargetLabel->StartAlignedinTier($Tier, $OtherTier, 
		                                           $TierStartPosition{$OtherTier});
                if($LinkedItem > -1)
	        {
		    # Store position
		    $TierStartPosition{$OtherTier} = $LinkedItem + 1;
		    # Jump to the correct item on the other tier
		    $TargetLabel->currentItem($OtherTier, $LinkedItem);
		    # Set the start time
	    	    $TargetLabel->currentStart($OtherTier, $CurrentStart);
		    # Mark the boundary as "tentative" if it is not the real boundary
		    if($CurrentStart > $MasterStart + $DeltaTime/2)
		    {
		    	$TargetLabel->currentValue($OtherTier,
                      $Fusedmarker.$TargetLabel->currentValue($OtherTier));
		    };
	        };
		
		# Align End
		$LinkedItem = $TargetLabel->EndAlignedinTier($Tier, $OtherTier,
		                                              $TierEndPosition{$OtherTier});
                if($LinkedItem > -1)
	        {
		    # Store position
		    $TierEndPosition{$OtherTier} = $LinkedItem + 1;
		    # Jump to the correct item on the other tier
		    $TargetLabel->currentItem($OtherTier, $LinkedItem);
		    # Set the end time
	    	    $TargetLabel->currentEnd($OtherTier, $CurrentEnd);
		    # Mark the boundary as "tentative" if it is not the real boundary
		    if($CurrentEnd < $MasterEnd - $DeltaTime/2)
		    {
		    	$TargetLabel->currentValue($OtherTier,
                      $TargetLabel->currentValue($OtherTier).$Fusedmarker);
		    };
	        };
	    };
	    # Align the source tier
	    $TargetLabel->currentStart($Tier, $CurrentStart);
	    # Mark the boundary as "tentative" if it is not the real boundary
	    if($CurrentStart > $MasterStart + $DeltaTime/2)
	    {
		 $TargetLabel->currentValue($Tier,
                    $Fusedmarker.$TargetLabel->currentValue($Tier));
	    };
	    $TargetLabel->currentEnd($Tier, $CurrentEnd);
	    # Mark the boundary as "tentative" if it is not the real boundary
	    if($CurrentEnd < $MasterEnd - $DeltaTime/2)
	    {
		  $TargetLabel->currentValue($Tier,
                    $TargetLabel->currentValue($Tier).$Fusedmarker);
	    };
	
	    # Increment the times
	    $CurrentStart = $CurrentEnd;
	    $CurrentEnd += $DeltaTime;
	
	    return 1 unless $TargetLabel->nextItem($Tier) > -1;   # If at the end of the tier
	};
    };
    
    # Ready
    return 1;
}

#
# 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;

foreach $FilePattern (@GlobFileList)
{
    # Get the real filenames (expand * and ?)
    my @FileList = glob("$FilePattern");
    my $FileName;
    
    # Handle All files
    foreach $FileName (@FileList)
    {

	my $LabelError = "";
	
	# Take apart the file path to get the relevant directories and ID numbers
	# e.g., "./Labels/F28G/ASPEX/F28G1FPA1VCVA_rvs.aspex"
	# -> $`=".", $1="Labels", $2="F28G", $3="ASPEX", $4="F28G1FPA1VCVA" , $5="aspex"
	$FileName =~ m@/([\w]+)/([\w]+)/([^/\.\_]+)_([\w]+)\.([\w]+)$@i;
	my $HomeDirectory = $`;
	my $SpeakerID = $1;
	my $AspexDirectory = $2;
	my $ItemID = $3;
	my $Labeler = $4;
	my $LabelFileType = $5;
	
	# Construct the filenames
	# First, the name (and path) of the Labelfile
	my $AspexLabelFileName = $FileName;
	my $LabelFileName = "$HomeDirectory/$SpeakerID/prephoneme/${ItemID}.prephoneme";
	my $TargetFileName = "$HomeDirectory/$SpeakerID/phoneme/${ItemID}_${Labeler}.phoneme";
	my $TranslitFileName = "$HomeDirectory/$SpeakerID/translit/${ItemID}.translit";

	# Do NOT change existing labelfiles
#	next if -s $TargetFileName;
	
	# Read the Aligned labelfile
	my $AspexLabelFile = new SentenceLabel;
	$AspexLabelFile->FoldedIDcodes('PHONEMES');
	next unless $AspexLabelFile->ReadLabelFile("$AspexLabelFileName");
	
	# Normalize labels
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/sil/\*/g');
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/^\s*[0]\s*$/\*/ig');
	$AspexLabelFile->map('PHONEMES', '$_ = (/\S/ ? $_ : "\*");');
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/\://ig');
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/Ei/E+/ig');
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/9y/9+/ig');
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/Y[\+]/9+/ig');
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/Ou/O+/ig');
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/Au/O+/ig');
	# Expand fused phonemes
	$AspexLabelFile->map('PHONEMES', '$_ =~ s/([A-Z0-9\@][\+\:\~]?)(?=[A-Z0-9\@])/\1 /ig');
	
	# Remove double silences
	$AspexLabelFile->presetItem('PHONEMES');
	while($AspexLabelFile->nextItem('PHONEMES') > -1)
	{
	    next unless $AspexLabelFile->currentValue('PHONEMES') =~ /^([\*\#]+|sil)$/;
	    
	    # Remove double silences
	    $AspexLabelFile->removeItem('PHONEMES')
	    if $AspexLabelFile->readNextValue('PHONEMES') =~ /^([\*\#]+|sil)$/;
	};
	
	# Construct the target labelfile
	my $TargetLabelFile = new SentenceLabel;
	$TargetLabelFile->FoldedIDcodes(
	'SENTENCE', 'TRANSLIT', 'WORDS', 'CGN', 'LEXCGN', 
	'SYLLABLES', 'LEXSYLL', 'SYLLPARTS', 'PHONEMES');
	next unless $TargetLabelFile->ReadLabelFile("$TranslitFileName");
	next unless $TargetLabelFile->ReadLabelFile("$LabelFileName");
	# Remove some "ancient" incorrect phoneme value labels
	$TargetLabelFile->map('PHONEMES', '$_ =~ s/\://ig');
	# Interpolate ID codes
	$TargetLabelFile->InterpolateIDtier('WORDS');

	# Initialize all labelfiles
	$AspexLabelFile->presetItem('PHONEMES');
	$TargetLabelFile->presetItem('PHONEMES');
	#
	$TargetLabelFile->firstItem('TRANSLIT');
	$TargetLabelFile->firstItem('WORDS');
	$TargetLabelFile->firstItem('SYLLABLES');
	
	# First check: Number of Phonemes is approximately equal
	my $EquivalenceQuotient = 2.0/3.0;

	if($AspexLabelFile->TierLength('PHONEMES')/$TargetLabelFile->TierLength('PHONEMES') <= $EquivalenceQuotient)
	{
	    $LabelError .= "Very few labels " . $AspexLabelFile->TierLength('PHONEMES')
	    . " vs. ". $TargetLabelFile->TierLength('PHONEMES') . "\t";
	}
	elsif($AspexLabelFile->TierLength('PHONEMES')/$TargetLabelFile->TierLength('PHONEMES') >= 1/$EquivalenceQuotient)
	{
	    $LabelError .= "Very many labels " . $AspexLabelFile->TierLength('PHONEMES')
	    . " vs. ". $TargetLabelFile->TierLength('PHONEMES') . "\t";
	};
	
	# Second check: Length of tiers is equal
	my $DurationMargin = 0.01;  # Suppress rounding errors
	if($AspexLabelFile->duration('PHONEMES') < $TargetLabelFile->duration('PHONEMES') - $DurationMargin)
	{
	    $LabelError .= "Tier too short " . $AspexLabelFile->duration('PHONEMES')
	    . " < ". $TargetLabelFile->duration('PHONEMES') . "\t";
	}
	elsif($AspexLabelFile->duration('PHONEMES') > $TargetLabelFile->duration('PHONEMES') + $DurationMargin)
	{
	    $LabelError .= "Tier too long " . $AspexLabelFile->duration('PHONEMES')
	    . " > ". $TargetLabelFile->duration('PHONEMES') . "\t";
	};
	# Print errors
	print STDERR "$AspexLabelFileName: $LabelError\n" if $LabelError;
	# Go to next file if this one isn't OK	
	next if $LabelError;
	
	#
	# Get diff list
	my @path = ();
	my @diff = diffPhonemeTiers($TargetLabelFile, $AspexLabelFile, \@path);
        
	# Use for test prints for best path
	# warpPhonemePrint($TargetLabelFile, $AspexLabelFile, \@path);

	$TargetLabelFile->patchTier('PHONEMES', \@diff, \&InitialInsert);

	# Remove empty (unlinked) items from other tiers
	$TargetLabelFile->removeUnlinked('SYLLABLES', 'PHONEMES');
	$TargetLabelFile->removeUnlinked('WORDS', 'SYLLABLES');
	$TargetLabelFile->removeUnlinked('TRANSLIT', 'WORDS');
	
	# Cut pauses through all tiers
	$TargetLabelFile->cutItems('PHONEMES', 'SYLLABLES', '^\*$');
	$TargetLabelFile->cutItems('PHONEMES', 'WORDS', '^\*$');
	$TargetLabelFile->cutItems('PHONEMES', 'SENTENCES', '^\*$');
	
	# Start handling the ID's
	# Make sure all words HAVE an ID
	$TargetLabelFile->InterpolateIDtier('WORDS');
	# Make sure every syllable contains only a single kernel
	$TargetLabelFile->normalizeTier('SYLLABLES', 'PHONEMES', \&SyllableSplitter);
	# Store the (original) Lexical Syllable transcription in a safe place
	$TargetLabelFile->copyTier('LEXSYLL', 'SYLLABLES');
	
	# Correct contents of the SYLLABLES and Words tiers to reflect the 
	# actual pronuciation
	$TargetLabelFile->assembleTierValues('SYLLABLES', 'PHONEMES', "", '[\"]');
	$TargetLabelFile->copyTier('CGN', 'WORDS');
	$TargetLabelFile->assembleTierValues('CGN', 'SYLLABLES', '-', '');
	
	# Construct a LEXCGN tier to store the original word transcription
	$TargetLabelFile->copyTier('LEXCGN', 'WORDS');
	$TargetLabelFile->assembleTierValues('LEXCGN', 'LEXSYLL', '-', '');
	
	# Construct the SYLLPARTS tier (i.e., Onset, Kernel, and Coda)
	$TargetLabelFile->interpolateBetweenTiers('SYLLPARTS', 
	                       'PHONEMES', 'SYLLABLES', \&SyllPartsGlue);
	
	# Now, all tiers are ready. Construct the ID codes
	$TargetLabelFile->FillIDcodes;
	
	# Handle the store of Lexical transcriptions
	# Make sure the 'LEXSYLL' tier gets the correct ID codes
	$TargetLabelFile->copyIDcodes('LEXSYLL', 'SYLLABLES');	
	
        # Check for correctness op patch
        # @diff = diffPhonemeTiers($TargetLabelFile, $AspexLabelFile, \@path);
        # print STDERR "Diff $AspexLabelFile After: $diff[2]\n";

	# Finish with copying all Start and End times
	copyTimes($TargetLabelFile, $AspexLabelFile, 'PHONEMES');
	
	$TargetLabelFile->print($TargetFileName, 
	'SENTENCE', 'TRANSLIT', 'WORDS', 'CGN', 'LEXCGN', 
	'SYLLABLES', 'LEXSYLL', 'SYLLPARTS', 'PHONEMES');
	
    };
};


