Solutions to challenge #54.

5 files changed, 132 insertions, 0 deletions

diff --git a/challenge-054/roger-bell-west/perl5/ch-1.pl b/challenge-054/roger-bell-west/perl5/ch-1.pl
new file mode 100755
index 0000000000..0ffa36208e
--- /dev/null
+++ b/challenge-054/roger-bell-west/perl5/ch-1.pl
@@ -0,0 +1,33 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use integer;
+
+my ($n,$k)=@ARGV;
+
+my @f;
+my $b=1;
+my $v=1;
+while ((scalar @f == 0) || $f[-1] < $k) {
+  push @f,$v;
+  $v*=$b;
+  $b++;
+}
+
+my $nk=$k-1;
+my @n;
+for (my $i=$#f;$i>=0;$i--) {
+  unshift @n,$nk/$f[$i];
+  $nk-=$f[$i]*$n[0];
+}
+
+my @i=(1..$n);
+my @o;
+for (my $i=$n;$i>=1;$i--) {
+  my $f=$n[$i-1] || 0;
+  push @o,splice @i,$f,1;
+}
+
+print join($n>9?',':'',@o),"\n";
diff --git a/challenge-054/roger-bell-west/perl5/ch-2.pl b/challenge-054/roger-bell-west/perl5/ch-2.pl
new file mode 100755
index 0000000000..652ff808d9
--- /dev/null
+++ b/challenge-054/roger-bell-west/perl5/ch-2.pl
@@ -0,0 +1,20 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use integer;
+
+while (my $n=shift @ARGV) {
+  my @k=($n);
+  while ($n != 1) {
+    if ($n % 2 == 0) {
+      $n/=2;
+    } else {
+      $n*=3;
+      $n++;
+    }
+    push @k,$n;
+  }
+  print join(', ',@k),"\n";
+}
diff --git a/challenge-054/roger-bell-west/perl5/ch-2a.pl b/challenge-054/roger-bell-west/perl5/ch-2a.pl
new file mode 100755
index 0000000000..d0d70103cc
--- /dev/null
+++ b/challenge-054/roger-bell-west/perl5/ch-2a.pl
@@ -0,0 +1,36 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use integer;
+
+my %l;
+my %s;
+
+$l{1}=1;
+
+foreach my $n (1..1e6) {
+  my $k=1;
+  my $na=$n;
+  while (!exists $l{$na}) {
+    if ($na % 2 == 0) {
+      $na/=2;
+    } else {
+      $na*=3;
+      $na++;
+    }
+    $k++;
+  }
+  $l{$n}=$k+$l{$na};
+  push @{$s{$l{$n}}},$n;
+}
+
+my $k=20;
+foreach my $c (sort {$b <=> $a} keys %s) {
+  print "$c: ".join(', ',sort @{$s{$c}}),"\n";
+  $k-=scalar @{$s{$c}};
+  if ($k<=0) {
+    last;
+  }
+}
diff --git a/challenge-054/roger-bell-west/perl6/ch-1.p6 b/challenge-054/roger-bell-west/perl6/ch-1.p6
new file mode 100755
index 0000000000..c415f5c47a
--- /dev/null
+++ b/challenge-054/roger-bell-west/perl6/ch-1.p6
@@ -0,0 +1,28 @@
+#! /usr/bin/perl6
+
+my ($n,$k)=@*ARGS;
+
+my @f;
+my $b=1;
+my $v=1;
+while ((@f.elems == 0) || @f[@f.end] < $k) {
+  push @f,$v;
+  $v*=$b;
+  $b++;
+}
+
+my $nk=$k-1;
+my @n;
+loop (my $i=@f.end;$i>=0;$i--) {
+  unshift @n,floor($nk/@f[$i]);
+  $nk-=@f[$i]*@n[0];
+}
+
+my @i=(1..$n);
+my @o;
+loop (my $j=$n;$j>=1;$j--) {
+  my $f=@n[$j-1] || 0;
+  push @o,splice @i,$f,1;
+}
+
+say join($n>9 ?? ',' !! '',@o);
diff --git a/challenge-054/roger-bell-west/perl6/ch-2.p6 b/challenge-054/roger-bell-west/perl6/ch-2.p6
new file mode 100755
index 0000000000..b895017e0e
--- /dev/null
+++ b/challenge-054/roger-bell-west/perl6/ch-2.p6
@@ -0,0 +1,15 @@
+#! /usr/bin/perl6
+
+while (my $n=shift @*ARGS) {
+  my @k=($n);
+  while ($n != 1) {
+    if ($n % 2 == 0) {
+      $n/=2;
+    } else {
+      $n*=3;
+      $n++;
+    }
+    push @k,$n;
+  }
+  say join(', ',@k);
+}