#!/usr/bin/perl
# Michael Tartaglia
# evolution.cgi
# Example of a Drip-by-Drip generational algorithm, where the user
#	enters a string, and the computer (starting from a random
#	string of identical length) eventually arrives at the user's
#	string.


use strict;
use CGI qw ( :standard );
require template;


template::startHTML("Freelance Program","Evolutionary Algorithms");

print "This is an example of a \"drop by drop\" evolutionary algorithm.<br>",
	"\t<FORM METHOD=\"get\" ACTION=\"evolution.cgi\">\n",
	"\t Input a string: <INPUT TYPE=\"text\" NAME=\"dest\" ",
	"SIZE=15>\n\t <INPUT TYPE=\"submit\" VALUE=\"Submit\">\n\t ",
	"<INPUT TYPE=\"reset\" VALUE=\"Reset\">\n\t</FORM>\n";

my $MAX = 350;		# MAXIMUM RUN OF PROGRAM
my $MAXLEN = 30;	# MAXIMUM LENGTH OF ENTERED WORD

# IF SOMEONE ENTERED A VALID, BUT LONG STRING
if ($ENV{'QUERY_STRING'} ne "" && cleanString(param("dest")) ne ""
    && length(cleanString(param("dest"))) > $MAXLEN) {
   print "<font color=800000>Sorry, your entered string was too ",
	"long.</font>";
}

# IF SOMEONE ENTERED A VALID STRING
elsif ($ENV{'QUERY_STRING'} ne "" && cleanString(param("dest")) ne "") {
  my $destination = cleanString(param("dest"));	#TARGET STRING
  my $start;					#RANDOM GUESS START	
  my $startCopy;				#START'S COPY FOR OUTPUT
  my (@generations, @group, $strongest);
  my $len = length($destination);		#LENGTH OF TARGET STRING
  my $radius = int(.5 + ($len/3));		#RADIUS OF CHAR MUTATION
     $radius = 1 if ($radius < 1);		#...MUST BE AT LEAST ONE
  my $rate = int(1000*($len/($len*$len+1)))/1000;	#MUTATION %
  my $size = int($len * 10.5);			#GROUP SIZE
  my $counter = 0;				#GENERATIONS COUNTER

  
  #START BY FINDING STRONGEST AMONGST POOL OF RANDOM MUTANTS
  $group[$_] = getRandomStart($destination) foreach (0 .. $size-1);
  $start = getStrongest($destination, \@group);
  $startCopy = $start;


  # THIS IS THE HEART OF THE PROGRAM: GET GROUP, GET STRONGEST OF GROUP,
  #    MAKE OFFSPRING GROUP FROM STRONGEST, AND REPEAT UNTIL STRONGEST
  #    EQUALS TARGET STRING
  do {
   @group = getMutationGroup($start, $size, $radius, $rate);
   $strongest = getStrongest($destination, \@group);
   $generations[$counter] = $strongest;
   $start = $strongest;
   $counter++;
  } until ($strongest eq $destination || $counter >= $MAX);


  # OUTPUT TABLE WITH DETAILS AND DESCRIPTION
  print "\n\t<br><br>\n\t<table border=0 class=\"noBr\">\n",
	"\t<tr><th width=50%>Random start string:</th><td>",
	cleanHTML($startCopy), "</td></tr>\n",
	"\t<tr><th><NOBR>Entered target string:</NOBR></th><td>",
	cleanHTML($destination),"</td></tr>",
	"\n\t<tr><th>Mutation radius:</th><td>$radius</td></tr>\n",
	"\t<tr><th>Mutation rate:</th><td>$rate</td></tr>\n",
	"\t<tr><th>Generation size:</th><td>$size</td></tr>\n",
	"\t<tr><th>Run size:</th><td>",
	($counter>=$MAX && $strongest ne $destination ? "$counter+" : $counter),
	"</td></tr>\n",
	"\t<tr><td colspan=2><p>Based on the above information, ",
	"the computer took the following route to find your string. ",
	"Each line represents the closest match to your string, ",
	"found by mutating the previous line $size times ",
	"and taking the \"fittest\" of that bunch.</p>",
	"</td></tr></table><br><b><tt>",cleanHTML($startCopy),"<br>";
  print "\n\t\t", cleanHTML(substr($generations[$_],0,$len)),
	"<BR>" foreach (0 .. $counter-1);
  print "\n\t</tt>\n\n";
  print "<font color=800000><br><i>The process would continue here, ",
	"<br>but you entered too long of a string!</i></font>"
	if ($strongest ne $destination);
}

# IF SOMEONE ENTERED A NULLSPACE AS A STRING
elsif (defined(param("dest"))) {
  print "<b><font color=800000>There was a problem with your ",
	"entry.</font></b><br>Please try again.";
}

template::endHTML();




sub getMutationGroup {
	my $parent = shift();		# PARENT STRING
	my $mutants = shift();		# NUMBER OF MUTANTS
	my ($radius,$rate) = (shift(),shift());
	my @group;			# MUTANT GROUP TO BE RETURNED
	foreach my $i (0 .. $mutants-1) {
	 $group[$i] = mutate($parent,$radius,$rate);
	}
	return @group;
}

sub getStrongest {
	# STRENGTH MONITORED LIKE GOLF SCORES!
	# STRENGTH IS MEASURED USING THE HAMMING DISTANCE, WHERE THE
	#    STRENGTH OF EACH "OFFSPRING" IS EQUAL TO THE SUMMATION
	#    OF THE SQUARES OF THE ASCII VALUE DIFFERENCES BETWEEN EACH
	#    RESPECTIVE PAIRS OF CHARACTERS IN EACH STRING

	my $start = shift();	# REFERECE STRING
	my @g = @{$_[0]};	# GROUP OF MUTANTS
	my ($strength,$min,$minIndex,$diff) = (-1,-1,-1,-1);

	# COMPUTE STRENGTH OF EACH STRING AND SAVE THE INDEX OF THE STRONGEST
	foreach my $cur (0 .. @g-1) {
	 $strength = 0;
	 foreach my $i (0 .. length($g[$cur])-1) {
	  $diff = ord(charAt($start,$i))-ord(charAt($g[$cur],$i));
	  $strength += ($diff*$diff);
	 }
	 if ($minIndex < 0 || $strength < $min) {
	  $minIndex = $cur;
	  $min = $strength;
	 }
	}

	# RETURN THE STRONGEST STRING
	return $g[$minIndex];
}


sub mutate {
	my $inString = shift();		# BASE STRING TO MUTATE
	my $radius = shift()+1;		# CHARACTER RANGE ALLOWED FOR MUTATIONS
	my $rate = int(length($inString)*shift());	# % OF BASE TO MUTATE
	my $outString = $inString;	# RETURNING STRING
	my ($char, $offset, $newChar);

	foreach my $i (0 .. $rate) { 	# FOR AS MANY CHARACTERS TO MUTATE
	 do {
	  $offset = int(rand(length($inString)));
	 } while (charAt($outString,$offset) ne charAt($inString,$offset));

	 do {				# MUTATE THE CHARACTER
	  $char = ord(charAt($outString,$offset)) - 32;
	  $newChar = ($char + ($radius - int(rand(2*$radius))))%(98);
	  $newChar = chr($newChar + 32);
	 } while (chr($char+32) eq $newChar);

	 $char = $newChar;		# INSERT THE CHARACTER WHERE IT BELONGS
	 if ($offset == 0) {
	  $outString = $char . substr($outString,1);
	 } elsif ($offset == length($outString)-1) {
	  $outString = substr($outString,0,$offset) . $char;
	 } else {
	  $outString = substr($outString,0,$offset) . $char
			. substr($outString,$offset+1);
	 }
	}
	return $outString;
}



# FOLLOWING SUB GENERATES STRING OF RANDOM CHARACTERS OF THE SAME
# LENGTH AS THE TARGET STRING
sub getRandomStart {
	my $inLength = length(shift());
	my $outString = "";
	for (0 .. $inLength-1) {
	 $outString .= chr(32 + int(rand(98)));
	}
	return $outString;
}

# CLEAN THE USER'S STRING BY RIDDING IT OF ILLEGAL CHARACTERS
sub cleanString {
	my $inString = "$_[0]";
	my $outString = "";
	my $c = "";
	$inString =~ s/(\n|\t)*//g;
	return $inString;
	foreach my $i (0 .. length($inString)) {
	 $c = ord(charAt($inString,$i));
	 $outString .= chr($c) if ($c >= 32 && $c <= 130); 
	}
}

# IF < OR > SIGN IS USED, CONVERT IT TO PREVENT BROWSER INTERPOLATION
sub cleanHTML {
	my $inString = shift();
	$inString =~ s/ /&nbsp;/g;
	$inString =~ s/</&lt;/g;
	$inString =~ s/>/&gt;/g;
	return $inString;
}

# EASIER WAY OF GETTING SINGLE CHARACTER SUBSTRING
sub charAt {
	return substr($_[0],$_[1],1);
}