initial commit for challenge 044

3 files changed, 216 insertions, 0 deletions

diff --git a/challenge-044/adam-russell/blog.txt b/challenge-044/adam-russell/blog.txt
new file mode 100644
index 0000000000..46627e3d24
--- /dev/null
+++ b/challenge-044/adam-russell/blog.txt
@@ -0,0 +1 @@
+https://adamcrussell.livejournal.com/14635.html
diff --git a/challenge-044/adam-russell/perl/ch-1.pl b/challenge-044/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..2ee336b1d7
--- /dev/null
+++ b/challenge-044/adam-russell/perl/ch-1.pl
@@ -0,0 +1,132 @@
+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);
+}
diff --git a/challenge-044/adam-russell/perl/ch-2.pl b/challenge-044/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..ea5d766db7
--- /dev/null
+++ b/challenge-044/adam-russell/perl/ch-2.pl
@@ -0,0 +1,83 @@
+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);
+}