#!/usr/bin/perl
#
# Add WordList to table.
#
# Smooth the frequency counts using Katz (Good-Turing) discounting up
# to $MaxCount (defaults to 5)
#
# Use:
# ./InsertWordList.pl [--katz k] <TablePath>
#
# -k k
# --katz k
# Maximum count for which Katz smoothing is used. k <=0 means NO smoothing.
# Default k=5. NOTE: the frequency distribution is NOT interpolated.
# The smoothing stops when the frequency of the next higher count is
# NOT-LOWER than the current count or ZERO.
#
# TablePath
# Full path to the wordlist table file. Should include a 'frequency' or 'count'
# column/attribute.
#
###############################################################################
#
# Copyright R.J.J.H. van Son © 2000, 2001, 2002
#
# 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 = '../../..';
print STDERR "$HomeDir/Links.pl: '", -r "$HomeDir/Links.pl", "'\n";
require "$HomeDir/Links.pl";
my $DatabaseDir = "$DatabaseTables/wordlists";


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

my $Target = 'WordList';
my @FileList = ();
my $KatzSmoothing = 5;

# Get Smoothing parameter
if(grep(/\-(k|\-katz)/i, @ARGV))
{
	my $i;
	for($i=0; $i<scalar(@ARGV); ++$i)
	{
		if($ARGV[$i] =~ /\-(k|\-katz)/i)
		{
			splice(@ARGV, $i, 1);
			if($ARGV[$i] !~ /[^\d\.\-]/i)
			{
				$KatzSmoothing = $ARGV[$i];
				splice(@ARGV, $i, 1);
			};
		};
	};
};

# Use arguments if given
if(@ARGV)
{
	my $argument;
	foreach $argument (@ARGV)
	{
		push(@FileList, glob("$argument"));
	};
}
else # Use standard Word list tables
{
	@FileList = glob("$DatabaseDir/*$Target.txt.gz");
};

my $WordList;
my %DatabaseCreated = ();
foreach $WordList (@FileList)
{
      my $TableName = $Target;
      $TableName = $1 if $WordList =~ m@/([\w\-]+)\.@;

	  my $FrequencyAttribute = 'count';
      my @Columns = ();
      my @ValueTypes = ();
      my @FileList = glob("$WordList");
      foreach $FilePath (@FileList)
      {

	   open(INPUT, "gunzip -qc $FilePath|") || die "gunzip -qc $FilePath|: $!\n";

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

	   # Skip comments
	   while(($Line = <INPUT>) =~ /^\s*(\#[\>]?\s*|$)/)
	   { 
	   	if($Line =~ /^\s*\#[\>]\s*/)
		{
			$Header .= "\t$'";
	   		chomp($Header);
		};
	   };
	   
	   unless($Header =~ /(^|\t)count\s\[/i)
	   {
		$FrequencyAttribute = 'frequency' if $Header =~ /(^|\t)frequency\s\[/i;
	   };
	   # Add Smoothened Count column
	   $Header .= "\tSMOOTH [FLOAT8] Smoothed frequency counts";

	   unless($DatabaseCreated{$TableName})
	   {
		   # Remove old table
		   $result = $conn->do("DROP TABLE $TableName");

		   # Create new table	
		   # Column names
		   @Columns = split(/[\t]+/, $Header);
		   @ValueTypes = map {/\[([^\]]+)\]/; $1;} @Columns;
@ValueTypes = map {s/INT1$/INT2/g; $_;} @ValueTypes; # Ugly patch to remove INT1 bug
@ValueTypes = map {s/INT$/INT4/g; $_;} @ValueTypes; # Ugly patch to remove INT bug

		   @Columns = map {/\s+\[([^\]]+)\]/i; $`;} @Columns;

		   # Construct table definition for CREATE
		   my $i;
		   $ColumnDef = "";

		   for($i=0; $i < scalar(@Columns); ++$i)
		   {
	        	   $Columns[$i] = "EndTime" if $Columns[$i] eq 'End';
			   $ColumnDef .= "$Columns[$i] $ValueTypes[$i], \n";
		   };
		   $ColumnDef =~ s/\,\s*$//g;
		   # Create table
		   $result = $conn->do("CREATE TABLE $TableName ($ColumnDef);");

		   print STDERR $conn->errstr, 
				   ": CREATE TABLE $TableName ($ColumnDef);\n" if $conn->err;

		   $DatabaseCreated{$TableName} = scalar(@Columns);

print STDERR "Created $TableName: $DatabaseCreated{$TableName}\n";
	   };

	   # Fill Table (NOTE: the first line has already been read!)
	   while($Line)
	   {
		   # Skip comments and empty lines
		   ($Line = <INPUT>, next) if $Line =~ /^\s*(\#|$)/;
		   chomp($Line);
		   $Line =~ s/\s+$//g;

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

		   # Add '-quotes to char values
		   my $InsertList = "";
		   my $i;
		   for($i=0; $i < scalar(@Values); ++$i)
		   {
	        	   $Values[$i] =~ s/\'/\\\'/g;
			   $Values[$i] = "E'$Values[$i]'" if($ValueTypes[$i] =~ /char|text/i && $Values[$i] ne 'NULL');
		   };
		   # Add NULL value for the Smoothed counts
		   push(@Values, 'NULL');

		   # Read next line
		   $Line = <INPUT>;

		   # Make sure NO values are entered that do NOT have a the first two entries
		   next unless $Values[0] && $Values[1];

		   if(scalar(@Values) != $DatabaseCreated{$TableName})
		   {
	     	  print STDERR "ERROR: ", scalar(@Values), " values found where $DatabaseCreated{$TableName} expected\n";
		      print STDERR join("\t", @Columns), "\n";
		      print STDERR join("\t", @Values), "\n";

		      next;
		   };

		   # Construct the insert list
		   $InsertList = join(", ", @Values);

		   # Insert the record
		   $result = $conn->do("INSERT INTO $TableName VALUES ($InsertList);");

		   if($conn->err)
		   {
			   print STDERR $conn->errstr, 
				   ": INSERT INTO $TableName VALUES ($InsertList);\n";

			   while(@Values || @ValueTypes)
			   {
				   print shift(@Values), "\t", shift(@ValueTypes), "\n";
			   };

			   die "$ColumnDef\n";
		   }; 
	   };

	};


    # Create indices on ID (Word)
    $result = $conn->do("CREATE INDEX ${TableName}_index ON $TableName (Word);");

	# Smooth counts
	# Copy Frequency to SMOOTH
	$result = $conn->do("UPDATE ${TableName} SET smooth = $FrequencyAttribute;");
	print STDERR $conn->errstr, 
				 ": UPDATE ${TableName} SET smooth = $FrequencyAttribute;\n" 
				 if($conn->err);
				 
	my $Count;
	my $MaxCount = $KatzSmoothing;
	my @Ncount=();
	if($MaxCount > 0)
	{	
		for($Count=0; $Count <= $MaxCount+1; ++$Count)
		{	
			($Ncount[$Count]) = getSQLrecordvalues($TableName, "smooth = $Count", 'count(word)');
		};

		# Interpolate problems, very, very crude (NOT for $Count = 0 and  $Count > $MaxCount)
		# Assumes Zipf's distribution and $Ncount[$Count] is the summ of all words with
		# "real" counts in [$Count - 0.5, $Count + 0.5>
		# This messes up the summ of all the counts, of course
		# However, I think this is better than to mess up all the other counts.
		for($Count=$MaxCount; $Count > 0; --$Count)
		{	
			if($Ncount[$Count] < $Ncount[$Count + 1]) 
			{
				# Get the summ of all items with $Count+1 counts
				my ($Ic1) = getSQLrecordvalues($TableName, "smooth > $Count", 'count(word)');
				print STDERR "Interpolating N[$Count]: $Ncount[$Count] ==> ";
				$Ncount[$Count] = $Ic1 / ($Count - 0.5);
				print STDERR "$Ncount[$Count] = $Ic1 / ($Count - 0.5);\n";
			};
		};

		# Remove singular counts and redistribute them over the ZERO counts (if they exist)
		for($Count=0; $Count <= $MaxCount; ++$Count)
		{
			if($Ncount[$Count] && $Ncount[$Count + 1])
			{
				my $C = $Count;
				my $Nc = $Ncount[$Count];
				my $Nc1 = $Ncount[$Count + 1]; 
				my $k = $MaxCount;
				my $N1 = $Ncount[1];
				my $Nk1 = $Ncount[$k + 1];
				$SmoothedCount = $C;
				# Catch divide by zero errors
				if($Nc && $N1 && (!$C || (1 - ($k+1)*$Nk1/$N1)))
				{
					$SmoothedCount = $C ? 
								(($C+1)*$Nc1/$Nc - $C*($k+1)*$Nk1/$N1) 
									/ (1 - ($k+1)*$Nk1/$N1) 
								: $Nc1 / $Nc;
				};
				# Ncounts should DEcrease monotonically. Stop when encountering NON-decreasing 
				# or zero frequencies 
				# Keep track of smoothing
				print STDERR "C: $C, Nc:$Nc, Nc1:$Nc1, Smooth: $SmoothedCount\n";
				# STOP smoothing if Nc <= Nc+1
				print STDERR "SMOOTHING STOPPED at $Count: Nc <= Nc1\n" if $C && $Nc <= $Nc1;
				last if $C && $Nc <= $Nc1;
			}
			elsif($Count > 0)	# Ignore zero counts
			{
				# STOP smoothing if Nc == 0 || Nc+1 == 0
				print STDERR "SMOOTHING STOPPED at $Count: Nc == 0 || Nc+1 == 0\n";
				last;
			};
			# Insert SMOOTHed frequencies, if there exist records to update
			if($Ncount[$Count])
			{
				$result = $conn->do("UPDATE ${TableName} SET smooth = $SmoothedCount where smooth = $Count;");
				print STDERR $conn->errstr, 
							 ": UPDATE ${TableName} SET smooth = $SmoothedCount where smooth = $Count;\n" 
							 if($conn->err);
			}
		};
		
	};

	# Handle Access and check results
    print STDERR $conn->errstr, 
	  ": create index ${TableName}_index on $TableName (word);\n" if $conn->err;

    # Grant SELECT to user ANONYMOUS
    $conn->do("GRANT SELECT on $TableName TO PUBLIC");
    print STDERR "Status doQuery GRANT SELECT on $TableName TO PUBLIC: ",$conn->errstr, "\n";

    # Test data
    my @ary = $conn->selectrow_array("select count(Number) from $TableName");

    print STDERR "Status doQuery $TableName: ",$conn->errstr, " ", $ary[0], "\n";

};
