initial commit

3 files changed, 143 insertions, 0 deletions

diff --git a/challenge-116/adam-russell/blog.txt b/challenge-116/adam-russell/blog.txt
new file mode 100644
index 0000000000..ebcf2cd6a2
--- /dev/null
+++ b/challenge-116/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2021/06/13
diff --git a/challenge-116/adam-russell/perl/ch-1.pl b/challenge-116/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..74972dbba1
--- /dev/null
+++ b/challenge-116/adam-russell/perl/ch-1.pl
@@ -0,0 +1,100 @@
+use strict;
+use warnings;
+##
+# You are given a number $N >= 10.
+# Write a script to split the given number such that the difference
+# between two consecutive numbers is always 1, and it shouldn't have a leading 0.
+# Print the given number if it impossible to split the number.
+##
+use boolean;
+use AI::Genetic;
+
+use constant THRESHOLD => 0;
+use constant NUMBERS   => "1234";
+
+sub no_op{
+    my($x) = @_;
+    return (caller(0))[3] if !defined($x);
+    return $x;
+}
+
+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 $fitness = -1 * (length($s) -1);
+    my @operands;
+    for my $gene (@{$genes}){
+        if(my($i) = $gene->() =~ m/get_([1-4])/){
+            push @operands, $gene->($s);
+            return -1 * NUMBERS if length($s) < $i;
+            $s = substr($s, $i) if length($s) >= $i;
+        }
+    }
+    for(my $i = 0; $i < @operands - 1; $i++){
+        $fitness += 1 if $operands[$i] == ($operands[$i + 1] - 1);
+    }
+    return $fitness;
+}
+
+sub terminate{
+    my($aig) = @_;
+    my $top_individual = $aig->getFittest();
+    if($top_individual->score == THRESHOLD){
+        my $genes = $top_individual->genes();
+        my $s = NUMBERS;
+        my @operands;
+        for my $gene (@{$genes}){
+            if(my($i) = $gene->() =~ m/get_([1-4])/){
+                push @operands, $gene->($s);
+                $s = substr($s, $i);
+            }
+        }
+        print join(",", @operands) . "\n"; 
+        return true;
+    }
+    print NUMBERS . "\n"; 
+    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}, [\&get_1, \&get_2, \&get_3, \&get_4, \&no_op],
+    }
+    $aig->init(
+        $genes
+    );
+    $aig->evolve("tournamentUniform", 1000);
+}
diff --git a/challenge-116/adam-russell/perl/ch-2.pl b/challenge-116/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..388e66952f
--- /dev/null
+++ b/challenge-116/adam-russell/perl/ch-2.pl
@@ -0,0 +1,42 @@
+use strict;
+use warnings;
+##
+# You are given a number $N >= 10.
+# Write a script to find out if the given number $N is such 
+# that sum of squares of all digits is a perfect square. 
+# Print 1 if it is otherwise 0.
+##
+use POSIX; 
+
+sub sum_squares{
+    my($n) = @_;
+    my @digits = split(//, $n);
+    my $sum = 0;
+    map { $sum += ($_ ** 2) } @digits; 
+    return (ceil(sqrt($sum)) == floor(sqrt($sum)));   
+}
+
+MAIN:{
+    my($N);
+    $N = 34;
+    if(sum_squares($N)){
+        print "1\n";  
+    }  
+    else{
+        print "0\n";  
+    }  
+    $N = 50;
+    if(sum_squares($N)){
+        print "1\n";  
+    }  
+    else{
+        print "0\n";  
+    }  
+    $N = 52;
+    if(sum_squares($N)){
+        print "1\n";  
+    }  
+    else{
+        print "0\n";  
+    }  
+}