package Lingua::BiTerm;

use 5.006;
use strict;
use warnings;
use Data::Dumper;
use MLDBM qw/DB_File Storable/;
use Fcntl;
require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use kvec ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(newKvec  newFromFile calcStat printToFile printStdOut printToString rank grep filter sum grepTest createDB newFromDB grepDb
);
our $VERSION = '0.01';


####################################################################
#								   #
# Falta Fazer:							   #
#		Fazer a impressao no formato "PERL"		   #
#		POD						   #
####################################################################


# Preloaded methods go here.
sub newFromDB
{
	my $self={};
	bless $self;
	shift;
	my $file=shift;
	$self->{'type'}="db";
	my %pal;
	my $dbm=tie %pal,'MLDBM',$file,O_CREAT|O_RDWR, 0640 or die $!;
	%{$self->{'words'}}=%pal;
	return $self;
}
sub grepDB
{
	my $self=shift;
	if ((!defined $self->{'type'}) or ($self->{'type'} ne "db"))
	{
		die "you cannot use this function(grepDB) with this kind of objects...\n";
	}

	my $word=shift;
	my $result;
	if (defined $self->{'words'}{$word})
	{
		my %temp=%{$self->{'words'}{$word}{'trans'}};
		for (sort {$temp{$b} <=> $temp{$a}} keys %temp)
		{
			if ($_ ne "")
			{
				$result.="$_ $temp{$_}\n";
			}
		}
	}
	else 
	{
		$result="Word not found\n";
	}
	return $result;
}

sub newFromFile
{	my $self={};
	bless $self;
	shift;
	my $file=shift;
	$self->fromFile($file);
	return $self;
}

sub newKvec
{
	my $self={};
	bless $self;
	
	shift;
	my $tam=@_;
	$self->{"lcutOff"}=5;
	$self->{"ucutOff"}=10000;
 	$self->{"statistic"}="calculateRightFisher";	
	if ($tam==2)
	{
		my $src=shift;
		my $trg=shift;
		
		$self->{"sourceFile"}=$src;
		$self->{"targetFile"}=$trg;
		$self->p2n3();
	}
	elsif ($tam==3)
	{
		my $h=shift;
		my $src=shift;
		my $trg=shift;
		
		$self->{"sourceFile"}=$src;
		$self->{"targetFile"}=$trg;

		if (defined $h->{'lcutOff'})
		{
			$self->{"lcutOff"}=$h->{'lcutOff'};
		}
		if (defined $h->{'ucutOff'})
		{
			$self->{"ucutOff"}=$h->{'ucutOff'};
		}
		if (defined $h->{'pieces'})
		{
			$self->{'pieces'}=$h->{'pieces'};
		}
		if (defined $h->{'aligned'})
		{
			$self->p2n3_align();
		}
		else
		{
			$self->p2n3();
		}
	}
	return $self
}

sub fromFile
{
	my $self=shift;
	my $file=shift;
	my @tokens;
	my @numbers;
	open(A,$file) or die "file $file not found\n";
	my $temp=<A>;
	chomp $temp;
	$self->{'pieces'}=$temp;
	while(<A>)
	{
		chomp($_);
		@tokens=split(/<>/,$_);
		@numbers=split(/ /,$tokens[2]);
		my $tam=@numbers;
		while($tam >3)
		{
			shift @numbers;
			$tam=@numbers;
		}
		$self->{'hashSourceWords'}{$tokens[0]}=$numbers[1];
		$self->{'hashTargetWords'}{$tokens[1]}=$numbers[2];
		$self->{'pairsHash'}{"$tokens[0] $tokens[1]"}=$numbers[0];
	}
	
	

}

sub grep
{
	my $self=shift;
	if (defined $self->{'type'}) 
	{
		die "you cannot use this function(grep) with this kind of objects...\n";
	}
	my @words=@_;
	my %newSrcHash;
	my %newTrgHash;
	my %newPairs;
	my @tokens;
	my $pares;
	my $newP2N3=newKvec();
	my $tempHash=$self->{'pairsHash'};

	for (@words)
	{
		#if (defined $self->{'hashSourceWords'}{$_})
		#{
			#$newSrcHash{$_}=$self->{'hashSourceWords'}{$_};
			#}
		for $pares(keys %{$tempHash})
		{
			@tokens=split(/ /,$pares);
			if ($_ eq $tokens[0])
			{
				$newPairs{$pares}=$self->{'pairsHash'}{$pares};
				$newTrgHash{$tokens[1]}=$self->{'hashTargetWords'}{$tokens[1]};
			}
		}
	}
	#$newP2N3->{'hashSourceWords'}=\%newSrcHash;
	$newP2N3->{'hashSourceWords'}=$self->{'hashSourceWords'};
	
	#$newP2N3->{'hashTargetWords'}=\%newTrgHash;
	$newP2N3->{'hashTargetWords'}=$self->{'hashTargetWords'};
	
	$newP2N3->{'pairsHash'}=\%newPairs;
	$newP2N3->{'pieces'}=$self->{'pieces'};
	return $newP2N3;
	
	
	
}

sub grepTest
{
	my $self=shift;
	if (defined $self->{'type'})
	{
		die "you cannot use this function(grepTest) with this kind of objects...\n";
	}
	my $value=shift;
	my %newSrcHash;
        my %newTrgHash;
        my %newPairs;
        my @tokens;
        my $pares;
        my $newP2N3=newKvec();
        my $tempHash=$self->{'pairsHash'};
	my $temp;
        
	for $pares(keys %{$tempHash})
        {
		$temp=$tempHash->{$pares};
		@tokens=split(/ /,$pares);
		if(conv($temp)>=$value*1000)
		{
                	$newPairs{$pares}=$self->{'pairsHash'}{$pares};
                        $newTrgHash{$tokens[1]}=$self->{'hashTargetWords'}{$tokens[1]};
		}
        }
        
        $newP2N3->{'hashSourceWords'}=$self->{"hashSourceWords"};
        $newP2N3->{'hashTargetWords'}=\%newTrgHash;
        $newP2N3->{'pairsHash'}=\%newPairs;
        $newP2N3->{'pieces'}=$self->{'pieces'};
        return $newP2N3;
}
																																																					
############################################################
sub filter
{
	my $self=shift;
	if (defined $self->{'type'})
	{
		die "you cannot use this function(filter) with this kind of objects...\n";
	}
	my $side=shift;
	my @words=@_;
	my $refpairs=$self->{"pairsHash"};
	my @w;
	my $pals;


	if (($side !=0) and ($side !=1))
	{
		print "Side must be 0 or 1\n";
		exit 0;
	}
	
	
	my $tot=0;
	for $pals(keys %$refpairs)
	{
		for (@words)
		{
			@w=split(/ /,$pals);
			if ($w[$side] eq $_)
			{
				$tot++;	
				delete $refpairs->{$pals};
			}
		}
	}
 	return $tot;	
			

	
}
############################################################

sub sum
{
	my $self=shift;
	if (defined $self->{'type'}) 
	{
		die "you cannot use this function(sum) with this kind of objects...\n";
	}
	my $other=shift;
	my $value;
	
	my $tempHash=$other->{'hashSourceWords'};

	$self->{'pieces'}+=$other->{'pieces'};
	for(keys  %$tempHash)
	{
		$value=$other->{'hashSourceWords'}{$_};
		$self->{'hashSourceWords'}{$_}+=$value;
	}
	$tempHash=$other->{'hashTargetWords'};
	for(keys  %$tempHash)
	{
		$value=$other->{'hashTargetWords'}{$_};
		$self->{'hashTargetWords'}{$_}+=$value;
	}
	$tempHash=$other->{'pairsHash'};
	for(keys  %$tempHash)
	{
		$value=$other->{'pairsHash'}{$_};
		if (defined $self->{'pairsHash'}{$_})
		{
			$self->{'pairsHash'}{$_}+=$value;
		}
		else
		{
			$self->{'pairsHash'}{$_}=$value;
		}
	}
}


sub get_statistic
{
	my $st={
		   "right fisher"       => "calculateRightFisher",
		   "log likelihood"     => "calculateLL",
		   "dice"	        => "calculateDice",
		   "mutual information" => "calculateMI",
		   "odds ratio"		=> "calculateOdds",
		   "t-score"		=> "calculateTscore"
	   };
	
	my $stat=shift;
	$stat=lc($stat);
	if (defined $st->{$stat})
	{
		
		return $st->{$stat};
	}
	else 
	{
		print STDERR "Statistic package not defined!\n";
		exit 0;
	}
}
	   
		


sub p2n3
{
	my $self=shift;
	my $sourceFile=$self->{"sourceFile"};
	my $targetFile=$self->{"targetFile"};
	my %sourceHash;
	my %targetHash;
	my @sourceArray;
	my @targetArray;
	my $i;
	my $pieces;
	my %pairsHash;
	my %sourceWords;
	my %targetWords;
	
	$self->{"sourceWords"}=&calculateWords($sourceFile,\%sourceHash);
	$self->{"targetWords"}=&calculateWords($targetFile,\%targetHash);
	$self->{"sourceHash"}=\%sourceHash;
	$self->{"targetHash"}=\%targetHash;
	$self->calculatePieces();
	$self->createPieces(\@sourceArray,$sourceFile,$self->{"Source_words_per_piece"},$self->{"pieces"});
	$self->createPieces(\@targetArray,$targetFile,$self->{"Target_words_per_piece"},$self->{"pieces"});
	$self->{"sourceArray"}=\@sourceArray;
	$self->{"targetArray"}=\@targetArray;
	$self->make_pairs();
		
}
sub p2n3_align
{
	my $self=shift;
	my $sourceFile=$self->{"sourceFile"};
	my $targetFile=$self->{"targetFile"};
	my %sourceHash;
	my %targetHash;
	my @sourceArray;
	my @targetArray;
        $self->{"sourceWords"}=&calculateWords($sourceFile,\%sourceHash);
        $self->{"targetWords"}=&calculateWords($targetFile,\%targetHash);
        $self->{"sourceHash"}=\%sourceHash;
        $self->{"targetHash"}=\%targetHash;
	$self->{"pieces"}=&countPieces($self->{"sourceFile"});
	$self->createPiecesAlign(\@sourceArray,$self->{"sourceFile"});
	$self->createPiecesAlign(\@targetArray,$self->{"targetFile"});
        $self->{"sourceArray"}=\@sourceArray;
        $self->{"targetArray"}=\@targetArray;
			
	$self->make_pairs();		
}

sub make_pairs
{
	my $self=shift;
	my $pieces=$self->{"pieces"};
	my $i;
	my %pairsHash;
	my %targetWords;
	my %sourceWords;
	for ($i=0;$i<$pieces;$i++)
	{
		my $hrefSource=$self->{"sourceArray"}[$i]; 
		my $hrefTarget=$self->{"targetArray"}[$i];
		$self->makePairs($hrefSource, $hrefTarget, \%pairsHash, \%sourceWords, \%targetWords);
	}
	$self->{"pairsHash"}=\%pairsHash;
	$self->{"hashSourceWords"}=\%sourceWords;
	$self->{"hashTargetWords"}=\%targetWords;
	undef $self->{"targetArray"};
	undef $self->{"sourceArray"};
}

sub createPiecesAlign
{
        my $self=shift;
	my $refArray = $_[0];
        my $fileName = $_[1];
        my $i=0;
	my $line;
	my $out;
	my @wordArray;
	$/="\n\$\n";
        open(FILE, $fileName ) || die "Error opening $fileName";
        while ( $line = <FILE> )
        {
		chomp($line);
		$line =~ tr/A-Z/a-z/;
        	$line = &removeSpaces($line);
        	@wordArray=split(/ /,$line);
        	foreach $out(@wordArray)
        	{
			$refArray->[$i]{$out}++;
		}
		$i++;
	}
}																																																	
sub countPieces

{
        my $fich=shift;
        my $c=0;
	$/="\n\$\n";
        open (A,$fich);
        while(<A>)
        {
	        $c++;
	}
        return $c;
}
													
sub calculatePieces #falta ver quais sao os argumentos
{
	
	my $self=shift;
	my $sourcePieces;
	my $targetPieces;
	my $Source_words_per_piece;
	my $Target_words_per_piece;
	if ( defined $self->{"pieces"} )
	{
		if($self->{"pieces"} == 0)
		{
			print "Number of pieces should be greater than zero\n";
			exit;
		}
		$sourcePieces = $self->{"pieces"};
		$targetPieces = $self->{"pieces"};
		$Source_words_per_piece = $self->{"sourceWords"} / $sourcePieces;
		$Target_words_per_piece = $self->{"targetWords"} / $targetPieces;
	}
	else
	{
		$sourcePieces = sqrt( $self->{"sourceWords"} );
		$sourcePieces = &floorCeil($sourcePieces);
		$Source_words_per_piece = $self->{"sourceWords"} / $sourcePieces;
		$targetPieces = $sourcePieces;
		$Target_words_per_piece = $self->{"targetWords"}/$targetPieces;
	}

	$self->{"pieces"} = $sourcePieces;
	$Source_words_per_piece = &floorCeil($Source_words_per_piece);
	$Target_words_per_piece = &floorCeil($Target_words_per_piece);
	$self->{"Source_words_per_piece"}=$Source_words_per_piece;
	$self->{"Target_words_per_piece"}=$Target_words_per_piece;
								   
}

sub calculateWords #Devolve o no de palavras num texto
{
	my $line;
	my $wordCount;
	my $word;
	my $fileName = $_[0];
	my $refHash = $_[1];
	my @wordArray;
    	# checks if the file exists !! 
	if( ! (-e $fileName ) )
	{
		print "\nERROR!!! $fileName not found\n ";
		exit;
        }
	 open(FILE, $fileName) || die "Error opening $fileName";
	 while( $line = <FILE>)
	 {
         	$line = &removeSpaces($line);
         	$line =~ tr/A-Z/a-z/;  #Converte tudo para minusculas
         	@wordArray = split(/\s+/,$line);
	         $wordCount += @wordArray;
		 foreach $word(@wordArray)
		 {
		 	$refHash->{$word}++;
		 }
	 	undef(@wordArray);
	}
	close(FILE);
	return($wordCount);
}
						      

sub deleteHash
{
	my $self=shift;
	my $word;
	my %tempHash = %{$self->{"pairsHash"}};
	my $lcutOff=$self->{"lcutOff"};
	my $ucutOff=$self->{"ucutOff"};

	foreach $word( sort keys %tempHash )
	{
		if( $tempHash{$word} < $lcutOff )
		{
			delete($tempHash{$word});
		}
		elsif( $tempHash{$word} > $ucutOff )
		{
			delete($tempHash{$word});
		}
	}
	$self->{"pairsHash"}=\%tempHash;
}

sub floorCeil
{
	my $x=0;
	$x = sprintf(" %d ", $_[0]);
	return $x;
}

sub createPieces
{
	
	my $self=shift;
	my $pieceNumber = 0;
	my $totalWords = 0;
	my $refArray = $_[0];
	my $fileName = $_[1];
	my $length = $_[2];
	my $totalPieces = $_[3];
	my @wordArray = ();
	my $line;
	my $p=0;
	my $out;
	my $pieces = $self->{"pieces"};
	open(FILE, $fileName ) || die "Error opening $fileName";
	while ( $line = <FILE> )
	{
		$line =~ tr/A-Z/a-z/;
		$line = &removeSpaces($line);
		# stores all the space seperated words in an array
		@wordArray = (@wordArray, split(/ /,$line ) );
		while($#wordArray >= $length)
		{
			#if loop added on 12-28-2001
			if($pieceNumber >= $totalPieces)
			{
				last;
			}
			#if loop added on 12-28-2001
			for($p=0;$p<$length;$p++)
			{
				($out, @wordArray) = @wordArray;
				$refArray->[$pieceNumber]{$out}++
			}
			$pieceNumber++;
		}
	}

# Once the whole file is read, it just concatenates all the words remaining
# in the array to the last piece and also stores each word in the hash
	if($pieceNumber >= $pieces)
	{
		$pieceNumber--;
	}
	foreach $out(@wordArray)
	{
		$refArray->[$pieceNumber]{$out}++;
	}
	close(FILE);
						 
}						 




sub removeSpaces{

	$_[0] =~ tr/A-Z/a-z/;
	$_[0] =~ s/[\/\|\(\)\[\]\{\}\^\$\*\+\?\.\,\"\!\-\;\\\:0-9%]//g;
	$_[0] =~ s/^\s+//g;
	$_[0] =~ s/\s+$//g;
	$_[0] =~ s/\s+/ /g;
	$_[0] =~ s/\n+//g;
	return $_[0];
}


sub makePairs{

    my $self=shift;
    my $hrefSourcehash = $_[0];
    my $hrefTargethash = $_[1];
    my $refPairs = $_[2];
    my $refSourcewords = $_[3];
    my $refTargetwords = $_[4];
    my $word1;
    my $word2;
    my $pair;
    my %temphash;
    my %sourceHash=%{$self->{"sourceHash"}};   
    my %targetHash=%{$self->{"targetHash"}};
    foreach $word1(keys %$hrefSourcehash)
    {
	if(exists $sourceHash{$word1})
	{
		$refSourcewords->{$word1}++;
		foreach $word2(keys %$hrefTargethash)
		{
	        	if(exists $targetHash{$word2})
	                {
		        	if(!(exists $temphash{$word2}))
		                {
			        	$refTargetwords->{$word2}++;
			        }
			        $temphash{$word2}++;
			        $pair = $word1." ".$word2;
			        $refPairs->{$pair}++;
			}
		}
	}
    }
}
sub printToFile
{
	my $self=shift;
	if (defined $self->{'type'}) 
	{
		die "you cannot use this function(printToFile) with this kind of objects...\n";
	}
	my $file=shift;
	my $h =shift;
	my $kbest;
	if (defined $h->{'kbest'})
	{
		$kbest=$h->{'kbest'};	
	}
	my $refpairs = $self->{"pairsHash"};
	my $refSource = $self->{"hashSourceWords"};
	my $refTarget = $self->{"hashTargetWords"};
	my $i=0;
	my $pairs;
	my $pieces=$self->{"pieces"};
	my $word1;
	my $word2;
	open(DST,">$file");
	#$self->deleteHash();
	
    	$pieces =~ s/\s+//g;
	$pieces = $pieces;
	my %tempHash=%{$refpairs};
	print DST "$pieces";
	my $cnt=0;
	foreach $pairs( sort {conv($refpairs->{$a}) <=> conv($refpairs->{$b})} keys %$refpairs)
	{
		if ((defined $kbest) and ($cnt >= $kbest))
		{
			last;
		}
		else 
		{
		($word1, $word2) = split(/ /,$pairs);
		print DST "\n$word1<>$word2<>$refpairs->{$pairs} $refSource->{$word1} $refTarget->{$word2}";
	}
	$cnt++;
}
	print DST  "\n";

}
sub printStdOut
{
        my $self=shift;
	if (defined $self->{'type'}) 
	{
		die "you cannot use this function(printStdOut) with this kind of objects...\n";
	}
        my $refpairs = $self->{"pairsHash"};
	my $h =shift;
	my $kbest;
	if (defined $h->{'kbest'})
	{
		$kbest=$h->{'kbest'};	
	}
        my $refSource = $self->{"hashSourceWords"};
        my $refTarget = $self->{"hashTargetWords"};
        my $i=0;
        my $word1;
        my $word2;
        my $pairs;
        #$self->deleteHash();
        my $pieces=$self->{"pieces"};
        $pieces =~ s/\s+//g;
        $pieces = $pieces;
        print "$pieces";
	my $cnt=0;
        foreach $pairs(sort {conv($refpairs->{$a}) <=> conv($refpairs->{$b})} keys %$refpairs)
        {
		if ((defined $kbest) and ($cnt >= $kbest))
		{
			last;
		}
		else 
		{
	        ($word1, $word2) = split(/ /,$pairs);
                print "\n$word1<>$word2<>$refpairs->{$pairs} $refSource->{$word1} $refTarget->{$word2}";
	} 
		$cnt++
	

	}
		print  "\n";
}																				
sub printToString
{
	my $self=shift;
	if (defined $self->{'type'}) 
	{
		die "you cannot use this function(printToString) with this kind of objects...\n";
	}
	my $h =shift;
	my $kbest;
	if (defined $h->{'kbest'})
	{
		$kbest=$h->{'kbest'};	
	}
	my $refpairs=$self->{"pairsHash"};
        my $refSource = $self->{"hashSourceWords"};
        my $refTarget = $self->{"hashTargetWords"};
        my $i=0;
        my $word1;
	my $pairs;
        my $word2;
        my $pieces=$self->{"pieces"};
        my $result="";
        #$self->deleteHash();
        $pieces =~ s/\s+//g;
        $pieces = $pieces;
        $result.= "$pieces";
	my $cnt=0;
        foreach $pairs(sort {conv($refpairs->{$a}) <=> conv($refpairs->{$b})} keys %$refpairs)
        {
		if ((defined $kbest) and ($cnt >= $kbest))
		{
			last;
		}
		else 
		{
                ($word1, $word2) = split(/ /,$pairs);
                $result.= "\n$word1<>$word2<>$refpairs->{$pairs} $refSource->{$word1} $refTarget->{$word2}";
	}
	$cnt++;
}
        $result.=  "\n";
	return $result;
}
																						
						     
sub conv
{
	my $valores=shift;
	my @n=split(/ /,$valores);
	my $res=$n[0]*1000;
	return $res;
}

sub rank
{
	my $self=shift;
	if (defined $self->{'type'}) 
	{
		die "you cannot use this function(rank) with this kind of objects...\n";
	}
	
	my $rank = 0;
	my $lastValue = 0;
	my %hash=%{$self->{"pairsHash"}};
	my $temp;
	my @numbers;
	#print Dumper \%hash;

	foreach ( sort { conv($hash{$b}) <=> conv($hash{$a}) } keys %hash )
	{
		my @tokens = split (/ /, $_ );
		$temp=$hash{$_};
		@numbers=split(/ /,$temp);
		if ( $lastValue != $numbers[0] )
		{
				
			$lastValue = $numbers[0];
			$rank++;
		}
		# do bit-stuffing
		#if ( $_ =~ /^@/ ) { $destination.= "@"; }
		chomp $rank;
		$self->{"pairsHash"}{$_}=$rank . " " . $self->{"pairsHash"}{$_};
	}
	$self->{"ranked"}=1;
}

sub calcStat
{
        my $self=shift;
	if (defined $self->{'type'}) 
	{
		die "you cannot use this function(calcStat) with this kind of objects...\n";
	}
        my $stat=shift;
        my $floatFormat = join '', '%', '.', 4, 'f';
        my $statistic = get_statistic($stat);
        my $destination = "";
        #my $p2n3 = ${$self->{"p2n3"}};
        #my @linhas=split(/\n/,$p2n3);
        my $flag = 1;
        #my $lineNo = 0; # will tell us where in the source file we have a problem!
        my $wordTotal = $self->{'pieces'};
        my @tokens;
        my $ngramSize;
        my @numbers;
        my $i;
        my %STATISTIC;
        my @individualFreq;
        my %ngramFreq;
        my %tempHash=%{$self->{'pairsHash'}};
        for (keys %tempHash)
        {
                chomp $_;
                @tokens = split(/ /, $_);
                $ngramSize = $#tokens;
		 	
		push @numbers ,$tempHash{$_};		
		push @numbers,$self->{'hashSourceWords'}{$tokens[0]};
		push @numbers,$self->{'hashTargetWords'}{$tokens[1]};
		# $freq, $freq1, $freq2, $totalBigrams
                my $tempSt=$self->$statistic(@numbers, $wordTotal);
		@numbers=();
                $tempSt=sprintf $floatFormat, $tempSt;
		my $temp="$tempSt $tempHash{$_}";
		$self->{'pairsHash'}{$_}=$temp;
        }

}


sub calculateRightFisher
{
	shift;
	my $tam=@_;
	my ($freq, $freq1, $freq2, $totalBigrams) = @_;
        my $n11 = $freq;
	my $npp = $totalBigrams;
	my $n1p = $freq1;
        my $np1 = $freq2;
        my $n2p = $npp - $n1p;
        my $np2 = $npp - $np1;
        # we shall have two arrays one for the numerator and one for the
        # denominator. the arrays will contain the factorial upper limits. we
        # shall be arrange these two arrays in descending order. while doing the
        # actual calculation, we shall take a numerator/denominator pair, and
        # go from the lower value to the higher value, in effect doing a
        # "cancellation" of sorts.
        # first create the numerator
        my @numerator = sort { $b <=> $a } ($n1p, $np1, $n2p, $np2);

        # now to the real calculation!!!
        my $probability = 0;
        my $i;
        my $j;
        # we shall calculate for n11 = 0. thereafter we shall just multiply and
        # divide the result for 0 with correct numbers to obtain result for i,
        # i>0, i<=n11!! :o)
        my $lower_limit = $n11;
	my $upper_limit;
        if($freq1 > $freq2)
        {
	        $upper_limit = $freq2;
	}
	else
	{
		$upper_limit = $freq1;
	}
	my $n12 = $n1p-$n11;
        my $n21 = $np1-$n11;
	my $n22 = $n2p - $n21;
	while($n22 < 0 or $n12 < 0 or $n21 < 0)
	{
		$n11++;
		$n12 = $n1p - $n11;
		$n21 = $np1 - $n11;
	        $n22 = $n2p - $n21;
        }
        my @denominator = sort { $b <=> $a } ($npp, $n22, $n12, $n21, $n11);
        # now that we have our two arrays all nicely sorted and in place,
        # lets do the calculations!
        my @dLimits = ();
        my @nLimits = ();
        my $dIndex = 0;
        my $nIndex = 0;
        for ( $j = 0; $j < 4; $j ++ )
        {
	        if ( $numerator[$j] > $denominator[$j] )
		{
        		$nLimits[$nIndex] = $denominator[$j] + 1;
			$nLimits[$nIndex+1] = $numerator[$j];
        	$nIndex += 2;
        	}
	        elsif ( $denominator[$j] > $numerator[$j] )
	        {
    	        	$dLimits[$dIndex] = $numerator[$j] + 1;
	                $dLimits[$dIndex+1] = $denominator[$j];
	                $dIndex += 2;
                }
	}
	$dLimits[$dIndex] = 1;
	$dLimits[$dIndex+1] = $denominator[4];
        my $product = 1;
        while ( defined ( $nLimits[0] ) )
        {
	        while ( ( $product < 10000 ) && ( defined ( $nLimits[0] ) ) )
	        {
        	        $product *= $nLimits[0];
			$nLimits[0]++;
	                if ( $nLimits[0] > $nLimits[1] )
     	                {
		                shift @nLimits;
		                shift @nLimits;
		        }
	        }
                while ( $product > 1 )
	        {
	                $product /= $dLimits[0];
	                $dLimits[0]++;
	                if ( $dLimits[0] > $dLimits[1] )
        	        {
		                shift @dLimits;
		                shift @dLimits;
                        }
                }
        }
        while ( defined ( $dLimits[0] ) )
        {
	        $product /= $dLimits[0];
	        $dLimits[0]++;
  	        if ( $dLimits[0] > $dLimits[1] )
	        {
                shift @dLimits;
                shift @dLimits;
	        }
        }
	# $product now has the hypergeometric probability for n11 = 0. add it to
        # the cumulative probability
        $probability += $product;
        # now for the rest of n11's !!
        for ( $i = $n11+1; $i <=  $upper_limit; $i++ )
        {
	        $product *= $n12;
	        $n22++;
	        $product /= $n22;
	        $product *= $n21;
	        $n12--;
	        $n21--;
	        $product /= $i;
	
		# thats our new probability for n11 = i! :o)) cool eh? ;o))
	        # add it to the main probability! :o))

		$probability += $product; # !! :o)
        }
										        # thats abt it!
        return (1-$probability);

}

sub calculateDice
{
	shift;
	my ($freq, $freq1, $freq2, $totalBigrams) = @_;
	return (2 * $freq / ( $freq1 + $freq2 ));
}

sub calculateLL
{
	shift;
	my ($freq, $freq1, $freq2, $totalBigrams) = @_;
        my $n11 = $freq;       # pair freq
	my $n1p = $freq1;      # single freq of first word
        my $np1 = $freq2;      # single freq of second word
	my $n12 = $n1p - $n11;
        my $n21 = $np1 - $n11;
        my $np2 = $totalBigrams - $np1;
        my $n2p = $totalBigrams - $n1p;
        my $n22 = $np2 - $n12;
        my $npp = $totalBigrams;
	my $m11 = $n1p * $np1 / $npp;
        my $m12 = $n1p * $np2 / $npp;
        my $m21 = $n2p * $np1 / $npp;
        my $m22 = $n2p * $np2 / $npp;
        my $logLikelihood = 0;
        if ( $n11 ) { $logLikelihood += $n11 * log ( $n11 / $m11 ); }
        if ( $n12 ) { $logLikelihood += $n12 * log ( $n12 / $m12 ); }
        if ( $n21 ) { $logLikelihood += $n21 * log ( $n21 / $m21 ); }
        if ( $n22 ) { $logLikelihood += $n22 * log ( $n22 / $m22 ); }
        return ( 2 * $logLikelihood );
}	

sub calculateMI
{
	shift;
	my ($freq, $freq1, $freq2, $totalBigrams) = @_;
        my $temp = ( $freq / $freq1 ) / $freq2;
        $temp *= $totalBigrams;		        
	return ( log($temp) / log(2) );
}

sub calculateOdds
{
	shift;
	my ($freq, $freq1, $freq2, $totalBigrams) = @_;
	my $a = $freq;
	my $b = $freq1 - $a;
	my $c = $freq2 - $a;
	my $d = ($totalBigrams - $a - $b - $c);
	if(($b == 0) and ($c == 0))
	{
		return ($a*$d);
	}
	elsif($b ==0 and $c!=0)
	{
	        return((($a)*($d))/($c));
	}
        elsif($b!=0 and $c==0)
        {
        	return((($a)*($d))/($b));
	}
        else
        {
     		my $OR = ( ($a * $d) / ($b * $c) );
	        return($OR);
        }
}

sub calculateTscore
{
	shift;
	my ($freq, $freq1, $freq2, $totalBigrams) = @_;
	my $pairFreq =  $freq/$totalBigrams;
	my $word1Freq = $freq1/$totalBigrams;
        my $word2Freq = $freq2/$totalBigrams;
        my $numerator = $pairFreq - ($word1Freq * $word2Freq);
        my $denominator = sqrt(($pairFreq/$totalBigrams));
        return ( ( $numerator / $denominator ) );
}

sub createDB
{
	my $self=shift;
	my $db;
	$db=shift or $db="test.db";
	my $kbest=shift;
	my $temp;
	my %pal;
	my $result;
	my $palavras;
	my $cnt=1;
	my @lines;
	my @lines2;
	my $dbm = tie %pal ,"MLDBM", $db , O_CREAT|O_RDWR,0640 or die "$!";
 	
	for my $word(keys  %{$self->{'hashSourceWords'}})
	{
		$cnt++;
		$temp=$self->grep($word);
		$temp->calcStat("right fisher");
		$temp->rank();
		$result=$temp->printToString({kbest => $kbest});
		@lines=split(/\n/,$result);
		shift(@lines);
		my $count=0;
		@lines2=();
		while(my $tmp=shift(@lines))
		{
			push @lines2,$tmp;
			
			$count++;
		}
		$palavras->{$word}{'oco'}=$count;
		for my $linha(@lines2)
		{
			my @tok=split(/<>/,$linha);
			my @tok2=split(/\ /,$tok[2]);
			my $per=$tok2[1]*100;
			$palavras->{$word}{'trans'}{$tok[1]}=$per;
		}
		undef $temp;
	}
%pal=%{$palavras};

 

}
			    
		






1;
__END__
# Below is stub documentation for your module. You better edit it!

=head1 NAME

Lingua::BiTerm - Perl extension for extraction of bilingual terminology




=head1 SYNOPSIS

  use Lingua::BiTerm;
  
  $file1=shift;
  $file2=shift;
  
  $a=newKvec Lingua::BiTerm($file1,$file2);
  $a->calcStat;
  $a->rank;
  $a->printTofile("a.tmp");
  


=head1 DESCRIPTION

This module uses the B<Kvec> algorithm to extract words translation based on two paralel texts

=head2 METHODS

B<newKvec>

Creates a new instance of LinguaBiterm object. You can use it in 2 diferent ways:

With 2 parameters (the files you want to open):

	$a->new kvec($file1.$file2)


With 3 parameters if you want to open 2 files wiht extra parameters

	$a->new kvec({pieces	=> 45,
		      lcutOff => 5,
		      ucutOff => 1000
		      aligned => 1}, $file1, $file2);

C<pieces> - is the number of pieces you want to divide the texts.

C<lcutOff> - the words with a frequency below this value aren't used .

C<ucutOff> - the words with a frequency higher than this value aren't used.

C<aligned> - you should use this value if the texts you are using are aligned in some sort of way. It does not make sense to use this value and C<pieces> at the same time. The aligned files should use "\n$\n" as separator.

B<newFromFile>

This methods reads form a file the result of a previous call on newKvec.

	$a->newFromFile($file);

B<calcStat>

This method calculates the dependence between words  using the chosen statistic test.
		   
	$a->calcStat($test);

	$test can be:
			"right fisher" or       
		   	"log likelihood" or
		   	"dice" or
		   	"mutual information" or
		   	"odds ratio" or
		   	"t-score".

B<rank>

This method ranks the results from B<calcStat>

B<printToFile> 

Prints the result to file 

	$a->printToFile($outfile);

B<printToString>

Returns the result as a string

	$result=$a->printToString();

B<printStdOut>

Prints the reult to Standard Output.

B<grep>

Returns a new object, but only with the result of a list of words

	$b=$a->grep($word1,$word2,...,$wordn)

B<grepTest>

Returns a new object, but only the pairs with the result test greater or equal than the parameter.

	$b=$a->grepTest("0.99");

B<sum>

With this method you can "sum" the result of 2 kvec objects

	$a->new kvec($file1,$file2);
	$b->new kvec($file3,$file4);
	$a->sum($b);
	

B<filter>

this methos accepts as parameter a list of words to be removed from the pairs, you can choose to which of the texts you refer, the first or the second text.

	$a->filter($file,@words);

	$file should be 0 if you want to refer to the first text.
	$file should be 1 if you eant to refer to the second text.

B<createDB>

this method creates a different output from the result of calcstat, ti stores the result as an hashtable in
a DBM file, this allows a quicker search for word translation. 
this mehtods takes as arguments, the name of an otput file to store the result and a value that represents 
the number of translations that you want to keep. This function may take some minutes to run, depending on 
the size of the kvec file and the speed of your computer.

B<newFromDB>

this method reads a DBM file previously created by B<createDB>, it allows the search for word trnslation. 
but only with the B<grepDB> function, this function is the only one you can use with the DbM files.

B<grepDB>

this method performs search in DBM files with a quicker response that the B<grep> function in the kvec files.


this methods 
=head1 HISTORY

=over 8

=item 0.01

Original version; created by h2xs 1.21 with options

  -A
	-C
	-X
	-c
	-n
	kvec

=back


=head1 AUTHOR

Ted Pedersen, E<lt>tpederse@d.umn.eduE<gt>

Nitin Varma, E<lt>varm0003@d.umn.eduE<gt>

Bruno Martins, E<lt>bsm@natura.di.uminho.ptE<gt>

=head1 SEE ALSO

L<perl>.


Fung. P. & K. W. Church. (1994) "K-vec: A New Approach for Aligning Parallel
Texts." Proceedings from the 15th International Conference on Computational
Linguistics, Kyoto.

Bigram Statistics Package by Ted Pedersen & Satanjeev Banerjee.
L<http://www.d.umn.edu/~tpederse/code.html>

=cut
