Merge pull request #1526 from rjt-pl/rjt_054

rjt's Week 054 solutions and blogs

7 files changed, 150 insertions, 5 deletions

diff --git a/challenge-054/ryan-thompson/README.md b/challenge-054/ryan-thompson/README.md
index f0cab5ade3..366f1ddd31 100644
--- a/challenge-054/ryan-thompson/README.md
+++ b/challenge-054/ryan-thompson/README.md
@@ -1,19 +1,19 @@
 # Ryan Thompson
 
-## Week 053 Solutions
+## Week 054 Solutions
 
-### Task 1 › Rotate Matrix
+### Task 1 › kth Permutation
 
  * [Perl](perl/ch-1.pl)
  * [Raku](raku/ch-1.p6)
 
-### Task 2 › Vowel Strings
+### Task 2 › Collatz Conjecture
 
  * [Perl](perl/ch-2.pl)
  * [Raku](raku/ch-2.p6)
 
 ## Blogs
 
- * [Week 052 › Rotate Matrix](http://ry.ca/2020/03/matrix-rotation/)
- * [Week 052 › Vowel Strings](http://ry.ca/2020/03/vowel-strings/)
+ * [Week 054 › kth Permutation](http://www.ry.ca/2020/04/kth-permutation/)
+ * [Week 054 › Collatz Conjecture](http://www.ry.ca/2020/04/collatz-conjecture/)
 
diff --git a/challenge-054/ryan-thompson/blog.txt b/challenge-054/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..ab7195c4fd
--- /dev/null
+++ b/challenge-054/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/04/kth-permutation/
diff --git a/challenge-054/ryan-thompson/blog1.txt b/challenge-054/ryan-thompson/blog1.txt
new file mode 100644
index 0000000000..fee5e88149
--- /dev/null
+++ b/challenge-054/ryan-thompson/blog1.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/04/collatz-conjecture/
diff --git a/challenge-054/ryan-thompson/perl/ch-1.pl b/challenge-054/ryan-thompson/perl/ch-1.pl
new file mode 100644
index 0000000000..24777789f9
--- /dev/null
+++ b/challenge-054/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - kth Permutation Sequence
+#
+# 2020 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+use Algorithm::Combinatorics qw<permutations>;
+
+my ($n, $k) = @ARGV;
+$n //= 3;
+$k //= 4;
+
+# Array version is compact
+say join '', @{ ( permutations([1..$n], $n) )[$k-1] };
+
+# Iterator version is usually slightly faster as it short-circuits
+my $it = permutations([1..$n], $n);
+$it->next for 1..$k-1;
+say join '', @{ $it->next };
+
+__END__
+use Benchmark qw<cmpthese>;
+
+cmpthese(-5, {
+    array => sub { join '', @{ (permutations([1..$n], $n))[$k-1] } },
+    iter  => sub {
+        my $it = permutations([1..$n], $n);
+        $it->next for 1..$k-1;
+        join '', @{ $it->next };
+    }
+});
diff --git a/challenge-054/ryan-thompson/perl/ch-2.pl b/challenge-054/ryan-thompson/perl/ch-2.pl
new file mode 100644
index 0000000000..b39b410b11
--- /dev/null
+++ b/challenge-054/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Collatz sequence
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+use List::Util qw/first shuffle/;
+use Data::Dump qw/pp dd/;
+
+use Getopt::Long;
+
+my @seqlen = (-1,1);    # Memoize sequence length
+my $top    = 20;        # Report this many of the top sequences
+my @top    = [ -1,-1 ]; # Top $top sequences
+my $upper  = 1e6;       # Upper limit starting term
+my $mintop = 0;         # Lowest value in @top
+
+GetOptions('top=i' => \$top, 'upper=i' => \$upper);
+
+# Run through the upper limit
+for (my $start = 3; $start < $upper; $start += 2) {
+    my ($n, $len) = ($start, 0);
+    while (! defined $seqlen[$n]) {
+        $len += 1 + $n % 2;
+        $n = $n % 2 ? (3*$n + 1)/2 : $n / 2;
+    }
+    $len += $seqlen[$n];
+    $seqlen[$start] = $len if $start < $upper * 2; # Cache
+    top($start => $len)            if $len > $mintop  and     $start <= $upper;
+    top($n * 2 => $seqlen[$n] + 1) if   $n < $upper/2 and $seqlen[$n] > $mintop;
+}
+
+# Report top sequences
+printf "Collatz(%5d) has sequence length of %3d steps\n", @$_ for @top;
+
+# Sorted insert [ $n, $len ] to @top, keep @top to $top length
+sub top {
+    my ($n, $len) = @_;
+
+    my $idx = first { $top[$_][1] < $len } 0..$#top;
+    splice @top, $idx, 0, [ $n, $len ];
+
+    pop @top if @top > $top;
+    $mintop = $top[-1][1];
+}
diff --git a/challenge-054/ryan-thompson/raku/ch-1.p6 b/challenge-054/ryan-thompson/raku/ch-1.p6
new file mode 100644
index 0000000000..6839178d15
--- /dev/null
+++ b/challenge-054/ryan-thompson/raku/ch-1.p6
@@ -0,0 +1,9 @@
+#!/usr/bin/env perl6
+
+# ch-1.p6 - kth Permutation
+#
+# Ryan Thompson <rjt@cpan.org>
+
+sub MAIN( Int $n = 3, Int $k = 4 ) {
+    say (1..$n).permutations[$k-1];
+}
diff --git a/challenge-054/ryan-thompson/raku/ch-2.p6 b/challenge-054/ryan-thompson/raku/ch-2.p6
new file mode 100644
index 0000000000..f9b38f8b8b
--- /dev/null
+++ b/challenge-054/ryan-thompson/raku/ch-2.p6
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl6
+
+# ch-2.p6 - Collatz Conjecture, extra credit
+#
+# Ryan Thompson <rjt@cpan.org>
+
+my $top-n   = 20;   # Number of top sequences to list
+my $limit   = 1e6;  # Highest starting number
+my $mintop  = 0;    # Minimum value in @top (efficiency/convenience)
+
+my @top     = 0 => 0, 1 => 1; # Top N list (start => seq-len)
+my @memo    = (0, 1);  # Memoization (@memo[start] = seq-len)
+
+#| Non extra-credit Collatz sequence
+sub collatz( Int $n is copy ) {
+    my @r = $n;
+    while ( $n ≠ 1 ) {
+        $n = $n %% 2 ?? ($n / 2).Int !! (3*$n + 1).Int;
+        @r.push: $n;
+    }
+    @r;
+}
+
+# Iterate through all starting numbers
+for 3..$limit -> $start {
+    my Int $n = $start;
+    my Int $len = 0;
+
+    # Keep going through the sequence until we hit a memoized value
+    while (!@memo[$n]) {
+        $len += 1 + $n % 2;
+        $n = $n %% 2 ?? ($n / 2).Int !! ((3*$n + 1) / 2).Int;
+    }
+
+    $len += @memo[$n];
+    @memo[$start] = $len if $start < $limit * 2;
+    
+    # If the $len is better than the worst value in @top, add it
+    top($start, $len)          if  $len > $mintop and $start ≤ $limit;
+    top($n * 2, @memo[$n] + 1) if $n ≤ $limit / 2 and @memo[$n] > $mintop;
+}
+
+printf "Start: %6d has %4d steps\n", .key, .value for @top;
+
+#| O(n) insert $n => $len into @top
+sub top(Int $n, Int $len) {
+    my $idx = @top.keys.first: { @top[$_].value < $len };
+    @top.splice: $idx.Int, 0, $n => $len;
+    @top.pop if @top > $top-n;
+    $mintop = @top[*-1].value;
+}