#! /usr/bin/perl
#
# Special purpose program for Unix/Linux:
# Read all arguments as Tab Delimited table files with 
# Phoneme data.
#
# Construct a Database table for Relative Lexical Phoneme Information.
# For each phoneme, determine the preceding and following
# word-fragments (in and excluding the phoneme) and determine
# the lexical information in this phoneme.
#
# Use:
# ./ConstructPhonLexInfoTables.pl [-d dictionary-table] [-f frequency] [SpeakerGlob]
#
# This will read in all files from <SpeakerGlob> (e.g., F*)
# and constructs Table files with the names <Speaker>PhonemeInfo.txt
# in the PhonemeInfo subdirectories of the DatabaseFiles/ directory
#
# Use word frequencies from the dictionary table given with -d [twentecorpuscontextdist]
# Use frequency attribute (column) from -f [count]
#
#
###############################################################################
#
# 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.
#
#
#######################################################
#
$HomeDir = '../../..';
require "$HomeDir/Links.pl";
require "$HomeDir/connectDBD.pl";
require "$Scripts/CGN_phonemes.pl";  # For the phoneme classes
require "$Scripts/dtw_phonemes.pl";  # For aligning the phonemes
require "$Scripts/SentenceLabel.pl";

# Remove password for writing access
require "$HomeDir/connectDBD.pl";

# Global Values
my @Dictionaries = ();
my @tempARGV = @ARGV;
my $i = 0;
while($i<scalar(@ARGV))
{
    if($ARGV[$i] =~ /^\-\-?d(ictionary)?$/)
    {
        push(@Dictionaries, $ARGV[$i+1]);
        @ARGV=splice(@ARGV, $i, 2);
    }
    else
    {
        ++$i;
    };
};
@Dictionaries = ('corpuswordlist', 'twentecorpuscontextdist') unless @Dictionaries;

# What is the frequency/count column
my $frequency = 'count';
while($i<scalar(@ARGV))
{
    if($ARGV[$i] =~ /^\-\-?f(requency)?$/)
    {
        $frequency = $ARGV[$i+1];
        @ARGV=splice(@ARGV, $i, 2);
    }
    else
    {
        ++$i;
    };
};


my %WordCounts = ();
my %DocCounts = ();
my $ReferenceTable = 'corpuswordlist';
#
#
# Prefetch all words in the corpus
{
    # First, get the total frequency
    unless(exists($WordFrequency{'!TOTAL!'}))
    {
        $WordFrequency{'!TOTAL!'} = -1;
        getWordFrequency('!TOTAL!', @TableNames);
    };
    my ($WordCount, $DocCount) = (0, 0);
	my $Table;
	foreach $Table (@Dictionaries)
    {
        # Check whether attributes are available
        unless(exists($Availlable{$Table}))
        {
	        my @result = getSQLrecordvalues($Table, 'number = 2');
            @AllAttributes = getSQLattributeNames();
            $Availlable{$Table} = grep(/doccount/, @AllAttributes);

        };
        # Not seen before, look up in database
        my $DocCountSelect = "";
        if($Availlable{$Table})
        {
            $DocCountSelect = ", max($Table.doccount)";
        };
	    my $SELECT = 
            "SELECT $ReferenceTable.word, sum($Table.smooth)".$DocCountSelect
            ." FROM $Table, $ReferenceTable WHERE $Table.word = $ReferenceTable.word GROUP BY $ReferenceTable.word;";
        if($Table eq $ReferenceTable)
        {
	        $SELECT = 
            "SELECT $ReferenceTable.word, sum($ReferenceTable.smooth)".$DocCountSelect
            ." FROM $ReferenceTable GROUP BY $ReferenceTable.word;";
        };
	    # $result = $conn->selectall_arrayref("SELECT sum(smooth), max(doccount) FROM $Table WHERE word = '$OrthographicWord';");
	    my $result = $conn->selectall_arrayref($SELECT);

	    # ERRORS
	    print STDERR "$Table: ", $conn->errstr, "\n$SELECT\n" if($conn->err);
print STDERR "$Table: ", scalar(@$result), " words\n";
        # Collect all matching words
        my $rowreference;
	    foreach $rowreference (@$result)
	    {
            my @row = @$rowreference;
		    my ($Word, $TempCount, $TempDocCount) = @row;
            $WordCounts{$Word} += $TempCount;
            $DocCounts{$Word}  += $Availlable{$Table} ? $TempDocCount : 1;
	    };
    };
};


my %WordFrequency = ();
my %Availlable = ();
# Get the Word and in document frequencies (-log(freq)).
sub getWordFrequency    # ($OrthographicWord, $TableName1[, $TableName2 ....]) -> \@(LogWordFreq, LogDocFreq)
{
    my $OrthographicWord = shift || return ();
	my @TableNames = @_;
	@TableNames = @Dictionaries unless @TableNames;
    
    # Sum all words
    unless(exists($WordFrequency{'!TOTAL!'}))
    {
        $WordFrequency{'!TOTAL!'} = -1;
        getWordFrequency('!TOTAL!', @TableNames);
    };
    
    # Word already seen?
    if(exists($WordFrequency{$OrthographicWord}) && $WordFrequency{$OrthographicWord} != -1)
    {
        return $WordFrequency{$OrthographicWord};
    };
    
	# Query all tables
    my ($LogWordFreq, $LogDocFreq) = (0, 0);
    my ($WordCount, $DocCount) = (0, 0);
    if(exists($WordCounts{$OrthographicWord}) && $OrthographicWord ne '!TOTAL!' && $OrthographicWord =~ /\S/)
    {
        $WordCount = $WordCounts{$OrthographicWord};
        $DocCount = $DocCounts{$OrthographicWord};
    }
    else
    {
	    my $Table;
	    foreach $Table (@TableNames)
        {
            # Check whether attributes are available
            unless(exists($Availlable{$Table}))
            {
	            my @result = getSQLrecordvalues($Table, 'number = 2');
                @AllAttributes = getSQLattributeNames();
                $Availlable{$Table} = grep(/doccount/, @AllAttributes);

            };
            # Not seen before, look up in database
	        my $SELECT = "SELECT sum(smooth) FROM $Table WHERE word = '$OrthographicWord';";
            if($Availlable{$Table})
            {
	            $SELECT = "SELECT sum(smooth), max(doccount) FROM $Table WHERE word = '$OrthographicWord';";
            };
            # No word => ALL
            $SELECT =~ s/ WHERE word \=\s+\'(!TOTAL!)?\'\;//g;

	        # $result = $conn->selectall_arrayref("SELECT sum(smooth), max(doccount) FROM $Table WHERE word = '$OrthographicWord';");
	        my $result = $conn->selectall_arrayref($SELECT);

	        # ERRORS
	        print STDERR "$Table: ", $conn->errstr, "\n$SELECT\n" if($conn->err);

            # Collect all matching words
            my $rowreference;
	        foreach $rowreference (@$result)
	        {
                my @row = @$rowreference;
		        my ($TempCount, $TempDocCount) = @row;
                $WordCount += $TempCount;
                $DocCount  += $Availlable{$Table} ? $TempDocCount : 1;
	        };
        };
    };
    
    # Handle empty word => !TOTAL!
    unless($OrthographicWord ne '!TOTAL!' && $OrthographicWord =~ /\S/)
    {
        $WordFrequency{'!TOTAL!'} = [$WordCount, $DocCount];
        return [$WordCount, $DocCount];
    };
    
    # Convert to log (bits)
    my ($TotalWords, $TotalDocs) = @{$WordFrequency{'!TOTAL!'}};
    if($TotalWords > 0)
    {
        $LogWordFreq = -log($WordCount/$TotalWords)/log(2) if $WordCount > 0;
    };
    if($TotalDocs > 0)
    {
        $LogDocFreq = -log($DocCount/$TotalDocs)/log(2) if $DocCount > 0;
    };
    
    # Store results
    $WordFrequency{$OrthographicWord} = [$LogWordFreq, $LogWordFreq - $LogDocFreq];
    
    # Ready
    return $WordFrequency{$OrthographicWord};
};

# Get the relative frequency
# Note, $SearchPattern is evaluated before it is used, so '^$SearchString(\[^\+\:\~\]|\$)' will
# come out correctly.
# $HashName is the name of the global hash table storing the frequency values.
# The reserved word NULL is removed from the query, this allows to construct
# $SearchString by concattenating NULL text entries (e.g., for word boundaries)
sub getWordlistFrequency	# ($SearchString, $SearchPattern, $TableColumn, $HashName, $TableName1[, $TableName2 ....]) -> $Frequency
{
	my $SearchString = shift;
	my $SearchPattern = shift;
	my $TableColumn = shift;
	my $HashName = shift;
	my @TableNames = @_;
	@TableNames = @Dictionaries unless @TableNames;
	
	my $Frequency = 0;
	
	# Protect special characters in the search string (twice evaluated)
	$SearchString =~ s/([\*])/\#/ig;
	$SearchString =~ s/([^\w\s])/\\\1/ig;

	# Look whether the query is already known
	if(exists(${$HashName}{$SearchString}))
	{
		$Frequency = ${$HashName}{$SearchString};
print STDERR "Hashtable/Database: ", $HashCount/$DbCount, "\t = $HashCount/$DbCount\t (".(localtime).")\n" unless ++$HashCount % 1000;
	}
	else
	{
		my $corpusFrequency = 0;
		my $celexFrequency = 0;
		my $Query = eval("qq($SearchPattern)");
		# Take care of NULL searchStrings
		$Query =~ s/NULL//g;   # EXACT match
		
		# Query all tables
		my $Table;
		foreach $Table (@TableNames)
		{
		    my $SELECT = "";
			# Catch queries that just indicate identity
			if($Query =~ /^\^($SearchString)\$$/)
			{
				$SELECT = "SELECT sum(smooth) FROM $Table WHERE $TableColumn = '$SearchString';";
			}
			else
			{
				$SELECT = "SELECT sum(smooth) FROM $Table WHERE $TableColumn ~ '$Query';";
			};
		    # $result = $conn->selectall_arrayref("SELECT sum(frequency+1) FROM $Table WHERE $TableColumn ~ '$Query';");
		    my $result = $conn->selectall_arrayref($SELECT);

		    # ERRORS
		    print STDERR "$Table: ", $conn->errstr, "\n$SELECT\n" if($conn->err);

		    foreach $rowreference (@$result)
		    {
                my @row = @$rowreference;
			    $corpusFrequency = shift(@row);
		    };

			# Handle unknown words
			unless($corpusFrequency > 0)
			{
				unless(exists(${$HashName}{'__SMOOTH0__'}))
				{
					# Get smoothed frequency count from table for ZERO counts
                    my $SELECT = "SELECT avg(smooth) FROM $Table WHERE $frequency = 0;";
		    		$result = $conn->selectall_arrayref($SELECT);
                    
		    		# ERRORS
		    		print STDERR "$Table: ", $conn->errstr, "\n$SELECT\n" if($conn->err);
		    		foreach $rowreference (@$result)
		    		{
                        my @row = @$rowreference;
			    		${$HashName}{'__SMOOTH0__'} = shift(@row);
		    		};
				};
				$corpusFrequency = ${$HashName}{'__SMOOTH0__'};
			};
		    $Frequency += $corpusFrequency;
		};
		$Frequency = 1 if $Frequency <= 0;
		${$HashName}{$SearchString} = $Frequency;
print STDERR "Hashtable/Database: ", $HashCount/$DbCount, "\t = $HashCount/$DbCount (".(localtime).")\n" unless ++$DbCount % 1000;
	};

	# Ready
	return $Frequency;
}
#
# A list of type extension/object name pairs
my %TypeBase =
(
'PhLxInfo' => 'PhonLexInformation',
'PhTxtInfo' => 'PhonTxtInformation',
'PhInfo' => 'PhonemeInformation',
);
#
# Where are the files
my $TypeExtension = 'PhLxInfo';
my $TypeName = exists($TypeBase{$TypeExtension}) ? $TypeBase{$TypeExtension} : $TypeExtension;

my $TableDirectory = "$DatabaseTables/PhInfo";
my $SourceDirectory = "$DatabaseTables/phoneme";

#
# Table to handle
$TablePattern = "PHONEMESphoneme.txt.gz";

# Define the columns (attributes) taken from the input file
@TargetHeaderList = (
'ID [TEXT] ID code of segment', 
'Value [TEXT] Value of item',
'Manner [CHAR(1)] Manner of Articulation',
'Articulator [CHAR(1)] Primary Articulator',
'Voicing [CHAR(1)] Voiced (+) / Unvoiced (-)',
'WORDSID [TEXT] ID code in LEXCGN tier',
'WORDSalign [CHAR(2)] Alignment in LEXCGN tier (Initial, Medial, or Final)',
'WORDSpos [INT2] Position in LEXCGN tier',
'SYLLABLES [TEXT] Realized Syllable',
'STRESS [CHAR(1)] Syllable Stress (+/-)',
'POSSYLL [INT2] Position of syllable in word',
'LEXSYLL [TEXT] Lexical Syllable',
'WORDS [TEXT] Orthographic word * marker',
'CGN [TEXT] CGN transcribed word',
'LEXCGN [TEXT] Lexical CGN transcribed word',
'TRANSCRIPT [TEXT] Lexical CGN transcribed word without syllable or stress markers',
);

# Add the new columns
push(@TargetHeaderList,
'HEAD [TEXT] Leading (preceding) fragment in the word, phonemes', 
'LEXVALUE [TEXT] Current lexical value in the word, phonemes', 
'VALUEMAN [TEXT] Manner transcription of current lexical value in the word, VGFSNO', 
'VALUEART [TEXT] Articulator transcription of current lexical value in the word, OCBLD-', 
'VALUEVOI [TEXT] Voicing transcription of current lexical value in the word, VU',
'TAIL [TEXT] trailing (following) fragment in the word, phonemes', 
'WordInfo [FLOAT8] Lexical information in the Word (bits)',
'DocInfo [FLOAT8] In document lexical information in the word',
'LexInfo [FLOAT8] Lexical information in the Value phoneme given the leading fragment',
'ManInfo [FLOAT8] Lexical information in the Value Manner given the leading fragment',
'ArtInfo [FLOAT8] Lexical information in the Value Articulation given the leading fragment',
'VoicInfo [FLOAT8] Lexical information in the Value Voicing given the leading fragment',
);

#
# Calculate the total frequencies
# Keep as global variables
my %WordlistQueryResults = ();
my $TotalWordlistFrequency = getWordlistFrequency('NULL', '.', 'phonemes', 'WordlistQueryResults', 
								@Dictionaries);

#
# Major loop, process all speakers
# Hash tables that collect parital results
# for reuse to prevent unnecessary database queries.
my %HeadQueryResults = ();
my %LexValueQueryResults = ();
my %LexValueMannerQueryResults = ();
my %LexValueArticulatorQueryResults = ();
my %LexValueVoicingQueryResults = ();

my %MannerRegexp = MannerRegexpHash();
my %ArticulatorRegexp = ArticulatorRegexpHash();
my %VoicingRegexp = VoicingRegexpHash();

my $SpeakerGlob;
unless(@ARGV)
{
	@ARGV = map {s@^.*/([^/]+)$TablePattern$@\1@;$_;} glob("$SourceDirectory/*$TablePattern");
};

foreach $SpeakerGlob (@ARGV)
{
    $SpeakerGlob =~ m@/?([^/]+)$@;
    $SpeakerGlob = $1;
    # Get the label filenames
    @PhonemeTableList = glob("$SourceDirectory/$SpeakerGlob$TablePattern");

    # Process all files
    my $File;
    foreach $File (@PhonemeTableList)
    {   
    	# Get the name of the output file
		$File =~ m!^$SourceDirectory/(\w+)$TablePattern$!;
		my $CurrentSpeaker = $1;

print STDERR "$TableDirectory/$CurrentSpeaker$TypeName.$TypeExtension\n";

   		# Open the output file
		open(OUTPUT, ">$TableDirectory/$CurrentSpeaker$TypeName.$TypeExtension") || die ">$TableDirectory/$1$TypeName.$TypeExtension: $!\n";

		#
		# Print the Prologue of the output table
		# Print the column headers
		print OUTPUT "\#> ", join("\n\#> ", @TargetHeaderList), "\n";

		# Print some extra information
		print OUTPUT "\#\n\# ";
		print OUTPUT "Tier: $TypeName\n\# Speaker: $CurrentSpeaker\n\# Source: $TypeExtension\n";
		print OUTPUT "\#\n";

		# Print the copyright license
		if(open(LICENSE, "<./licenseterms.txt"))
		{
			my $Date = localtime();
			$Date =~ /\s([\d]+)\s*$/;
			my $Year = $1;
			while(<LICENSE>)
			{
				if(/\©/ && ! /$Year/)
				{
					s/(\d)\s{6}(\s+\#)/\1, $Year\2/ig;
				};
				print OUTPUT $_;
			};
			close(LICENSE)
		};

                    
        my %ColumnHeaders = ();
        
        # Open the file
        open(SOURCETABLE, "gunzip -qc $File|") || die  "gunzip -qc $File|: $!\n";

        # Get the first line
        my $Header = <SOURCETABLE>;
        chomp($Header);
        # Remove leading #
        $Header =~ s/^\s*\#[\>]?\s*//g;

        # Skip comments
        while(($Line = <SOURCETABLE>) =~ /^\s*(\#[\>]?\s*|$)/)
        { 
             if($Line =~ /^\s*\#[\>]\s*/)
             {
                     $Header .= "\t$'";
                     chomp($Header);
             };
        };
        
        my $Counter = 0;
        my @HeaderLine = split(/\t/, $Header);
        $Header = "";
        foreach $Header (@HeaderLine)
        {
                my ($HeaderName) = split(' ', $Header);
                $ColumnHeaders{$HeaderName} = $Counter;
                ++$Counter;
        };

        # Get the positions of the relevant parameters
        my $ItemIDposition = $ColumnHeaders{'ID'};
        my $Valueposition = $ColumnHeaders{'Value'};
        my $Mannerposition = $ColumnHeaders{'Manner'};
        my $Articulatorposition = $ColumnHeaders{'Articulator'};
        my $Voicingposition = $ColumnHeaders{'Voicing'};
        my $WORDSIDposition = $ColumnHeaders{'WORDSID'};
        my $WORDSalignposition = $ColumnHeaders{'WORDSalign'};
        my $WORDSposposition = $ColumnHeaders{'WORDSpos'};
        my $SYLLABLESposition = $ColumnHeaders{'SYLLABLES'};
        my $STRESSposition = $ColumnHeaders{'STRESS'};
        my $POSSYLLposition = $ColumnHeaders{'POSSYLL'};
        my $LEXSYLLposition = $ColumnHeaders{'LEXSYLL'};
        my $WORDSposition = $ColumnHeaders{'WORDS'};
        my $CGNposition = $ColumnHeaders{'CGN'};
        my $LEXCGNposition = $ColumnHeaders{'LEXCGN'};
        
        # Process all the lines (note, the first line has already been read!
		my $LastWordID = '';
        while($Line)
        {
        	($Line = <SOURCETABLE>, next) if $Line =~ /^\s*\#/;       # Skip comments
            ($Line = <SOURCETABLE>, next) unless $Line =~ /\S/;       # Skip empty lines
			chomp($Line);

            my @Record = split(/\t/, $Line);

            # Get the relevant values from the source table
            my $ItemID = $Record[$ItemIDposition];
            my $Value = $Record[$Valueposition];
            my $Manner = $Record[$Mannerposition];
            my $Articulator = $Record[$Articulatorposition];
            my $Voicing = $Record[$Voicingposition];
            my $WORDSID = $Record[$WORDSIDposition];
            my $WORDSalign = $Record[$WORDSalignposition];
            my $WORDSpos = $Record[$WORDSposposition];
            my $SYLLABLES = $Record[$SYLLABLESposition];
            my $STRESS = $Record[$STRESSposition];
            my $POSSYLL = $Record[$POSSYLLposition];
            my $LEXSYLL = $Record[$LEXSYLLposition];
            my $WORDS = $Record[$WORDSposition];
            my $CGN = $Record[$CGNposition];
            my $LEXCGN = $Record[$LEXCGNposition];
			my $CLEANLEXCGN = $LEXCGN;
			$CLEANLEXCGN =~ s/[\"\-]//g;
                
            my $TargetFile = "$TableDirectory/$Speaker$TypeExtension";

            # Start the future output record (and store the values)
            my @OutputRecord = ($ItemID, $Value, $Manner, $Articulator, $Voicing, $WORDSID, 
                                $WORDSalign, $WORDSpos, $SYLLABLES, $STRESS, $POSSYLL, $LEXSYLL,
                                $WORDS, $CGN, $LEXCGN, $CLEANLEXCGN);

            # clean up CGN and LEXCGN
			my $Phonemes = $CGN;
            $Phonemes =~ s/[\"\-]//g;
			my $LexPhonemes = $LEXCGN;
            $LexPhonemes =~ s/[\"\-]//g;
                
            # Two situations: Simple, $CGN and $LEXCGN are identical
            # Complex, they are not identical (needs DP)
            my $Head = "";
			my $LexValue = "";
            my $Tail = "";
		
			# Silence or rubish, that's it, skip it
			unless($Value eq '*' || $Value eq '#' || $WORDS =~ /\*x+/)
			{
		    	# Convert the Lexical Word to a list of phonemes
		    	# Split the Lexical Phonemes
		    	$LexPhonemes =~ s/([^\+\~\:\s][\+\~\:]?)/\1 /g;
		    	my @LexPhonemeList = split(' ', $LexPhonemes);
		    	my $CurrentPhonemePosition = $WORDSpos - 1;
		    	my $CurrentLexPhonemePosition = $CurrentPhonemePosition;
		    	my $NumberOfLexPhonemes = scalar(@LexPhonemeList);

                # Difficult, use Dynamic Programming
                if($CGN ne $LEXCGN)
		    	{			
					# Only calculate the path when needed
					if($LastWordID ne $WORDSID)
					{
						# Save the current WORD ID
						$LastWordID = $WORDSID;

		    			$Phonemes =~ s/([^\+\~\:\s][\+\~\:]?)/\1 /g;
		    			my @PhonemeList = split(' ', $Phonemes);
		    			my $NumberOfPhonemes = scalar(@PhonemeList);
						my @path = (); 
						my @distmatr = ();

						# warpFind(\@reference, \@pattern [, \@path, \@distmatr]) -> @diff 
						warpFind(\@LexPhonemeList, \@PhonemeList, \@path, \@distmatr);

						# Extract the relevant paths
						@ReferencePath = ();
						@RealizedPath = ();
						map {push(@ReferencePath, $$_[0]); push(@RealizedPath, $$_[1])} @path;
					};

					# Locate the Lexical Phoneme corresponding to the realized phoneme
					my $i = 0;
					while($i < scalar(@RealizedPath) && $RealizedPath[$i] < $WORDSpos - 1)
					{
						++$i;
					};
					$CurrentLexPhonemePosition = $ReferencePath[$i];
                };

		    	# At this point, $LEXCGN eq $Head.$LexValue.$Tail
                $Head = join('', @LexPhonemeList[0..($CurrentLexPhonemePosition-1)]) if $CurrentLexPhonemePosition-1 >= 0;
		    	$LexValue = $LexPhonemeList[$CurrentLexPhonemePosition];
                $Tail = join('', @LexPhonemeList[($CurrentLexPhonemePosition+1)..$NumberOfLexPhonemes]) 
							if $CurrentLexPhonemePosition+1 < $NumberOfLexPhonemes;
			};

			# Lex value
			my $LexValueManner = CGNtoManner($LexValue) || 'NULL';
			my $LexValueArticulator = CGNtoArticulator($LexValue) || 'NULL';
			my $LexValueVoicing = CGNtoVoicing($LexValue) || 'NULL';

			# Make sure there is something in the Head, Value, and Tail
			$Head = 'NULL' unless $Head =~ /\S/;
			$LexValue = 'NULL' unless $LexValue =~ /\S/;
			$Tail = 'NULL' unless $Tail =~ /\S/;


             # Add values
			push(@OutputRecord,
			$Head, 
			$LexValue, $LexValueManner, $LexValueArticulator, $LexValueVoicing,
			$Tail
			);

            # Get the "clean" word and its frequencies
            my $OrthographicWord = $WORDS;
            $OrthographicWord =~ s/\*.*//g;
            $OrthographicWord =~ s/\'/\\'/g;
            my ($WordFreq, $DocFreq) = @{getWordFrequency($OrthographicWord, @Dictionaries)};
            ($WordFreq, $DocFreq) = ('NULL', 'NULL') unless $WordFreq > 0 && $DocFreq > 0;
            push(@OutputRecord, $WordFreq, $DocFreq);
                

			# Get the Frequency Information
			my $HeadFrequency = 1;
			my $LexValueFrequency = 1;
			my $HeadMannerFrequency = 1;
			my $LexValueMannerFrequency = 1;
			my $HeadArticulatorFrequency = 1;
			my $LexValueArticulatorFrequency = 1;
			my $HeadVoicingFrequency = 1;
			my $LexValueVoicingFrequency = 1;

			unless($LexValue eq 'NULL')
			{
				# Phonemes
				# Secure phonemes against interpretation of [+:~]
				my $SafeHead = $Head;
				my $SafeLexValue = $LexValue;

				$SafeHead =~ s/([\+\:\~\*])/\[\1\]/g;
				$SafeLexValue =~ s/([\+\:\~\*])/\[\1\]/g;

				$HeadFrequency = getWordlistFrequency($SafeHead, '^$SearchString\[^+:~\]', 'phonemes', 'HeadQueryResults', 
									@Dictionaries);
				$LexValueFrequency = getWordlistFrequency("$SafeHead$SafeLexValue", '^$SearchString(\[^+:~\]|\$)', 'phonemes', 'LexValueQueryResults', 
									@Dictionaries);

				# Manner of Articulation
				$HeadMannerFrequency = $HeadFrequency;
				$LexValueMannerFrequency = getWordlistFrequency("$SafeHead($MannerRegexp{$LexValueManner})", '^$SearchString', 'phonemes', 
			                          'LexValueMannerQueryResults', 
									  @Dictionaries);
				# Articulator
				$HeadArticulatorFrequency = $HeadFrequency;
				$LexValueArticulatorFrequency = getWordlistFrequency("$SafeHead($ArticulatorRegexp{$LexValueArticulator})", '^$SearchString', 'phonemes', 
			                          'LexValueArticulatorQueryResults', 
									  @Dictionaries);

				# Voicing
				$HeadVoicingFrequency = $HeadFrequency;
				$LexValueVoicingFrequency = getWordlistFrequency("$SafeHead($VoicingRegexp{$LexValueVoicing})", '^$SearchString', 'phonemes', 
			                          'LexValueVoicingQueryResults', 
									  @Dictionaries);
			};

			# Calculate the Information in bits
			my $PhonemeInfo = (log($HeadFrequency)-log($LexValueFrequency))/log(2);
			my $MannerInfo = (log($HeadMannerFrequency)-log($LexValueMannerFrequency))/log(2);
			my $ArticulatorInfo = (log($HeadArticulatorFrequency)-log($LexValueArticulatorFrequency))/log(2);
			my $VoicingInfo = (log($HeadVoicingFrequency)-log($LexValueVoicingFrequency))/log(2);

			# Create the output record
			push(@OutputRecord,	$PhonemeInfo, $MannerInfo, $ArticulatorInfo, $VoicingInfo);

			# Write output
			print OUTPUT join("\t", @OutputRecord), "\n";

			# Read next line
			$Line = <SOURCETABLE>;
       	};
       	close(SOURCETABLE);
		close(OUTPUT);
    };
};


exit;



