#!/usr/local/bin/perl
#
#
#  Author: Preslav Nakov, nakov@cs.berkeley.edu
#          UC Berkeley
#  
#  Description: Stems a text file
#
#  Last modified: 04/25/03
#
#

use strict;

use locale;
use POSIX qw (locale_h);
setlocale(LC_CTYPE, 'Bulgarian_Bulgaria.1251');


### CONSTANTS
use constant RULES_FILE => "stem_rules.txt";
## use constant RULES_FILE => "lemma_rules.txt";
use constant MIN_RULE_FREQ => 2;

### Global variables
my (%rules, $total, $matched);

fetchTheRules(RULES_FILE);

while (<>)
{
	chomp;

	{	my $word;
		/^([^à-ÿÀ-ß]*)(.*)/ ;
		print $1;
		$_ = $2;
		unless ( /^([à-ÿÀ-ß]+[à-ÿÀ-ß\-]*)(.*)/ ) { last; }
		$word = lc $1; # turn to lower case before calling
		$_ = $2;
		$word = stem($word);
		print $word;
		redo;
	}
	print "\n";
}

print "STATISTICS FOR WORDS WITH AT LEAST ONE VOWEL\n";
print "MATCHED   : $matched\n";
print "TOTAL     : $total\n";
printf "% MATCHED : %0.2f%%\n", 100.0 * $matched / $total;

sub fetchTheRules {
	my $fname = shift;
	open(INPUT, $fname) or die ("Failed to open $fname for reading!");
	while (<INPUT>) {
		chomp;

		### 1. Check the file format (and find the pair: ending ==> stem)
		die "Incorrect file format!\n" if (!/^([à-ÿ\-]+) ==> ([à-ÿ\-]+) (\d+)$/);

		### 2. Check the rule frequency
		next if ($3 < MIN_RULE_FREQ);

		### 3. Assert there are no duplicates
		die "Incorrect assumption:\n" if (exists $rules{$1});

		### 4. Add the rule to the hash table
		$rules{$1} = $2;

	}
	close(INPUT);
}


sub stem {
	my ($word, $wordLen, $start);
	$total++;

	# 1. Find the word length
	$wordLen = length($word = shift);

	# 2. Return if no vowels are found
	if ($word !~ /([^àúîóåèÿþ]*)[àúîóåèÿþ]/) {
		$total--;
		return $word;
	}

	# 3. Try to match against the rules
	for ($start = 1 + length($1); $start < $wordLen; $start++) {
		my $suffix;
		if (exists $rules{$suffix = substr($word, $start)}) {
			$matched++;
			return substr($word,0,$start) . $rules{$suffix};
		}
	}

	# 4. No compatible rule - return
	return $word;
}