#!/usr/bin/perl
#
# this program uses AI::NaturalSelection as well
# as AI::NaturalSelection::Plot to attempt to hone in
# on a good solution to the travelling salesman problem
#
# still some work being done to this

my $percent	= 80;	# percent of paths that have to have
			# the same distance for us to exit
			# and assume we have a short path

die "usage: $0 <cities|plotfile> <population>" unless @ARGV == 2;
my ($points, $population) = @ARGV;

use AI::NaturalSelection;
use AI::NaturalSelection::Plot;

my $plot = AI::NaturalSelection::Plot->new();
my $ga = AI::NaturalSelection->new($population);

if ($points =~ /^\d+$/) {
  $plot->createPlot($points, $points + 10, $points + 10); # create a random plot
}
else {
  $plot->setPlot(&readPlot($points));
}

$plot->drawPlot();
print "\n";

foreach (0 .. $population - 1) {
  my $newplot = $plot->clone();
  $newplot->setTour(0);
  $ga->setDNA($newplot, $_);
}

$ga->setMutateRate(	0.05);		# 5% mutation rate
$ga->setCrossoverFunc(	\&crossover);	# set a crossover function
$ga->setEvaluateFunc(	\&evaluate);	# set an evaluation function
$ga->setSurvival(	5);		# set the # of chromosomes that survive per gen
$ga->setFitnessFunc(	\&fitness);	# set the function that returns the fitness
$ga->setFitWhenGreater(	0);		# specify that the lesser the &fitness val, the MORE fit it is
$ga->setMutationFunc(	\&mutate);	# set a mutate function
$ga->setEnvironmentFunc(\&environment);	# 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) = @_;

  my %fitness;
  my @fitness = map { $$dna[$_]->tourDistance(0) } 0 .. @$dna - 1;
  foreach (@fitness) {
    $fitness{$_}++;
  }

  print "generation $generation:\n";
  foreach (sort { $fitness[$a] <=> $fitness[$b] } 0 .. @$dna - 1) {
    print " fitness $_: $fitness[$_]\n";
  }
  print "\n";

  my ($shortest) = (sort { $fitness[$a] <=> $fitness[$b] } 0 .. @$dna - 1)[0];
  if ($fitness{$fitness[$shortest]} >= int((scalar @$dna / 100) * $percent)) {
    print "generation $generation (tour $shortest) has distance of $fitness[$shortest]\n";
    print "\n";
    $$dna[$shortest]->drawTour(0);
    print "\n";

    return 1;
  }
  return 0;
}


# return the fitness of the dna (length of tour)
# the lesser the return value, the more fit
sub fitness {
  return shift->tourDistance(0);
}


# all chromosomes go throug this function once.
# afterwards, they are evaluated about how fit they
# remained while in this 'environment'
sub environment {
  my ($self, $plot, $chromosome) = @_;


print "env $chromosome ".$plot->tourDistance(0)."\n";
  return $plot;
}


sub mutate {
  my ($self, $plot, $chromosome) = @_;
  my @tour = $plot->getTour(0);

  my ($a, $b) = (int(rand(@tour)), int(rand(@tour)));
  @tour[$a, $b] = @tour[$b, $a];

  $plot->setTour(\@tour, 0);
print "mutated $chromosome ".$plot->tourDistance(0)."\n";
  return $plot;
}


# breeds 2 dna samples to create a new dna sample which
# will be used in the next generation
sub crossover {
  my ($self1, $self2, $tour1, $tour2) = @_;
  my @tour1 = $self1->getTour(0);
  my @tour2 = $self2->getTour(0);

  my $child = $self1->clone();
  my @child;
  my %unused = map { $_ => 1 } 0 .. @tour1 - 1;

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

  $child->setTour(\@child, 0);
  return $child;
}


sub readPlot {
  my $file = shift;
  my @points;
  open(FILE, "<$file") || die "Can't read $file: $!";

  my $x = my $maxx = my $maxy = 0;
  while (<FILE>) {
    s/\s//g;
    next unless /[.X]/;

    for (my $y = 0; s/^(.)//; $y++) {
      if ($1 eq "X") {
        push(@points, [$x, $y]);
        $maxy++ if $x == 0;
      }
      elsif ($1 eq ".") {
        $maxy++ if $x == 0;
      }
    }

    $x++;
    $maxx++;
  }
  close(FILE);
  return (\@points, $maxx, $maxy);
}