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

4 files changed, 1000 insertions, 0 deletions

diff --git a/challenge-270/athanasius/perl/ch-1.pl b/challenge-270/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..7da4d570ab
--- /dev/null
+++ b/challenge-270/athanasius/perl/ch-1.pl
@@ -0,0 +1,248 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 270
+=========================
+
+TASK #1
+-------
+*Special Positions*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a m x n binary matrix.
+
+Write a script to return the number of special positions in the given binary
+matrix.
+
+    A position (i, j) is called special if $matrix[i][j] == 1 and all other
+    elements in the row i and column j are 0.
+
+Example 1
+
+  Input: $matrix = [ [1, 0, 0],
+                     [0, 0, 1],
+                     [1, 0, 0],
+                   ]
+  Output: 1
+
+  There is only special position (1, 2) as $matrix[1][2] == 1
+  and all other elements in row 1 and column 2 are 0.
+
+Example 2
+
+  Input: $matrix = [ [1, 0, 0],
+                     [0, 1, 0],
+                     [0, 0, 1],
+                   ]
+  Output: 3
+
+  Special positions are (0,0), (1, 1) and (2,2).
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+-----------
+The input matrix is not empty (i.e., m > 0 and n > 0).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The matrix is entered on the command-line as a series of same-length bit-
+   strings, one for each matrix row.
+3. If the constant $VERBOSE is set to a true value, the required output (number
+   of special positions) is followed by a list of the special positions found.
+
+Reference
+---------
+Code for handling binary matrices adapted from the Perl solution to Week 242,
+Task #2, "Flip Matrix".
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   => <<END;
+Usage:
+  perl $0 [<matrix> ...]
+  perl $0
+
+    [<matrix> ...]    A non-empty m x n binary matrix, e.g., 1100 0110 0010
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 270, Task #1: Special Positions (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $matrix = parse_matrix( \@ARGV );
+
+        printf "Input: \$matrix = [%s]\n",    join ' ', $matrix->[ 0    ]->@*;
+
+        for my $row (1 .. $#$matrix)
+        {
+            printf "                 [%s]\n", join ' ', $matrix->[ $row ]->@*;
+        }
+
+        my $positions = find_special_positions( $matrix );
+        my $count     = scalar @$positions;
+
+        print "Output: $count\n";
+
+        if ($VERBOSE)
+        {
+            my $indices = $count == 0 ? 'none' :
+                          join ', ',
+                          map { sprintf '(%s)', join ', ', @$_ } @$positions;
+
+            printf "\nSpecial position%s: %s\n",
+                   ($count == 1 ? '' : 's'), $indices;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_special_positions
+#-------------------------------------------------------------------------------
+{
+    my ($matrix)  = @_;
+    my  $cols_end = scalar $matrix->[ 0 ]->@* - 1;
+    my  @positions;
+
+    L_ROWS:
+    for my $row (0 .. $#$matrix)
+    {
+        for my $col (0 .. $cols_end)
+        {
+            next unless $matrix->[ $row ][ $col ] == 1;
+
+            for my $c ($col + 1 .. $cols_end)
+            {
+                next L_ROWS unless $matrix->[ $row ][ $c ] == 0;
+            }
+
+            for my $r (0 .. $#$matrix)
+            {
+                next if $r == $row;
+
+                next L_ROWS unless $matrix->[ $r ][ $col ] == 0;
+            }
+
+            push @positions, [ $row, $col ];
+            next L_ROWS;
+        }
+    }
+
+    return \@positions;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_matrix
+#-------------------------------------------------------------------------------
+{
+    my  ($rows) = @_;
+    my   @row   = split //, $rows->[ 0 ];
+    my   $n     = scalar @row;
+    my   @matrix;
+    push @matrix, [ @row ];
+
+    for my $col (1 .. $#$rows)
+    {
+        my $row_str = $rows->[ $col ];
+        my @row     = split //, $row_str;
+
+        scalar @row == $n or error( 'The input matrix is not rectangular' );
+
+        for (@row)
+        {
+            / ^ [01] $ /x or error( qq["$_" is not a binary number] );
+        }
+
+        push @matrix, [ @row ];
+    }
+
+    return \@matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $matrix_str, $expected_str) = split / \| /x, $line;
+
+        for ($test_name, $matrix_str, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @rows      = split / \s+ /x, $matrix_str;
+        my $matrix    = parse_matrix( \@rows );
+        my $positions = find_special_positions( $matrix );
+        my @expected;
+
+        for (split / \s* ; \s* /x, $expected_str)
+        {
+            push @expected, [ split / \s+ /x ];
+        }
+
+        is_deeply $positions, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1  |100   001   100        |1 2
+Example 2  |100   010   001        |0 0; 1 1; 2 2
+4x5        |10100 01000 00100 00010|1 1; 3 3
+None       |101   010   101   010  |
+Singleton 0|0                      |
+Singleton 1|1                      |0 0
+Same column|00100 00000 00100 00001|3 4
+Same row   |0000  1001  0010  0000 |2 2
diff --git a/challenge-270/athanasius/perl/ch-2.pl b/challenge-270/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..2fea0202c4
--- /dev/null
+++ b/challenge-270/athanasius/perl/ch-2.pl
@@ -0,0 +1,266 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 270
+=========================
+
+TASK #2
+-------
+*Equalize Array*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and two integers, $x and $y.
+
+Write a script to execute one of the two options:
+
+  Level 1:
+  Pick an index i of the given array and do $ints[i] += 1
+
+  Level 2:
+  Pick two different indices i,j and do $ints[i] +=1 and $ints[j] += 1.
+
+You are allowed to perform as many levels as you want to make every elements in
+the given array equal. There is cost attached for each level, for Level 1, the
+cost is $x and $y for Level 2.
+
+In the end return the minimum cost to get the work done.
+
+Example 1
+
+  Input: @ints = (4, 1), $x = 3 and $y = 2
+  Output: 9
+
+  Level 1: i=1, so $ints[1] += 1.
+  @ints = (4, 2)
+
+  Level 1: i=1, so $ints[1] += 1.
+  @ints = (4, 3)
+
+  Level 1: i=1, so $ints[1] += 1.
+  @ints = (4, 4)
+
+  We performed operation Level 1, 3 times.
+  So the total cost would be 3 x $x => 3 x 3 => 9
+
+Example 2
+
+  Input: @ints = (2, 3, 3, 3, 5), $x = 2 and $y = 1
+  Output: 6
+
+  Level 2: i=0, j=1, so $ints[0] += 1 and $ints[1] += 1
+  @ints = (3, 4, 3, 3, 5)
+
+  Level 2: i=0, j=2, so $ints[0] += 1 and $ints[2] += 1
+  @ints = (4, 4, 4, 3, 5)
+
+  Level 2: i=0, j=3, so $ints[0] += 1 and $ints[3] += 1
+  @ints = (5, 4, 4, 4, 5)
+
+  Level 2: i=1, j=2, so $ints[1] += 1 and $ints[2] += 1
+  @ints = (5, 5, 5, 4, 5)
+
+  Level 1: i=3, so $ints[3] += 1
+  @ints = (5, 5, 5, 5, 5)
+
+  We performed operation Level 1, 1 time and Level 2, 4 times.
+  So the total cost would be (1 x $x) + (3 x $y) => (1 x 2) + (4 x 1) => 6
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+Costs cannot be negative.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The costs $x and $y are entered as named arguments on the command-line,
+   followed by the elements of @ints; e.g.
+
+        perl ch-2.pl -x 3 -y 2 4 1
+
+3. If @ints contains negative numbers, they must be preceded by "--" to prevent
+   them from being interpreted as command-line flags; e.g.
+
+        perl ch-2.pl -x 5 -y 3 -- -1 -2 -3 -6
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use List::Util     qw( max );
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [-x[=UInt]] [-y[=UInt]] [<ints> ...]
+  perl $0
+
+    -x[=UInt]       Cost of Level 1 option
+    -y[=UInt]       Cost of Level 2 option
+    [<ints> ...]    List of one or more integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 270, Task #2: Equalize Array (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($x, $y, $ints) = parse_command_line();
+
+        printf "Input:  \@ints = (%s), \$x = %d and \$y = %d\n",
+                join( ', ', @$ints ), $x, $y;
+
+        my $cost = find_min_cost( $ints, $x, $y );
+
+        print  "Output: $cost\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_min_cost
+#-------------------------------------------------------------------------------
+{
+    my ($ints, $x, $y) = @_;
+    my  $cost = 0;
+
+    if ($x > 0)   # Otherwise array can be equalized with all Level 1 at no cost
+    {
+        my $max = max @$ints;
+
+        if ($y < 2 * $x)     # Otherwise Level 2 gives no advantage over Level 1
+        {
+            # First, apply Level 2 as often as possible
+
+            L_OUTER:
+            for my $i (0 .. $#$ints - 1)
+            {
+                for my $j ($i + 1 .. $#$ints)
+                {
+                    if ($ints->[ $i ] < $max && $ints->[ $j ] < $max)
+                    {
+                        ++$ints->[ $i ];
+                        ++$ints->[ $j ];
+
+                        $cost += $y;
+
+                        redo L_OUTER;
+                    }
+                }
+            }
+        }
+
+        # Now complete array equalization with Level 1
+
+        $cost += ($max - $_) * $x for @$ints;
+    }
+
+    return $cost;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my ($x, $y);
+
+    GetOptions
+    (
+        'x=i' => \$x,
+        'y=i' => \$y
+    )                          or error( 'Invalid command-line arguments' );
+
+    defined $x                 or error( 'Missing $x' );
+    defined $y                 or error( 'Missing $y' );
+
+    my @ints = @ARGV;
+
+    scalar @ints > 0           or error( 'Missing @ints' );
+
+    for ($x, $y, @ints)
+    {
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+    }
+
+    for ($x, $y)
+    {
+        $_ >= 0                or error( "$_ is an invalid cost" );
+    }
+
+    return ($x, $y, \@ints);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $x, $y, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $x, $y, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints = split / \s+ /x, $ints_str;
+        my $cost = find_min_cost( \@ints, $x, $y );
+
+        is $cost, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 4  1        |3|2| 9
+Example 2| 2  3  3  3 5|2|1| 6
+Zero x   | 2  3  3  3 5|0|1| 0
+Zero y   | 2  3  3  3 5|7|0| 7
+Uniform  | 4  4  4  4  |2|1| 0
+Negatives|-1 -2 -3 -6  |5|3|26|     # 2×3 + 4×5
+Singleton|17           |3|2| 0
diff --git a/challenge-270/athanasius/raku/ch-1.raku b/challenge-270/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..8c8d8eb0ba
--- /dev/null
+++ b/challenge-270/athanasius/raku/ch-1.raku
@@ -0,0 +1,259 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 270
+=========================
+
+TASK #1
+-------
+*Special Positions*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a m x n binary matrix.
+
+Write a script to return the number of special positions in the given binary
+matrix.
+
+    A position (i, j) is called special if $matrix[i][j] == 1 and all other
+    elements in the row i and column j are 0.
+
+Example 1
+
+  Input: $matrix = [ [1, 0, 0],
+                     [0, 0, 1],
+                     [1, 0, 0],
+                   ]
+  Output: 1
+
+  There is only special position (1, 2) as $matrix[1][2] == 1
+  and all other elements in row 1 and column 2 are 0.
+
+Example 2
+
+  Input: $matrix = [ [1, 0, 0],
+                     [0, 1, 0],
+                     [0, 0, 1],
+                   ]
+  Output: 3
+
+  Special positions are (0,0), (1, 1) and (2,2).
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+-----------
+The input matrix is not empty (i.e., m > 0 and n > 0).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The matrix is entered on the command-line as a series of same-length bit-
+   strings, one for each matrix row.
+3. If the constant $VERBOSE is set to a true value, the required output (number
+   of special positions) is followed by a list of the special positions found.
+
+Reference
+---------
+Code for handling binary matrices adapted from the Raku solution to Week 242,
+Task #2, "Flip Matrix".
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Bit    of Int where 0 | 1;
+subset BitStr of Str where / ^ <[01]>+ $ /;
+
+my Bool constant VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 270, Task #1: Special Positions (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty m x n binary matrix, e.g., 1100 0110 0010
+
+    *@matrix where { .elems > 0 && .all ~~ BitStr:D }
+)
+#===============================================================================
+{
+    my Array[Bit] @binary = parse-matrix( @matrix );
+
+    "Input: \$matrix = [%s]\n"\  .printf: @binary[ 0    ].join: ' ';
+
+    for 1 .. @binary.end -> UInt $row
+    {
+        "                 [%s]\n".printf: @binary[ $row ].join: ' ';
+    }
+
+    my Array[UInt] @positions = find-special-positions( @binary );
+    my UInt        $count     = @positions.elems;
+
+    "Output: $count".put;
+
+    if VERBOSE
+    {
+        my Str $indices = $count == 0 ?? 'none' !!
+                          @positions.map( { '(%s)'.sprintf: .join: ', ' } )\
+                                                            .join: ', ';
+
+        "\nSpecial position%s: %s\n".printf: $count == 1 ?? '' !! 's', $indices;
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-special-positions
+(
+    List:D[List:D[Bit:D]] $matrix
+--> List:D[List:D[UInt:D]]
+)
+#-------------------------------------------------------------------------------
+{
+    my Array[UInt] @positions = Array[Array[UInt]].new;
+    my UInt        $cols-end  = $matrix[ 0 ].end;
+
+    L-ROWS:
+    for 0 .. $matrix.end -> UInt $row
+    {
+        for 0 .. $cols-end -> UInt $col
+        {
+            next unless $matrix[ $row; $col ] == 1;
+
+            for $col + 1 .. $cols-end -> UInt $c
+            {
+                next L-ROWS unless $matrix[ $row; $c ] == 0;
+            }
+
+            for 0 .. $matrix.end -> UInt $r
+            {
+                next if $r == $row;
+
+                next L-ROWS unless $matrix[ $r; $col ] == 0;
+            }
+
+            @positions.push: Array[UInt].new: $row, $col;
+            next L-ROWS;
+        }
+    }
+
+    return @positions;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-matrix( List:D[BitStr:D] $rows --> List:D[List:D[Bit:D]] )
+#-------------------------------------------------------------------------------
+{
+    my Array[Bit] @matrix;
+    my Bit        @row = $rows[ 0 ].split( '', :skip-empty ).map: { .Int };
+    my UInt       $n   = @row.elems;
+
+    @matrix.push: @row;
+
+    for 1 .. $rows.end -> UInt $col
+    {
+        my BitStr $row-str = $rows[ $col ];
+        my Bit    @row = $row-str\ .split( '', :skip-empty ).map: { .Int };
+
+        @row.elems == $n or error( 'The input matrix is not rectangular' );
+
+        @matrix.push: @row;
+    }
+
+    return @matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $matrix-str, $expected-str) = $line.split: / \| /;
+
+        for     $test-name, $matrix-str, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my BitStr      @rows      = $matrix-str.split: / \s+ /, :skip-empty;
+        my Array[Bit]  @matrix    = parse-matrix( @rows );
+        my Array[UInt] @positions = find-special-positions( @matrix );
+        my Array[UInt] @expected;
+
+        for $expected-str.split: / \s* \; \s* /, :skip-empty
+        {
+            @expected.push: Array[UInt].new: .split( / \s+ / ).map: { .Int };
+        }
+
+        is-deeply @positions, @expected, $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  |100   001   100        |1 2
+        Example 2  |100   010   001        |0 0; 1 1; 2 2
+        4x5        |10100 01000 00100 00010|1 1; 3 3
+        None       |101   010   101   010  |
+        Singleton 0|0                      |
+        Singleton 1|1                      |0 0
+        Same column|00100 00000 00100 00001|3 4
+        Same row   |0000  1001  0010  0000 |2 2
+        END
+}
+
+################################################################################
diff --git a/challenge-270/athanasius/raku/ch-2.raku b/challenge-270/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..f8242cbd28
--- /dev/null
+++ b/challenge-270/athanasius/raku/ch-2.raku
@@ -0,0 +1,227 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 270
+=========================
+
+TASK #2
+-------
+*Equalize Array*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and two integers, $x and $y.
+
+Write a script to execute one of the two options:
+
+  Level 1:
+  Pick an index i of the given array and do $ints[i] += 1
+
+  Level 2:
+  Pick two different indices i,j and do $ints[i] +=1 and $ints[j] += 1.
+
+You are allowed to perform as many levels as you want to make every elements in
+the given array equal. There is cost attached for each level, for Level 1, the
+cost is $x and $y for Level 2.
+
+In the end return the minimum cost to get the work done.
+
+Example 1
+
+  Input: @ints = (4, 1), $x = 3 and $y = 2
+  Output: 9
+
+  Level 1: i=1, so $ints[1] += 1.
+  @ints = (4, 2)
+
+  Level 1: i=1, so $ints[1] += 1.
+  @ints = (4, 3)
+
+  Level 1: i=1, so $ints[1] += 1.
+  @ints = (4, 4)
+
+  We performed operation Level 1, 3 times.
+  So the total cost would be 3 x $x => 3 x 3 => 9
+
+Example 2
+
+  Input: @ints = (2, 3, 3, 3, 5), $x = 2 and $y = 1
+  Output: 6
+
+  Level 2: i=0, j=1, so $ints[0] += 1 and $ints[1] += 1
+  @ints = (3, 4, 3, 3, 5)
+
+  Level 2: i=0, j=2, so $ints[0] += 1 and $ints[2] += 1
+  @ints = (4, 4, 4, 3, 5)
+
+  Level 2: i=0, j=3, so $ints[0] += 1 and $ints[3] += 1
+  @ints = (5, 4, 4, 4, 5)
+
+  Level 2: i=1, j=2, so $ints[1] += 1 and $ints[2] += 1
+  @ints = (5, 5, 5, 4, 5)
+
+  Level 1: i=3, so $ints[3] += 1
+  @ints = (5, 5, 5, 5, 5)
+
+  We performed operation Level 1, 1 time and Level 2, 4 times.
+  So the total cost would be (1 x $x) + (3 x $y) => (1 x 2) + (4 x 1) => 6
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+Costs cannot be negative.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The costs $x and $y are entered as named arguments on the command-line,
+   followed by the elements of @ints; e.g.
+
+        raku ch-2.raku -x=3 -y=2 4 1
+
+3. If the first element of @ints is a negative number, it must be preceded by
+   "--" to prevent it from being interpreted as a command-line flag; e.g.
+
+        raku ch-2.raku -x=5 -y=3 -- -1 -2 -3 -6
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 270, Task #2: Equalize Array (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    UInt:D :$x,                                  #= Cost of Level 1 option
+    UInt:D :$y,                                  #= Cost of Level 2 option
+    *@ints where { .elems > 0 && .all ~~ Int:D } #= List of one or more integers
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s), \$x = %d and \$y = %d\n".printf:
+              @ints.join( ', ' ), $x, $y;
+
+    my UInt $cost = find-min-cost( @ints, $x, $y );
+
+    "Output: $cost".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-min-cost( List:D[Int:D] $ints, UInt:D $x, UInt:D $y --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $cost = 0;
+
+    if $x > 0     # Otherwise array can be equalized with all Level 1 at no cost
+    {
+        my Int @ints = @$ints;              # Make a copy
+        my Int $max  = $ints.max;
+
+        if $y < 2 * $x       # Otherwise Level 2 gives no advantage over Level 1
+        {
+            # First, apply Level 2 as often as possible
+
+            L-OUTER:
+            for 0 .. @ints.end - 1 -> UInt $i
+            {
+                for $i + 1 .. @ints.end -> UInt $j
+                {
+                    if @ints[ $i ] < $max && @ints[ $j ] < $max
+                    {
+                        ++@ints[ $i ];
+                        ++@ints[ $j ];
+
+                        $cost += $y;
+
+                        redo L-OUTER;
+                    }
+                }
+            }
+        }
+
+        # Now complete array equalization with Level 1
+
+        $cost += ($max - $_) * $x for @ints;
+    }
+
+    return $cost;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $x-str, $y-str, $expected-str) =
+                $line.split: / \| /;
+
+        for     $test-name, $ints-str, $x-str, $y-str, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int  @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my UInt $cost = find-min-cost( @ints, $x-str.Int, $y-str.Int );
+
+        is $cost, $expected-str.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+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| 4  1        |3|2| 9
+        Example 2| 2  3  3  3 5|2|1| 6
+        Zero x   | 2  3  3  3 5|0|1| 0
+        Zero y   | 2  3  3  3 5|7|0| 7
+        Uniform  | 4  4  4  4  |2|1| 0
+        Negatives|-1 -2 -3 -6  |5|3|26|     # 2×3 + 4×5
+        Singleton|17           |3|2| 0
+        END
+}
+
+################################################################################