Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #054

On branch branch-for-challenge-054
Changes to be committed:
	new file:   challenge-054/athanasius/perl/ch-1.pl
	new file:   challenge-054/athanasius/perl/ch-2.pl
	new file:   challenge-054/athanasius/raku/ch-1.raku
	new file:   challenge-054/athanasius/raku/ch-2.raku

4 files changed, 525 insertions, 0 deletions

diff --git a/challenge-054/athanasius/perl/ch-1.pl b/challenge-054/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..dbe74ce474
--- /dev/null
+++ b/challenge-054/athanasius/perl/ch-1.pl
@@ -0,0 +1,94 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 054
+=========================
+
+Task #1
+*kth Permutation Sequence*
+
+Write a script to accept two integers *n (>=1)* and *k (>=1)*. It should print
+the *kth permutation* of *n integers*. For more information, please follow the
+[ https://en.wikipedia.org/wiki/Permutation#k-permutations_of_n |wiki page].
+
+For example, *n=3* and *k=4*, the possible permutation sequences are listed
+below:
+
+  123
+  132
+  213
+  231
+  312
+  321
+
+The script should print the *4th* permutation sequence *231*.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Algorithm::Loops      qw( NextPermuteNum );
+use Const::Fast;
+use Scalar::Util::Numeric qw( isint );
+
+const my $USAGE =>
+  "USAGE: perl $0 <N> <K> - Find the Kth permutation of the sequence 1 .. N\n" .
+  "                              where N and K are integers >= 1\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 054, Task #1: kth Permutation Sequence (Perl)\n\n";
+
+    scalar @ARGV == 2   or die "ERROR: Incorrect number of arguments\n$USAGE";
+
+    my ($n, $k) = @ARGV;
+
+    isint($n) && $n > 0 or die "ERROR: '$n' is not a valid value for N\n$USAGE";
+    isint($k) && $k > 0 or die "ERROR: '$k' is not a valid value for K\n$USAGE";
+
+    my  @list   =  1 .. $n;
+    my  $sep    = ($n < 10) ? '' : ' ';
+
+    NextPermuteNum( @list ) for 2 .. $k;
+
+    printf "The %s permutation of %s is %s\n",
+            ordinal($k), join($sep, 1 .. $n), join($sep, @list);
+}
+
+#-------------------------------------------------------------------------------
+sub ordinal
+#-------------------------------------------------------------------------------
+{
+    my ($n)     = @_;
+    my  $suffix = 'th';
+    my  $dig1   = int(($n % 100) / 10);
+
+    unless ($dig1 == 1)
+    {
+        my $dig0 = $n % 10;
+        $suffix  = $dig0 == 1 ? 'st' :
+                   $dig0 == 2 ? 'nd' :
+                   $dig0 == 3 ? 'rd' : 'th';
+    }
+
+    return $n . $suffix;
+}
+
+################################################################################
diff --git a/challenge-054/athanasius/perl/ch-2.pl b/challenge-054/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..4b75646b73
--- /dev/null
+++ b/challenge-054/athanasius/perl/ch-2.pl
@@ -0,0 +1,196 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 054
+=========================
+
+Task #2
+*Collatz Conjecture*
+*Contributed by Ryan Thompson*
+
+It is thought that the following sequence will always reach 1:
+
+  $n = $n / 2 when $n is even
+  $n = 3*$n + 1 when $n is odd
+
+For example, if we start at 23, we get the following sequence:
+
+23 → 70 → 35 → 106 → 53 → 160 → 80 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
+
+Write a function that finds the *Collatz* sequence for any positive integer.
+Notice how the sequence itself may go far above the original starting number.
+
+*Extra Credit*
+
+Have your script calculate the sequence length for _all_ starting numbers up to
+1000000 (1e6), and output the starting number and sequence length for the long-
+est 20 sequences.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use List::Priority;
+use Scalar::Util::Numeric qw( isint );
+use constant
+{
+    DEBUG => 0,
+    TIMER => 1,
+};
+
+const my $MAX_TERMS =>  20;
+const my $MAX_N     => 1e6;
+const my $MAX_N_STR => commas( $MAX_N );
+const my $BAR       => '-' x 30 . "\n";
+const my $USAGE     =>
+     "USAGE: perl $0 <N> - find the Collatz sequence for positive integer N\n" .
+     "   OR  perl $0     - find the $MAX_TERMS longest sequences for N up to " .
+                          "$MAX_N_STR\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    use if TIMER, 'Time::HiRes' => qw( gettimeofday tv_interval );
+
+    my $t0 = [gettimeofday] if TIMER;
+
+    print "Challenge 054, Task #2: Collatz Conjecture (Perl)\n\n";
+
+    if (scalar @ARGV == 0)
+    {
+        printf "The %d longest Collatz sequences for N up to %s:\n\n%s       " .
+               "  Starting    Sequence\n Rank   Number (N)    Length\n%s",
+                $MAX_TERMS, $MAX_N_STR, $BAR, $BAR;
+
+        my $seqs = find_longest_seqs();
+
+        printf "%4d%13s%10d\n", ($_ + 1), commas($seqs->[$_][0]), $seqs->[$_][1]
+            for 0 .. $MAX_TERMS - 1;
+
+        print $BAR;
+    }
+    elsif (scalar @ARGV == 1)
+    {
+        my $n     = $ARGV[0];
+        my $seq   = find_seq($n);
+        my $terms = scalar @$seq;
+
+        printf "The Collatz sequence (of %d term%s) for N = %s:\n%s\n",
+                $terms, $terms == 1 ? '' : 's', commas($n), join ' -> ', @$seq;
+    }
+    else
+    {
+        die $USAGE;
+    }
+
+    printf "\n%.1f seconds\n", tv_interval($t0) if TIMER;
+}
+
+#-------------------------------------------------------------------------------
+sub find_longest_seqs
+#-------------------------------------------------------------------------------
+{
+    my $longest_seqs = List::Priority->new(capacity => $MAX_TERMS);
+       $longest_seqs->insert(1, 1);
+
+    my $max = 1                              if DEBUG;
+    print "Max seq length: [  1,       1]\n" if DEBUG;
+
+    for my $start (2 .. $MAX_N)
+    {
+        my $terms = count_terms($start);
+
+        if (DEBUG && $terms > $max)
+        {
+            $max = $terms;
+            printf "Max seq length: [%3d, %7d]\n", $terms, $start;
+        }
+
+        $longest_seqs->insert($terms, $start);
+    }
+
+    my @longest_seqs;
+
+    while ($longest_seqs->size > 0)
+    {
+        my $seq_len = $longest_seqs->highest_priority;
+        my $start   = $longest_seqs->pop;
+
+        push @longest_seqs, [ $start, $seq_len ];
+    }
+
+    return \@longest_seqs;
+}
+
+#===============================================================================
+# Memoize Collatz sequences (chains)
+#===============================================================================
+{
+    my %chains;
+
+    #---------------------------------------------------------------------------
+    BEGIN
+    #---------------------------------------------------------------------------
+    {
+        $chains{ 1 } = 1;
+    }
+
+    #---------------------------------------------------------------------------
+    sub count_terms
+    #---------------------------------------------------------------------------
+    {
+        my ($n) = @_;
+
+        return $chains{ $n } if exists $chains{ $n };
+
+        no warnings 'recursion';
+
+        return $chains{ $n } = 1 + count_terms( $n / 2     ) unless $n % 2;
+        return $chains{ $n } = 1 + count_terms( $n * 3 + 1 );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_seq
+#-------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    die $USAGE unless isint($n) && $n > 0;
+
+    my @seq = ($n);
+
+    push @seq, $n = ($n % 2) ? (3 * $n + 1) : ($n / 2) while $n > 1;
+
+    return \@seq;
+}
+
+#-------------------------------------------------------------------------------
+sub commas
+#-------------------------------------------------------------------------------
+{
+    my ($number) = @_;
+
+    # Regex from perlfaq5: "How can I output my numbers with commas added?"
+
+    return $number =~ s/(^\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/gr;
+}
+
+################################################################################
diff --git a/challenge-054/athanasius/raku/ch-1.raku b/challenge-054/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..7662b59d7b
--- /dev/null
+++ b/challenge-054/athanasius/raku/ch-1.raku
@@ -0,0 +1,81 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 054
+=========================
+
+Task #1
+*kth Permutation Sequence*
+
+Write a script to accept two integers *n (>=1)* and *k (>=1)*. It should print
+the *kth permutation* of *n integers*. For more information, please follow the
+[ https://en.wikipedia.org/wiki/Permutation#k-permutations_of_n |wiki page].
+
+For example, *n=3* and *k=4*, the possible permutation sequences are listed
+below:
+
+  123
+  132
+  213
+  231
+  312
+  321
+
+The script should print the *4th* permutation sequence *231*.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+sub MAIN
+(
+    #| Integer >= 1, upper bound of integer series 1..N to be permuted
+    UInt:D $N where $_ >= 1,
+
+    #| Integer >= 1, the number of the required permutation of the series
+    UInt:D $K where $_ >= 1,
+)
+#===============================================================================
+{
+    "Challenge 054, Task #1: kth Permutation Sequence (Raku)\n".put;
+
+    my UInt @list  = 1 .. $N;
+    my UInt $size  = [*] @list;
+    my UInt $index = ($K - 1) % $size;
+    my List $perm  = @list.permutations[ $index ];
+    my Str  $sep   = $N < 10 ?? '' !! ' ';
+
+    "The %s permutation of %s is %s\n".printf:
+        ordinal($K), (1 .. $N).join($sep), $perm.list.join($sep);
+}
+
+#-------------------------------------------------------------------------------
+sub ordinal(UInt:D $n --> Str:D)
+#-------------------------------------------------------------------------------
+{
+    my Str  $suffix = 'th';
+    my UInt $dig1   = (($n % 100) / 10).UInt;
+
+    unless $dig1 == 1
+    {
+        my UInt $dig0 = $n % 10;
+
+        $suffix = $dig0 == 1 ?? 'st' !!
+                  $dig0 == 2 ?? 'nd' !!
+                  $dig0 == 3 ?? 'rd' !! 'th';
+    }
+
+    return $n ~ $suffix;
+}
+
+###############################################################################
diff --git a/challenge-054/athanasius/raku/ch-2.raku b/challenge-054/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..a42c1f6fd1
--- /dev/null
+++ b/challenge-054/athanasius/raku/ch-2.raku
@@ -0,0 +1,154 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 054
+=========================
+
+Task #2
+*Collatz Conjecture*
+*Contributed by Ryan Thompson*
+
+It is thought that the following sequence will always reach 1:
+
+  $n = $n / 2 when $n is even
+  $n = 3*$n + 1 when $n is odd
+
+For example, if we start at 23, we get the following sequence:
+
+23 → 70 → 35 → 106 → 53 → 160 → 80 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
+
+Write a function that finds the *Collatz* sequence for any positive integer.
+Notice how the sequence itself may go far above the original starting number.
+
+*Extra Credit*
+
+Have your script calculate the sequence length for _all_ starting numbers up to
+1000000 (1e6), and output the starting number and sequence length for the
+longest 20 sequences.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use Lingua::EN::Numbers;                            # For the comma() subroutine
+use List::Priority:from<Perl5>;
+
+my UInt constant MAX-N     = 1e6.UInt;
+my UInt constant MAX-TERMS = 20;
+my Str  constant BAR       = '-' x 30;
+my Bool constant DEBUG     = False;
+
+my Instant $t0;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $t0 = now;
+    ''.put;
+}
+
+#-------------------------------------------------------------------------------
+END "\n%.1f seconds\n".printf: now - $t0;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+multi sub MAIN         #= Find the MAX-TERMS longest sequences for N up to MAX-N
+#===============================================================================
+{
+    "Challenge 054, Task #2: Collatz Conjecture (Raku)\n".put;
+
+    ("The %d longest Collatz sequences for N up to %s:\n\n%s\n       " ~
+        "  Starting    Sequence\n Rank   Number (N)    Length\n%s\n").printf:
+        MAX-TERMS, comma(MAX-N), BAR, BAR;
+
+    my @seqs = find-longest-seqs();
+
+    "%4d%13s%10d\n".printf: ($_ + 1), comma( @seqs[$_][0] ), @seqs[$_][1]
+        for 0 .. MAX-TERMS - 1;
+
+    BAR.put;
+}
+
+#-------------------------------------------------------------------------------
+sub find-longest-seqs( --> Array:D )
+#-------------------------------------------------------------------------------
+{
+    my $longest-seqs = List::Priority.new(capacity => MAX-TERMS);
+       $longest-seqs.insert(1, 1);
+
+    my UInt $max = 1                         if DEBUG;
+    print "Max seq length: [  1,       1]\n" if DEBUG;
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    # N.B.: For MAX-N == 1e6, this for loop takes ~20 minutes to complete!
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+    for 2 .. MAX-N -> UInt $start
+    {
+        my UInt $terms = count-terms($start);
+
+        if (DEBUG && $terms > $max)
+        {
+            $max = $terms;
+            "Max seq length: [%3d, %7d]\n".printf: $terms, $start;
+        }
+
+        $longest-seqs.insert($terms, $start);
+    }
+
+    my @longest-seqs;
+
+    while $longest-seqs.size > 0
+    {
+        my UInt $seq-len = $longest-seqs.highest_priority.UInt;
+        my UInt $start   = $longest-seqs.pop;
+
+        push @longest-seqs, [ $start, $seq-len ];
+    }
+
+    return @longest-seqs;
+}
+
+#-------------------------------------------------------------------------------
+sub count-terms( UInt:D $n --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    state  %chains = 1 => 1;            # Memoize
+
+    return %chains{$n}                                  if %chains{$n}:exists;
+    return %chains{$n} = 1 + count-terms(($n / 2).UInt) if $n % 2 == 0;
+    return %chains{$n} = 1 + count-terms( $n * 3 + 1 );
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    UInt:D $N where $_ > 0   #= Find the Collatz sequence for positive integer N
+)
+#===============================================================================
+{
+    "Challenge 054, Task #2: Collatz Conjecture (Raku)\n".put;
+
+    my UInt @seq = $N;
+    my UInt $n   = $N;
+
+    while $n > 1
+    {
+        $n = ($n % 2 == 0) ?? ($n / 2    ).UInt
+                           !! ($n * 3 + 1);
+        @seq.push: $n;
+    }
+
+    my UInt $terms = @seq.elems;
+
+    "The Collatz sequence (of %d term%s) for N = %s:\n%s\n".printf:
+        $terms, ($terms == 1 ?? '' !! 's'), comma($N), @seq.join: ' -> ';
+}
+
+################################################################################