Merge pull request #1884 from Firedrake/rogerbw-challenge-067

Solutions for challenge #67.

2 files changed, 82 insertions, 0 deletions

diff --git a/challenge-067/roger-bell-west/perl/ch-1.pl b/challenge-067/roger-bell-west/perl/ch-1.pl
new file mode 100755
index 0000000000..eea5a35b45
--- /dev/null
+++ b/challenge-067/roger-bell-west/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+is_deeply(combine(5,2),
+          [ [1,2], [1,3], [1,4], [1,5], [2,3], [2,4], [2,5], [3,4], [3,5], [4,5] ],
+          'expansion 5 2',
+            );
+is_deeply(combine(4,3),
+          [ [1,2,3], [1,2,4], [1,3,4], [2,3,4] ],
+          'expansion 4 3',
+            );
+
+sub combine {
+  my ($m,$n)=@_;
+  my @out;
+  my @a;
+  do {
+    my $s=[];
+    if (@a) {
+      $s=shift @a;
+    }
+    if (scalar @{$s} < $n) {
+      my $base=0;
+      if (@{$s}) {
+        $base=$s->[-1];
+      }
+      foreach my $k ($base+1..$m) {
+        push @a,[@{$s},$k];
+      }
+    } else {
+      push @out,$s;
+    }
+  } while @a;
+  return \@out;
+}
diff --git a/challenge-067/roger-bell-west/perl/ch-2.pl b/challenge-067/roger-bell-west/perl/ch-2.pl
new file mode 100755
index 0000000000..21d5067ce6
--- /dev/null
+++ b/challenge-067/roger-bell-west/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+is_deeply(expand('35'),
+          ["dj", "dk", "dl", "ej", "ek", "el", "fj", "fk", "fl"],
+          'expansion 35',
+            );
+
+sub expand {
+  my ($digits)=@_;
+  my %table=(
+    2 => [qw(a b c)],
+    3 => [qw(d e f)],
+    4 => [qw(g h i)],
+    5 => [qw(j k l)],
+    6 => [qw(m n o)],
+    7 => [qw(p q r s)],
+    8 => [qw(t u v)],
+    9 => [qw(w x y z)],
+      );
+  my @d=grep {exists $table{$_}} split '',$digits;
+  my @out;
+  my @a;
+  do {
+    my $s=[];
+    if (@a) {
+      $s=shift @a;
+    }
+    my $l=scalar @{$s};
+    if ($l <= $#d) {
+      foreach my $dx (@{$table{$d[$l]}}) {
+        push @a,[@{$s},$dx];
+      }
+    } else {
+      push @out,join('',@{$s});
+    }
+  } while @a;
+  return \@out;
+}