Solutions for challenge #43

4 files changed, 155 insertions, 0 deletions

diff --git a/challenge-043/roger-bell-west/perl5/ch-1.pl b/challenge-043/roger-bell-west/perl5/ch-1.pl
new file mode 100755
index 0000000000..5002b84618
--- /dev/null
+++ b/challenge-043/roger-bell-west/perl5/ch-1.pl
@@ -0,0 +1,47 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use List::MoreUtils qw(minmax);
+
+my @names=qw(blue yellow black green red);
+my @base=(8,7,0,5,9);
+my @candidate=(1,2,3,4,6);
+my $target=11;
+
+my @index;
+my @metanames;
+foreach my $k (0..$#names-1) {
+  push @metanames,$names[$k];
+  push @metanames,$names[$k].'/'.$names[$k+1];
+}
+push @metanames,$names[-1];
+
+foreach my $a (0..$#base*2) {
+  $index[0]=$a;
+  foreach my $b (0..$#base*2) {
+    $index[1]=$b;
+    foreach my $c (0..$#base*2) {
+      $index[2]=$c;
+      foreach my $d (0..$#base*2) {
+        $index[3]=$d;
+        foreach my $e (0..$#base*2) {
+          $index[4]=$e;
+          my @sums=@base;
+          foreach my $i (0..$#candidate) {
+            my $ix=int($index[$i]/2);
+            $sums[$ix]+=$candidate[$i];
+            if ($index[$i]%2==1) {
+              $sums[$ix+1]+=$candidate[$i];
+            }
+          }
+          my @l=minmax(@sums);
+          if ($l[0]==$target && $l[1]==$target) {
+            print join(', ',map {"$candidate[$_] in $metanames[$index[$_]]"} (0..$#candidate)),"\n";
+          }
+        }
+      }
+    }
+  }
+}
diff --git a/challenge-043/roger-bell-west/perl5/ch-2.pl b/challenge-043/roger-bell-west/perl5/ch-2.pl
new file mode 100755
index 0000000000..6ca6614cbd
--- /dev/null
+++ b/challenge-043/roger-bell-west/perl5/ch-2.pl
@@ -0,0 +1,35 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+my $base=$ARGV[0] || 10;
+if ($base<4 || $base==6) {
+  die "No self-descriptive numbers in base $base\n";
+}
+
+my @digit=('0'..'9','A'..'Z','a'..'z');
+
+my @n=(0) x $base;
+
+$n[0]=1;
+
+if ($base>6) {
+  $n[0]=$base-4;
+  $n[1]=2;
+  $n[2]=1;
+  $n[$base-4]=1
+}
+while (1) {
+  my @o=@n;
+  my %o;
+  map {$o{$_}++} @o;
+  foreach my $i (0..$#o) {
+    $n[$i]=$o{$i} || 0;
+  }
+  if (join('',@o) eq join('',@n)) {
+    last;
+  }
+}
+
+print join('',map {$digit[$_]} @n),"\n";
diff --git a/challenge-043/roger-bell-west/perl6/ch-1.p6 b/challenge-043/roger-bell-west/perl6/ch-1.p6
new file mode 100755
index 0000000000..c3d79ef991
--- /dev/null
+++ b/challenge-043/roger-bell-west/perl6/ch-1.p6
@@ -0,0 +1,41 @@
+#! /usr/bin/perl6
+
+my @names=('blue','yellow','black','green','red');
+my @base=(8,7,0,5,9);
+my @candidate=(1,2,3,4,6);
+my $target=11;
+
+my @index;
+my @metanames;
+for (0..@names.end-1) -> $k {
+  @metanames.push(@names[$k]);
+  @metanames.push(@names[$k] ~ '/' ~ @names[$k+1]);
+}
+push @metanames,@names[@names.end];
+
+for (0..@base.end*2) -> $a {
+  @index[0]=$a;
+  for (0..@base.end*2) -> $b {
+    @index[1]=$b;
+    for (0..@base.end*2) -> $c {
+      @index[2]=$c;
+      for (0..@base.end*2) -> $d {
+        @index[3]=$d;
+        for (0..@base.end*2) -> $e {
+          @index[4]=$e;
+          my @sums=@base;
+          for (0..@candidate.end) -> $i {
+            my $ix=floor(@index[$i]/2);
+            @sums[$ix]+=@candidate[$i];
+            if (@index[$i]%2==1) {
+              @sums[$ix+1]+=@candidate[$i];
+            }
+          }
+          if (min(@sums)==$target && max(@sums)==$target) {
+            say join(', ',map {"@candidate[$_] in @metanames[@index[$_]]"}, (0..@candidate.end));
+          }
+        }
+      }
+    }
+  }
+}
diff --git a/challenge-043/roger-bell-west/perl6/ch-2.p6 b/challenge-043/roger-bell-west/perl6/ch-2.p6
new file mode 100755
index 0000000000..d872e4ebf5
--- /dev/null
+++ b/challenge-043/roger-bell-west/perl6/ch-2.p6
@@ -0,0 +1,32 @@
+#! /usr/bin/perl6
+
+my $base=(shift @*ARGS) || 10;
+if ($base < 4 || $base == 6) {
+  die "No self-descriptive numbers in base $base\n";
+}
+
+my @digit=(slip('0'..'9'),slip('A'..'Z'),slip('a'..'z'));
+
+my @n=0 xx $base;
+
+@n[0]=1;
+
+if ($base>6) {
+  @n[0]=$base-4;
+  @n[1]=2;
+  @n[2]=1;
+  @n[$base-4]=1
+}
+while (1) {
+  my @o=@n;
+  my %o;
+  map {%o{$_}++}, @o;
+  for (0..@o.end) -> $i {
+    @n[$i]=%o{$i} || 0;
+  }
+  if (join('',@o) eq join('',@n)) {
+    last;
+  }
+}
+
+print join('',map {@digit[$_]}, @n),"\n";