"Divide" challenge - AI solution

Well, enough delaying, let's present AI::Genetic::Pro solution to "Divide" challenge. I was thinking a little about how to present permutation in AI, but, as usual, the thinking ended when I incidentally found AI::Genetic::Pro module, which had a solution ready for me. This is one more situation, where whole programming resolves itself into finding solution on CPAN. This way I won't probably never publish anything on CPAN, because I am 100 years after it! So I decided, my contribution to CPAN will be just to use it and present as many usages as possible.

One more thought: this won't be cool usage of Perl, it will be actually tutorial on what is needed for genetic algorithms with an example in Perl. Because Perl with modules is easy to read. That's right!

OK, to the point, first let's define and initialize some data structures:

use AI::Genetic::Pro;

my @costs = map [split], <DATA>;
my $NUM_OF_NODES = @costs;
my $GROUP_SIZE = $NUM_OF_NODES/2;

my @connections = sort {$a <=> $b }
    map
        { my $r=$_; map { $costs[$r][$_] } $_+1..$NUM_OF_NODES-1 }
    0..$NUM_OF_NODES-1;

my $numbetweengroups = $GROUP_SIZE * $GROUP_SIZE;
my $numinsidegroups = @connections - $numbetweengroups;

my $ideal_score = 0;
my $all_conn_sum = 0;

for(0..$#connections)
{
    if($_<$numbetweengroups)
        { $ideal_score += $connections[$_] }
    $all_conn_sum += $connections[$_];
}
[download]

We define fitness function which calculates score of every member of the population. In our case this is just sum of all connection weights inside groups

sub fitness
{
    my ($ga, $chromosome) = @_;
    my @queue = $ga->as_array($chromosome);
    my @group1ids = @queue[0..$GROUP_SIZE-1];
    my @group2ids = @queue[$GROUP_SIZE..$NUM_OF_NODES-1];
    my $current_score = 0;
    for my $src(@nodes[@group1ids])
    {
        for my $dst(@nodes[@group2ids])
        {
            $current_score += $costs[$src][$dst]
        }
    }
    return $all_conn_sum - $current_score;
}
[download]

We define optimal solution. In some problems it is impossible, so one may hardcode it to 0.

sub terminate
{
    my ($ga) = @_;
    my $result = $all_conn_sum - fitness($ga, $ga->getFittest);
    return $result == $ideal_score ? 1 : 0;
}
[download]

Here is the object tying all together. Most variables are self-explained. In my codes I leave most of them with default values, changing only type and population size.

my $ga = AI::Genetic::Pro->new(
    -fitness         => \&fitness,        # fitness function
    -terminate       => \&terminate,      # terminate function
    -type            => 'combination',    # type of chromosomes
    -population      => 1000,             # population
    -crossover       => 0.9,              # probab. of crossover
    -mutation        => 0.01,             # probab. of mutation
    -parents         => 2,                # number  of parents
    -selection       => [ 'Roulette' ],   # selection strategy
    -strategy        => [ 'OX' ],         # crossover strategy
    -cache           => 0,                # cache results
    -history         => 1,                # remember best results
    -preserve        => 3,                # remember the bests
);
[download]

Model of chromosome, set here to list of numbers of nodes 0 1 2 3 4 ..., which will be permuted.

$ga->init([0..$#costs]);
[download]

Set number of generations. Ready, steady, go!

$ga->evolve(10);
[download]

Now wait, wait, wait, there it is. The result.

print "SCORE: ", $ga->as_value($ga->getFittest), " for set: ", "[".joi
+n(", ", $ga->as_array($ga->getFittest))."]", ".\n";

<p>And if someone want's to see history of evolution:</p>
# $ga->chart(-filename => 'evolution.png');
[download]

Whole program with some input __DATA__ section:

use AI::Genetic::Pro;

my @costs = map [split], <DATA>;
my $NUM_OF_NODES = @costs;
my $GROUP_SIZE = $NUM_OF_NODES/2;

my @connections = sort {$a <=> $b }
    map
        { my $r=$_; map { $costs[$r][$_] } $_+1..$NUM_OF_NODES-1 }
    0..$NUM_OF_NODES-1;

my $numbetweengroups = $GROUP_SIZE * $GROUP_SIZE;
my $numinsidegroups = @connections - $numbetweengroups;

my $ideal_score = 0;
my $all_conn_sum = 0;

for(0..$#connections)
{
    if($_<$numbetweengroups)
        { $ideal_score += $connections[$_] }
    $all_conn_sum += $connections[$_];
}

sub fitness
{
    my ($ga, $chromosome) = @_;
    my @queue = $ga->as_array($chromosome);
    my @group1ids = @queue[0..$GROUP_SIZE-1];
    my @group2ids = @queue[$GROUP_SIZE..$NUM_OF_NODES-1];
    my $current_score = 0;
    for my $src(@nodes[@group1ids])
    {
        for my $dst(@nodes[@group2ids])
        {
            $current_score += $costs[$src][$dst]
        }
    }
    return $all_conn_sum - $current_score;
}

sub terminate
{
    my ($ga) = @_;
    my $result = $all_conn_sum - fitness($ga, $ga->getFittest);
    return $result == $ideal_score ? 1 : 0;
}

my $ga = AI::Genetic::Pro->new(
    -fitness         => \&fitness,        # fitness function
    -terminate       => \&terminate,      # terminate function
    -type            => 'combination',    # type of chromosomes
    -population      => 1000,             # population
    -crossover       => 0.9,              # probab. of crossover
    -mutation        => 0.01,             # probab. of mutation
    -parents         => 2,                # number  of parents
    -selection       => [ 'Roulette' ],   # selection strategy
    -strategy        => [ 'OX' ],         # crossover strategy
    -cache           => 0,                # cache results
    -history         => 1,                # remember best results
    -preserve        => 3,                # remember the bests
);

# init population of 32-bit vectors
$ga->init([0..$#costs]);

# evolve 10 generations
$ga->evolve(10);

# best score
print "SCORE: ", $ga->as_value($ga->getFittest), " for set: ", "[".joi
+n(", ", $ga->as_array($ga->getFittest))."]", ".\n";

    
# save evolution path as a chart
# $ga->chart(-filename => 'evolution.png');

__DATA__
- 159 38 172 76 143 155 78 282 58
159 - 7 264 128 105 42 169 124 153
38 7 - 226 142 85 163 120 74 285
172 264 226 - 48 271 15 151 255 116
76 128 142 48 - 189 152 237 183 10
143 105 85 271 189 - 167 193 18 127
155 42 163 15 152 167 - 99 187 59
78 169 120 151 237 193 99 - 51 12
282 124 74 255 183 18 187 51 - 281
58 153 285 116 10 127 59 12 281 -
[download]

And for those of you, who want a homework: try to analyse this application fighting with approximation problem:

#!perl -l

use AI::Genetic;
my $ga = new AI::Genetic
    (
        -fitness    => \&fitnessFunc,
        -type       => 'rangevector',
        -population => 50,
        -crossover  => 0.9,
        -mutation   => 0.01,
        -terminate  => \&terminateFunc,
    );

    # 3x^2+2x-5
@aPoints = ([-2,3], [-1,-4], [0,-5], [1,0], [2,11], [3,28]);
$ga->init([[-10, 31], [1, 3], [-10, 31], [1, 3], [-10, 31], [1, 3], [-
+10, 31], [1, 3], [-10, 31]]);
sub translate
{
    ($p, @aa) = @_;
    
    %operators = (1=>'+',2=>'-',3=>'*');
    
    while(@aa)
    {
        $operator = shift @aa;
        $value = shift @aa;
        $value = '$x' if $value > 10;
        $p .= $operators{$operator}.'('.$value.')';
    }
    # substitute (12) -> 12
    $p=~s/\((\d+|\$x)\)/$1/g;
    # substitute -(-12) -> +12
    $p=~s/-\(-(\d+|\$x)\)/+$1/g;
    # substitute +(-12) -> -12
    $p=~s/\+\((-\d+|-\$x)\)/$1/g;
    # remove +0 lub -0
    $p=~s/(\+|-)0(\+|-)/$2/g;
    # print $p;
    $p
}
$ga->evolve('rouletteTwoPoint', 300);
print "Best score = ", $ga->getFittest->score, ", for genes: ", transl
+ate(@{$ga->getFittest->genes}), ".\n";

sub fitnessFunc
{
    my $genes = shift;

    my $equation = translate(@$genes);
    
    my $fitness = 0;
    for(@aPoints)
    {
        ($x, $y) = @$_;
        $fitness -= abs($y - eval $equation);
    }

    return $fitness;
}

sub terminateFunc
{
    my $ga = shift;

    # terminate if reached result.
    return 1 if $ga->getFittest->score == @aPoints;
    return 0;
}
[download]

Comment on "Divide" challenge - AI solution Select or Download Code

Replies are listed 'Best First'.
Re: "Divide" challenge - AI solution by zentara (Cardinal) on Mar 23, 2009 at 11:46 UTC
WoW, ++grizzley , what bears come up with during their long months of hibernation....what a dream for those long slumbers......lucky bears.... :-) I'm not really a human, but I play one on earth My Petition to the Great Cosmic Conciousness	[reply]