aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-270/athanasius/perl/ch-1.pl248
-rw-r--r--challenge-270/athanasius/perl/ch-2.pl266
-rw-r--r--challenge-270/athanasius/raku/ch-1.raku259
-rw-r--r--challenge-270/athanasius/raku/ch-2.raku227
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
+}
+
+################################################################################
generated by cgit (git 2.34.1) at 2026-07-04 13:02:33 +0000