#!/usr/bin/perl
#
# BNCweb: A user-friendly interface to the British National Corpus - Version 4.3
# Copyright (C) 2005-10 Hoffmann/Evert/Lehmann
#
# Updates and information available at http://www.bncweb.info
#
# This file is part of BNCweb.
# 
# BNCweb 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 3 of the License, or
# (at your option) any later version.
# 
# BNCweb 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, see <http://www.gnu.org/licenses/>.

#
# based on BNCweb Version 2.0:
# © 1996/2004 Lehmann/Hoffmann/Schneider
#

use lib "../lib_files";
use bncLibCQPXML;
use DBI;

#SETTINGS
$thisProg  = "keywords.pl";
$newQuery  = "BNCquery.pl";
$main      = "processQuery.pl";

$username = $ENV{'REMOTE_USER'};
	
unless (getParams($ENV{'QUERY_STRING'})) {
	barkFull("incomplete transmition of URL<BR>This problem is likely to occur in combination with proxy servers<BR>turn off your web-proxy and try again");
}

$theQuery= $ENV{'QUERY_STRING'};
$theQuery = "&" . $theQuery . "&";
$theInput = $theQuery;


# connect to mysql
$bncHandle = DBI->connect("DBI:mysql:$bwMYSQLtable:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd") or bark("Can't connect to mysql on $bwMYSQLhost at port: $bwMysqlPort <BR>" . $bncHandle::errstr);
$frequencyHandle = DBI->connect("DBI:mysql:$bwMYSQLfrequency:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd") or bark("Can't connect to mysql on $bwMYSQLhost at port: $bwMysqlPort <BR>" . $frequencyHandle::errstr);

($table1, $subcorpus1) = split(/##/, $params{table1});
($table2, $subcorpus2) = split(/##/, $params{table2});


if ($table1 eq $table2) {
	barkFull("The two frequency lists you have chosen are identical.");
}

$crlf = &linefeed();

# The following code is partially prepared for offering tag-restrictions
# This is not yet fully functional and has therefore not yet been made available
# SH - 16.7.2007

# if ($params{tag} ne "all") {
# 	$pos = $params{tag};
# 	$check=$params{tag}=~m/(ADJ|ADV|ART|CONJ|INTERJ|PREP|PRON|SUBST|VERB|UNC|STOP)/;
# 	if ($check) {
# 		$value=$1;
# 		$lemma_tag = 1;
# 		# for the display 
# 		$tagRestriction="any verb" if ($value eq "VERB");
# 		$tagRestriction="any noun" if ($value eq "SUBST");
# 		$tagRestriction="any adjective" if ($value eq "ADJ");
# 		$tagRestriction="any adverb" if ($value eq "ADV");
# 		$tagRestriction="any pronoun" if ($value eq "PRON");
# 		$tagRestriction="any preposition" if ($value eq "PREP");
# 		$tagRestriction="any conjunction" if ($value eq "CONJ");
# 		$tagRestriction="any article" if ($value eq "ART");
# 		$tagRestriction="any interjection" if ($value eq "INTERJ");
# 		$tagRestriction="any punctuation" if ($value eq "STOP");
# 		$tagRestriction="any unclear" if ($value eq "UNC");
# 		$db_selector = "G";
# 	} else {
# 		$tagRestriction = $pos;
# 		$db_selector = "T";
# 	}
# } else {
	$tagRegexp = "";
	$tagRestriction="";
	$db_selector = "";
# }

if ($params{threshold} eq "5") {
	$threshold = "3.84"
} elsif ($params{threshold} eq "1") {
	$threshold = "6.63"
} elsif ($params{threshold} eq "0.1") {
	$threshold = "10.83"
} elsif ($params{threshold} eq "0.01") {
	$threshold = "15.13"
} else {
	$threshold = "0"
}


$tagRegexp = "";

if ($params{compare} eq "word") {
	if ($table1=~m/_\d+/) {
		$wordFreq1="$bwMYSQLfrequency.allWords${db_selector}_$table1";
		$tagRegexp = "and $bwMYSQLfrequency.allWords${db_selector}_$table1.word regexp \'_$pos\$\' " if ($db_selector);
	} else {
		$wordFreq1="$bwMYSQLtable.${table1}${db_selector}";
		$tagRegexp = "and $bwMYSQLtable.${table1}${db_selector}.word regexp \'_$pos\$\' " if ($db_selector);
	}
	if ($table2=~m/\d/) {
		$wordFreq2="$bwMYSQLfrequency.allWords${db_selector}_$table2";
	} else {
		$wordFreq2="$bwMYSQLtable.${table2}${db_selector}";
	}
	
} elsif ($params{compare} eq "wordtag") {
	if ($table1=~m/_\d/) {
		$wordFreq1="$bwMYSQLfrequency.allWordsT_$table1";
	} else {
		if ($table1 eq "allWords") {
			$wordFreq1="$bwMYSQLtable.allWordsT";
		} elsif ($table1 eq "allWordsS") {
			$wordFreq1="$bwMYSQLtable.allWordsTS";
		} else {
			$wordFreq1="$bwMYSQLtable.allWordsTW";
		}
	}
	if ($table2=~m/_\d/) {
		$wordFreq2="$bwMYSQLfrequency.allWordsT_$table2";
	} else {
		if ($table2 eq "allWords") {
			$wordFreq2="$bwMYSQLtable.allWordsT";
		} elsif ($table2 eq "allWordsS") {
			$wordFreq2="$bwMYSQLtable.allWordsTS";
		} else {
			$wordFreq2="$bwMYSQLtable.allWordsTW";
		}
	}
	
} elsif ($params{compare} eq "lemma") {
	if ($table1=~m/_\d/) {
		$wordFreq1="$bwMYSQLfrequency.allLemma_$table1";
	} else {
		if ($table1 eq "allWords") {
			$wordFreq1="$bwMYSQLtable.allLemma";
		} elsif ($table1 eq "allWordsS") {
			$wordFreq1="$bwMYSQLtable.allLemmaS";
		} else {
			$wordFreq1="$bwMYSQLtable.allLemmaW";
		}
	}
	if ($table2=~m/_\d/) {
		$wordFreq2="$bwMYSQLfrequency.allLemma_$table2";
	} else {
		if ($table2 eq "allWords") {
			$wordFreq2="$bwMYSQLtable.allLemma";
		} elsif ($table2 eq "allWordsS") {
			$wordFreq2="$bwMYSQLtable.allLemmaS";
		} else {
			$wordFreq2="$bwMYSQLtable.allLemmaW";
		}
	}
	
}

$subcorpus1 = "Whole BNC" if ($subcorpus1 eq "all");
$subcorpus1 = "Written component" if ($subcorpus1 eq "1");
$subcorpus1 = "Spoken component" if ($subcorpus1 eq "2");
$subcorpus2 = "Whole BNC" if ($subcorpus2 eq "all");
$subcorpus2 = "Written component" if ($subcorpus2 eq "1");
$subcorpus2 = "Spoken component" if ($subcorpus2 eq "2");

# update timestamp in cache
$theTime = int(time);
if ($table1=~m/\d/)  {
	$sqlQuery = "UPDATE frequencyLists set time_of_creation=$theTime where theName='$table1'";
	$bncHandle->do($sqlQuery) or bark("Can't $sqlQuery: " . $bncHandle::errstr);
}
if ($table2=~m/\d/)  {
	$sqlQuery = "UPDATE frequencyLists set time_of_creation=$theTime where theName='$table2'";
	$bncHandle->do($sqlQuery) or bark("Can't $sqlQuery: " . $bncHandle::errstr);
}



$sqlQuery = "SELECT sum(freq) FROM $wordFreq1";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery: " . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: " . $sth::errstr);
@rowArray=$sth->fetchrow_array;
$totalTable1=$rowArray[0];

$sqlQuery = "SELECT sum(freq) FROM $wordFreq2";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery: " . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: " . $sth::errstr);
@rowArray=$sth->fetchrow_array;
$totalTable2=$rowArray[0];


if ($params{compare} eq "lemma") {
	$wordOrLemma = "Lemma";
} else {
	$wordOrLemma = "Word";
}

if ($params{theMethod} eq "Calculate keywords!") {
	if ($params{statistics} eq "LL") {
	
		$sqlQuery = "select $wordFreq1.$wordOrLemma, $wordFreq1.freq as freq1, $wordFreq2.freq as freq2, 
		($totalTable1 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)) as E1, 
		($totalTable2 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)) as E2, 
		2 * (($wordFreq1.freq * log($wordFreq1.freq / ($totalTable1 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)))) + 
		($wordFreq2.freq * log($wordFreq2.freq / ($totalTable2 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2))))) as theValue 
		from $wordFreq1, $wordFreq2 where $wordFreq1.$wordOrLemma = $wordFreq2.$wordOrLemma and $wordFreq1.freq >= $params{f1} and $wordFreq2.freq >= $params{f2} having theValue >= $threshold order by theValue desc;
		";
		
		$displayType = "LL-value";
	} elsif ($params{statistics} eq "MI") {
		# not yet implemented
	} else {
		$sqlQuery = "select $wordFreq1.$wordOrLemma, $wordFreq1.freq as freq1, $wordFreq2.freq as freq2, 
		($totalTable1 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)) as E1, 
		($totalTable2 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)) as E2, 
	
		
		(POW(($wordFreq1.freq - ($totalTable1 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2))), 2)
		/ ($totalTable1 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)))
		
		+
		
		(POW(($wordFreq2.freq - ($totalTable2 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2))), 2)
		/ ($totalTable2 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)))
		
		+
		
		(POW((($totalTable1 - $wordFreq1.freq) - ($totalTable1 - ($totalTable1 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)))), 2)
		/ ($totalTable1 - ($totalTable1 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2))))
		
		
		+
		
		(POW((($totalTable2 - $wordFreq2.freq) - ($totalTable2 - ($totalTable2 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2)))), 2)
		/ ($totalTable2 - ($totalTable2 * ($wordFreq1.freq + $wordFreq2.freq) / ($totalTable1 + $totalTable2))))
		
		as theValue
		
		from $wordFreq1, $wordFreq2 where $wordFreq1.$wordOrLemma = $wordFreq2.$wordOrLemma and $wordFreq1.freq >= $params{f1} and $wordFreq2.freq >= $params{f2} having theValue >= $threshold order by theValue desc;
		";
		$displayType = "Chi-square value";
	}
	$theTitle = "Keywords for '$subcorpus1' and '$subcorpus2'";
} elsif ($params{theMethod} eq "Compare lists!") {
	if ($params{empty} eq "f2") {
		$sqlQuery = "SELECT * FROM $wordFreq1 left join $wordFreq2 on $wordFreq1.$wordOrLemma = $wordFreq2.$wordOrLemma where $wordFreq2.freq is NULL order by $wordFreq1.freq desc";
		$theTitle = "Items which only occur in '$subcorpus1'";
	} else {
		$sqlQuery = "SELECT * FROM $wordFreq2 left join $wordFreq1 on $wordFreq2.$wordOrLemma = $wordFreq1.$wordOrLemma where $wordFreq1.freq is NULL order by $wordFreq2.freq desc";
		$theTitle = "Items which only occur in '$subcorpus2'";
	}
}

$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery:" . $sth::errstr);
$countFRes=$sth->rows;
$resArrayResult=$sth->fetchall_arrayref;


print "Content-Type: text/text\n";
print "Content-disposition: attachment; filename=frequency_list.txt\n\n";

print "$theTitle$crlf";
print "__________________$crlf$crlf";


$theLines="";
for $k ( 0 .. ($#{$resArrayResult}) ) {
	$theWord=$resArrayResult->[$k][0];
	$theFrequency1=$resArrayResult->[$k][1];
	$theFrequency2=$resArrayResult->[$k][2];
	$E1=$resArrayResult->[$k][3];
	$E2=$resArrayResult->[$k][4];
	$LL=$resArrayResult->[$k][5];
	
	if ($theFrequency1 > $E1) {
		$plusMinus = "+";
	} else {
		$plusMinus = "-";
	}
	
	if ($params{compare} eq "wordtag") {
		$theWord=~m/_([A-Z0-2]{3}(-[A-Z0-2]{3})?)\Z/;
		$theWord=$`;
		$theTag=$&;
		$theWord=lc($theWord);		
		$theWord = $theWord . $theTag;
	} elsif ($params{compare} eq "lemma") {
		$theWord=~m/_([A-Z]+)\Z/;
		$theWord= $`;
		$theTag=$&;
		$theWord=lc($theWord);	
		$theWord = $theWord . $theTag;
	} else {
		$theWord = lc($theWord);
		# do nothing
	}
	
	$theWord=&output2($theWord);
	
	$theFrequency1=&makeDecimals($theFrequency1);
	$theFrequency2=&makeDecimals($theFrequency2);
	
	$LL = int(($LL * 100) + 0.5)/ 100;
	
	$lineIndicator = $k + 1;
	if ($params{theMethod} ne "Compare lists!") {
		print "$lineIndicator\t$theWord\t$theFrequency1\t$theFrequency2\t$plusMinus\t$LL$crlf";
	} else {
		print "$lineIndicator\t$theWord\t$theFrequency1$crlf";
	}
}

exit(0);
