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

2 files changed, 505 insertions, 0 deletions

diff --git a/challenge-336/athanasius/perl/ch-1.pl b/challenge-336/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..de49ab58bc
--- /dev/null
+++ b/challenge-336/athanasius/perl/ch-1.pl
@@ -0,0 +1,249 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 336
+=========================
+
+TASK #1
+-------
+*Equal Group*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers.
+
+Write a script to return true if the given array can be divided into one or more
+groups: each group must be of the same size as the others, with at least two
+members, and with all members having the same value.
+
+Example 1
+
+  Input: @ints = (1,1,2,2,2,2)
+  Output: true
+
+  Groups: (1,1), (2,2), (2,2)
+
+Example 2
+
+  Input: @ints = (1,1,1,2,2,2,3,3)
+  Output: false
+
+  Groups: (1,1,1), (2,2,2), (3,3)
+
+Example 3
+
+  Input: @ints = (5,5,5,5,5,5,7,7,7,7,7,7)
+  Output: true
+
+  Groups: (5,5,5,5,5,5), (7,7,7,7,7,7)
+
+Example 4
+
+  Input: @ints = (1,2,3,4)
+  Output: false
+
+Example 5
+
+  Input: @ints = (8,8,9,9,10,10,11,11)
+  Output: true
+
+  Groups: (8,8), (9,9), (10,10), (11,11)
+
+=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 integers is entered on the command-line.
+
+Algorithm
+---------
+The integers in the input list are merely markers -- they could just as well be
+characters or words. The order in which they appear is also irrelevant. What
+matters is the frequency with which they appear in the list:
+
+(1) If any list element occurs only once, no solution is possible.
+
+(2) Otherwise, a solution is possible if and only if the frequencies share a
+    common divisor greater than 1. This gives rise to the following algorithm:
+
+    1. For each element in the list, find its frequency, f.
+    2. For each f, find the bag (multiset) containing the prime factors of f.
+    3. Find X, the intersection of all bags found in step 2.
+    4. If X is empty, no solution is possible.
+    5. Otherwise, find p, the product of all the members of X.
+    6. A solution may now be generated by partitioning the elements of the
+       original list into same-element bags, each of size p.
+
+=cut
+#===============================================================================
+
+use v5.38.2;          # Enables strictures
+use warnings;
+use Const::Fast;
+use Math::Prime::Util qw( factor );
+use Regexp::Common    qw( number );
+use Set::Bag;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of integers
+END
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 336, Task #1: Equal Group (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        for (@ints)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+        }
+
+        printf "Input:  \@ints = (%s)\n", join ',', @ints;
+
+        my ($result, $groups) = equal_groups( \@ints );
+
+        printf "Output: %s\n", $result ? 'true' : 'false';
+
+        if ($result)
+        {
+            printf "\nGroups: %s\n",
+                    join ', ', map { '(' . join( ',', @$_ ) . ')' } @$groups;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub equal_groups
+#-------------------------------------------------------------------------------
+{
+    my ($ints)  = @_;
+    my  $result = '';
+    my  $groups = [];
+    my  %count;
+      ++$count{ $_ } for @$ints;
+
+    my  @counts = sort { $a <=> $b } values %count;
+
+    if ($counts[ 0 ] > 1)  # If the smallest count is 1, no solution is possible
+    {
+        my $common_prime_factors = Set::Bag->new;
+           $common_prime_factors->insert( $_ => 1 ) for factor( $counts[  0 ] );
+
+        for my $i (1 .. $#counts)
+        {
+            my $prime_factors    = Set::Bag->new;
+               $prime_factors   ->insert( $_ => 1 ) for factor( $counts[ $i ] );
+
+            $common_prime_factors &= $prime_factors;     # Keep the intersection
+        }
+
+        my @factors = $common_prime_factors->elements;
+
+        if (scalar @factors > 0)
+        {
+            $result = 1;
+            $groups = make_groups( \%count, \@factors );
+        }
+    }
+
+    return ($result, $groups);
+}
+
+#-------------------------------------------------------------------------------
+sub make_groups
+#-------------------------------------------------------------------------------
+{
+    my ($count, $factors) = @_;
+    my  @groups;
+    my  $product  = 1;
+        $product *= $_ for @$factors;
+
+    for my $n (sort { $a <=> $b } keys %$count)
+    {
+        my $multiplier = $count->{ $n } / $product;
+
+        push @groups, [ ($n) x $product ] for 1 .. $multiplier;
+    }
+
+    return \@groups;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expected_str, $groups_str) =
+             split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expected_str, $groups_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my  @ints             = split / \s+ /x, $ints_str;
+        my ($result, $groups) = equal_groups( \@ints );
+        my  $expected         = $expected_str eq 'true';
+        my  @group_str        = split / \; \s* /x, $groups_str;
+        my  @exp_groups       = map { [ split / \s+ /x, $_ ] } @group_str;
+
+        is        $result,  $expected,   "$test_name: Result";
+        is_deeply $groups, \@exp_groups, "$test_name: Groups" if $result;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 1 2 2 2 2            |true |1 1; 2 2; 2 2
+Example 2|1 1 1 2 2 2 3 3        |false|1 1 1; 2 2 2; 3 3
+Example 3|5 5 5 5 5 5 7 7 7 7 7 7|true |5 5 5 5 5 5; 7 7 7 7 7 7
+Example 4|1 2 3 4                |false|
+Example 5|8 8 9 9 10 10 11 11    |true |8 8; 9 9; 10 10; 11 11
diff --git a/challenge-336/athanasius/perl/ch-2.pl b/challenge-336/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..a834ebfead
--- /dev/null
+++ b/challenge-336/athanasius/perl/ch-2.pl
@@ -0,0 +1,256 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 336
+=========================
+
+TASK #2
+-------
+*Final Score*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of scores by a team.
+
+Write a script to find the total score of the given team. The score can be any
+integer, +, C or D. The + adds the sum of previous two scores. The score C
+invalidates the previous score. The score D will double the previous score.
+
+Example 1
+
+  Input: @scores = ("5","2","C","D","+")
+  Output: 30
+
+  Round 1: 5
+  Round 2: 5 + 2
+  Round 3: 5 (invalidate the previous score 2)
+  Round 4: 5 + 10 (double the previous score 5)
+  Round 5: 5 + 10 + 15 (sum of previous two scores)
+
+  Total Scores: 30
+
+Example 2
+
+  Input: @scores = ("5","-2","4","C","D","9","+","+")
+  Output: 27
+
+  Round 1: 5
+  Round 2: 5 + (-2)
+  Round 3: 5 + (-2) + 4
+  Round 4: 5 + (-2) (invalidate the previous score 4)
+  Round 5: 5 + (-2) + (-4) (double the previous score -2)
+  Round 6: 5 + (-2) + (-4) + 9
+  Round 7: 5 + (-2) + (-4) + 9 + 5 (sum of previous two scores)
+  Round 8: 5 + (-2) + (-4) + 9 + 5 + 14 (sum of previous two scores)
+
+  Total Scores: 27
+
+Example 3
+
+  Input: @scores = ("7","D","D","C","+","3")
+  Output: 45
+
+  Round 1: 7
+  Round 2: 7 + 14 (double the previous score 7)
+  Round 3: 7 + 14 + 28 (double the previous score 14)
+  Round 4: 7 + 14 (invalidate the previous score 28)
+  Round 5: 7 + 14 + 21 (sum of previous two scores)
+  Round 6: 7 + 14 + 21 + 3
+
+  Total Scores: 45
+
+Example 4
+
+  Input: @scores = ("-5","-10","+","D","C","+")
+  Output: -55
+
+  Round 1: (-5)
+  Round 2: (-5) + (-10)
+  Round 3: (-5) + (-10) + (-15) (sum of previous two scores)
+  Round 4: (-5) + (-10) + (-15) + (-30) (double the previous score -15)
+  Round 5: (-5) + (-10) + (-15) (invalidate the previous score -30)
+  Round 6: (-5) + (-10) + (-15) + (-25) (sum of previous two scores)
+
+  Total Scores: -55
+
+Example 5
+
+  Input: @scores = ("3","6","+","D","C","8","+","D","-2","C","+")
+  Output: 128
+
+  Round  1: 3
+  Round  2: 3 + 6
+  Round  3: 3 + 6 + 9 (sum of previous two scores)
+  Round  4: 3 + 6 + 9 + 18 (double the previous score 9)
+  Round  5: 3 + 6 + 9 (invalidate the previous score 18)
+  Round  6: 3 + 6 + 9 + 8
+  Round  7: 3 + 6 + 9 + 8 + 17 (sum of previous two scores)
+  Round  8: 3 + 6 + 9 + 8 + 17 + 34 (double the previous score 17)
+  Round  9: 3 + 6 + 9 + 8 + 17 + 34 + (-2)
+  Round 10: 3 + 6 + 9 + 8 + 17 + 34 (invalidate the previous score -2)
+  Round 11: 3 + 6 + 9 + 8 + 17 + 34 + 51 (sum of previous two scores)
+
+  Total Scores: 128
+
+=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 scores is entered on the command-line.
+
+Assumptions
+-----------
+During score evaluation, it is an error if a "+" score is not preceded by at
+least two other (integer) scores. Likewise, it is an error if a "C" or a "D"
+score is not preceded by at least one other (integer) score.
+
+=cut
+#===============================================================================
+
+use v5.38.2;       # Enables strictures
+use warnings;
+use Const::Fast;
+use List::Util     qw( sum0 );
+use Regexp::Common qw( number );
+use Test::More;
+use Try::Tiny;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<scores> ...]
+  perl $0
+
+    [<scores> ...]    A non-empty list of scores (integers, '+', 'C', 'D')
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 336, Task #2: Final Score (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @scores = @ARGV;
+
+        for (@scores)
+        {
+            / ^ $RE{num}{int} | [+CD] $ /x
+                or error( qq["$_" is not a valid score] );
+        }
+
+        printf "Input:  \@scores = (%s)\n", join ',', map { qq["$_"] } @scores;
+
+        try
+        {
+            my $score = find_final_score( \@scores );
+
+            print "Output: $score\n";
+        }
+        catch
+        {
+            print "\nERROR: $_";
+        };
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_final_score
+#-------------------------------------------------------------------------------
+{
+    my ($scores) = @_;
+    my  @queue;
+
+    for my $score (@$scores)
+    {
+        my $q_len = scalar @queue;
+
+        if    ($score eq '+')
+        {
+            die qq[Illegal "+" score placement\n] if $q_len < 2;
+            push @queue, $queue[ -2 ] + $queue[ -1 ];
+        }
+        elsif ($score eq 'C')
+        {
+            die qq[Illegal "C" score placement\n] if $q_len < 1;
+            pop  @queue;
+        }
+        elsif ($score eq 'D')
+        {
+            die qq[Illegal "D" score placement\n] if $q_len < 1;
+            push @queue, 2 * $queue[ -1 ];
+        }
+        else    # $score must be an integer
+        {
+            push @queue, $score;
+        }
+    }
+
+    return sum0 @queue;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $scores_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $scores_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @scores = split / \s+ /x, $scores_str;
+        my $score  = find_final_score( \@scores );
+
+        is $score, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 5   2 C D +             | 30
+Example 2| 5  -2 4 C D 9 + +       | 27
+Example 3| 7   D D C + 3           | 45
+Example 4|-5 -10 + D C +           |-55
+Example 5| 3   6 + D C 8 + D -2 C +|128