#!/usr/local/bin/perl -w
use strict;
use Storable;

# Hamlet: Makes Markov model of Hamlet's speeches
#         Outputs new speeches based on model

#################### VARIABLES ######################

my %model1;			# 1st order Markov Model for first words
my %model2;			# 2nd order Markov Model for first words
my %model3;			# 3rd order Markov Model for first words
my %model4;			# 4th order Markov Model for all text
my @model_keys;			# List of characters encountered in text
				#   (i.e., letters not people!)

my $order = 4;			# Order of Markov Model used
my $speech;			# Contains speech currently considered
my $begin_speech = "{";		# Symbol representing beginning of speech
my $end_speech = "}";		# Symbol representing end of speech

my $true = 1;			# Perl doesn't have logical variables so
my $false = -$true;		#    we simulate them
my $do_more = $true;		# Variable to tell program when you're through
my $linewidth = 60;		# Print no more than this many characters/line

###################### FILES ########################
#  Input file must consist of speeches with the following properties:
#      1. One line only, but the line can be very big
#      2. Text is bounded on the left with "{" 
#      3. Text is bounded on the right with "}"

my $input_file_name = 'HamletSpeech.txt';
open INPUT_FILE, "<$input_file_name" or die "Can't open $input_file_name: $!\n";

################### MAIN PROGRAM ####################

print "Please wait a few seconds for Hamlet to be created...", "\n";

while (<INPUT_FILE>) {             # Analyze text
   Process_First_Word ();	   # First word requires special handling
   Process_Text ();		   # Process rest of text
}

Make_Keys();                       # List of all characters encountered

while ($do_more == $true) {              # Produce text
   my $first_word = Make_First_Word ();  # First word requires special handling
   Make_Speech ($first_word);		 # Make rest of text, given first word
   Print_Speech ();			 
   $do_more = Ask_If_More ();	         # Ask user if another speech wanted
}
########### SUBROUTINES FOR ANALYZING TEXT ##########

sub Process_First_Word {
   # It's necessary for the first word to build a Markov table for each character
   # up to order - 1 so that text can later be produced from scratch

   chomp;
   $speech = $_;
   if (not substr($speech,0,1) = $begin_speech) {print $speech, "\n"; die "no beginning"}
   foreach my $word_length (1 .. $order-1) {
     my $word = substr($speech,1,$word_length);
     Update_Entry($word);
   }
}

sub Process_Text {
   foreach my $starting_letter (1 .. length($speech) - $order) {
      my $word = substr($speech, $starting_letter, $order);
      Update_Entry($word);
   }
}

sub Update_Entry {
   my ($word) = @_;
   my @letter = split("", $word);
   my $sum = "SUM";
   if (length($word) == 1) {
      if (defined($model1{$letter[0]})) {
         $model1{$letter[0]} = $model1{$letter[0]} + 1;
         $model1{"SUM"} = $model1{"SUM"} + 1;
      } else {
         $model1{$letter[0]} = 1;
         if (defined($model1{"SUM"})) {$model1{"SUM"} = $model1{"SUM"} + 1}
         else {$model1{"SUM"} = 1}
      }
   } elsif (length($word) == 2) {
      if (defined($model2{$letter[0]}{$letter[1]})) {
         $model2{$letter[0]}{$letter[1]} = $model2{$letter[0]}{$letter[1]} + 1;
         $model2{$letter[0]}{"SUM"} = $model2{$letter[0]}{"SUM"} + 1;
      } else {
         $model2{$letter[0]}{$letter[1]} = 1;
         if (defined($model2{$letter[0]}{"SUM"})) 
            {$model2{$letter[0]}{"SUM"} = $model2{$letter[0]}{"SUM"} + 1}
         else {$model2{$letter[0]}{"SUM"} = 1}
      }
   } elsif (length($word) == 3) {
      if (defined($model3{$letter[0]}{$letter[1]}{$letter[2]})) {
         $model3{$letter[0]}{$letter[1]}{$letter[2]} = 
               $model3{$letter[0]}{$letter[1]}{$letter[2]} + 1;
         $model3{$letter[0]}{$letter[1]}{"SUM"} = 
               $model3{$letter[0]}{$letter[1]}{"SUM"} + 1;
      } else {
         $model3{$letter[0]}{$letter[1]}{$letter[2]} = 1;
         if (defined($model3{$letter[0]}{$letter[1]}{"SUM"})) 
            {$model3{$letter[0]}{$letter[1]}{"SUM"} = 
                $model3{$letter[0]}{$letter[1]}{"SUM"} + 1;
         }
         else {$model3{$letter[0]}{$letter[1]}{"SUM"} = 1}
      }
   } elsif (length($word) == 4) {
      if (defined($model4{$letter[0]}{$letter[1]}{$letter[2]}{$letter[3]})) {
         $model4{$letter[0]}{$letter[1]}{$letter[2]}{$letter[3]} = 
               $model4{$letter[0]}{$letter[1]}{$letter[2]}{$letter[3]} + 1;
         $model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"} = 
               $model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"} + 1;
      } else {
         $model4{$letter[0]}{$letter[1]}{$letter[2]}{$letter[3]} = 1;
         if (defined($model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"})) 
            {$model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"} = 
                $model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"} + 1;
         }
         else {$model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"} = 1;}
      }
   } elsif (length($word) == 5) {
   }
}

sub Make_Keys {
   @model_keys = keys(%model4);
   push @model_keys, "}";
}

########### SUBROUTINES FOR PRODUCING TEXT ###########

sub Make_First_Word {
   my $letter1 = Find_Next_Letter1();
   my $letter2 = Find_Next_Letter2($letter1);
   my $letter3 = Find_Next_Letter3($letter1 . $letter2);
   my $word = $letter1 . $letter2 . $letter3;
   $speech = $word;
   return $word;
}

sub Make_Speech {
   my ($word) = @_;
   my $next_letter = "";
   while (not $next_letter eq $end_speech) {
      $speech = $speech . $next_letter;
      $next_letter = Find_Next_Letter4 ($word);
      $word = substr($word, 1, $order - 1) . $next_letter;
   }
}

sub Find_Next_Letter1 {
   my $sum;
   my $target;
   my $running_sum;
   my $occurrences;
   if (defined($model1{"SUM"})) {
      $sum = $model1{"SUM"};
      $target = random_integer (1,$sum);
      $running_sum = 0;
      foreach my $key (@model_keys) {
          if (defined($model1{$key})) {
             $occurrences = $model1{$key};
             $running_sum = $running_sum + $occurrences;
             if ($running_sum >= $target) {return $key}
          }
      }
   } else {
      Error_in_Find("");
      return $end_speech;
   }
   return $end_speech;
}

sub Find_Next_Letter2 {
   (my $word) = @_;
   my @letter = split("",$word);
   my $sum;
   my $target;
   my $running_sum;
   my $occurrences;
   if (defined($model2{$letter[0]}{"SUM"})) {
      $sum = $model2{$letter[0]}{"SUM"};
      $target = random_integer (1,$sum);
      $running_sum = 0;
      foreach my $key (@model_keys) {
          if (defined($model2{$letter[0]}{$key})) {
             $occurrences = $model2{$letter[0]}{$key};
             $running_sum = $running_sum + $occurrences;
             if ($running_sum >= $target) {return $key}
          }
      }
   } else {
      Error_in_Find($word);
      return $end_speech;
   }
   return $end_speech;
}

sub Find_Next_Letter3 {
   (my $word) = @_;
   my @letter = split("",$word);
   my $sum;
   my $target;
   my $running_sum;
   my $occurrences;
   if (defined($model3{$letter[0]}{$letter[1]}{"SUM"})) {
      $sum = $model3{$letter[0]}{$letter[1]}{"SUM"};
      $target = random_integer (1,$sum);
      $running_sum = 0;
      foreach my $key (@model_keys) {
          if (defined($model3{$letter[0]}{$letter[1]}{$key})) {
             $occurrences = $model3{$letter[0]}{$letter[1]}{$key};
             $running_sum = $running_sum + $occurrences;
             if ($running_sum >= $target) {return $key}
          }
      }
   } else {
      Error_in_Find($word);
      return $end_speech;
   }
   return $end_speech;
}

sub Find_Next_Letter4 {
   (my $word) = @_;
   my @letter = split("",$word);
   my $sum;
   my $target;
   my $running_sum;
   my $occurrences;
   if (defined($model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"})) {
      $sum = $model4{$letter[0]}{$letter[1]}{$letter[2]}{"SUM"};
      $target = random_integer (1,$sum);
      $running_sum = 0;
      foreach my $key (@model_keys) {
          if (defined($model4{$letter[0]}{$letter[1]}{$letter[2]}{$key})) {
             $occurrences = $model4{$letter[0]}{$letter[1]}{$letter[2]}{$key};
             $running_sum = $running_sum + $occurrences;
             if ($running_sum >= $target) {return $key}
          }
      }
   } else {
      Error_in_Find($word);
      return $end_speech;
   }
   return $end_speech;
}

sub Print_Speech {
   print "\n";
   my $right_character = $linewidth - 1;
   while (length($speech) > $linewidth - 1) {
      if (substr($speech, $right_character, 1) eq " ") {
         print substr($speech, 0, $right_character), "\n";
         substr($speech, 0, $right_character+1) = "";
         $right_character = $linewidth - 1;
      } else {$right_character = $right_character - 1}
   }
   print $speech, "\n";
}
 
sub Ask_If_More {
   print "\n";
   print "Want another? (Yes/No)  ";
   my $key = substr(lc <STDIN>,0,1);
   if (uc($key) eq "Y") {return $true}
   else {return $false}
}

sub Error_in_Find {
   my ($word) = $_;
   print "\n","MISTAKE IN PROGRAM!  Please note following:", "\n";
   print "     No values for (", $word, ")","\n";
}

sub random_integer {
  my ($low, $high) = @_;
  my $range = $high - $low + 1;
  my $random_fraction_of_range = rand($range);
  return $low + int($random_fraction_of_range);
}

  