#! /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 Phoneme Information
# based on Lexical Information corrected for Context Distinctiveness.
#
# Use:
# ./ConstructPhonemeInfoTables.pl [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
#
#
###############################################################################
#
# 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 = '../../..';
use Pg;
require "$HomeDir/Links.pl";

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

# 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 = ('corpuswordlist') 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 (i.e., $SearchPattern = '^($SearchString)\$'
			if($Query =~ /^\^($SearchString)\$$/)
			{
				$SELECT = "SELECT sum(frequency+1) FROM $Table WHERE $TableColumn = '$SearchString';";
			}
			else
			{
				$SELECT = "SELECT sum(frequency+1) FROM $Table WHERE $TableColumn ~ '$Query';";
			};
		    # $result = $conn->selectall_arrayref("SELECT sum(frequency+1) FROM $Table WHERE $TableColumn ~ '$Query';");
		    $result = $conn->selectall_arrayref($SELECT);

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

            my $rowreference;
		    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);
		    		while(@row = $result->fetchrow)
		    		{
			    		${$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;
}
# Get the InfoDiff (context reduced information content)
# 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 getInfoDiffRelFrequency	# ($SearchString, $TableColumn, $HashName, $TableName1[, $TableName2 ....]) -> $Frequency
{
	my $SearchString = shift;
	my $TableColumn = shift;
	my $HashName = shift;
	my @TableNames = @_;
	@TableNames = ('plaincontextdist') 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 "Use of Hashtable/Database: ", $HashCount/$DbCount, "\t = $HashCount/$DbCount\n" unless ++$HashCount % 1000;
	}
	else
	{
		my $corpusFrequency = 0;
		my $celexFrequency = 0;
		
		# Query all tables
		my $Table;
		foreach $Table (@TableNames)
		{ 
		    my $SELECT = "";
			# Construct Query
			$SELECT = "SELECT sum(exp(-infodiff*ln(2.0))) FROM $Table WHERE $TableColumn = '$SearchString';";
			
		    $result = $conn->selectall_arrayref($SELECT);

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

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

		    $Frequency += $corpusFrequency;
		};
		# These are relative frequencies in [0, 1]
		$Frequency = 0 unless $Frequency >= 0 && $Frequency <= 1;
		${$HashName}{$SearchString} = $Frequency;
print STDERR "Use of Hashtable/Database: ", $HashCount/$DbCount, "\t = $HashCount/$DbCount\n" unless ++$DbCount % 1000;
	};

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

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

#
# Table to handle
$TablePattern = "PhonLexInformation.PhLxInfo.gz";

# Define the columns (attributes) taken from the input file
@TargetHeaderList = (
'ID [TEXT] ID code of segment', 
'Value [TEXT] Value of item',
'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',
'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',
'LexInfo [FLOAT8] Lexical information in the Value phoneme given the leading fragment (bits)',
'ManInfo [FLOAT8] Lexical information in the Value Manner given the leading fragment (bits)',
'ArtInfo [FLOAT8] Lexical information in the Value Articulation given the leading fragment (bits)',
'VoicInfo [FLOAT8] Lexical information in the Value Voicing given the leading fragment (bits)',
);

# Add the new columns
push(@TargetHeaderList,
'PlainContextDist [FLOAT8] Context corrected information in the Value phoneme given the leading fragment (bits)',
'LemmaContextDist [FLOAT8] Context corrected information in the Value phoneme given the leading fragment (bits)',
'WordInfo [FLOAT8] Lexical information in the current word (bits)'
);

#
# Calculate the total frequencies
# Keep as global variables
my %WordlistQueryResults = ();
my $TotalWordlistFrequency = getWordlistFrequency('NULL', '.', 'word', 'WordlistQueryResults', 
								'celexwordlist');
my %PlainContextDistQueryResults = ();
my %LemmaContextDistQueryResults = ();

#
# Store the Lemma values for each ID
my %LemmaTable = ();
my @IDlist = getSQLrecordvalues('lemmapos', '', 'DISTINCT id', 'value');
while(@IDlist)
{
	my $ID = shift(@IDlist);
	my $lemma = shift(@IDlist);
	$LemmaTable{$ID} = $lemma;
};

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

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;

   		# 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 $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'};
        my $HEADposition = $ColumnHeaders{'HEAD'}; 
        my $LexInfoposition = $ColumnHeaders{'LexInfo'};
        my $ManInfoposition = $ColumnHeaders{'ManInfo'};
        my $ArtInfoposition = $ColumnHeaders{'ArtInfo'};
        my $VoicInfoposition = $ColumnHeaders{'VoicInfo'};
        
        # 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 $HEAD = $Record[$HEADposition];
            my $LexInfo = $Record[$LexInfoposition];
            my $ManInfo = $Record[$ManInfoposition];
            my $ArtInfo = $Record[$ArtInfoposition];
            my $VoicInfo = $Record[$VoicInfoposition];
                
            my $TargetFile = "$TableDirectory/$Speaker$TypeExtension";

            # Start the future output record (and store the values)
            my @OutputRecord = ($ItemID, $Value, $WORDSID, 
                                $WORDSalign, $WORDSpos, $SYLLABLES, $LEXSYLL,
                                $WORDS, $CGN, $LEXCGN, $CLEANLEXCGN, 
								$LexInfo, $ManInfo, $ArtInfo, $VoicInfo);
								
			my $PlainContextDistInfo = $LexInfo;
			my $LemmaContextDistInfo = $LexInfo;
			# Store the current word frequency (in bits)
			my $currentWordLogFrequency = $TotalWordlistFrequency > 0 ? log($TotalWordlistFrequency)/log(2) : 0;
			
			# Skip silence
			unless($Value eq '*')
			{
				# Get the frequency of the Head of the word (Necessary to calculate the original frequencies)
				my $HeadFrequency = 0;
				$HeadFrequency = getWordlistFrequency($HEAD, '^$SearchString\[^+:~\]', 'phonemes', 'HeadQueryResults', 
										'celexphonemeslist');
				my $LexValueFrequency = 2**(-$LexInfo) * $HeadFrequency;

				# Get context distinctiveness values based on the CORRECT word
				# Plain Text context distinctiveness
				my $QueryWord = $WORDS;
				# Remove * marker
				$QueryWord =~ s/\*.*$//ig;
				$QueryWord =~ s/eeen/een/ig;
				$QueryWord =~ s/[\']/\\\'/g;
				my $currentWordFrequency = getWordlistFrequency($QueryWord, '^$SearchString\$', 'word', 'WordListQueryResults', 
										'celexwordlist');
				# Store the current word frequency (in bits)
				$currentWordLogFrequency = -(log($currentWordFrequency) - log($TotalWordlistFrequency))/log(2) 
											if $currentWordFrequency > 0 && $TotalWordlistFrequency > 0;
				my $PlainCDrelFrequency = getInfoDiffRelFrequency($QueryWord, 'word', 'PlainContextDistQueryResults', 
										'plaincontextdist');
                #
                # Estimate a PlainCDrelFrequency for unseen, rare words
                if($PlainCDrelFrequency <= 0)
                {
                    my $currentRelFrequency = $currentWordFrequency / $TotalWordlistFrequency;
                    # CD = 2 * Info - 26
                    my $CD = 2 * -log($currentRelFrequency)/log(2) - 26;
                    # CDrelFrequency = RelFrequency * 2 ** CD
                    $PlainCDrelFrequency = $currentRelFrequency * 2 ** $CD;
                };
				# Calculate the PlainText Context Distinctiveness corrected Info as a correction in the number of observations
				# (if the frequency has any validity)
				my $PlainContextDistFrequencyCorrection = $PlainCDrelFrequency && $PlainCDrelFrequency < 1 ?
													($PlainCDrelFrequency * $TotalWordlistFrequency - $currentWordFrequency) : 0;
				$PlainContextDistInfo = $PlainContextDistFrequencyCorrection >= 0
										? (log($HeadFrequency + $PlainContextDistFrequencyCorrection)
											-log($LexValueFrequency + $PlainContextDistFrequencyCorrection))/log(2)
										: 'NULL';

				# Lemma context distinctiveness
				# First, get the corresponding lemma
				my @CurrentLemma = ($LemmaTable{$WORDSID});
				# Get the lemma-value when it is not in the table BLOCKED
				# @CurrentLemma = getSQLrecordvalues('lemmapos', "id='$WORDSID'", 'value') unless $CurrentLemma[0];
				# Get the lemma Context Distinctiveness value
				my $LemmaCDrelFrequency = $CurrentLemma[0] && $CurrentLemma[0] =~ /\w/ ?
										getInfoDiffRelFrequency($CurrentLemma[0], 'word', 'LemmaContextDistQueryResults', 
										'lemmacontextdist') : 0;
				$LemmaCDrelFrequency = $PlainCDrelFrequency unless $LemmaCDrelFrequency;
				# Calculate the Lemma Context Distinctiveness corrected Info as a correction in the number of observations
				# (if the frequency has any validity)
				my $LemmaContextDistFrequencyCorrection = $LemmaCDrelFrequency && $LemmaCDrelFrequency < 1 ?
													($LemmaCDrelFrequency * $TotalWordlistFrequency - $currentWordFrequency) : 0;
				$LemmaContextDistInfo = $LemmaContextDistFrequencyCorrection >= 0
										? (log($HeadFrequency + $LemmaContextDistFrequencyCorrection)
											-log($LexValueFrequency + $LemmaContextDistFrequencyCorrection))/log(2)
										: 'NULL';
			};

			# Create the output record
			push(@OutputRecord, $PlainContextDistInfo, $LemmaContextDistInfo, $currentWordLogFrequency);

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

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


exit;



