#!/usr/bin/perl
use strict;
$|++;

my @CLASSES = split /\s+/, <<'END';
XXX
a-1 a-2 a-3 a-4 a-5
b-1 b-2 b-3 b-4 b-5
c-1 c-2 c-3
d-1 d-2 d-3 d-4 d-5
e-1 e-2 e-3 e-4
f-1 f-2 f-3 f-4 f-5 f-6
g-1
END

my $SLOTS = 6;
my $ROOMS = 3;

use AI::Genetic;

my $ga = AI::Genetic->new
  (
   -fitness => \&my_fitness,
   -type => 'listvector',
   -terminate => \&my_terminate,
  );

$ga->init([(\@CLASSES) x ($SLOTS * $ROOMS)]);
$ga->evolve(rouletteTwoPoint => 20);
print "final winners\n";
for my $i ($ga->getFittest(5)) {
  show_individual($i);
}

sub show_individual {
  my $i = shift;
  printf "score: %g\n", $i->score;
  my @g = $i->genes;
  while (@g) {
    print "  ", join " ", splice @g, 0, $ROOMS;
    print "\n";
  }
  print "\n";
}

sub my_fitness {
  my $genes = shift;
  my $score = 0;

  ## process slot by slot
  my %seen;
  my @g = @$genes;
  while (@g) {
    my @rooms = splice @g, 0, $ROOMS;
    my %teacher_seen;
    for (@rooms) {
      ## "in with the good"...
      $score++ if /-/;           # good if scheduled (no room left beh
+ind!)
      $score += 0.5 if /3/;       # good if it's a 3 (simulate user de
+mand)

      ## "and out with the bad"...
      $score -= 100 if /-/ and $seen{$_}++; # bad if duplicated
      if (/(.+)-/) {         # actual class?
    $score -= 100 if $teacher_seen{$1}++;
      }
    }
  }
  return $score;
}

sub my_terminate {
  my $ga = shift;
  print "[", $ga->getFittest->score, "]";
  ## show_individual($ga->getFittest);
  return 0;            # do not terminate
}
[download]