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

4 files changed, 733 insertions, 0 deletions

diff --git a/challenge-325/athanasius/perl/ch-1.pl b/challenge-325/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..6b4ee45540
--- /dev/null
+++ b/challenge-325/athanasius/perl/ch-1.pl
@@ -0,0 +1,151 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 325
+=========================
+
+TASK #1
+-------
+*Consecutive One*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a binary array containing only 0 or/and 1.
+
+Write a script to find out the maximum consecutive 1 in the given array.
+
+Example 1
+
+  Input: @binary = (0, 1, 1, 0, 1, 1, 1)
+  Output: 3
+
+Example 2
+
+  Input: @binary = (0, 0, 0, 0)
+  Output: 0
+
+Example 3
+
+  Input: @binary = (1, 0, 1, 0, 1, 1)
+  Output: 2
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of binary digits is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<binary> ...]
+  perl $0
+
+    [<binary> ...]    A non-empty list of binary digits
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 325, Task #1: Consecutive One (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @binary = @ARGV;
+
+        for (@binary)
+        {
+            $_ eq '0' || $_ eq '1' or error( qq["$_" is not a binary digit] );
+        }
+
+        printf "Input:  \@binary = (%s)\n", join ', ', @binary;
+
+        my $max_ones = find_max_ones( \@binary );
+
+        print  "Output: $max_ones\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_max_ones
+#-------------------------------------------------------------------------------
+{
+    my ($binary) = @_;
+    my  $string = join  '',     @$binary;
+    my  @groups = split / 0 /x, $string;
+    my  @sorted = sort @groups;
+
+    return scalar @sorted == 0 ? 0 : length $sorted[ -1 ];
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $binary_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $binary_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @binary   = split / \s+ /x, $binary_str;
+        my $max_ones = find_max_ones( \@binary );
+
+        is $max_ones, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|0 1 1 0 1 1 1|3
+Example 2|0 0 0 0      |0
+Example 3|1 0 1 0 1 1  |2
diff --git a/challenge-325/athanasius/perl/ch-2.pl b/challenge-325/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..cc282fc8b2
--- /dev/null
+++ b/challenge-325/athanasius/perl/ch-2.pl
@@ -0,0 +1,223 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 325
+=========================
+
+TASK #2
+-------
+*Final Price*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of item prices.
+
+Write a script to find out the final price of each items in the given array.
+
+There is a special discount scheme going on. If there’s an item with a lower or
+equal price later in the list, you get a discount equal to that later price (the
+first one you find in order).
+
+Example 1
+
+  Input: @prices = (8, 4, 6, 2, 3)
+  Output: (4, 2, 4, 2, 3)
+
+  Item 0:
+  The item price is 8.
+  The first time that has price <= current item price is 4.
+  Final price = 8 - 4 => 4
+
+  Item 1:
+  The item price is 4.
+  The first time that has price <= current item price is 2.
+  Final price = 4 - 2 => 2
+
+  Item 2:
+  The item price is 6.
+  The first time that has price <= current item price is 2.
+  Final price = 6 - 2 => 4
+
+  Item 3:
+  The item price is 2.
+  No item has price <= current item price, no discount.
+  Final price = 2
+
+  Item 4:
+  The item price is 3.
+  Since it is the last item, so no discount.
+  Final price = 3
+
+Example 2
+
+  Input: @prices = (1, 2, 3, 4, 5)
+  Output: (1, 2, 3, 4, 5)
+
+Example 3
+
+  Input: @prices = (7, 1, 1, 5)
+  Output: (6, 0, 1, 5)
+
+  Item 0:
+  The item price is 7.
+  The first time that has price <= current item price is 1.
+  Final price = 7 - 1 => 6
+
+  Item 1:
+  The item price is 1.
+  The first time that has price <= current item price is 1.
+  Final price = 1 - 1 => 0
+
+  Item 2:
+  The item price is 1.
+  No item has price <= current item price, so no discount.
+  Final price = 1
+
+  Item 3:
+  The item price is 5.
+  Since it is the last item, so no discount.
+  Final price = 5
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+Item prices are unsigned integers.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of unsigned integers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number  );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<prices> ...]
+  perl $0
+
+    [<prices> ...]    A non-empty list of unsigned integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 325, Task #2: Final Price (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @prices = @ARGV;
+
+        for (@prices)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+            $_ >= 0                or error( "$_ is negative" );
+        }
+
+        printf "Input: \@prices = (%s)\n", join ', ', @prices;
+
+        my $final_prices = find_final_prices( \@prices );
+
+        printf "Output:          (%s)\n",  join ', ', @$final_prices;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_final_prices
+#-------------------------------------------------------------------------------
+{
+    my ($prices) = @_;
+    my  @final_prices;
+
+    for my $i (0 .. $#$prices)
+    {
+        my $price_i = $prices->[ $i ];
+
+        push @final_prices, $price_i;
+
+        for my $j ($i + 1 .. $#$prices)
+        {
+            my $price_j = $prices->[ $j ];
+
+            if ($price_j <= $price_i)
+            {
+                $final_prices[ $i ] -= $price_j;
+                last;
+            }
+        }
+    }
+
+    return \@final_prices;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $prices_str, $expected_str) = split / \| /x, $line;
+
+        for ($test_name, $prices_str, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @prices       = split / \s+ /x, $prices_str;
+        my $final_prices = find_final_prices( \@prices );
+        my @expected     = split / \s+ /x, $expected_str;
+
+        is_deeply $final_prices, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|8 4 6 2 3|4 2 4 2 3
+Example 2|1 2 3 4 5|1 2 3 4 5
+Example 3|7 1 1 5  |6 0 1 5
diff --git a/challenge-325/athanasius/raku/ch-1.raku b/challenge-325/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..c796cc191a
--- /dev/null
+++ b/challenge-325/athanasius/raku/ch-1.raku
@@ -0,0 +1,145 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 325
+=========================
+
+TASK #1
+-------
+*Consecutive One*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a binary array containing only 0 or/and 1.
+
+Write a script to find out the maximum consecutive 1 in the given array.
+
+Example 1
+
+  Input: @binary = (0, 1, 1, 0, 1, 1, 1)
+  Output: 3
+
+Example 2
+
+  Input: @binary = (0, 0, 0, 0)
+  Output: 0
+
+Example 3
+
+  Input: @binary = (1, 0, 1, 0, 1, 1)
+  Output: 2
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of binary digits is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset BinDigit of Int where 0 | 1;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 325, Task #1: Consecutive One (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of binary digits
+
+    *@binary where { .elems > 0 && .all ~~ BinDigit:D }
+)
+#===============================================================================
+{
+    "Input:  \@binary = (%s)\n".printf: @binary.join: ', ';
+
+    my UInt $max-ones = find-max-ones( @binary );
+
+    "Output: $max-ones".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-max-ones( List:D[BinDigit:D] $binary --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $string = $binary.join;
+    my Str @groups = $string.split: '0', :skip-empty;
+    my Str @sorted = @groups.sort;
+
+    return @sorted.elems == 0 ?? 0 !! @sorted[ *-1 ].chars;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $binary-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $binary-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my BinDigit @binary   = $binary-str\ .split( / \s+ /, :skip-empty )
+                                             .map: { .Int };
+        my UInt     $max-ones = find-max-ones( @binary );
+
+        is $max-ones, $expected.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|0 1 1 0 1 1 1|3
+        Example 2|0 0 0 0      |0
+        Example 3|1 0 1 0 1 1  |2
+        END
+}
+
+################################################################################
diff --git a/challenge-325/athanasius/raku/ch-2.raku b/challenge-325/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..7ea6040ada
--- /dev/null
+++ b/challenge-325/athanasius/raku/ch-2.raku
@@ -0,0 +1,214 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 325
+=========================
+
+TASK #2
+-------
+*Final Price*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of item prices.
+
+Write a script to find out the final price of each items in the given array.
+
+There is a special discount scheme going on. If there’s an item with a lower or
+equal price later in the list, you get a discount equal to that later price (the
+first one you find in order).
+
+Example 1
+
+  Input: @prices = (8, 4, 6, 2, 3)
+  Output: (4, 2, 4, 2, 3)
+
+  Item 0:
+  The item price is 8.
+  The first time that has price <= current item price is 4.
+  Final price = 8 - 4 => 4
+
+  Item 1:
+  The item price is 4.
+  The first time that has price <= current item price is 2.
+  Final price = 4 - 2 => 2
+
+  Item 2:
+  The item price is 6.
+  The first time that has price <= current item price is 2.
+  Final price = 6 - 2 => 4
+
+  Item 3:
+  The item price is 2.
+  No item has price <= current item price, no discount.
+  Final price = 2
+
+  Item 4:
+  The item price is 3.
+  Since it is the last item, so no discount.
+  Final price = 3
+
+Example 2
+
+  Input: @prices = (1, 2, 3, 4, 5)
+  Output: (1, 2, 3, 4, 5)
+
+Example 3
+
+  Input: @prices = (7, 1, 1, 5)
+  Output: (6, 0, 1, 5)
+
+  Item 0:
+  The item price is 7.
+  The first time that has price <= current item price is 1.
+  Final price = 7 - 1 => 6
+
+  Item 1:
+  The item price is 1.
+  The first time that has price <= current item price is 1.
+  Final price = 1 - 1 => 0
+
+  Item 2:
+  The item price is 1.
+  No item has price <= current item price, so no discount.
+  Final price = 1
+
+  Item 3:
+  The item price is 5.
+  Since it is the last item, so no discount.
+  Final price = 5
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+Item prices are unsigned integers.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of unsigned integers is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 325, Task #2: Final Price (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of unsigned integers
+
+    *@prices where { .elems > 0 && .all ~~ UInt:D }
+)
+#===============================================================================
+{
+    "Input: \@prices = (%s)\n".printf: @prices.join: ', ';
+
+    my UInt @final-prices = find-final-prices( @prices );
+
+    "Output:          (%s)\n".printf: @final-prices.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-final-prices( List:D[UInt:D] $prices --> List:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt @final-prices;
+
+    for 0 .. $prices.end -> UInt $i
+    {
+        my UInt $price-i = $prices[ $i ];
+
+        @final-prices.push: $price-i;
+
+        for $i + 1 .. $prices.end -> UInt $j
+        {
+            my UInt $price-j = $prices[ $j ];
+
+            if $price-j <= $price-i
+            {
+                @final-prices[ $i ] -= $price-j;
+                last;
+            }
+        }
+    }
+
+    return @final-prices;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $prices-str, $expected-str) = $line.split: / \| /;
+
+        for     $test-name, $prices-str, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt @prices       = $prices-str\ .split( / \s+ /, :skip-empty )
+                                             .map: { .Int };
+        my UInt @final-prices = find-final-prices( @prices );
+        my UInt @expected     = $expected-str.split( / \s+ /, :skip-empty )
+                                             .map: { .Int };
+
+        is-deeply @final-prices, @expected, $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|8 4 6 2 3|4 2 4 2 3
+        Example 2|1 2 3 4 5|1 2 3 4 5
+        Example 3|7 1 1 5  |6 0 1 5
+        END
+}
+
+################################################################################