#!/usr/bin/env perl
##############################################################
##  Script     : sentSimilarity.pl 
##  Author     : Jinqiu Yang
##  Date       : 2011 December
##  Last Edited: 30/08/2012
##  Description: This script processes a list of sentences and produces semantically related words mined from these sentences.
###############################################################
## ## Syntax: 
##  sentSimilarity.pl -i input file (a list of sentences)
##                    -idf tfidf file
##                    -out output file
##                    -stoplist stoplist file (e.g., a, this, the etc), default is stoplist.txt
##                    -thres threshold (default is 0.6)
###############################################################
use Text::Similarity::Overlaps;
use Text::OverlapFinder;
use MyLibrary::Process;
use Getopt::Long;
use strict;
my $in = '';
my $idf = '';
my $out = '';
my $debug = 'debug.txt';
my $stoplist = 'stoplist.txt';

#overlap over threshold will be adopted, for comment, value = 0.65, refer to MSR'12 paper for detailed configurations
my $threshold = 0.6;
GetOptions("i=s" => \$in,
	   "idf=s" => \$idf,
           "out=s" => \$out,
	   "stoplist=s" => \$stoplist,
	   "thres=s" => \$threshold
		);

open (IN, "<", $in) or die "Can't open file $in\n";
open (OUT, ">", $out) or die "Can't open file $out\n";
open (Stop, "<", $stoplist) or die "can't open file stoplist.txt!";
open (Debug, ">", $debug) or die "can't open file group.debug";#for word baskets information
print Debug "This is for $in group info\n";

my $debug = 0;#enable/disable verbose debug information
my @stops = <Stop>;
close Stop;
my @sentences;
my $num=0;
my $wordNum=0;
my %idf_hash;

#######################################################
#A set of configurations to be set for your own purpose
#######################################################
my $gap = 0; #gap of length between two sentences in a pair, refer to MSR'12
my $longest=10;#for comment, value = 10
my $shortest=4;#for comment, value = 5
my %wordToArray;#hash, key is word, value is list of indexes of comments which contain the word
my %compareRecord;#to record the comparisions between comments->index1,index2
my %sentFile;#TODO add file info along with output
my %thres_map = (
	id => 0.5,
	sentence => 0.70,
);
#input idf data and put in hash if_hash with key=word and value=idf
my $cc = 1; #this flag to enable/disable idf, make sure you provide idf file if $cc = 1
######################################################
if ($in =~ /\.sent$/) { #if input is .sent (comment and identifier file)
	$threshold = 0.60;
	$shortest = 2;
	$gap = 2;
	$cc = 1;
}

if ($cc == 1) {
#get tf-df input values
	open (my $idf, "<", $idf) or die "can't open file $idf with sentence analysis!";
	my @lines = <$idf>;
	foreach (@lines) {
		my @tmp = split /\s*\:\s*/, $_;
		$idf_hash{$tmp[0]}=$tmp[1];
	}
}

#this loop is to process the input lines by skipping lines with httpd links, <..filename>, and braclets
loop: while (my $line = <IN>) {
	next loop if skip($line); #function skip() is in 
	chomp($line);
	my @subsent = split /\,/, $line;#split the comment sentence by comma
	inloop: foreach my $sub (@subsent){
			$sub = cleanSentence($sub);
			my @temp = split /\s+/,$sub; 
			next inloop if @temp > $longest;
			next inloop if @temp < $shortest;
			push(@sentences,$sub);
		}
}
close IN;

#delete duplicate comment sentences and print # before and after
{
print "num of comments: ".@sentences."\n";
my %comb;
@comb{@sentences} = ();
@sentences = sort keys %comb;
print "num of comments after deleting duplicate ones: ".@sentences."\n";
}

wordIndex();#group the comments into word baskets

#now comes to the algorithm as to find overlaps between two sentences
my $numGroups = keys(%wordToArray);
my $currentGroup=1;
print "num of groups divided by words: ".$numGroups."\n";
nextgroup: foreach my $groupWord (keys %wordToArray){#start the loop of comparing comments in every basket
	my @lines = keys($wordToArray{$groupWord});#get the list of indexes in one basket
	my $tmp_num = @lines;#number of sentences in every basket
	$currentGroup++;
	if ($tmp_num > 1000 or $tmp_num < 2){#jump to next group if this one is too large or too small
		print Debug "$currentGroup\t$groupWord\t$tmp_num\n";
		next nextgroup;
	}	
	print Debug "*** $currentGroup\t$groupWord\t$tmp_num\n";
	for (my $index1 = 0; $index1 < @lines; $index1++){#loop of starting from the first index
	badscore: for (my $index2 = $index1+1; $index2 < @lines; $index2++) {#start from the index+1
			my $line1 = $lines[$index1];
			my $line2 = $lines[$index2];
			#next badscore if exists $compareRecord{"$line1,$line2"} or exists $compareRecord{"$line2,$line1"};
			if ($line1 < $line2) {
				next badscore if exists $compareRecord{$line1}{$line2};
				$compareRecord{$line1}{$line2} = 1;
			} else {
				next badscore if exists $compareRecord{$line2}{$line1};
				$compareRecord{$line2}{$line1} = 1;
			}
			my $string1; my $string2;
			my $string1_copy; my $string2_copy;
			if (length($sentences[$line1]) < length($sentences[$line2])) {
				$string1 = $sentences[$line1];#string1 is always the shorter string
				$string2 = $sentences[$line2];
			}
			else {
				$string1 = $sentences[$line2];
				$string2 = $sentences[$line1];
			}
			$string1 =~ s/^\s+//;
			$string1 =~ s/\s+$//;
			$string2 =~ s/^\s+//;
			$string2 =~ s/\s+$//; 
			next badscore if $string1 eq $string2;
			my @words_string1 = split /\s+/, $string1;
			my @words_string2 = split /\s+/, $string2;
			next badscore if @words_string1-@words_string2> $gap or @words_string2 - @words_string1> $gap;
			$time++;
		#next badscore if $score/@words < $threshold;
#extract corresponding word pairs from two strings
#use Text::OverlapFinder module and store overlap words
#Basically, the algorithm works as: calculate index for every corresponding words and make two together
			my $finder = Text::OverlapFinder->new;
			defined $finder or die "Construction of Text::OverlapFinder failed";
#overlaps is a hash of references to the overlaps found
#len1 and len2 are the lengths of the strings in terms of words
			$string1_copy = $string1;
			$string2_copy = $string2;
			$string1 =~ tr/A-Z/a-z/;
			$string2 =~ tr/A-Z/a-z/;	
			my ($overlaps, $len1, $len2) = $finder->getOverlaps ($string1, $string2);
			my $start_1=0;
			my $end_1=0;
			my $start_2=0;
			my $end_2=0; 
#sort keys %$overlaps by increasing index in string1
			my %myoverlap;# a hash for overlap and index in string2
			my %anotherOverlap;# a hash for overlap and index in string1
			my $overlap_count = 0;
			my $overlap_score =0;
			foreach my $overlap (keys %$overlaps) {
				$myoverlap{$overlap} = rindex($string2, $overlap);
				$anotherOverlap{$overlap} = rindex($string1, $overlap);
				my @overlap_words = split /\s+/, $overlap;
				$overlap_count += @overlap_words;
				if ($cc==1) {
					$overlap_score += score(\@overlap_words);
				}
			}
#check the ratio satisfies
			my $short;
			my $short_score=0;
			my $long_score=0;
			if (@words_string1 < @words_string2) {
				$short = @words_string1;	
				$short_score = score(\@words_string1);
				$long_score = score(\@words_string2);
			} else {
				$short = @words_string2;
				$short_score = score(\@words_string2);
				$long_score = score(\@words_string1);
			}
			next badscore if $short == 0;
			my $ratio=$overlap_count/$short;
			if ($cc=1) {
				next badscore if $short_score == 0 or $long_score == 0;
				$ratio = 2*$overlap_score/($short_score+$long_score);
			}
		    #print "$ratio\t$string1\t$string2\n";
			next badscore if $ratio < $threshold;

			$num++;
			print Debug "num of word pairs: ".$num."\n" if $debug ==1;#actually num of qualified sentence pairs
#sort keys of two hashes according to their index in string1 and string2
			my @overlap_keys = sort {$myoverlap{$a} <=> $myoverlap{$b}} keys %myoverlap;
			my @anotherOverlap_keys = sort {$anotherOverlap{$a} <=> $anotherOverlap{$b}} keys %anotherOverlap;
#check if indexes of overlaps in string1 and string2 actually correspond
			for (my $count = 0; $count < @overlap_keys; $count++) {
				next badscore if $overlap_keys[$count] ne $anotherOverlap_keys[$count];
			}

#print out corresponding word pairs in string1 and string2
			nexttoken: foreach my $overlap (sort {$myoverlap{$a} <=> $myoverlap{$b}} keys %myoverlap ) {
#					print "Overlap: $overlap\n";
					$end_1 = rindex($string1, $overlap);
					$end_2 = rindex($string2, $overlap);
					if ($start_1 == $end_1 or $start_2 == $end_2) {
					$start_1 = $end_1 + length($overlap)+1;
					$start_2 = $end_2 + length($overlap)+1;
					next nexttoken;
					}
					#print "$start_1:$end_1\t$start_2:$end_2\n";
					my $substr1 = substr $string1_copy, $start_1, $end_1-$start_1-1;
					my $substr2 = substr $string2_copy, $start_2, $end_2-$start_2-1;
					#print "substr: $substr1,$end_1,$substr2,$end_2\n";
					$substr1 =~ s/\s*/ /;
					$substr2 =~ s/\s*/ /;
					if (length($substr1)==0 or length($substr2)==0 or $substr1 eq " " or $substr2 eq " ") {					
						$start_1 = $end_1 + length($overlap);					
						$start_2 = $end_2 + length($overlap);
						next nexttoken;
					}

					$wordNum++;
					print OUT "$wordNum,$substr1,$substr2,$string1,$string2, $ratio\n";
					$start_1 = $end_1 + length($overlap);
					$start_2 = $end_2 + length($overlap);
	}	
#print out the last overlap to the end of the string
					if ( $start_1 != length($string1) and $start_2 != length($string2)){
						my $substr1 = substr $string1_copy, $start_1;
						my $substr2 = substr $string2_copy, $start_2;
	#					print "$string1_copy:$start_1\t$string2_copy:$start_2\n";
						$substr1 =~ s/\s*//; $substr2 =~ s/\s*//;
						if ($substr1 ne "" and $substr2 ne "") {
							$wordNum++;
							print OUT "$wordNum,$substr1,$substr2,$string1,$string2, $ratio\n";
						}
					}	
#print out two strings and measure of similarity
		
		}#end of loop for second index
	}#end of loop for first index
	delete $wordToArray{$groupWord};
}#end of loop where compare comments in every basket
print "total num of comparisoon: $time\n";
print "Total num of word pairs after sentSimilarity.pl: $wordNum\n";
close OUT;
close Debug;
#foreach my $compare (keys %compareRecord) {
#	print $compare."\n";
#}
#construct word and array of sentence indexes mapping
sub wordIndex {
	my @stoplist;
	my %stophash;
	open (my $stopwords, "<", "stoplist.txt") or die "Can't open $!";
	@stoplist = <$stopwords>;
	close $stopwords;
	foreach (@stoplist) {
		chomp($_);
		$stophash{$_}=1;
	}
	for(my $count = 0; $count < @sentences; $count++) {
	#	print $_."\n";
		my @words = split /\s+/, $sentences[$count];
		nextword: foreach my $word (@words) { 
			$word =~ tr/A-Z/a-z/;
			next nextword if exists $stophash{$word};
			#check if curent word is already a key in wordToArray hash, if it's in
			#it, append the index of the sentence to the array of the key; 
			#otherwise, add a new pair <key, array> to the wordToArray hash
			if (exists $wordToArray{$word}) {
				next nextword if exists $wordToArray{$word}{$count};  
				$wordToArray{$word}{$count} = 1;
			} else {
				$wordToArray{$word} = {$count => 1};
			}
		}
	}
	#print word and arrays
	foreach my $family (keys %wordToArray) {
		if (keys(%{$wordToArray{$family}}) > 1) {
		print Debug "$family: ".keys(%{$wordToArray{$family}})."\n" if $debug == 1;
		}
	}
}

sub score {
	my $ref = shift;
	my $score;
	foreach my $word(@{ $ref }) {
		$word =~ s/^\s+//;
		$word =~ s/\s+$//;
		$word =~ tr/A-Z/a-z/;
		$score += $idf_hash{$word};	
		
	}	
	return $score;
}
