#!/usr/bin/perl -w

use strict;
use AI::NaturalSelection;

my @randData = ('a' .. 'z', 'A' .. 'Z', ',', qw(_ . ! ? ' " ; : -));
my $target = join(" ", @ARGV) || "Methinks I'm a weasel";
push(@randData, ' ') if $target =~ / /;
my $pop_size = 100;

my $ga = AI::NaturalSelection->new($pop_size);

foreach my $chromosome (0 .. $pop_size - 1) {
  my $randDNA;
  foreach (0 .. length($target) - 1) {
    $randDNA .= $randData[int(rand(@randData))];
  }

  $ga->setDNA($randDNA, $chromosome);	# give all chromosomes random dna
}

$ga->setMutateRate(0.05);		# 5% mutation rate
$ga->setCrossoverFunc(\&crossover);	# set a crossover (breeding) function
$ga->setEvaluateFunc(\&evaluate);	# set an evaluation function
$ga->setSurvival(1);			# set the # of chromosomes that survive per gen
$ga->setFitnessFunc(\&fitness);		# set the function that returns the fitness
$ga->setMutationFunc(\&generation);	# set a mutate function
$ga->setEnvironmentFunc(\&generation);	# set the 'environment' function that all chromosomes go through

$ga->spawn;				# spawn the chromosomes in the tournament

exit;

sub evaluate {
  my ($generation, $dna) = @_;

  if (grep { $_ eq $target } @$dna) {
    print "generation $generation got target $target\n";
    return 1;
  }

  my @fit = map { fitness($_) } @$dna;
  my $fittest = $$dna[(sort { $fit[$b] <=> $fit[$a] } 0 .. $#fit)[0]];
  print "Best in generation $generation is:\t'$fittest'\n";

  return 0;
}

# also the mutation function
sub generation {
  my ($self, $dna, $chromosome) = @_;
  substr($dna, int(rand(length($dna))), 1, $randData[int(rand(@randData))]);
  return $dna;
}

sub crossover {
  my ($dna1, $dna2)	= @_;
  my $point		= int(rand(length($dna1)));
  my $length		= int(rand(length($dna1) - $point));

  substr($dna1, $point, $length, substr($dna2, $point, $length));
  return $dna1;
}

sub fitness {
	my ($string)	= @_;
	my $tmp		= $target;
	my $len		= length $string;
	my $sum		= 0;

	for (my $f = 0; $f < $len; $f++) {
		my $z1	= substr($string, $f, 1);
		my $z2	= substr($tmp, $f, 1);
		my $a	= (ord($z1) - ord($z2)) * (ord($z1) - ord($z2));
		$sum	-= $a;
	}

	return $sum;
}

=pod

=head1 NAME

ains_textmatcher.pl - demo of AI::NaturalSelection, originally for AI::GP.

=head1 SYNOPSIS

 % perl ains_textmatcher.pl
 % perl ains_textmatcher.pl Hello World!

=head1 DESCRIPTION


This description taken from textmatcher.pl included in AI::GP by James Hugman
I've recreated the program while using AI::NaturalSelection, instead of AI::GP

"Program to evolve a string.

The individuals are strings of characters generated at random, and tested against 
a target string.

The strings are represented by a single codon of tokens, C<join>ed with the empty 
string.

They are crossed over using uniform crossover and mutated on a per gene basis.

Output shows the closest fitting string found in the generation.

 Best in generation 12 is:       'EZwoh_nr!G:r.b;tjWyai'

The program stops when the target string is found.

If you're wondering why the default string is used, see The Blind Watchmaker, by 
Richard Dawkins."

=head1 AUTHORS

(not so c) Samy Kamkar 2002

(c) James Hugman 2002

=cut