Merge pull request #11457 from PerlMonk-Athanasius/branch-for-challenge-304

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

4 files changed, 800 insertions, 0 deletions

diff --git a/challenge-304/athanasius/perl/ch-1.pl b/challenge-304/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..c5b2e160a0
--- /dev/null
+++ b/challenge-304/athanasius/perl/ch-1.pl
@@ -0,0 +1,232 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 304
+=========================
+
+TASK #1
+-------
+*Arrange Binary*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of binary digits (0 and 1) and a positive integer, $n.
+
+Write a script to return true if you can re-arrange the list by replacing at
+least $n digits with 1 in the given list so that no two consecutive digits are 1
+otherwise return false.
+
+Example 1
+
+  Input: @digits = (1, 0, 0, 0, 1), $n = 1
+  Output: true
+
+  Re-arranged list: (1, 0, 1, 0, 1)
+
+Example 2
+
+  Input: @digits = (1, 0, 0, 0, 1), $n = 2
+  Output: false
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. Replacement: Only a 0 digit may be replaced with a 1 digit.
+2. The given $n must be greater than zero.
+
+Discussion
+----------
+In the Task description, juxtaposition of the words "re-arrange" and "replace"
+creates ambiguity. Is the requirement to:
+
+ 1. replace $n 0 digits with 1 digits, leaving them in their original places; or
+ 2. rearrange all the digits (after replacement) into the required sequence?
+
+Rather than choose between these alternatives, I have decided to solve both. For
+example, an input of @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1) and $n = 1 will
+produce the following result:
+
+    Input: @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1), $n = 1
+    Output
+      Can rearrange: true
+      Can replace:   false
+
+which indicates that the digits CAN be re-arranged with no two consecutive 1s:
+
+    (1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1)
+
+but CANNOT have no consecutive 1s if there is replacement but no rearrangement
+(because there are consecutive 1s in the original list).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A binary string and a positive integer are 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 <digits> <n>
+  perl $0
+
+    <digits>    A non-empty string of binary digits
+    <n>         A positive integer
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 304, Task #1: Arrange Binary (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($digits, $n) = @ARGV;
+
+        $digits =~ / ^ [01]+ $ /x
+               or error( qq["$digits" is not a valid string of binary digits] );
+
+        $n =~ / ^ $RE{num}{int} $ /x
+               or error( qq["$n" is not a valid integer] );
+
+        $n > 0 or error( "$n is not positive" );
+
+        my @digits = split //, $digits;
+
+        printf "Input: \@digits = (%s), \$n = %d\n", join( ', ', @digits ), $n;
+
+        my ($can_rearrange, $can_replace) = arrange( \@digits, $n );
+
+        print  "Output\n";
+        printf "  Can rearrange: %s\n", $can_rearrange ? 'true' : 'false';
+        printf "  Can replace:   %s\n", $can_replace   ? 'true' : 'false';
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub arrange
+#-------------------------------------------------------------------------------
+{
+    my ($digits, $n) = @_;
+
+    my  $ones  = 0;
+        $ones += $_ for @$digits;
+    my  $zeros = scalar @$digits - $ones;
+
+    my  $can_rearrange = ($ones + $n) - ($zeros - $n) <= 1;
+    my  $can_replace   =  $can_rearrange;
+
+    if ($can_replace)
+    {
+        my $digit_str = join '', @$digits;
+        $can_replace  = ($digit_str =~ / 11 /x) ? 0 : replace( $digit_str, $n );
+    }
+
+    return ($can_rearrange, $can_replace);
+}
+
+#-------------------------------------------------------------------------------
+sub replace
+#-------------------------------------------------------------------------------
+{
+    my ($digits, $n) = @_;
+
+    --$n if $digits =~ / ^ 0 /x;
+
+    if ($n > 0)
+    {
+        --$n if $digits =~ / 0 $ /x;
+
+        while ($n > 0)
+        {
+            $digits =~ s/ 000 /010/x or last;
+            --$n;
+        }
+    }
+
+    return $n == 0;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $digit_str, $n, $exp_rearrange, $exp_replace) =
+             split / \| /x, $line;
+
+        for ($test_name, $digit_str, $n, $exp_rearrange, $exp_replace)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my  @digits = split //, $digit_str;
+        my ($can_rearrange, $can_replace) = arrange( \@digits, $n );
+        my  $can_rearrange_str = $can_rearrange ? 'true' : 'false';
+        my  $can_replace_str   = $can_replace   ? 'true' : 'false';
+
+        is  $can_rearrange_str, $exp_rearrange, "$test_name: rearrange";
+        is  $can_replace_str,   $exp_replace,   "$test_name: replace";
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|10001      |1|true |true
+Example 2|10001      |2|false|false
+Groups 1 |11100000011|1|true |false
+Groups 2 |1000010001 |2|true |true
+Groups 3 |1000001    |2|true |true
diff --git a/challenge-304/athanasius/perl/ch-2.pl b/challenge-304/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..2402029e83
--- /dev/null
+++ b/challenge-304/athanasius/perl/ch-2.pl
@@ -0,0 +1,174 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 304
+=========================
+
+TASK #2
+-------
+*Maximum Average*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and an integer, $n which is less than
+or equal to total elements in the given array.
+
+Write a script to find the contiguous subarray whose length is the given inte-
+ger, $n, and has the maximum average. It should return the average.
+
+Example 1
+
+  Input: @ints = (1, 12, -5, -6, 50, 3), $n = 4
+  Output: 12.75
+
+  Subarray: (12, -5, -6, 50)
+  Average: (12 - 5 - 6 + 50) / 4 = 12.75
+
+Example 2
+
+  Input: @ints = (5), $n = 1
+  Output: 5
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+$n is greater than zero. (If $n = 0, calculation of the average would result in
+division by zero, which is undefined. If $n < 0, the "window" would have nega-
+tive length, which makes no sense.)
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A positive integer $n is entered on the command-line, followed by a non-empty
+   list of integers. 0 < $n <= (the number of elements in the list).
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures and warnings
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <n> [<ints> ...]
+  perl $0
+
+    <n>             A positive integer not greater than the size of ints
+    [<ints> ...]    A non-empty list of integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 304, Task #2: Maximum Average (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        error( "Expected 0 or 2+ command-line arguments, found 1" )
+    }
+    else
+    {
+        my ($n, @ints) = @ARGV;
+
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+            for $n, @ints;
+
+        0 < $n <= scalar @ints or error( "$n is not a valid value for n" );
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $max_avg = find_max_average( \@ints, $n );
+
+        print  "Output: $max_avg\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_max_average
+#-------------------------------------------------------------------------------
+{
+    my ($ints, $n) = @_;
+    my  $left      = 0;
+    my  $right     = $n - 1;
+    my  $total     = 0;
+        $total    += $_ for @$ints[ $left .. $right ];
+    my  $max       = $total;
+
+    while ($right < $#$ints)
+    {
+        $total -= $ints->[   $left++ ];
+        $total += $ints->[ ++$right  ];
+        $max    = $total if $total > $max;
+    }
+
+    return $max / $n;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $n, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $n, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints    = split / \s+ /x, $ints_str;
+        my $max_avg = find_max_average( \@ints, $n );
+
+        is $max_avg, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 12 -5 -6 50 3|4|12.75
+Example 2|5              |1| 5
+Repeating|1 -1  1        |3| 0.333333333333333
diff --git a/challenge-304/athanasius/raku/ch-1.raku b/challenge-304/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..1f2158c1fc
--- /dev/null
+++ b/challenge-304/athanasius/raku/ch-1.raku
@@ -0,0 +1,217 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 304
+=========================
+
+TASK #1
+-------
+*Arrange Binary*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of binary digits (0 and 1) and a positive integer, $n.
+
+Write a script to return true if you can re-arrange the list by replacing at
+least $n digits with 1 in the given list so that no two consecutive digits are 1
+otherwise return false.
+
+Example 1
+
+  Input: @digits = (1, 0, 0, 0, 1), $n = 1
+  Output: true
+
+  Re-arranged list: (1, 0, 1, 0, 1)
+
+Example 2
+
+  Input: @digits = (1, 0, 0, 0, 1), $n = 2
+  Output: false
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. Replacement: Only a 0 digit may be replaced with a 1 digit.
+2. The given $n must be greater than zero.
+
+Discussion
+----------
+In the Task description, juxtaposition of the words "re-arrange" and "replace"
+creates ambiguity. Is the requirement to:
+
+ 1. replace $n 0 digits with 1 digits, leaving them in their original places; or
+ 2. rearrange all the digits (after replacement) into the required sequence?
+
+Rather than choose between these alternatives, I have decided to solve both. For
+example, an input of @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1) and $n = 1 will
+produce the following result:
+
+    Input: @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1), $n = 1
+    Output
+      Can rearrange: true
+      Can replace:   false
+
+which indicates that the digits CAN be re-arranged with no two consecutive 1s:
+
+    (1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1)
+
+but CANNOT have no consecutive 1s if there is replacement but no rearrangement
+(because there are consecutive 1s in the original list).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A binary string and a positive integer are entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset BinStr of Str where / ^ <[ 0 1 ]>+ $ /;
+subset Bin    of Int where 0 | 1;
+subset Pos    of Int where * > 0;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 304, Task #1: Arrange Binary (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    BinStr:D $digits,          #= A non-empty string of binary digits
+    Pos:D    $n                #= A positive integer
+)
+#===============================================================================
+{
+    my Bin @digits = $digits.split( '', :skip-empty ).map: { .Int };
+
+    "Input: \@digits = (%s), \$n = %d\n".printf: @digits.join( ', ' ), $n;
+
+    my Bool ($can-rearrange, $can-replace) = arrange( @digits, $n );
+
+    'Output'.put;
+    "  Can rearrange: %s\n".printf: $can-rearrange ?? 'true' !! 'false';
+    "  Can replace:   %s\n".printf: $can-replace   ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub arrange( List:D[Bin:D] $digits, Pos:D $n --> List:D[Bool:D, Bool:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt $ones  = 0;
+            $ones += $_ for @$digits;
+    my UInt $zeros = $digits.elems - $ones;
+
+    my Bool $can-rearrange = ($ones + $n) - ($zeros - $n) <= 1;
+    my Bool $can-replace   =  $can-rearrange;
+
+    if $can-replace
+    {
+        my BinStr $digit-str = $digits.join: '', :skip-empty;
+        $can-replace = ($digit-str ~~ / 11 /) ?? False
+                                              !! replace( $digit-str, $n );
+    }
+
+    return $can-rearrange, $can-replace;
+}
+
+#-------------------------------------------------------------------------------
+sub replace( BinStr:D $digits is rw, Pos:D $n --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $n-left = $n;
+
+    --$n-left if $digits ~~ / ^ 0 /;
+
+    if $n-left > 0
+    {
+        --$n-left if $digits ~~ / 0 $ /;
+
+        while $n-left > 0
+        {
+            $digits ~~ s/ 000 /010/ or last;
+            --$n-left;
+        }
+    }
+
+    return $n-left == 0;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $digit-str, $n, $exp-rearrange, $exp-replace) =
+                $line.split: / \| /;
+
+        for     $test-name, $digit-str, $n, $exp-rearrange, $exp-replace
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Bin @digits = $digit-str.split( '', :skip-empty ).map: { .Int };
+
+        my Bool ($can-rearrange, $can-replace) = arrange( @digits, $n.Int );
+
+        my Str $can-rearrange-str = $can-rearrange ?? 'true' !! 'false';
+        my Str $can-replace-str   = $can-replace   ?? 'true' !! 'false';
+
+        is $can-rearrange-str, $exp-rearrange, "$test-name: rearrange";
+        is $can-replace-str,   $exp-replace,   "$test-name: replace";
+    }
+
+    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|10001      |1|true |true
+        Example 2|10001      |2|false|false
+        Groups 1 |11100000011|1|true |false
+        Groups 2 |1000010001 |2|true |true
+        Groups 3 |1000001    |2|true |true
+        END
+}
+
+################################################################################
diff --git a/challenge-304/athanasius/raku/ch-2.raku b/challenge-304/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..6b197530b9
--- /dev/null
+++ b/challenge-304/athanasius/raku/ch-2.raku
@@ -0,0 +1,177 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 304
+=========================
+
+TASK #2
+-------
+*Maximum Average*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and an integer, $n which is less than
+or equal to total elements in the given array.
+
+Write a script to find the contiguous subarray whose length is the given inte-
+ger, $n, and has the maximum average. It should return the average.
+
+Example 1
+
+  Input: @ints = (1, 12, -5, -6, 50, 3), $n = 4
+  Output: 12.75
+
+  Subarray: (12, -5, -6, 50)
+  Average: (12 - 5 - 6 + 50) / 4 = 12.75
+
+Example 2
+
+  Input: @ints = (5), $n = 1
+  Output: 5
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+$n is greater than zero. (If $n = 0, calculation of the average would result in
+division by zero, which is undefined. If $n < 0, the "window" would have nega-
+tive length, which makes no sense.)
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A positive integer named n is entered on the command-line, followed by a non-
+   empty list of integers. 0 < n <= (the number of elements in the list).
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 304, Task #2: Maximum Average (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Pos:D :$n,           #= A positive integer not greater than the size of ints
+
+    *@ints where { .elems > 0 && .all ~~ Int:D } #= A non-empty list of integers
+)
+#===============================================================================
+{
+    $n <= @ints.elems or error( "\$n is too large" );
+
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my Rat $max-avg = find-max-average( @ints, $n );
+
+    "Output: $max-avg".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-max-average
+(
+    List:D[Int:D] $ints where { .elems > 0 },
+    Pos:D         $n    where { $n <= $ints.elems }
+--> Rat:D
+)
+#-------------------------------------------------------------------------------
+{
+    my UInt $left  = 0;
+    my UInt $right = $n - 1;
+    my Int  $total = [+] $ints[ $left .. $right ];
+    my Int  $max   = $total;
+
+    while $right < $ints.end
+    {
+        $total -= $ints[   $left++ ];
+        $total += $ints[ ++$right  ];
+        $max    = $total if $total > $max;
+    }
+
+    return $max / $n;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $n, $expected) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $n, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @ints    = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Rat $max-avg = find-max-average( @ints, $n.Int );
+
+        is $max-avg, $expected.Rat, $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|1 12 -5 -6 50 3|4|12.75
+        Example 2|5              |1| 5
+        Repeating|1 -1  1        |3| 0.333333
+        END
+}
+
+################################################################################