Perl & Raku solutions to Tasks 1 & 2 for Week 262

4 files changed, 830 insertions, 0 deletions

diff --git a/challenge-262/athanasius/perl/ch-1.pl b/challenge-262/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..dd0289f757
--- /dev/null
+++ b/challenge-262/athanasius/perl/ch-1.pl
@@ -0,0 +1,226 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 262
+=========================
+
+TASK #1
+-------
+*Max Positive Negative*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to return the maximum number of either positive or negative
+integers in the given array.
+
+Example 1
+
+  Input: @ints = (-3, 1, 2, -1, 3, -2, 4)
+  Output: 4
+
+  Count of positive integers: 4
+  Count of negative integers: 3
+  Maximum of count of positive and negative integers: 4
+
+Example 2
+
+  Input: @ints = (-1, -2, -3, 1)
+  Output: 3
+
+  Count of positive integers: 1
+  Count of negative integers: 3
+  Maximum of count of positive and negative integers: 3
+
+Example 3
+
+  Input: @ints = (1,2)
+  Output: 2
+
+  Count of positive integers: 2
+  Count of negative integers: 0
+  Maximum of count of positive and negative integers: 2
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. Duplicate integers are counted as often as they appear.
+   This may be overridden by including the flag "--unique" on the command-line.
+2. The number 0 (zero) is positive.
+   This may be overridden by including the flag "--skip_0" on the command-line.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. One or more integers are given as arguments on the command-line.
+3. If any integer in the list on the command-line is negative, the first such
+   integer must be preceded by "--" to indicate that what follows does not
+   contain command-line flags.
+4. If the constant VERBOSE is set to True, the assumptions under which the
+   result is calculated are displayed along with the input integers.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use List::Util     qw( max uniqint );
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   => <<END;
+Usage:
+  perl $0 [--unique] [--skip_0] [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of integers
+    --unique        Count unique ints only (ignore duplicates)  [default: False]
+    --skip_0        Consider zero neither positive nor negative [default: False]
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 262, Task #1: Max Positive Negative (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($ints, $unique, $skip_0) = parse_command_line();
+
+        printf "Input:  \@ints = (%s)\n", join ',', @$ints;
+
+        if ($VERBOSE)
+        {
+            printf "        Count %s\n",
+                    $unique ? 'unique integers only (ignore duplicates)'
+                            : 'all integers, including duplicates';
+
+            printf "        Consider zero as %s\n",
+                    $skip_0 ? 'neither positive nor negative'
+                            : 'positive';
+        }
+
+        my $max = find_max_pos_neg( $ints, $unique, $skip_0 );
+
+        print  "Output: $max\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_max_pos_neg
+#-------------------------------------------------------------------------------
+{
+    my ($ints, $unique, $skip_0) = @_;
+    my  $neg_count = 0;
+    my  $pos_count = 0;
+    my  @integers  = $unique ? uniqint( @$ints ) : @$ints;
+
+    for my $n (@integers)
+    {
+        if    ($n < 0)
+        {
+            ++$neg_count;
+        }
+        elsif ($n > 0 || ($n == 0 && !$skip_0))
+        {
+            ++$pos_count;
+        }
+    }
+
+    return max( $neg_count, $pos_count );
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my ($unique, $skip_0);
+
+    GetOptions
+    (
+        'unique' => \$unique,
+        'skip_0' => \$skip_0,
+
+    ) or error( 'Invalid command line argument(s)' );
+
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+    }
+
+    return (\@ARGV, $unique, $skip_0);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expected, $unique, $skip_0) =
+             split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expected, $unique, $skip_0)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints = split / \s+ /x, $ints_str;
+        my $max  = find_max_pos_neg( \@ints, $unique, $skip_0 );
+
+        is $max, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1   |-3  1  2 -1 3 -2  4|4|0|0
+Example 2   |-1 -2 -3  1        |3|0|0
+Example 3   | 1  2              |2|0|0
+Duplicates 1| 1 -2  1 -3 2  1 -4|3|1|0
+Duplicates 2| 1 -2  1 -3 2  1 -4|4|0|0
+Zeros 1     | 4  0 -3 -2 1 -4  0|4|0|0
+Zeros 2     | 4  0 -3 -2 1 -4  0|3|0|1
diff --git a/challenge-262/athanasius/perl/ch-2.pl b/challenge-262/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..ced867803c
--- /dev/null
+++ b/challenge-262/athanasius/perl/ch-2.pl
@@ -0,0 +1,202 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 262
+=========================
+
+TASK #2
+-------
+*Count Equal Divisible*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and an integer $k.
+
+Write a script to return the number of pairs (i, j) where
+
+  a) 0 <= i < j < size of @ints
+  b) ints[i] == ints[j]
+  c) i x j is divisible by k
+
+Example 1
+
+  Input: @ints = (3,1,2,2,2,1,3) and $k = 2
+  Output: 4
+
+  (0, 6) => ints[0] == ints[6] and 0 x 6 is divisible by 2
+  (2, 3) => ints[2] == ints[3] and 2 x 3 is divisible by 2
+  (2, 4) => ints[2] == ints[4] and 2 x 4 is divisible by 2
+  (3, 4) => ints[3] == ints[4] and 3 x 4 is divisible by 2
+
+Example 2
+
+  Input: @ints = (1,2,3) and $k = 1
+  Output: 0
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+The divisor $k may take any integer value, positive or negative, except zero.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The divisor $k is given on the command-line as a named argument, followed by
+   a (possibly empty) list of integers.
+3. If any integer in the list (i.e., following $k) on the command-line is
+   negative, the first such integer must be preceded by "--" to indicate that
+   what follows does not contain command-line flags.
+4. If the constant $VERBOSE is set to a true value, the output count is followed
+   by a list of the (i, j) pairs themselves.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   => <<END;
+Usage:
+  perl $0 [-k[=Int]] [<ints> ...]
+  perl $0
+
+    -k[=Int]        The divisor: a non-zero integer
+    [<ints> ...]    A list of integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 262, Task #2: Count Equal Divisible (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($k, $ints) = parse_command_line();
+
+        printf "Input:  \@ints = (%s) and \$k = %d\n", join( ', ', @$ints ), $k;
+
+        my $pairs = find_equal_divisible_pairs( $ints, $k );
+
+        printf "Output: %d\n", scalar @$pairs;
+
+        printf "\nPairs found: %s\n",
+            join ', ', map { '(' . $_->[ 0 ] . ', ' . $_->[ 1 ] . ')' } @$pairs
+                if $VERBOSE;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_equal_divisible_pairs
+#-------------------------------------------------------------------------------
+{
+    my ($ints, $k) = @_;
+    my  @pairs;
+
+    for my $i (0 .. $#$ints - 1)
+    {
+        for my $j ($i + 1 .. $#$ints)
+        {
+            push @pairs,  [ $i, $j ]
+                if $ints->[ $i ] == $ints->[ $j ] && ($i * $j) % $k == 0;
+        }
+    }
+
+    return \@pairs;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $k;
+
+    GetOptions( 'k=i' => \$k )
+                           or  error( 'Invalid command-line argument' );
+
+    defined $k             or  error( '$k is missing' );
+    
+    $k =~ / ^ $RE{num}{int} $ /x
+                           or  error( qq[\$k ("$k") is not a valid integer] );
+
+    $k == 0                and error( '$k is zero' );
+
+    my @ints = @ARGV;
+
+    / ^ $RE{num}{int} $ /x or  error( qq["$_" is not a valid integer] )
+        for @ints;
+
+    return ($k, \@ints);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $k_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $k_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints  = split / \s+ /x, $ints_str;
+        my $pairs = find_equal_divisible_pairs( \@ints, $k_str );
+
+        is scalar( @$pairs ), $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1      | 3  1 2  2  2  1  3| 2|4
+Example 2      | 1  2 3            | 1|0
+Negative $k 1  | 3  1 2  2  2  1  3|-1|5
+Negative $k 2  | 3  1 2  2  2  1  3|-2|4
+Negative ints 1|-3 -1 2 -2 -2 -1 -3| 2|2
+Negative ints 2|-3 -1 2 -2 -2 -1 -3|-2|2
diff --git a/challenge-262/athanasius/raku/ch-1.raku b/challenge-262/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..e9df5d2943
--- /dev/null
+++ b/challenge-262/athanasius/raku/ch-1.raku
@@ -0,0 +1,214 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 262
+=========================
+
+TASK #1
+-------
+*Max Positive Negative*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to return the maximum number of either positive or negative
+integers in the given array.
+
+Example 1
+
+  Input: @ints = (-3, 1, 2, -1, 3, -2, 4)
+  Output: 4
+
+  Count of positive integers: 4
+  Count of negative integers: 3
+  Maximum of count of positive and negative integers: 4
+
+Example 2
+
+  Input: @ints = (-1, -2, -3, 1)
+  Output: 3
+
+  Count of positive integers: 1
+  Count of negative integers: 3
+  Maximum of count of positive and negative integers: 3
+
+Example 3
+
+  Input: @ints = (1,2)
+  Output: 2
+
+  Count of positive integers: 2
+  Count of negative integers: 0
+  Maximum of count of positive and negative integers: 2
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. Duplicate integers are counted as often as they appear.
+   This may be overridden by including the flag "--unique" on the command-line.
+2. The number 0 (zero) is positive.
+   This may be overridden by including the flag "--skip_0" on the command-line.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. One or more integers are given as arguments on the command-line.
+3. If the first integer is negative, it must be preceded by "--" to indicate
+   that it is not a command-line flag.
+4. If the constant VERBOSE is set to True, the assumptions under which the
+   result is calculated are displayed along with the input integers.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 262, Task #1: Max Positive Negative (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+           *@ints where { .elems > 0 && .all ~~ Int:D },
+                                  #= A non-empty list of integers
+    Bool:D :$unique = False,      #= Count unique ints only (ignore duplicates)
+    Bool:D :$skip_0 = False       #= Consider zero neither positive nor negative
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    if VERBOSE
+    {
+        "        Count %s\n".printf:
+                    $unique ?? 'unique integers only (ignore duplicates)'
+                            !! 'all integers, including duplicates';
+
+        "        Consider zero as %s\n".printf:
+                    $skip_0 ?? 'neither positive nor negative'
+                            !! 'positive';
+    }
+
+    my UInt $max = find-max-pos-neg( @ints, $unique, $skip_0 );
+
+    "Output: $max".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-max-pos-neg
+(
+    List:D[Int:D] $ints,
+    Bool:D        $unique,
+    Bool:D        $skip_0
+--> UInt:D
+)
+#-------------------------------------------------------------------------------
+{
+    my UInt $neg-count = 0;
+    my UInt $pos-count = 0;
+    my Int  @integers  = $unique ?? $ints.unique !! @$ints;
+
+    for @integers -> Int $n
+    {
+        if    $n < 0
+        {
+            ++$neg-count;
+        }
+        elsif $n > 0 || ($n == 0 && !$skip_0)
+        {
+            ++$pos-count;
+        }
+    }
+
+    return ($neg-count, $pos-count).max;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $expected, $unique, $zero-pos) =
+                $line.split: / \| /;
+
+        for     $test-name, $ints-str, $expected, $unique, $zero-pos
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int  @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my UInt $max  = find-max-pos-neg( @ints, $unique.Bool, $zero-pos.Bool );
+
+        is $max, $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1   |-3  1  2 -1 3 -2  4|4| |
+        Example 2   |-1 -2 -3  1        |3| |
+        Example 3   | 1  2              |2| |
+        Duplicates 1| 1 -2  1 -3 2  1 -4|3|1|
+        Duplicates 2| 1 -2  1 -3 2  1 -4|4| |
+        Zeros 1     | 4  0 -3 -2 1 -4  0|4| |
+        Zeros 2     | 4  0 -3 -2 1 -4  0|3| |1
+        END
+}
+
+################################################################################
diff --git a/challenge-262/athanasius/raku/ch-2.raku b/challenge-262/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..4e3d959843
--- /dev/null
+++ b/challenge-262/athanasius/raku/ch-2.raku
@@ -0,0 +1,188 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 262
+=========================
+
+TASK #2
+-------
+*Count Equal Divisible*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and an integer $k.
+
+Write a script to return the number of pairs (i, j) where
+
+  a) 0 <= i < j < size of @ints
+  b) ints[i] == ints[j]
+  c) i x j is divisible by k
+
+Example 1
+
+  Input: @ints = (3,1,2,2,2,1,3) and $k = 2
+  Output: 4
+
+  (0, 6) => ints[0] == ints[6] and 0 x 6 is divisible by 2
+  (2, 3) => ints[2] == ints[3] and 2 x 3 is divisible by 2
+  (2, 4) => ints[2] == ints[4] and 2 x 4 is divisible by 2
+  (3, 4) => ints[3] == ints[4] and 3 x 4 is divisible by 2
+
+Example 2
+
+  Input: @ints = (1,2,3) and $k = 1
+  Output: 0
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+The divisor $k may take any integer value, positive or negative, except zero.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The divisor $k is given on the command-line as a named argument, followed by
+   a (possibly empty) list of integers.
+3. If the first integer in the list (i.e., following $k) on the command-line is
+   negative, it must be preceded by "--" to indicate that it is not a command-
+   line flag.
+4. If the constant VERBOSE is set to True, the output count is followed by a
+   list of the (i, j) pairs themselves.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 262, Task #2: Count Equal Divisible (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Int:D :$k where { $k != 0 },              #= The divisor: a non-zero integer
+          *@ints where { .all ~~ Int:D }      #= A list of integers
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s) and \$k = %d\n".printf: @ints.join( ', ' ), $k;
+
+    my Pair @pairs = find-equal-divisible-pairs( @ints, $k );
+
+    "Output: %d\n".printf: @pairs.elems;
+
+    "\nPairs found: %s\n".printf:
+        @pairs.map( { '(' ~ .key ~ ', ' ~ .value ~ ')' } ).join( ', ' )
+            if VERBOSE;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-equal-divisible-pairs
+(
+    List:D[Int:D] $ints,
+    Int:D         $k where { $k != 0 }
+--> List:D[Pair:D]
+)
+#-------------------------------------------------------------------------------
+{
+    my Pair @pairs;
+
+    for 0 .. $ints.end - 1 -> UInt $i
+    {
+        for $i + 1 .. $ints.end -> UInt $j
+        {
+            @pairs.push: $i => $j
+                if $ints[ $i ] == $ints[ $j ] && ($i * $j) %% $k;
+        }
+    }
+
+    return @pairs;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $k-str, $expected) =
+                $line.split: / \| /;
+
+        for     $test-name, $ints-str, $k-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int  @ints  = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Pair @pairs = find-equal-divisible-pairs( @ints, $k-str.Int );
+
+        is @pairs.elems, $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1      | 3  1 2  2  2  1  3| 2|4
+        Example 2      | 1  2 3            | 1|0
+        Negative $k 1  | 3  1 2  2  2  1  3|-1|5
+        Negative $k 2  | 3  1 2  2  2  1  3|-2|4
+        Negative ints 1|-3 -1 2 -2 -2 -1 -3| 2|2
+        Negative ints 2|-3 -1 2 -2 -2 -1 -3|-2|2
+        END
+}
+
+################################################################################