aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xchallenge-060/roger-bell-west/perl5/ch-1.pl72
-rwxr-xr-xchallenge-060/roger-bell-west/perl5/ch-2.pl35
-rwxr-xr-xchallenge-060/roger-bell-west/perl6/ch-1.p668
-rwxr-xr-xchallenge-060/roger-bell-west/perl6/ch-2.p634
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 $_;
+}