Merge pull request #1699 from Firedrake/rogerbw-challenge-060

Solutions for challenge #60.

4 files changed, 209 insertions, 0 deletions

diff --git a/challenge-060/roger-bell-west/perl5/ch-1.pl b/challenge-060/roger-bell-west/perl5/ch-1.pl
new file mode 100755
index 0000000000..df94fd04ef
--- /dev/null
+++ b/challenge-060/roger-bell-west/perl5/ch-1.pl
@@ -0,0 +1,72 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+foreach my $testpair (
+  [1,'A'],
+  [26,'Z'],
+  [27,'AA'],
+  [52,'AZ'],
+  [53,'BA'],
+  [520,'SZ'],
+  [620,'WV'],
+  [676,'YZ'],
+  [677,'ZA'],
+  [701,'ZY'],
+  [702,'ZZ'],
+  [703,'AAA'],
+  [1024,'AMJ'],
+  [2600,'CUZ'],
+  [10000,'NTP'],
+    ) {
+  my $l=encode($testpair->[0]);
+  if ($l ne $testpair->[1]) {
+    die "Failed $testpair->[0] gives $l should be $testpair->[1]\n";
+  }
+  $l=decode($testpair->[1]);
+  if ($l ne $testpair->[0]) {
+    die "Failed $testpair->[1] gives $l should be $testpair->[0]\n";
+  }
+}
+
+sub encode {
+  my $in=shift;
+  my $b=26;
+  my $c=$b;
+  my $d=1;
+  while ($in > $c) {
+    $in-=$c;
+    $c*=$b;
+    $d++;
+  }
+  $in--;
+  my @digits;
+  my @c=('A'..'Z');
+  foreach (1..$d) {
+    unshift @digits,$c[$in % $b];
+    $in=int($in/$b);
+  }
+  return join('',@digits);
+}
+
+sub decode {
+  my $in=shift;
+  my @c=('A'..'Z');
+  my %c=map {$c[$_] => $_} (0..$#c);
+  my @digits=split '',$in;
+  my $d=scalar @digits;
+  my $b=26;
+  my $o=0;
+  foreach (@digits) {
+    $o*=$b;
+    $o+=$c{$_};
+  }
+  my $c=1;
+  $o++;
+  foreach (2..$d) {
+    $c*=$b;
+    $o+=$c;
+  }
+  return $o;
+}
diff --git a/challenge-060/roger-bell-west/perl5/ch-2.pl b/challenge-060/roger-bell-west/perl5/ch-2.pl
new file mode 100755
index 0000000000..5220d858d8
--- /dev/null
+++ b/challenge-060/roger-bell-west/perl5/ch-2.pl
@@ -0,0 +1,35 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+my @L = (0, 1, 2, 5);
+my $X = 2;
+my $Y = 21;
+
+my %out;
+my @counter=(0) x $X;
+my $d=1;
+while ($d) {
+  my $c=join('',map {$L[$_]} @counter);
+  $c =~ s/^0+//;
+  if (length($c) == $X && $c < $Y) {
+    $out{$c}=1;
+  }
+  # evaluate
+  my $i=0;
+  while (1) {
+    $counter[$i]++;
+    if ($counter[$i] <= $#L) {
+      last;
+    }
+    $counter[$i]=0;
+    $i++;
+    if ($i>$#counter) {
+      $d=0;
+      last;
+    }
+  }
+}
+
+print map {"$_\n"} sort keys %out;
diff --git a/challenge-060/roger-bell-west/perl6/ch-1.p6 b/challenge-060/roger-bell-west/perl6/ch-1.p6
new file mode 100755
index 0000000000..fc1ed00603
--- /dev/null
+++ b/challenge-060/roger-bell-west/perl6/ch-1.p6
@@ -0,0 +1,68 @@
+#! /usr/bin/perl6
+
+for (
+  (1,'A'),
+  (26,'Z'),
+  (27,'AA'),
+  (52,'AZ'),
+  (53,'BA'),
+  (520,'SZ'),
+  (620,'WV'),
+  (676,'YZ'),
+  (677,'ZA'),
+  (701,'ZY'),
+  (702,'ZZ'),
+  (703,'AAA'),
+  (1024,'AMJ'),
+  (2600,'CUZ'),
+  (10000,'NTP'),
+    ) -> @testpair {
+  my $l=encode(@testpair[0]);
+  if ($l ne @testpair[1]) {
+    die "Failed @testpair[0] gives $l should be @testpair[1]\n";
+  }
+  $l=decode(@testpair[1]);
+  if ($l ne @testpair[0]) {
+    die "Failed @testpair[1] gives $l should be @testpair[0]\n";
+  }
+}
+
+sub encode ($inc) {
+  my $in=$inc;
+  my $b=26;
+  my $c=$b;
+  my $d=1;
+  while ($in > $c) {
+    $in-=$c;
+    $c*=$b;
+    $d++;
+  }
+  $in--;
+  my @digits;
+  my @c=('A'..'Z');
+  for (1..$d) {
+    unshift @digits,@c[$in % $b];
+    $in=truncate($in/$b);
+  }
+  return join('',@digits);
+}
+
+sub decode ($in) {
+  my @c=('A'..'Z');
+  my %c=map {@c[$_] => $_}, (0..@c.end);
+  my @digits=$in.comb(/./);
+  my $d=@digits.elems;
+  my $b=26;
+  my $o=0;
+  for (@digits) {
+    $o*=$b;
+    $o+=%c{$_};
+  }
+  my $c=1;
+  $o++;
+  for (2..$d) {
+    $c*=$b;
+    $o+=$c;
+  }
+  return $o;
+}
diff --git a/challenge-060/roger-bell-west/perl6/ch-2.p6 b/challenge-060/roger-bell-west/perl6/ch-2.p6
new file mode 100755
index 0000000000..f3a5d61c42
--- /dev/null
+++ b/challenge-060/roger-bell-west/perl6/ch-2.p6
@@ -0,0 +1,34 @@
+#! /usr/bin/perl6
+
+my @L = (0, 1, 2, 5);
+my $X = 2;
+my $Y = 21;
+
+my %out;
+my @counter=(0) xx $X;
+my $d=1;
+while ($d) {
+  my $c=join('',map {@L[$_]},@counter);
+  $c ~~ s/^0+//;
+  if (chars($c) == $X && $c < $Y) {
+    %out{$c}=1;
+  }
+  # evaluate
+  my $i=0;
+  while (1) {
+    @counter[$i]++;
+    if (@counter[$i] <= @L.end) {
+      last;
+    }
+    @counter[$i]=0;
+    $i++;
+    if ($i>@counter.end) {
+      $d=0;
+      last;
+    }
+  }
+}
+
+for %out.keys.sort {
+  say $_;
+}