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

4 files changed, 603 insertions, 0 deletions

diff --git a/challenge-142/athanasius/perl/ch-1.pl b/challenge-142/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..ea97ab601f
--- /dev/null
+++ b/challenge-142/athanasius/perl/ch-1.pl
@@ -0,0 +1,192 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 142
+=========================
+
+TASK #1
+-------
+*Divisor Last Digit*
+
+Submitted by: Mohammad S Anwar
+
+You are given positive integers, $m and $n.
+
+Write a script to find total count of divisors of $m having last digit $n.
+
+Example 1:
+
+ Input: $m = 24, $n = 2
+ Output: 2
+
+ The divisors of 24 are 1, 2, 3, 4, 6, 8 and 12.
+ There are only 2 divisors having last digit 2 are 2 and 12.
+
+Example 2:
+
+ Input: $m = 30, $n = 5
+ Output: 2
+
+ The divisors of 30 are 1, 2, 3, 5, 6, 10 and 15.
+ There are only 2 divisors having last digit 5 are 5 and 15.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Configuration
+-------------
+1. $INCLUDE_M
+   The "divisors" of $m usually include both 1 and $m itself. However, in the
+   two examples given in the task description, $m is omitted from the list of
+   divisors. The constant $INCLUDE_M (false by default) may be set to a true
+   value to ensure that $m will be included in the output if it is divisible by
+   $n.
+2. $VERBOSE
+   When this is set to a true value (the default), the output will be followed
+   by an explanation similar to the explanations shown in the Examples. This
+   explanation will be omitted if $VERBOSE is set to a false value.
+
+Algorithm
+---------
+The subroutine find_divisors() is copied from the solution to Task 1 in Week
+141:
+
+    1. Divisors come in pairs: if i is a divisor of n then j = n / i is also a
+       divisor of n
+    2. If i = j then i = sqrt(n)
+
+    So, to find all the divisors of n by searching, it's only necessary to
+    search the range 1 to sqrt(n):
+
+        divisors := empty
+        FOR d in range 1 to ⌊sqrt(n)⌋
+            IF d is a divisor of n THEN
+                Add d to divisors
+                d1 := n / d
+                IF d < d1
+                    Add d1 to divisors
+                ENDIF
+            ENDIF
+        ENDFOR
+        sort divisors ascending
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $INCLUDE_M => 0;
+const my $VERBOSE   => 1;
+const my $USAGE     =>
+"Usage:
+  perl $0 <m> <n>
+
+    <m>    A positive integer
+    <n>    A decimal digit (0-9)\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 142, Task #1: Divisor Last Digit (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($m, $n) = parse_command_line();
+
+    print "Input:  \$m = $m, \$n = $n\n";
+
+    my  @divisors = find_divisors( $m );
+
+    pop @divisors unless $INCLUDE_M;
+
+    my  @solution = grep { / $n $ /x } @divisors;
+    my  $count    = scalar @solution;
+
+    print "Output: $count\n";
+
+    if ($VERBOSE)
+    {
+        printf "\nThe divisors of %d are %s\n",
+            $m,
+            join ', ', @divisors;
+
+        printf "Of these, %d ha%s %d as %s last digit%s\n",
+            $count,
+            $count == 1 ? 's'   : 've',
+            $n,
+            $count == 1 ? 'its' : 'their',
+            $count == 0 ? ''    : ': ' . join ', ', @solution;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_divisors
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+    my  @div;
+
+    for my $d (1 .. int sqrt $n)
+    {
+        if ($n % $d == 0)
+        {
+            push @div, $d;
+
+            my $d1 = $n / $d;
+
+            push @div, $d1 if $d < $d1;
+        }
+    }
+
+    return sort { $a <=> $b } @div;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 2 or error( "Expected 2 command line arguments, found $args" );
+
+    my ($m, $n) = @ARGV;
+
+    $m =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$m" is not a valid integer] );
+
+    $m > 0        or error( qq["$m" is not positive] );
+
+    $n =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$n" is not a valid integer] );
+
+    0 <= $n <= 9  or error( qq["$n" is not a digit] );
+
+    return ($m, $n);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-142/athanasius/perl/ch-2.pl b/challenge-142/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..327e70df1f
--- /dev/null
+++ b/challenge-142/athanasius/perl/ch-2.pl
@@ -0,0 +1,133 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 142
+=========================
+
+TASK #2
+-------
+*Sleep Sort*
+
+Submitted by: Adam Russell
+
+Another joke sort similar to JortSort suggested by champion Adam Russell.
+
+You are given a list of numbers.
+
+Write a script to implement Sleep Sort. For more information, please checkout
+this [ https://iq.opengenus.org/sleep-sort |post].
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Configuration
+-------------
+Sleep Sort's performance is governed by the value assigned to the constant
+$INTERVAL, and involves a tradeoff between speed and accuracy: the smaller the
+value, the faster the sort will complete but the greater the chance that some
+of the values will be out of their correct sort order.
+
+Output
+------
+1. The sorted output is shown progressively, each value being displayed as it
+   is found. (An alternative would be to store sorted values in a shared array
+   and display them once the last thread has terminated.)
+2. The input values are not restricted to integers: all non-negative real num-
+   bers are accepted. This makes it more difficult to determine a practical
+   value for $INTERVAL, as the minimum setting required to ensure accurate
+   sorting depends on the smallest difference between non-identical numbers.
+   For example, on my machine the integers 9, 2, 7, 0, 1, 5, 4, 8, 9, 0
+   (minimum difference 1) are correctly sorted when $INVERVAL is set to 1, but
+   correct sorting of the real numbers 9.2, 2, 7, 0, 1, 5, 4, 8.5, 9, 0
+   (minimum difference 0.2) requires $INTERVAL to be set to at least 4.03.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use threads;
+use threads::shared;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $INTERVAL => 1;
+const my $USAGE    =>
+"Usage:
+  perl $0 [<numbers> ...]
+
+    [<numbers> ...]    A list of non-negative real numbers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 142, Task #2: Sleep Sort (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @numbers = parse_command_line();
+
+    printf "Input:  %s\n", join ', ', @numbers;
+    print  'Output: ';
+
+    my @threads;
+    my $first :shared = 1;
+
+    for my $n (@numbers)
+    {
+        push @threads,
+             threads->create(
+                                sub
+                                {
+                                    sleep $n * $INTERVAL if $n > 0;
+                                    print ', ' unless $first;
+                                    print $n;
+                                    $first = 0;
+                                }
+                            );
+    }
+
+    $_->join for @threads;
+
+    print "\n";
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    for (@ARGV)
+    {
+        / ^ $RE{num}{real} $ /x
+                or error( qq["$_" is not a valid real number] );
+
+        $_ >= 0 or error( qq["$_" is negative] );
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-142/athanasius/raku/ch-1.raku b/challenge-142/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..bfe8609d52
--- /dev/null
+++ b/challenge-142/athanasius/raku/ch-1.raku
@@ -0,0 +1,162 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 142
+=========================
+
+TASK #1
+-------
+*Divisor Last Digit*
+
+Submitted by: Mohammad S Anwar
+
+You are given positive integers, $m and $n.
+
+Write a script to find total count of divisors of $m having last digit $n.
+
+Example 1:
+
+ Input: $m = 24, $n = 2
+ Output: 2
+
+ The divisors of 24 are 1, 2, 3, 4, 6, 8 and 12.
+ There are only 2 divisors having last digit 2 are 2 and 12.
+
+Example 2:
+
+ Input: $m = 30, $n = 5
+ Output: 2
+
+ The divisors of 30 are 1, 2, 3, 5, 6, 10 and 15.
+ There are only 2 divisors having last digit 5 are 5 and 15.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Configuration
+-------------
+1. $INCLUDE-M
+   The "divisors" of $m usually include both 1 and $m itself. However, in the
+   two examples given in the task description, $m is omitted from the list of
+   divisors. The constant $INCLUDE-M (False by default) may be set to True to
+   ensure that $m will be included in the output if it is divisible by $n.
+2. $VERBOSE
+   When this is set to True (the default), the output will be followed by an
+   explanation similar to the explanations shown in the Examples. This explana-
+   tion will be omitted if $VERBOSE is set to False.
+
+Algorithm
+---------
+The subroutine find-divisors() is copied from the solution to Task 1 in Week
+141:
+
+    1. Divisors come in pairs: if i is a divisor of n then j = n / i is also a
+       divisor of n
+    2. If i = j then i = sqrt(n)
+
+    So, to find all the divisors of n by searching, it's only necessary to
+    search the range 1 to sqrt(n):
+
+        divisors := empty
+        FOR d in range 1 to ⌊sqrt(n)⌋
+            IF d is a divisor of n THEN
+                Add d to divisors
+                d1 := n / d
+                IF d < d1
+                    Add d1 to divisors
+                ENDIF
+            ENDIF
+        ENDFOR
+        sort divisors ascending
+
+=end comment
+#==============================================================================
+
+my Bool constant $INCLUDE-M = False;
+my Bool constant $VERBOSE   = True;
+
+subset Positive of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 142, Task #1: Divisor Last Digit (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Positive:D $m,                         #= A positive integer
+    UInt:D     $n where $n < 10            #= A decimal digit (0-9)
+)
+#==============================================================================
+{
+    "Input:  \$m = $m, \$n = $n".put;
+
+    my Positive @divisors = find-divisors( $m );
+
+    @divisors.pop unless $INCLUDE-M;
+
+    my Positive @solution = @divisors.grep: { / $n $ / };
+    my UInt     $count    = @solution.elems;
+
+    "Output: $count".put;
+
+    if $VERBOSE
+    {
+        "\nThe divisors of %d are %s\n".printf:
+            $m,
+            @divisors.join: ', ';
+
+        "Of these, %d ha%s %d as %s last digit%s\n".printf:
+            $count,
+            $count == 1 ?? 's'   !! 've',
+            $n,
+            $count == 1 ?? 'its' !! 'their',
+            $count == 0 ?? ''    !! ': ' ~ @solution.join: ', ';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find-divisors( UInt:D $m --> Seq:D[Positive:D] )
+#------------------------------------------------------------------------------
+{
+    my Positive @divisors;
+
+    for 1 .. $m.sqrt.Int -> UInt $d
+    {
+        if $m % $d == 0
+        {
+            @divisors.push: $d;
+
+            my UInt $d1 = $m div $d;          # Note: integer division
+
+            @divisors.push: $d1 if $d < $d1;
+        }
+    }
+
+    return @divisors.sort;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-142/athanasius/raku/ch-2.raku b/challenge-142/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..ff34895dc6
--- /dev/null
+++ b/challenge-142/athanasius/raku/ch-2.raku
@@ -0,0 +1,116 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 142
+=========================
+
+TASK #2
+-------
+*Sleep Sort*
+
+Submitted by: Adam Russell
+
+Another joke sort similar to JortSort suggested by champion Adam Russell.
+
+You are given a list of numbers.
+
+Write a script to implement Sleep Sort. For more information, please checkout
+this [ https://iq.opengenus.org/sleep-sort |post].
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Configuration
+-------------
+Sleep Sort's performance is governed by the value assigned to the constant
+$INTERVAL, and involves a tradeoff between speed and accuracy: the smaller the
+value, the faster the sort will complete but the greater the chance that some
+of the values will be out of their correct sort order.
+
+Output
+------
+1. The sorted output is shown progressively, each value being displayed as it
+   is found.
+2. The input values are not restricted to integers: all non-negative real num-
+   bers are accepted. This makes it more difficult to determine a practical
+   value for $INTERVAL, as the minimum setting required to ensure accurate
+   sorting depends on the smallest difference between non-identical numbers.
+   For example, on my machine the integers 9, 2, 7, 0, 1, 5, 4, 8, 9, 0
+   (minimum difference 1) are correctly sorted when $INVERVAL is set to 1, but
+   correct sorting of the real numbers 9.2, 2, 7, 0, 1, 5, 4, 8.5, 9, 0
+   (minimum difference 0.2) requires $INTERVAL to be set to at least 3.4.
+
+=end comment
+#==============================================================================
+
+my Real constant $INTERVAL = 1;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 142, Task #2: Sleep Sort (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| A list of non-negative real numbers
+
+    *@numbers where { .all ~~ Real:D && .all >= 0 }
+)
+#==============================================================================
+{
+    "Input:  %s\n".printf: @numbers.join: ', ';
+    'Output: '.print;
+
+    my Channel $chan = Channel.new;
+
+    for @numbers -> Real $n
+    {
+        start
+        {
+            sleep $n * $INTERVAL if $n > 0;
+            $chan.send: $n;
+        }
+    }
+
+    my Bool $first = True;
+
+    loop (my UInt $count = 0; $count < @numbers.elems; )
+    {
+        my Str $item = $chan.poll;
+
+        if $item.defined
+        {
+            ', '.print unless $first;
+            $item.print;
+            ++$count;
+            $first = False;
+        }
+    }
+
+    put();
+    $chan.close;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################