#!/usr/bin/perl -w
use strict;    
use warnings;  
use List::Util 'shuffle';

my $outputfile = "sim.harmony.TVK.csv";
open (OUTPUT, ">" . $outputfile) or die "Can't open output file. $!";

# recall that this is not everything that Trevor said, but rather  
# what his parents wrote down. It's a sample of what Trevor said. 
# KVT tokens: 26 types, 998 tokens
my @KVT = qw(cat cat kitty kitty get get get get get get get get get cat cat kitty kitty get get cat cat cat cat cat kitty cat kite cat cat cat cat cat cat cat get get cat cat cat cat cat cat gone cat cat cat cat cat cone gate kiss cat cat get goat goat cat cat coat cone kiss gone gone keys cat gone can cat cone gate get get gone kiss kiss cat cat cone gate gate gate get gone keys kiss kiss candle cat get good kiss kitten cat keys kiss kiss kitty kitty candy cat cat keys kiss kitten kitty cat cat kiss kiss cat cat gate gate gate get good kiss cat cat get kiss kiss kiss cat cat gone kiss kiss cat cat get kiss cat cat cone gate gate gone good kiss kite kitchen candy cat get kiss kiss cat gone good good keys keys kitchen kite cat cat cat good kiss candle candy cat get god gone keys keys keys kids kiss candy get get keys candy cat cat cone cone get get gone gone good kiss kitchen get couch gas get gone gone candy get gas gas goat cone cone can cat cone gas gas gone good good good can gone can can cone cone gone keys can coat cone cone get get keys keys keys keys keys kiss couch gate gate gate get good good good can can can can cat cat cone couch god gone gone kiss kiss kiss kiss kite can can can candy cat coat cone gas gone gone can can can cat cut gone gone good cone kiss can can candy cat cat get gone got got can can candy couch cut gas gone gone got kiss can gas gas gas gas gone get goodness cat catch gas kiss kiss candle cat couch get get get kitty kitty gone gone kiss kiss kiss kiss kiss kitchen can can gas get get get gone kiss kiss kitchen kitchen gone gone got cone cone couch get good goodness kiss kitchen can can can can candy cat cat cat cut gone gone gone kiss kitty kitty kitty can goat good good gone candy good good goodness got kiss kiss can cone good got kiss kiss can cat gone kiss catch get get get get get gone good got kiss kitchen gas gone got good got can couch cut cute keys get get get get get kiss kiss candy catch can cute kiss catch couch get gone good good got get cut get get good good got keys good good good got couch get get get goodness goodness got kiss kiss kiss kiss kitchen can catch cone get get gone good good good good kiss kiss can cut get good goodness can can candy cut gone good goodness kiss can catch can cone cut get good goodness got can get get gone got got can can can can candy cone god good got can can candy get get good good good got kiss kiss catch get goodness got got kitchen can can cut get get get got got got got got cute get get get kiss can get good good good got got got kiss can can can coat coat couch get get good got can can can can can gas get cone couch couch get get get gone good got got can can can can can catch cut good got can can can can can cut get get good kiss kiss kiss kitchen catch get get get get get good got got got kite can can can can can can cat gas get get get get got kids kids get get get kiss can get can can couch cut cut get get get get get kitchen can can can cut get get good good got got got kitchen kitchen can can can can can candle cat cone get get get get get got kids kids can can can gas get get get got got got got kiss can can get get gone good good kite can can can can can can can can cone couch cute gas get get get get get get get good good good got can can can get get get gone gone kiss can can get get gone good got got got kiss can can can can can couch get get get get good good good got kitchen kitchen can can can can candy catch cut cut get get get get get get get get get get got got got got got got got got can can can can can can can can can can can can can can candy cut get get get get got got got got kitchen can can can can can can candle catch cut cut cut get get get get get get get good good good got got got got got kids kids kite can can can got got can can get get get good can can can can candy candy candy candy gate get get get get get get get get get get goat good good good got got got got kids can can can can can can can can can candle candy candy candy couch cut cut cut cute gas get get get get get get get get get get get get good got got got got got got got got got got got got kiss got kitchen can can get good got kiss kitchen can can can can can can cute gas gate get get get get get good got can can can can can can candy cut get get get get get get get good got got got got got can can can can can can can can can can can cut get get get get good good good kiss can can can can can can can cut get get good good got kids get get can can can can get get get get get get get get good got got got got);
# TVK tokens: 28 types, 596 tokens
my @TVK = qw(dog dog dog dog dog duck dog dog dog dog dog dog dog duck Truck dog dog dog dog dog dog dog jacket tickle dog dog dog dog dog dog duck duck duck duck dog dog duck dog dog dog duck stick dog dog duck dog dog duck dog dog dog dog dog duck sock dog dog duck dog duck nicky nicky dog dog duck stick dog dog Truck dog duck thank tickle duck thank tickle dog duck jacket dog sink thank cheek ding dog duck thank tickle Truck ding dog thank thank dog shake shake stick thank tickle dog stick stick thank tickle dog dog duck stick thank thank Truck thank dog dog thank thank tickle dog duck shake shake stick stick thank thank Truck ding dog duck duck stick thank Truck dog dog shake shake sing sink song thank dog dog Truck ding dog sing sink song thank tickle dog shake dog Truck sink dog Truck ding thank Truck Truck Truck Truck dog thank thank Truck Truck ding dog sink tickle tickle Truck Truck dog dog duck shake stick stick stick stick Truck Truck jacket sugar sugar thank Truck dog duck stick thank thank dog sugar taking dog dog sink thank Truck Truck duck sneakers thank dog duck nick sneakers song Truck duck shake sink tickle duck snack Truck Truck Truck Truck dog sneakers sock Truck Truck Truck cycle sink dog duck neck shake shake sneakers Truck Truck Truck Truck Truck chicken dog dog Truck Truck Truck Truck Truck Truck sugar take Truck Truck Truck Truck Truck dog Truck Truck Truck dog duck sink snack thank tickle thank Truck Truck Truck neck sink sink sneakers take take sink sugar ding take take thank Truck Truck Truck take take Truck Truck Truck dog neck take take Truck Truck duck sugar thank Truck Truck Truck dog dog take sock take take take take take take dog dog song take take thank tickle Truck Truck Truck dog dog duck sneakers song take take take take thank thank took Truck dog shake thank thank chicken take take Truck dog dog duck sink take tickle Truck Truck take taking thank dog take nick stick dog neck sneakers sneakers stick take take take take take thank Truck Truck Truck dog nick sink snake take take tiger Truck Truck Truck stick take take thank Truck Truck neck take take tickle Truck take thank dog dog take take take Truck Truck Truck take take Truck knock take take dog dog take take take take take thank knock sneakers nick take take tickle Truck Truck snack snack take take thank Truck neck Truck sing song take Truck sneakers thank take take take take thank take thank Truck sing sing song take take thank thank ding knock take take take take take thank dog dog sing take take thank thank thank thank nick take take take take take take take take take Truck dog sugar thank Truck chicken dog dog take take dog take thank dog dog sing sock song take take take taking tickle Truck Truck Truck dog nick take take take thank cheek cheek chicken take cycle dog nick take take take take take taking thank Truck take duck snack take sing snack snack snake song take take taking taking thank cycle dog dog knock nick nick nick sink snack take take take take take taking thank thank thank sock sing take dog dog dog snack snack take take take taking taking thank Truck Truck dog dog take take take take take thank dog snack Truck dog duck sing song took Truck);
my @speech = (@KVT, @TVK);

# the grammars that the learner will go through
my @grammar;
$grammar[0] = {ranking =>"Agree(tvk) >> Max(dor) >> Max(cor)              ", KVToutput => "faithful", TVKoutput => "t⟶k"};
$grammar[1] = {ranking =>"Agree(tvk) >> Agree(kvt) >> Max(dor) >> Max(cor)", KVToutput => "t⟶k"	, TVKoutput => "t⟶k"};
$grammar[2] = {ranking =>"Max(cor) >> Agree(tvk) >> Agree(kvt) >> Max(dor)", KVToutput => "k⟶t"	, TVKoutput => "k⟶t"};
$grammar[3] = {ranking =>"Max(dor) >> Max(cor) >> Agree(tvk) >> Agree(kvt)", KVToutput => "faithful", TVKoutput => "faithful"};
my $current_grammar = 0;

sub grammarOutput {
	my $type = shift(@_);
	if ($type =~ /^[kgc][^hyn]/) { # matches cat, kitty, *knock, *cycle, *chicken
		return ${$grammar[$current_grammar]}{KVToutput};
	} else {
		return ${$grammar[$current_grammar]}{TVKoutput};
	}
}

for(my $sim=0; $sim < 20; $sim++) {
	
	@speech = shuffle(@speech);
	$current_grammar = 0;
	my %cache; # store every form the learner said, error or not
	my %decayRate; # each type's decay rate is stored here
	my $K = 0;
	my $T = 0;
	
	
	for (my $i=0; $i<@speech; $i++) {
		
		my $word = $speech[$i];
		
		if ($word =~ /^[kgc][^hyn]/) { $K++ } else { $T++ };
		
		
		# make up a random decay rate for any new word
		unless(exists($decayRate{$word})) {
			$decayRate{$word} = .98 + rand(.02);
		}
	
		$current_grammar=1 if($i>100);
		$current_grammar=2 if($i>250);
		$current_grammar=3 if($i>500);
		
	
		# now add the current form to the Cache if it isn't already there
		if (!exists($cache{$word})) {
			$cache{$word} = [];  # initialize cache array if empty
		}
		my $found = 0;
		for my $cached (@{$cache{$word}}) {
			$found =1 if (${$cached}{winner} eq grammarOutput($word) );
		}
		if (!$found) {
			my $c = {weight => 1, winner => grammarOutput($word) };
			push(@{$cache{$word}}, $c); 
		}
	
	
		# go through the Cache, and decrease the
		# weights of forms that are at odds with the current grammar
		for my $cached (keys %cache) {
	
			for my $current_cache (@{$cache{$word}}) {
				if (${$current_cache}{winner} ne grammarOutput($word) ) {
					${$current_cache}{weight} *= $decayRate{$word};
				}
			}
	
			# get rid of old errors that will only be chosen 1 out of 20 times
			#if (${$current_cache}{weight}<.05) { ${$current_cache}{weight}<.05 }
		}
	
		# now decide how to say this word
		my $production = "";
		my $maxNonGrammarWeight = 0;
		my $totalNonGrammarWeight = 0;
		for my $cached (@{$cache{$word}}) {
			if (${$cached}{winner} ne grammarOutput($word) ) {
				$totalNonGrammarWeight += ${$cached}{weight};
				$maxNonGrammarWeight = ${$cached}{weight} if (${$cached}{weight} > $maxNonGrammarWeight);
			}
		}
		
		my $cumulProbility = 0;
		my $rand = rand(1);
		CACHED: for my $cached (@{$cache{$word}}) {
	
			my $prob = 0;
			if (${$cached}{winner} ne grammarOutput($word) ) {
				$prob = ${$cached}{weight} * $maxNonGrammarWeight / $totalNonGrammarWeight;
			} else {
				$prob = 1-$maxNonGrammarWeight;
			}
			my $winner = ${$cached}{winner};
			
			$cumulProbility+= $prob;
			if ($rand < $cumulProbility) {
				$production = $winner;
				last CACHED;
			}
		}
		if ($production eq "") {die "$word $T $K $!"}; # sanity check; should never happen
	
	
		# print the current status in an R-legible form
		print OUTPUT "$sim,";
		if ($word =~ /^[kgc][^hyn]/) {print OUTPUT "$K,";} else {print OUTPUT "$T,";};
		print OUTPUT '"'. ${$grammar[$current_grammar]}{ranking} . '"' . ","; 
		print OUTPUT scalar(keys %decayRate) ;
		print OUTPUT ",$word,0". ($word =~ /^[kgc][^hyn]/) .",$production";	
		print OUTPUT "\n";
	
	
	}

}
close(OUTPUT) or die "Can't close output file. $!";