#!/usr/bin/perl
use strict;
use warnings;

=head1 task1.pl

Skript pro reseni ukolu cislo 1.

=head2 Pouziti

./task1.pl file

=cut

=head2 TextInfo

Trida s informacemi o vstupnim textu. 

=cut
package TextInfo;
my $class = { 
	chars => {},
	words => {},
	wordProbs => {}, 
	wordCondCounts => {}, 
	wordCondProbs => {},
	bigramProbs => {}, 
};

sub new { 
	my $self = {};
	
	$self->{chars} = {};
	$self->{words} = {};
	$self->{wordProbs} = {};
	$self->{wordCondCounts} = {};
	$self->{wordCondProbs} = {};
	$self->{bigramProbs} = {};
	
	bless($self);
	return ($self);
}

package Main;

srand ( time ^ $$ );

# map of all words + counts
our @wordsAr;

# map of all chars + counts
our @charsAr;

our %wordLengths;

# array representing inputLines
our @inputLines;

our $wordCount = 0;
our $charCount = 0;

our @messUpLevels = reverse( .1, .05, .01, .001, .0001, .00001, 0  );

our $RUN_COUNT = 10;

our %wordCondCounts;

our %wordProbs;
our %wordCondProbs;

our $LOG_2 = log(2);

sub log2
{
	my $n = shift;
	return log($n) / $LOG_2;
}

=head2 printInputStats($info)

Vypise informace o vstupnim souboru $info.

=cut
sub printInputStats
{
	my $info = shift;
	
	my (@wAr, %wH);

	my $words = $info->{words};
	my $chars = $info->{chars};

	my @swKeys = sort { $$words{$b} <=> $$words{$a} } keys %$words;
	my @scKeys = sort { $$chars{$b} <=> $$chars{$a} } keys %$chars;
	
	# prumerna delka slova
	my $uniqueWordLength = 0;
	my $uniqueCharsInWord = 0;
	for my $w (keys %$words) { 
		$uniqueWordLength += length($w);
		@wAr = split(/ */, $w);
		%wH = map { $_ => 1 } @wAr;
		$uniqueCharsInWord += scalar (keys %wH);	
	}
	
	# pocet unikatnich slov	
	my $uniqueWordCount = scalar @swKeys;
	

	# zakladni statistiky
	print "\n=======================\n";
	print "Basic Stats\n";

	printf("%-22s%d\n", "Word count:", $wordCount);
	printf("%-22s%d\n", "Char count:", $charCount);	
	printf("%-22s%d\n", "Unique word count:", $uniqueWordCount);
	printf("%-22s%d\n", "Unique char count:", scalar @scKeys);
	printf("%-22s%2.3f\n", "Chars per word: ", 1.0 * $charCount / $wordCount);
	printf("%-22s%2.3f\n", "Avg. word length: ", 1.0 * $uniqueWordLength / $uniqueWordCount);
	printf("%-22s%2.3f\n", "Avg. unique chars in word: ", 1.0 * $uniqueCharsInWord / $uniqueWordCount);

	my %wordCount;
	my %occurenceCount;
	
	# 20 nejcastejsich slov
	print "\n=======================\n";
	print "Top 20 words\n";
	print "Word\tcount\t%\n\n";

	for my $i ( 0 .. $#swKeys ) {
		if ( $i < 20 ) { 
			printf("%-17s\t%d\t%2.3f%%\n", $swKeys[$i], $$words{$swKeys[$i]}, (100.0 * $$words{$swKeys[$i]}) / $wordCount);
		}
		$occurenceCount{$$words{$swKeys[$i]}}++;
	}

	# vyskyt slov
	print "\n=======================\n";
	print "Word occurrence\n";
	print "Occur\tcount\t%\n\n";

	my @socKeys = sort { $occurenceCount{$b}<=> $occurenceCount{$a} } keys %occurenceCount;
	for my $i ( 0 .. $#socKeys ) { 
		my $k = $socKeys[$i];
		printf("%2d\t%5d\t%2.3f%%\n", $k, $occurenceCount{$k}, (100.0 * $occurenceCount{$k}) / $uniqueWordCount );
	}
	
	# delka slov
	print "\n=======================\n";
	print "Word lengths\n";
	print "Length\tcount\n\n";

	my @slKeys = sort { $wordLengths{$b} <=> $wordLengths{$a} } keys %wordLengths;
	for my $i ( 0 .. $#slKeys ) { 
		my $k = $slKeys[$i];
		printf("%2d\t%8d\n", $k, $wordLengths{$k});
	}

	# 20 nejcastejsich pismen
	print "\n=======================\n";
	print "Top 20 chars\n";
	print "Char\tcount\t%\n\n";

	for my $i ( 0 .. $#scKeys ) {
		if ( $i < 20 ) {
			printf("%s\t%8d\t%2.3f%%\n", $scKeys[$i], $$chars{$scKeys[$i]}, (100.0 * $$chars{$scKeys[$i]}) / $charCount);
		}
	}
	
}

=head2 computeProbabilities($info)

Spocita pravdepodobnosi bigramu na vstupnim souboru $info. 

=cut
sub computeProbabilities
{
	my $info = shift;

	# single word probabilities
	for my $k ( keys % { $info->{words} } ) { 
		$info->{wordProbs}{$k} = $info->{words}{$k} / $wordCount;
	}

	my $bigramCount = $wordCount - 1;

#	my $s = 0;

	foreach my $i ( keys % { $info->{wordCondCounts} } ) {

		my $w = $info->{wordCondCounts}{$i}{'w'};

		foreach my $j ( keys %$w  ) {
			$info->{wordCondProbs}{$i}{$j} = $$w{$j} / $info->{wordCondCounts}{$i}{'c'};
			$info->{bigramProbs}{$i}{$j} = $$w{$j} / $bigramCount;
		}
	}
#	print "Bigram sum: ", $s, "\n";
}


=head2 computeCondEntropy($info)

Spocita podminenou entropii na vstupu $info. 

=cut
sub computeCondEntropy
{
	my $info = shift;

	my $entropy = 0;

	foreach my $w1 ( keys % { $info->{bigramProbs} } ) { 
		foreach my $w2 ( keys % { $info->{bigramProbs}{$w1} } ) { 
#			print $w1, ":", $w2, ": ", $info->{wordCondProbs}{$w1}{$w2},  " | ", $info->{bigramProbs}{$w1}{$w2}, "\n";
			$entropy += ( $info->{bigramProbs}{$w1}{$w2} * log2($info->{wordCondProbs}{$w1}{$w2}) );
		}
	}

	return ( -1 * $entropy );
}

=head2 computeCondPerplexity($entropy)

Z podminene entropie $entropy spocita podminenou perplexitu.   

=cut
sub computeCondPerplexity
{
	my $entropy = shift;
	return 2 ** $entropy;
}

=head2 messUpChars($level) = @out

Ze vstupniho souboru zmeni $level znaku za jine znaky vyskytujici se v textu.

Vraci zmenene radky @out.

=cut
sub messUpChars
{
	my $level = shift;
	my @out;

#	printf("Messing up chars with likelyhood %2.2f%%\n", $level * 100);

	my $messedUp = 0;
	for my $i ( 0 .. ( $#inputLines ) ) { 
		my @wChars = split(/ */, $inputLines[$i]);

		for my $j ( 0 .. ( $#wChars ) ) {
			if ( rand() <= $level ) {
				$messedUp++;
				$wChars[$j] = $charsAr[int(rand($#charsAr))];
			}
		}
		$out[$i] = join("", @wChars);
	}
#	printf("	Real: %2.4f (%d / %d)\n", 100 * ($messedUp / $charCount), $messedUp, $charCount);

	return (@out);
}

=head2 messUpWords($level) = @out

Ze vstupniho souboru zmeni $level slov za jina slova vyskytujici se v textu.

Vraci zmenene radky @out.

=cut
sub messUpWords
{
	my $level = shift;
	my @out;

#	printf("Messing up chars with likelyhood %2.2f%%\n", $level * 100);

	my $messedUp = 0;
	for my $i ( 0 .. ( $#inputLines ) ) { 
		if ( rand() <= $level ) {
			$messedUp++;
			$out[$i] = $wordsAr[int(rand($#wordsAr))];
		} else { 
			$out[$i] = $inputLines[$i];
		}
	}
#	printf("	Real: %2.4f (%d / %d)\n", 100 * ($messedUp / $charCount), $messedUp, $charCount);

	return (@out);
}

=head2 createTextInfo(@input) = $info

Ze vstupnich radek @input vytvori tridu s informacemi TextInfo $info.

=item * see TextInfo

=cut
sub createTextInfo
{
	my @input = @_;
	my $last = '';

	my $info = TextInfo->new();

	# prochazej vstupni radky
	for my $i ( 0 .. ( $#input ) ) {
		my $word = $input[$i];
		my $len = length($word);

#		print $i, ": ", $word, "\n";

		# zapocitej slova 
		$info->{words}{lc($word)}++;

		my @wAr = split(/ */, $word);

		# zapocitej pismena
		for ( 0..($len - 1) ) {
			$info->{chars}{lc($wAr[$_])}++;
		}	

		if ($i > 0) { 
			$info->{wordCondCounts}{$last}{'w'}{$word}++;
			$info->{wordCondCounts}{$last}{'c'}++;
		}

		$last = $word;
	}

	return ( $info );
}


# nacteni vstupniho souboru
while ( <> ) { 
	my $word = substr($_, 0, -1);
	my $len = length($word);
	$inputLines[$wordCount] = $word;

	$wordLengths{$len}++;

	$charCount += $len;

	$wordCount++;
}

# vytvoreni informaci o souboru
my $inputInfo = createTextInfo(@inputLines);

# spocitej slova a pismena
@wordsAr = keys % { $inputInfo->{words} };

@charsAr = keys % { $inputInfo->{chars} };

# spocitej pravdepoobnosti
computeProbabilities($inputInfo);

# spocitej entropii a perplexitu
my $entropy = computeCondEntropy($inputInfo);
my $perplexity = computeCondPerplexity($entropy);

print "\nInput text\n";
printf("\tCond. Enthropy: %3.5f\n", $entropy);
printf("\tCond. Perplexity: %3.5f\n", $perplexity);
print "\n=============================\n";

# zamenuj slova
for my $m (@messUpLevels)  { 
	print STDERR sprintf("Mess up words: %2.4f\n", 100 * $m);

	for my $j ( 1 .. $RUN_COUNT ) { 
		my @mInput = messUpWords($m);

		my $mInfo = createTextInfo(@mInput);
		computeProbabilities($mInfo);
		my $entropy = computeCondEntropy($mInfo);
		my $perplexity = computeCondPerplexity($entropy);

		print STDERR sprintf("\t%2d Cond. Enthropy:\t%3.5f\n", $j, $entropy);
		print STDERR sprintf("\t%2d Cond. Perplexity:\t%3.5f\n", $j, $perplexity);
		printf("%2.4f\t%3.5f\t%3.5f\n", 100 * $m, $entropy, $perplexity);
	}
}

print "\n=============================\n";

# zamenuj pismena
for my $m (@messUpLevels)  { 
	print STDERR sprintf("Mess up chars: %2.2f%%\n", 100 * $m);

	for my $j ( 1 .. $RUN_COUNT ) { 
		my @mInput = messUpChars($m);

		my $mInfo = createTextInfo(@mInput);
		computeProbabilities($mInfo);
		my $entropy = computeCondEntropy($mInfo);
		my $perplexity = computeCondPerplexity($entropy);

		print STDERR sprintf("\t%2d Cond. Enthropy:\t%3.5f\n", $j, $entropy);
		print STDERR sprintf("\t%2d Cond. Perplexity:\t%3.5f\n", $j, $perplexity);
		printf("%2.2f\t%3.5f\t%3.5f\n", 100 * $m, $entropy, $perplexity);
	}
}

# vypis informace o vstupnim souboru
printInputStats($inputInfo);
