#!/usr/bin/env perl
#Created by Jinqiu Yang on Dec 2011, last modifed on Jan 11 2012.
#This program is intended to process word pairs extracted by sentSimilarity.pl via the following steps:
#1. Remove all words from stoplist in wordpairs, e.g. a, an, the;
#2. Remove duplicate word pairs, and present the word pairs by decreasing duplicate frequency;
#3. Remove phrases with more than 3 words;
#4. Remove stemming words;
#Input: xxx.csv -- output from sentSimilarity.pl
#output: xxx.csv -- process input
#log info: all in debug.txt  
use strict;
use Lingua::Stem;

open(my $in, "<", $ARGV[0] ) or die "can't open #!\n";
open(OUT, ">", $ARGV[1] ) or die "can't open #!\n";
open(Cluster, ">", $ARGV[2] ) or die "can't open $ARGV[2]!\n";
open(Debug, ">", "$ARGV[1].debug" ) or die "can't open debug.txt";
open(my $stoplist, "<", "stoplist.txt") or die "can't open stoplist.txt";
open(Dic, "<", "myDictionary.txt.sorted" ) or die "can't open dictionary";
my %pairs;
my %idfScores;
my %support;

my @words =<$in>;
my $num = @words;
my @stoplist = <$stoplist>;
my $numOfLongWord=0;

#process my dictionary
my @dics = <Dic>;
my %dic_hash;
chomp(@dics);
nextdic: foreach (@dics) {
	my @tmp = split /\s+/, $_;
	next nextdic if $tmp[0] eq $tmp[1];
	$dic_hash{$tmp[0]} = $tmp[1];
}


chomp(@stoplist);
#foreach (@stoplist) {
#	print Debug "STOPLIST: ****$_\n";
#}
print Debug "num of pairs from file $ARGV[0]: $num\n";
{
#start of the block(to delete @words
nextpair: foreach my $word (@words) {
	my @split = split /,/,$word;
	print Debug "$word\n" if ($split[0] == -1);
	$split[1] =~ s/^\s*//;
	$split[1] =~ s/\s*$//;
	$split[2] =~ s/^\s*//;
	$split[2] =~ s/\s*$//;
	my $word1 = $split[1];
	my $word2 = $split[2];
	$word1 =~ tr/A-Z/a-z/;
	$word2 =~ tr/A-Z/a-z/;
	next nextpair if $word1 eq $word2;
	#next nextpair if $word1 =~ /$word2/;
	#elimate stemming pairs
	next nextpair if $word1 eq '' or $word2 eq '';
	next nextpair if $word1 =~ /^\s+$/ or $word2 =~ /^\s+$/;
	my @word1_space = split /\s+/, $word1;
	my @word2_space = split /\s+/, $word2;
	my $num1 = @word1_space;
	my $num2 = @word2_space;
	if( $num1 > 2 or $num2 >2 or $num1 != $num2){
		$numOfLongWord++;
		print Debug "Multiple Word ***: $word1,$word2\n";
		next nextpair;
	}


#remove stoplist words from word pairs
	#$word1 = $split[1];
	#$word2 = $split[2];
	#print "$word1,$word2\n";
	foreach my $stop (@stoplist) {
		if ($num1==1){
			if ($word1 eq $stop or $word2 eq $stop){
				print Debug "Stoplist ***:$word1,$word2\n";	
				next nextpair;
			}
		}
		$word1 =~ s/^$stop\s//g;
		$word1 =~ s/\s$stop$//g;
		$word2 =~ s/^$stop\s//g;#TODO why this would probabaly introduce two words without space?
		$word2 =~ s/\s$stop$//g;
		my @words1_array = split /\s+/, $word1;
		my @words2_array = split /\s+/, $word2;
		next nextpair if @words1_array != @words2_array;
	}
#here to break a,b and A,B pairs to a,A and b,B
#	if ($num1 == 2) {
#		my @word1_array = split /\s+/, $word1;
#		my @word2_array = split /\s+/, $word2;
#		push @words,"-1,$word1_array[0],$word2_array[0],$split[3],$split[4]";
#		push @words,"-2,$word1_array[1],$word2_array[1],$split[3],$split[4]"; 
#		next nextpair;
#	}

#end of remove stoplist words
	#print Debug "$word1, $word2, $num1, $num2\n";
#TODO add normalize process
	if (exists $dic_hash{$word1} and exists $dic_hash{$word2}) {
		$word1 = $dic_hash{$word1};
		$word2 = $dic_hash{$word2};
	}
	my $string1= "$word1,$word2";
	my $string2= "$word2,$word1";
	if (exists $pairs{$string1}){
		my $comments = $pairs{$string1};
		$comments = "$comments,$split[3],$split[4]";
		chomp($comments);
		$pairs{$string1}=$comments;

        if (exists $idfScores{$string1} and exists $support{$string1}) {
            my $score = $idfScores{$string1};
            my $su = $support{$string1};
            $idfScores{$string1} = $score + $split[-1];
            $support{$string1} = $su + 1;
        }
	} elsif (exists $pairs{$string2}) {
		my $comments = $pairs{$string2};
		$comments = "$comments,$split[3],$split[4]";
		$pairs{$string2} = $comments;

        if (exists $idfScores{$string2} and exists $support{$string2}) {
            my $score = $idfScores{$string2};
            my $su = $support{$string2};
            $idfScores{$string2} = $score + $split[-1];
            $support{$string2} = $su + 1;
        }
	} else {
		$pairs{$string1} = "$split[3],$split[4]";
        my $score = $idfScores{$string1};
        $idfScores{$string1} = $score + $split[-1];
        $support{$string1} = 1;
	}


#end of foreach loop for all word pairs
}
#end of block(to delete @words)
}
my $numOfHash = keys %pairs;
print Debug "num of elements in hash is: $numOfHash.\n";
#sort hash according to values in hashes
#now no need to sort the word pairs according to occurrences
#my @sortedPairs = sort {$pairs{$b} <=> $pairs{$a} } keys %pairs;
loop: foreach (keys %pairs) {
#delete pairs if either phrase is more than 2 words
	my @pair = split /\s*,\s*/, $_;
	$pair[0] =~ s/^\s*//;
	$pair[1] =~ s/\s*$//;
	#print Debug "$pair[0],$pair[1]\n";
	my @words1 = split /\s/, $pair[0];
	my @words2 = split /\s/, $pair[1];
#	print OUT "$_\t$pairs{$_}\n";

#in this one way of processing, adding analysis of stemming words
	my $stemmer = Lingua::Stem->new( -locale => 'EN-UK');
	my $words1_ref = $stemmer->stem(@words1);
	my $words2_ref = $stemmer->stem(@words2);
	if ($words1_ref->[0] eq $words2_ref->[0] ) {
		print Debug "STEMMING: **** $_\n";
	}
	next loop if $words1_ref->[0] eq $words2_ref->[0];
    my $count = $support{$_};
    my $averageIdf = $idfScores{$_}/$count;
	print OUT "$pair[0],$pair[1],$averageIdf,$count,$pairs{$_}\n";
}
print "num of long words deleted: $numOfLongWord\n";
close OUT;#close the xxx_order.csv file so $in2 can read from it

open (my $in2, "<", $ARGV[1]) or die "can't take $ARGV[1] as input!";
my @pairs2 = <$in2>; 
chomp(@pairs2);
#cluster word pairs
my %clusterHash; #this is a hash of hash, key is word, value hash is a list of words
my %expandHash;
my $td = 1;
nextpair: foreach (@pairs2) {
	my @splits = split /\,/, $_;
	#print "$_\n";
	my $w1 = $splits[0];
	my $w2 = $splits[1];
	#next nextpair if $w1 eq '' or $w2 eq '';	
	#print "$w1,$w2\n";
	$clusterHash{$w1}{$w2} = 0;
	$clusterHash{$w2}{$w1} = 0;	
}
my @clusters = keys %clusterHash;
my $numOfCluster = @clusters;
foreach (@clusters) {
	for (my $count = 0; $count < $td; $count++){
		my @all_words = keys %{ $clusterHash{$_} };
		foreach my $expand_w (@all_words){
			my @seeds = keys %{ $clusterHash{$expand_w} };
			foreach my $seed(@seeds) {
				$clusterHash{$_}{$seed} = 0;
#				print "$_: add $seed by $expand_w\n";
			}
		}
	}
}



#end of cluster word pairs
print "Total num of clusters is $numOfCluster\n";

#print out words with same No.Cluster and corresponding comments
foreach my $word (@clusters) {
	my @all = keys %{ $clusterHash{$word} };
	my @all_expand = keys %{ $expandHash{$word}};
	my $num = @all+@all_expand;
	print Cluster "$word:$num\t";
	foreach (@all) {
		print Cluster "$_,";
	}
	foreach (@all_expand) {
		print Cluster "$_,";
	}
	print Cluster "\n";
}


close Cluster;
close Debug;
close OUT;
close $in;
close $in2;

