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

4 files changed, 768 insertions, 0 deletions

diff --git a/challenge-342/athanasius/perl/ch-1.pl b/challenge-342/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..132326de07
--- /dev/null
+++ b/challenge-342/athanasius/perl/ch-1.pl
@@ -0,0 +1,197 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 342
+=========================
+
+TASK #1
+-------
+*Balance String*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of lowercase English letters and digits only.
+
+Write a script to format the give[n] string where no letter is followed by
+another letter and no digit is followed by another digit. If there are multiple
+valid rearrangements, always return the lexicographically smallest one. Return
+empty string if it is impossible to format the string.
+
+Example 1
+
+  Input: $str = "a0b1c2"
+  Output: "0a1b2c"
+
+Example 2
+
+  Input: $str = "abc12"
+  Output: "a1b2c"
+
+Example 3
+
+  Input: $str = "0a2b1c3"
+  Output: "0a1b2c3"
+
+Example 4
+
+  Input: $str = "1a23"
+  Output: ""
+
+Example 5
+
+  Input: $str = "ab123"
+  Output: "1a2b3"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+Digits are lexicographically "lower" than letters (as in ASCII, but not EBCDIC).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single, non-empty string, comprising lowercase English letters and digits
+   only, is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.38.2;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    A non-empty string of lowercase English letters and digits
+END
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 342, Task #1: Balance String (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str = $ARGV[0];
+
+        $str =~  / ^ [0-9a-z]+ $ /x or error( qq[Invalid string "$str"] );
+
+        print qq[Input: \$str = "$str"\n];
+
+        my $balanced = balance_string( $str );
+
+        print qq[Output:       "$balanced"\n];
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub balance_string
+#-------------------------------------------------------------------------------
+{
+    my ($str) =  @_;
+        $str  =~ / ^ [0-9a-z]+ $ /x or die qq[Invalid string "$str"];
+    my (@digits, @letters);
+
+    for my $char (split //, $str)
+    {
+        my    $target = $char =~ / [0-9] /x ? \@digits : \@letters;
+        push @$target,  $char;
+    }
+
+    @digits  = sort { $a <=> $b } @digits;
+    @letters = sort { $a cmp $b } @letters;
+
+    my  $balanced  = '';
+
+    if    (scalar @digits == scalar @letters + 1)
+    {
+        $balanced  = shift  @digits;
+        $balanced .= shift( @letters ) . shift( @digits  ) while @letters;
+    }
+    elsif (scalar @digits == scalar @letters)
+    {
+        $balanced .= shift( @digits  ) . shift( @letters ) while @digits;
+    }
+    elsif (scalar @digits == scalar @letters - 1)
+    {
+        $balanced  = shift  @letters;
+        $balanced .= shift( @digits  ) . shift( @letters ) while @digits;
+    }
+
+    return $balanced;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $balanced = balance_string( $str );
+
+        is $balanced, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|a0b1c2 |0a1b2c
+Example 2|abc12  |a1b2c
+Example 3|0a2b1c3|0a1b2c3
+Example 4|1a23   |
+Example 5|ab123  |1a2b3
diff --git a/challenge-342/athanasius/perl/ch-2.pl b/challenge-342/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..d16588cffa
--- /dev/null
+++ b/challenge-342/athanasius/perl/ch-2.pl
@@ -0,0 +1,197 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 342
+=========================
+
+TASK #2
+-------
+*Max Score*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, containing 0 and 1 only.
+
+Write a script to return the max score after splitting the string into two non-
+empty substrings. The score after splitting a string is the number of zeros in
+the left substring plus the number of ones in the right substring.
+
+Example 1
+
+  Input: $str = "0011"
+  Output: 4
+
+  1: left = "0", right = "011" => 1 + 2 => 3
+  2: left = "00", right = "11" => 2 + 2 => 4
+  3: left = "001", right = "1" => 2 + 1 => 3
+
+Example 2
+
+  Input: $str = "0000"
+  Output: 3
+
+  1: left = "0", right = "000" => 1 + 0 => 1
+  2: left = "00", right = "00" => 2 + 0 => 2
+  3: left = "000", right = "0" => 3 + 0 => 3
+
+Example 3
+
+  Input: $str = "1111"
+  Output: 3
+
+  1: left = "1", right = "111" => 0 + 3 => 3
+  2: left = "11", right = "11" => 0 + 2 => 2
+  3: left = "111", right = "1" => 0 + 1 => 1
+
+Example 4
+
+  Input: $str = "0101"
+  Output: 3
+
+  1: left = "0", right = "101" => 1 + 2 => 3
+  2: left = "01", right = "01" => 1 + 1 => 2
+  3: left = "010", right = "1" => 2 + 1 => 3
+
+Example 5
+
+  Input: $str = "011101"
+  Output: 5
+
+  1: left = "0", right = "11101" => 1 + 4 => 5
+  2: left = "01", right = "1101" => 1 + 3 => 4
+  3: left = "011", right = "101" => 1 + 2 => 3
+  4: left = "0111", right = "01" => 1 + 1 => 2
+  5: left = "01110", right = "1" => 2 + 1 => 3
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single string, at least 2 characters long, and comprising only the charac-
+   ters "0" and "1", is entered on the command-line.
+   
+=cut
+#===============================================================================
+
+use v5.38.2;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    A 2+ character string containing only "0" and "1"
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 342, Task #2: Max Score (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str =  $ARGV[0];
+           $str =~ / ^ [01]{2,} $ /x
+                   or error( qq[The input string "$str" is invalid] );
+
+        print qq[Input:  \$str = "$str"\n];
+
+        my $max_score = find_max_score( $str );
+
+        print qq[Output: $max_score\n];
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_max_score
+#-------------------------------------------------------------------------------
+{
+    my ($str)   = @_;
+    my  $max    = 0;
+    my  @digits = split //, $str;
+    my  $score  = 0;
+        $score += $_ for @digits;
+
+    for my $i (0 .. $#digits - 1)
+    {
+        $score += $digits[$i] ? -1 : 1;
+        $max    = $score if $score > $max;
+    }
+
+    return $max;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $max_score = find_max_score( $str );
+
+        is $max_score, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|0011  |4
+Example 2|0000  |3
+Example 3|1111  |3
+Example 4|0101  |3
+Example 5|011101|5
diff --git a/challenge-342/athanasius/raku/ch-1.raku b/challenge-342/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..a1ca1cb2e4
--- /dev/null
+++ b/challenge-342/athanasius/raku/ch-1.raku
@@ -0,0 +1,190 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 342
+=========================
+
+TASK #1
+-------
+*Balance String*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of lowercase English letters and digits only.
+
+Write a script to format the give[n] string where no letter is followed by
+another letter and no digit is followed by another digit. If there are multiple
+valid rearrangements, always return the lexicographically smallest one. Return
+empty string if it is impossible to format the string.
+
+Example 1
+
+  Input: $str = "a0b1c2"
+  Output: "0a1b2c"
+
+Example 2
+
+  Input: $str = "abc12"
+  Output: "a1b2c"
+
+Example 3
+
+  Input: $str = "0a2b1c3"
+  Output: "0a1b2c3"
+
+Example 4
+
+  Input: $str = "1a23"
+  Output: ""
+
+Example 5
+
+  Input: $str = "ab123"
+  Output: "1a2b3"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+Digits are lexicographically "lower" than letters (as in ASCII, but not EBCDIC).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single, non-empty string, comprising lowercase English letters and digits
+   only, is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 342, Task #1: Balance String (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty string of lowercase English letters and digits
+
+    Str:D $str where { / ^ <[ a..z 0..9 ]>+ $ / }
+)
+#===============================================================================
+{
+    qq[Input: \$str = "$str"].put;
+
+    my Str $balanced = balance-string( $str );
+
+    qq[Output:       "$balanced"].put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub balance-string
+(
+    Str:D $str where { / ^ <[ 0..9 a..z ]>+ $ / }
+--> Str:D
+)
+#-------------------------------------------------------------------------------
+{
+    my Str (@digits, @letters);
+
+    for $str.split( '', :skip-empty ) -> Str $char
+    {
+        my Str @target := $char ~~ / <[ 0..9 ]> / ?? @digits !! @letters;
+
+        @target.push: $char;
+    }
+
+    @digits  .= sort;
+    @letters .= sort;
+
+    my Str $balanced = '';
+
+    if    @digits.elems == @letters.elems + 1
+    {
+        $balanced  = @digits\.shift;
+        $balanced ~= @letters.shift ~ @digits\.shift while @letters;
+    }
+    elsif @digits.elems == @letters.elems
+    {
+        $balanced ~= @digits\.shift ~ @letters.shift while @digits;
+    }
+    elsif @digits.elems == @letters.elems - 1
+    {
+        $balanced  = @letters.shift;
+        $balanced ~= @digits\.shift ~ @letters.shift while @digits;
+    }
+
+    return $balanced;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $balanced = balance-string( $str );
+
+        is $balanced, $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|a0b1c2 |0a1b2c
+        Example 2|abc12  |a1b2c
+        Example 3|0a2b1c3|0a1b2c3
+        Example 4|1a23   |
+        Example 5|ab123  |1a2b3
+        END
+}
+
+################################################################################
diff --git a/challenge-342/athanasius/raku/ch-2.raku b/challenge-342/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..2b6df8deec
--- /dev/null
+++ b/challenge-342/athanasius/raku/ch-2.raku
@@ -0,0 +1,184 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 342
+=========================
+
+TASK #2
+-------
+*Max Score*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, containing 0 and 1 only.
+
+Write a script to return the max score after splitting the string into two non-
+empty substrings. The score after splitting a string is the number of zeros in
+the left substring plus the number of ones in the right substring.
+
+Example 1
+
+  Input: $str = "0011"
+  Output: 4
+
+  1: left = "0", right = "011" => 1 + 2 => 3
+  2: left = "00", right = "11" => 2 + 2 => 4
+  3: left = "001", right = "1" => 2 + 1 => 3
+
+Example 2
+
+  Input: $str = "0000"
+  Output: 3
+
+  1: left = "0", right = "000" => 1 + 0 => 1
+  2: left = "00", right = "00" => 2 + 0 => 2
+  3: left = "000", right = "0" => 3 + 0 => 3
+
+Example 3
+
+  Input: $str = "1111"
+  Output: 3
+
+  1: left = "1", right = "111" => 0 + 3 => 3
+  2: left = "11", right = "11" => 0 + 2 => 2
+  3: left = "111", right = "1" => 0 + 1 => 1
+
+Example 4
+
+  Input: $str = "0101"
+  Output: 3
+
+  1: left = "0", right = "101" => 1 + 2 => 3
+  2: left = "01", right = "01" => 1 + 1 => 2
+  3: left = "010", right = "1" => 2 + 1 => 3
+
+Example 5
+
+  Input: $str = "011101"
+  Output: 5
+
+  1: left = "0", right = "11101" => 1 + 4 => 5
+  2: left = "01", right = "1101" => 1 + 3 => 4
+  3: left = "011", right = "101" => 1 + 2 => 3
+  4: left = "0111", right = "01" => 1 + 1 => 2
+  5: left = "01110", right = "1" => 2 + 1 => 3
+
+=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 single string, at least 2 characters long, and comprising only the charac-
+   ters "0" and "1", is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 342, Task #2: Max Score (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A 2+ character string containing only "0" and "1"
+
+    Str:D $str where { / ^ <[ 0 1 ]> ** 2..* $ / }
+)
+#===============================================================================
+{
+    qq[Input:  \$str = "$str"].put;
+
+    my UInt $max-score = find-max-score( $str );
+
+    qq[Output: $max-score].put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-max-score( Str:D $str where { / ^ <[ 0 1 ]> ** 2..* $ / } --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $max    = 0;
+    my UInt @digits = $str.split( '', :skip-empty ).map: { .Int };
+    my UInt $score  = [+] @digits;
+
+    for 0 .. @digits.end - 1 -> UInt $i
+    {
+        $score += @digits[$i] ?? -1 !! 1;
+        $max    = $score if $score > $max;
+    }
+
+    return $max;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt $max-score = find-max-score( $str );
+
+        is $max-score, $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|0011  |4
+        Example 2|0000  |3
+        Example 3|1111  |3
+        Example 4|0101  |3
+        Example 5|011101|5
+        END
+}
+
+################################################################################