Perl Weekly Challenge 044

ch-1.pl

use strict;
use warnings;
##
# You are given a string "123456789". Write a script 
# that would insert "+" or "-" in between digits so
# that when you evaluate, the result should be 100.
##
use boolean;
use AI::Genetic;

use constant THRESHOLD => 0;
use constant NUMBERS   => "123456789";

sub no_op{
    my($x) = @_;
    return (caller(0))[3] if !defined($x);
    return $x;
}

sub add{
    my($x, $y) = @_;
    return (caller(0))[3] if !defined($x);
    return $x + $y;
}

sub subtract{
    my($x, $y) = @_;
    return (caller(0))[3] if !defined($x);
    return $x - $y;
}

sub get_1{
    my($s) = @_;
    return (caller(0))[3] if !defined($s);
    return substr($s, 0, 1);
}

sub get_2{
    my($s) = @_;
    return (caller(0))[3] if !defined($s);
    return substr($s, 0, 2);
}

sub get_3{
    my($s) = @_;
    return (caller(0))[3] if !defined($s);
    return substr($s, 0, 3);
}

sub get_4{
    my($s) = @_;
    return (caller(0))[3] if !defined($s);
    return substr($s, 0, 4);
}

sub fitness{
    my($genes) = @_;
    my $s = NUMBERS;
    my $total = 0;
    my @operands = ($total);
    for my $gene (@{$genes}){
        if(my($i) = $gene->() =~ m/get_([1-4])/){
            return (-1 * NUMBERS) if(@operands == 2);
            return (-1 * NUMBERS) if(length($s) < $i);
            push @operands, $gene->($s);  
            $s = substr($s, $i);  
        }
        if($gene->() =~ m/add/){
            return (-1 * NUMBERS) if(@operands != 2);
            $total = add(@operands); 
            @operands = ($total);  
        } 
        if($gene->() =~ m/subtract/){
            return (-1 * NUMBERS) if(@operands != 2);
            $total = subtract(@operands); 
            @operands = ($total);  
        } 
    }
    return 100 - $total if $total > 100;
    return $total - 100;
}

sub terminate{
    my($aig) = @_;
    my $top_individual = $aig->getFittest();
    if($top_individual->score == THRESHOLD){
        my @operations;
        my $genes = $top_individual->genes();
        my $n = NUMBERS;
        my $s = ""; 
        my $operand;
        my $op_count = 0;
        for my $g (@{$genes}){
            if(my($i) = $g->() =~ m/get_([1-4])/){
                $operand = $g->($n);
                $n = substr($n, $i);  
            }
            if($g->() =~ m/add/){
                $s .= "+ $operand " if $op_count > 0;
                $s = "$operand " if $op_count == 0;
                $op_count++;  
            }
            if($g->() =~ m/subtract/){
                $s .= "- $operand " if $op_count > 0;  
                $s = "$operand  " if $op_count == 0;
                $op_count++;  
            }
        }
        print "$s= " . eval($s) . "\n";
        return true;
    }
    return false;
}

MAIN:{
    my $aig = new AI::Genetic(
        -fitness    => \&fitness,
        -type       => "listvector",
        -population => 50000,
        -crossover  => 0.9,
        -mutation   => 0.1,
        -terminate  => \&terminate,
    );
    my $genes = [];
    for (0 .. 7){
        push @{$genes}, [\&add, \&subtract, \&get_1, \&get_2, \&get_3, \&get_4, \&no_op],
    }
    $aig->init(
        $genes
    );
    $aig->evolve("tournamentUniform", 1000);
}

ch-2.pl

use strict;
use warnings;
##
# You have only $1 left at the start of the week. 
# You have been given an opportunity to make it $200. 
# The rule is simple: with every move you can either
# double what you have or add another $1. Write a script 
# to help you get $200 with the smallest number of moves.
##
use boolean;
use AI::Genetic;

use constant THRESHOLD => 0;

sub no_op{
    my($x) = @_;
    return (caller(0))[3] if !defined($x);
    return $x;
}

sub add_one{
    my($x) = @_;
    return (caller(0))[3] if !defined($x);
    return $x+1;
}

sub double{
    my($x) = @_;
    return (caller(0))[3] if !defined($x);
    return $x * 2;
}

sub fitness{
    my($genes) = @_;
    my $total = 1;
    my $count_no_op = 1;
    for my $gene (@{$genes}){
        $total = $gene->($total);
        $count_no_op++ if $gene->() =~ m/no/;
    }
    return 200 - $total if $total >= 200;
    return ($total - 200) * $count_no_op;
}

sub terminate{
    my($aig) = @_;
    my $top_individual = $aig->getFittest();
    if($top_individual->score == THRESHOLD){
        my @operations;
        my $genes = $top_individual->genes();
        for my $g (@{$genes}){
            push @operations, "add" if $g->() =~ m/add/;
            push @operations, "double" if $g->() =~ m/double/;
        }
        my $total = 1; 
        print "Start:     \$$total\n"; 
        for my $o (@operations){
            print "Add One:   \$" . ++$total . "\n" if($o eq "add"); 
            do{ $total = $total * 2; print "Double:    \$" .  $total . "\n" } if($o eq "double"); 
        } 
        return true;
    }
    return false;
}

MAIN:{
    my $aig = new AI::Genetic(
        -fitness    => \&fitness,
        -type       => "listvector",
        -population => 5000,
        -crossover  => 0.9,
        -mutation   => 0.01,
        -terminate  => \&terminate,
    );
    my $genes = [];
    for (0 .. 8){
        push @{$genes}, [\&add_one, \&double, \&no_op],
    }
    $aig->init(
        $genes
    );
    $aig->evolve("tournamentUniform", 1000);
}