Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Re: Looking for help with AI::Genetic and classroom scheduling

by merlyn (Sage)
on Feb 20, 2005 at 04:29 UTC ( [id://432827]=note: print w/replies, xml ) Need Help??


in reply to Looking for help with AI::Genetic and classroom scheduling

Well, so far, this looks promising. After spending a couple of hours just blindly rushing into it, I'm getting some pretty fast convergence on the basic criteria (rooms as occupied as possible, no room overbooked, no teacher overbooked, rudimentary bias) with the following code. I'm generally seeing convergence in about 20 generations, or about 15 seconds of real time.
#!/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 }

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

Replies are listed 'Best First'.
Re^2: Looking for help with AI::Genetic and classroom scheduling
by fizbin (Chaplain) on Feb 21, 2005 at 15:57 UTC
    This is what I get for going a weekend without reading all of perlmonks - I miss out on discussions like this.

    Note that another way to deal with the problem of disallowed configurations is to narrow the search space to exclude them by having the individuals in your population be things that generate an acceptable layout, rather than being a layout directly.

    For example, instead of a listvector gene sequence based on slots, you could do a rangevector gene based on available courses - these genes would then represent priority values for the courses. In the scoring phase, you'd use the gene values to sort the courses and you'd then fill in the slots one after another, each time using the highest priority acceptable course.

    Well that explanation was clear as mud. Let me attempt to code it up and I'll post a reply - the code is probably clearer.

    Update: This approach won't work immediately, because of the perl bug described in 433559. There's a way to patch AI::Genetic to work around the perl bug, but I don't think that there's any way to work around it short of tweaking AI::Genetic. (It's a one-line patch, though)

    -- @/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/; map{y/X_/\n /;print}map{pop@$_}@/for@/
Re^2: Looking for help with AI::Genetic and classroom scheduling
by DrHyde (Prior) on Feb 21, 2005 at 10:15 UTC
    This would make a great article for $magazine ;-)
      Well, oddly enough, I was already thinking the same thing. Neil says that he'll cut me a deal on future cruises if I solve this problem for him, but then I can turn around and write up the experience as a class to teach on PerlWhirl, and also turn that into an article for which I get paid, and then take that paid-for article and put it on my website for free, and then the author of AI::Genetic can put that as an example in his distro.

      Everybody wins.

      -- Randal L. Schwartz, Perl hacker
      Be sure to read my standard disclaimer if this is a reply.

Re^2: Looking for help with AI::Genetic and classroom scheduling
by fizbin (Chaplain) on Feb 23, 2005 at 06:58 UTC
    Okay, I've finally managed to get working the approach I mentioned in my other reply, that of having the genes be precedence vectors for class assignments. However, first this requires a hack to AI::Genetic to work around a perl bug.

    The fix is to change sortIndividuals in AI/Genetic.pm to read: (this is tweaking one line)

    sub sortIndividuals { my ($self, $list) = @_; return [sort {$b->score <=> $a->score} map {$_->score;$_} @$list]; }
    Update: You also have to change the two sort commands in AI/Genetic/OpSelection.pm if you want this to work reliably for small populations. In both cases, change
    sort {$b->score <=> $a->score}
    to
    sort {$b->score <=> $a->score} map {$_->score;$_}

    An alternative to patching AI::Genetic internals is to get a version of perl that doesn't suffer from the bug described here: http://www.nntp.perl.org/group/perl.perl5.porters/37481. To my knowledge, such a version of perl does not yet exist, but hey, you are merlyn.

    Once that's done, you can try my approach. However, to make it easier to understand and compare side-by-side with your original approach, I rewrote your approach so that both ways of coding this had as much identical code as possible. This means that neither approach is implemented as cleanly or as efficiently as it could be - the goal was side-by-side comparison, not efficiency. In fact, the two scripts are now so similar that I'm just going to present yours as I recoded it and then explain how to transform it into mine:

    Now, to change that into my approach, where the genes represent class priorities, first change the setup code to:
    my $ga = AI::Genetic->new ( -fitness => \&my_fitness, -type => 'rangevector', -terminate => \&my_terminate ); $ga->init([map {[0,100]} @CLASSES]);
    Then, change the make_config sub:
    sub make_config { my (@genes) = @_; # sort classes in order by genes: use Data::Dumper; my (@order) = sort {$genes[$a] <=> $genes[$b];} (0..$#CLASSES); my (@sclasses) = @CLASSES[@order]; push(@sclasses, (qw{XXX}) x ($SLOTS * $ROOMS)); my ($config) = []; for my $s (0..$SLOTS-1) { push @$config, []; for my $r (0..$ROOMS-1) { my $i=0; while (!is_acceptable($sclasses[$i],$s,$r,$config)) {$i++;} push @{$config->[-1]}, splice(@sclasses,$i,1); } } $config; }
    And that's it.

    The interesting thing is that this priority-driven approach converges almost instantly with the scoring function you supplied - the first or second generation usually has a configuration that scores at 20.5 or 21. (21 is the max. possible here)

    I would be interested to know what more advanced scoring functions you come up with later and whether this priority-driven approach ends up being significantly better in practice than your initial approach of having a gene for each room/slot combination.

    -- @/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/; map{y/X_/\n /;print}map{pop@$_}@/for@/
      As halley pointed out to me in node 433726, there is in fact a way to avoid the necessity of changing AI::Genetic at all, though it requires a small use of prototyping, which I know you abhor, to make it work.

      In my version, you just have to write the make_config sub like this:

      sub make_config { my (@genes) = @_; # sort classes in order by genes: # stupid #!@#!#$! sort bug my $sortsub = sub ($$) { my ($a,$b) = @_; $genes[$a] <=> $genes[$b]; }; my (@sclasses) = @CLASSES[sort $sortsub (0..$#CLASSES)]; push(@sclasses, (qw{XXX}) x ($SLOTS * $ROOMS)); my ($config) = []; for my $s (0..$SLOTS-1) { push @$config, []; for my $r (0..$ROOMS-1) { my $i=0; while (!is_acceptable($sclasses[$i],$s,$r,$config)) {$i++;} push @{$config->[-1]}, splice(@sclasses,$i,1); } } $config; }
      -- @/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/; map{y/X_/\n /;print}map{pop@$_}@/for@/

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://432827]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2024-03-28 13:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found