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

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

4 files changed, 572 insertions, 0 deletions

diff --git a/challenge-109/athanasius/perl/ch-1.pl b/challenge-109/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..f0c7aa2f94
--- /dev/null
+++ b/challenge-109/athanasius/perl/ch-1.pl
@@ -0,0 +1,141 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 109
+=========================
+
+TASK #1
+-------
+*Chowla Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 Chowla Numbers, named after, *Sarvadaman D.
+S. Chowla*, a London born Indian American mathematician. It is defined as:
+
+[ C(n) = (sum of divisors of n) - 1 - n ]
+  C(n) =  sum of divisors of n except 1 and n
+
+NOTE: Updated the above definition as suggested by Abigail [2021/04/19 18:40].
+
+Output:
+
+ 0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+Although the Task requires the first 20 Chowla Numbers, an option is provided
+for the user to specify the number of Chowla Numbers to be generated and dis-
+played.
+
+Algorithm
+---------
+From OEIS "A048050. Chowla's function: sum of divisors of n except 1 and n." :-
+"a(n) = 0 if and only if n is a noncomposite number (Cf. A008578). - Omar E.
+ Pol, Jul 31 2012"
+
+The algorithm employed is a straightforward calculation:
+(1) If n = 1 or n is prime, a(n) = 0
+(2) Else a(n) = sum of divisors of n except 1 and n
+
+Implementation
+--------------
+The CPAN module Math::Prime::Util provides the divisors() function which
+returns "a uniqued sorted list" of the divisors of a given positive integer.
+That module's is_prime() function is also used to screen out zero-valued Chowla
+Numbers.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Math::Prime::Util qw( divisors is_prime );
+use Regexp::Common    qw( number );
+
+const my $TARGET => 20;
+const my $USAGE  =>
+"Usage:
+  perl $0 [<target>]
+
+    [<target>]    How many Chowla numbers are to be generated?\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 109, Task #1: Chowla Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $target = parse_command_line();
+
+    print "Input:  $target\n";
+    print 'Output: ', chowla( 1  );
+    print ', ',       chowla( $_ ) for 2 .. $target;
+    print "\n";
+}
+
+#------------------------------------------------------------------------------
+sub chowla
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    return 0 if $n == 1 || is_prime( $n );
+
+    my @divisors = divisors( $n );
+
+    my $sum  = 0;
+       $sum += $divisors[ $_ ] for 1 .. $#divisors - 1;         # Omit 1 and $n
+
+    return $sum;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+
+    0 <= $args <= 1
+        or error( "Expected 0 or 1 command line arguments, found $args" );
+
+    my $target = ($args == 1) ? $ARGV[0] : $TARGET;
+
+    $target =~ / ^ $RE{num}{int} $ /x
+        or error( qq["$target" is not an integer] );
+
+    $target > 0
+        or error( 'The target must be greater than zero' );
+
+    return $target;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-109/athanasius/perl/ch-2.pl b/challenge-109/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..d0f4bb85eb
--- /dev/null
+++ b/challenge-109/athanasius/perl/ch-2.pl
@@ -0,0 +1,168 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 109
+=========================
+
+TASK #2
+-------
+*Four Squares Puzzle*
+
+Submitted by: Mohammad S Anwar
+
+You are given four squares as below with numbers named a,b,c,d,e,f,g.
+
+              (1)                    (3)
+        ╔══════════════╗      ╔══════════════╗
+        ║              ║      ║              ║
+        ║      a       ║      ║      e       ║
+        ║              ║ (2)  ║              ║  (4)
+        ║          ┌───╫──────╫───┐      ┌───╫─────────┐
+        ║          │   ║      ║   │      │   ║         │
+        ║          │ b ║      ║ d │      │ f ║         │
+        ║          │   ║      ║   │      │   ║         │
+        ║          │   ║      ║   │      │   ║         │
+        ╚══════════╪═══╝      ╚═══╪══════╪═══╝         │
+                   │       c      │      │      g      │
+                   │              │      │             │
+                   │              │      │             │
+                   └──────────────┘      └─────────────┘
+
+Write a script to place the given unique numbers in the square box so that sum
+of numbers in each box is the same.
+
+Example
+
+ Input: 1,2,3,4,5,6,7
+
+ Output:
+
+     a = 6
+     b = 4
+     c = 1
+     d = 5
+     e = 2
+     f = 3
+     g = 7
+
+     Box 1: a + b = 6 + 4 = 10
+     Box 2: b + c + d = 4 + 1 + 5 = 10
+     Box 3: d + e + f = 5 + 2 + 3 = 10
+     Box 4: f + g = 3 + 7 = 10
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+A sequence of 7 unique numbers can be arranged in 7! = 5040 different ways. For
+a computer, that is a small search space; therefore, the algorithm used is a
+simple search.
+
+Note that a given input of 7 numbers may produce zero solutions, or many:
+
+    Input                               Solutions
+     1,   2, 3,   4, 5,   6,  7             8
+     1,   2, 3,   4, 5,   6, 17             0
+    -1.5, 0, 1.5, 3, 4.5, 6,  7.5          10
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Algorithm::Loops qw( NextPermute );
+use Const::Fast;
+use List::Util       qw( uniqnum );
+use Regexp::Common   qw( number );
+
+const my $ARGUMENTS => 7;
+const my $USAGE     =>
+"Usage:
+  perl $0 -- Default: 1 .. 7
+  perl $0 [<numbers> ...]
+
+    [<numbers> ...]    A list of 7 unique real numbers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 109, Task #2: Four Squares Puzzle (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @numbers = parse_command_line();
+
+    printf "Input: %s\n\nOutput:\n\n", join ', ', @numbers;
+
+       @numbers   = sort { $a <=> $b } @numbers;
+    my $solutions = 0;
+
+    do
+    {{
+        my ($a, $b, $c, $d, $e, $f, $g) = @numbers;
+        my  $box1 = $a + $b;
+
+        next unless $b + $c + $d == $box1 &&
+                    $d + $e + $f == $box1 &&
+                    $f + $g      == $box1;
+
+        ++$solutions;
+
+        print "  Solution $solutions: a = $a, b = $b, c = $c, d = $d, " .
+              "e = $e, f = $f, g = $g\n    Each box sums to $box1\n\n";
+
+    }} while (NextPermute( @numbers ));
+
+    printf "  %s solution%s found\n", $solutions == 0 ? 'No' : $solutions,
+                                      $solutions == 1 ? ''   : 's';
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+
+    $args == 0 || $args == $ARGUMENTS
+            or error( "Expected 0 or $ARGUMENTS command line arguments, " .
+                      "found $args" );
+
+    my @numbers = ($args == 0) ? 1 .. $ARGUMENTS : @ARGV;
+
+    for (@numbers)
+    {
+        / ^ $RE{num}{real} $ /x
+            or error( qq["$_" is not a real number] );
+    }
+
+    scalar uniqnum( @numbers ) == $ARGUMENTS
+            or error( 'The arguments must be unique' );
+
+    return @numbers;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-109/athanasius/raku/ch-1.raku b/challenge-109/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..76baf4c94b
--- /dev/null
+++ b/challenge-109/athanasius/raku/ch-1.raku
@@ -0,0 +1,113 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 109
+=========================
+
+TASK #1
+-------
+*Chowla Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 Chowla Numbers, named after, *Sarvadaman D.
+S. Chowla*, a London born Indian American mathematician. It is defined as:
+
+[ C(n) = (sum of divisors of n) - 1 - n ]
+  C(n) =  sum of divisors of n except 1 and n
+
+NOTE: Updated the above definition as suggested by Abigail [2021/04/19 18:40].
+
+Output:
+
+ 0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+Although the Task requires the first 20 Chowla Numbers, an option is provided
+for the user to specify the number of Chowla Numbers to be generated and dis-
+played.
+
+Algorithm
+---------
+From OEIS "A048050. Chowla's function: sum of divisors of n except 1 and n." :-
+"a(n) = 0 if and only if n is a noncomposite number (Cf. A008578). - Omar E.
+ Pol, Jul 31 2012"
+
+The algorithm employed is a straightforward calculation:
+(1) If n = 1 or n is prime, a(n) = 0
+(2) Else a(n) = sum of divisors of n except 1 and n
+
+Implementation
+--------------
+Raku's built-in is-prime() method is used to screen out zero-valued Chowla
+Numbers. Divisors are generated by searching the integer range 2 to (n - 1) for
+numbers which divide n without remainder. Raku's reduction metaoperator [+] is
+used to sum the divisors.
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET = 20;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 109, Task #1: Chowla Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| How many Chowla numbers are to be generated?
+
+    UInt:D $target where { $target > 0 } = $TARGET;
+)
+#==============================================================================
+{
+    "Input:  $target".put;
+    'Output: %d'.printf: chowla( 1  );
+    ', %d'.\     printf: chowla( $_ ) for 2 .. $target;
+    ''.put;
+}
+
+#------------------------------------------------------------------------------
+sub chowla( UInt:D $n where { $n > 0 } --> UInt:D )
+#------------------------------------------------------------------------------
+{
+    return 0 if $n == 1 || $n.is-prime;
+
+    my UInt @divisors;
+
+    for 2 .. $n - 1 -> UInt $div
+    {
+        @divisors.push: $div if $n % $div == 0;
+    }
+
+    return [+] @divisors;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-109/athanasius/raku/ch-2.raku b/challenge-109/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..7612c1439c
--- /dev/null
+++ b/challenge-109/athanasius/raku/ch-2.raku
@@ -0,0 +1,150 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 109
+=========================
+
+TASK #2
+-------
+*Four Squares Puzzle*
+
+Submitted by: Mohammad S Anwar
+
+You are given four squares as below with numbers named a,b,c,d,e,f,g.
+
+              (1)                    (3)
+        ╔══════════════╗      ╔══════════════╗
+        ║              ║      ║              ║
+        ║      a       ║      ║      e       ║
+        ║              ║ (2)  ║              ║  (4)
+        ║          ┌───╫──────╫───┐      ┌───╫─────────┐
+        ║          │   ║      ║   │      │   ║         │
+        ║          │ b ║      ║ d │      │ f ║         │
+        ║          │   ║      ║   │      │   ║         │
+        ║          │   ║      ║   │      │   ║         │
+        ╚══════════╪═══╝      ╚═══╪══════╪═══╝         │
+                   │       c      │      │      g      │
+                   │              │      │             │
+                   │              │      │             │
+                   └──────────────┘      └─────────────┘
+
+Write a script to place the given unique numbers in the square box so that sum
+of numbers in each box is the same.
+
+Example
+
+ Input: 1,2,3,4,5,6,7
+
+ Output:
+
+     a = 6
+     b = 4
+     c = 1
+     d = 5
+     e = 2
+     f = 3
+     g = 7
+
+     Box 1: a + b = 6 + 4 = 10
+     Box 2: b + c + d = 4 + 1 + 5 = 10
+     Box 3: d + e + f = 5 + 2 + 3 = 10
+     Box 4: f + g = 3 + 7 = 10
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+A sequence of 7 unique numbers can be arranged in 7! = 5040 different ways. For
+a computer, that is a small search space; therefore, the algorithm used is a
+simple search.
+
+Note that a given input of 7 numbers may produce zero solutions, or many:
+
+    Input                               Solutions
+     1,   2, 3,   4, 5,   6,  7             8
+     1,   2, 3,   4, 5,   6, 17             0
+    -1.5, 0, 1.5, 3, 4.5, 6,  7.5          10
+
+=end comment
+#==============================================================================
+
+my UInt constant $ARGUMENTS = 7;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 109, Task #2: Four Squares Puzzle (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN()                                             #= Default: 1 .. 7
+#==============================================================================
+{
+    my Real @numbers = 1 .. $ARGUMENTS;
+
+    place-numbers( @numbers );
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A list of 7 unique real numbers
+
+    *@numbers where { .all ~~ Real:D && @numbers.unique.elems == $ARGUMENTS }
+)
+#==============================================================================
+{
+    my Real @reals = @numbers.map: { .Real };
+
+    place-numbers( @reals );
+}
+
+#------------------------------------------------------------------------------
+sub place-numbers( Array:D[Real:D] $numbers )
+#------------------------------------------------------------------------------
+{
+    "Input: %s\n\nOutput:\n\n".printf: $numbers.join: ', ';
+
+    my UInt $solutions = 0;
+
+    for permutations @$numbers.sort -> List $permutation
+    {
+        my Real ($a, $b, $c, $d, $e, $f, $g) = @$permutation;
+        my Real  $box1 = $a + $b;
+
+        next unless $b + $c + $d == $box1 &&
+                    $d + $e + $f == $box1 &&
+                    $f + $g      == $box1;
+
+        ++$solutions;
+
+        ("  Solution $solutions: a = $a, b = $b, c = $c, d = $d, e = $e, " ~
+         "f = $f, g = $g\n    Each box sums to $box1\n").put;
+    }
+
+    "  %s solution%s found\n".printf: $solutions == 0 ?? 'No' !! $solutions,
+                                      $solutions == 1 ?? ''   !! 's';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################