#!/usr/bin/perl
#
# this program accepts a string with unique letters
# on the command line and sorts it without knowing
# "how" to sort, only knowing whether one word is
# closer to being fully sorted than another
# after mindlessly swapping letters

use AI::NaturalSelection;

my $dna = shift || die "usage: $0 <DNA>";
my $evolved = join "", sort split //, $dna; # this is our goal

my $ga = new AI::NaturalSelection(10);
# $ga->setPopulationSize(5);		# we already set population size (chromosomes) to 5
$ga->setDNA(		$dna);		# give all chromosomes this dna
$ga->setMutateRate(	0.03);		# 3% mutation rate
$ga->setCrossoverFunc(	\&crossover);	# set a crossover function
$ga->setEvaluateFunc(	\&evaluate);	# set an evaluation function
$ga->setSurvival(	2);		# set the # of chromosomes that survive per gen
$ga->setFitnessFunc(	\&fitness);	# set the function that returns the fitness
$ga->setMutationFunc(	\&mutate);	# 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;


# function evaluates all the dna in a generation
# if returns true, tournament and evolutionary cycle ends
# otherwise, goes through another generation and wait
# until next evaluation
sub evaluate {
  my ($generation, $dna) = @_;
  if (grep { $_ eq $evolved } @$dna) {
    print "generation $generation has created " . join(" ", @$dna) . "\n";
    return 1;
  }
  return 0;
}


# return the fitness of the dna (chromosome data)
# the greater the return value, the more fit
sub fitness {
  my @word = split(//, shift);
  my $fitness = 0;
  for (my $i = 0; $i < @word; $i++) {
    for (my $j = $i + 1; $j < @word; $j++) {
      $fitness++ if $word[$j] lt $word[$i];
    }
  }

  @word = reverse(split(//, $evolved));
  my $opp_fitness = 0;
  for (my $i = 0; $i < @word; $i++) {
    for (my $j = $i + 1; $j < @word; $j++) {
      $opp_fitness++ if $word[$j] lt $word[$i];
    }
  }

  return $opp_fitness - $fitness;
}


# all chromosomes go throug this function once.
# afterwards, they are evaluated about how fit they
# remained while in this 'environment'
sub generation {
  my ($self, $word, $chromosome) = @_;
  my @word = split(//, $word);
  my ($a, $b) = (int(rand(@word)), int(rand(@word)));
  @word[$a, $b] = @word[$b, $a];
  return join "", @word;
}


# same as the generation (environment) function except
# we include a print() statement to see whenever a
# chromosome is mutated
sub mutate {
  my ($self, $word, $chromosome) = @_;
  my @word = split(//, $word);
  my ($a, $b) = (int(rand(@word)), int(rand(@word)));
  @word[$a, $b] = @word[$b, $a];
  return join "", @word;
}


# breeds 2 dna samples to create a new dna sample which
# will be used in the next generation
sub crossover {
  my @word1 = split(//, shift);
  my @word2 = split(//, shift);
  my (@child);
  my %unused = map { $_ => 1 } @word1;

  for (my $i = 0; $i < @word1; $i++) {
    if ($word1[$i] eq $word2[$i]) {
      push(@child, $word1[$i]);
      delete $unused{$word1[$i]};
    }
    elsif (int(rand(2))) {
      if (!grep { $_ eq $word1[$i] } @child) {
        push(@child, $word1[$i]);
        delete $unused{$word1[$i]};
      }
      elsif (!grep { $_ eq $word2[$i] } @child) {
        push(@child, $word2[$i]);
        delete $unused{$word2[$i]};
      }
      else {
        my ($tmp) = (keys %unused)[int(rand(keys(%unused)))];
        push(@child, $tmp);
        delete $unused{$tmp};
      }
    }
    else {
      if (!grep { $_ eq $word2[$i] } @child) {
        push(@child, $word2[$i]);
        delete $unused{$word2[$i]};
      }
      elsif (!grep { $_ eq $word1[$i] } @child) {
        push(@child, $word1[$i]);
        delete $unused{$word1[$i]};
      }
      else {
        my ($tmp) = (keys %unused)[int(rand(keys(%unused)))];
        push(@child, $tmp);
        delete $unused{$tmp};
      }
    }
  }

  return join("", @child);
}