Merge pull request #12992 from PerlMonk-Athanasius/branch-for-challenge-346

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

4 files changed, 807 insertions, 0 deletions

diff --git a/challenge-346/athanasius/perl/ch-1.pl b/challenge-346/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..8a98763190
--- /dev/null
+++ b/challenge-346/athanasius/perl/ch-1.pl
@@ -0,0 +1,210 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 346
+=========================
+
+TASK #1
+-------
+*Longest Parenthesis*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only ( and ).
+
+Write a script to find the length of the longest valid parenthesis.
+
+Example 1
+
+  Input: $str = '(()())'
+  Output: 6
+
+  Valid Parenthesis: '(()())'
+
+Example 2
+
+  Input: $str = ')()())'
+  Output: 4
+
+  Valid Parenthesis: '()()' at positions 1-4.
+
+Example 3
+
+  Input: $str = '((()))()(((()'
+  Output: 8
+
+  Valid Parenthesis: '((()))()' at positions 0-7.
+
+Example 4
+
+  Input: $str = '))))((()('
+  Output: 2
+
+  Valid Parenthesis: '()' at positions 6-7.
+
+Example 5
+
+  Input: $str = '()(()'
+  Output: 2
+
+  Valid Parenthesis: '()' at positions 0-1 and 3-4.
+
+=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, containing only left and right parentheses, 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 string containing only ( and )
+END
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 346, Task #1: Longest Parenthesis (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str =  $ARGV[0];
+           $str =~ / ^ [()]* $ /x or error( 'The input string is invalid' );
+
+        print "Input:  \$str = '$str'\n";
+
+        my $len = find_longest_paren_len( $str );
+
+        print "Output: $len\n";
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_longest_paren_len
+#-------------------------------------------------------------------------------
+{
+    my ($str)     =  @_;
+        $str      =~ m/ ^ [()]* $ /x or die 'Invalid string';
+        $str      =~ s/ ^ \)+   //x;
+        $str      =~ s/   \(+ $ //x;
+    my  $max_len  =  0;
+    my  $last_idx =  length( $str ) - 1;
+    my  $start    =  0;
+    my  $last_end = -2;
+    my  $last_len =  0;
+
+    while ($start < $last_idx)
+    {
+        my $count = 1;
+        my $found = 0;
+
+        for my $end ($start + 1 .. $last_idx)
+        {
+            if    (substr( $str, $end, 1 ) eq '(')
+            {
+                ++$count;
+            }
+            elsif (--$count == 0)      # Match found
+            {
+                my  $len  = $end - $start + 1;
+                    $len += $last_len if $start == $last_end + 1;
+                $max_len  = $len      if $len > $max_len;
+                $last_end = $end;
+                $last_len = $len;
+                $found    = 1;
+                $start    = $end + 1;
+
+                ++$start while substr( $str, $start, 1 ) eq ')';
+
+                last;
+            }
+        }
+
+        ++$start unless $found;        # No match: advance 1 char & search again
+    }
+
+    return $max_len;
+}
+
+#-------------------------------------------------------------------------------
+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 $len = find_longest_paren_len( $str );
+
+        is $len, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|(()())       |6|(()())
+Example 2|)()())       |4|()()     at positions 1-4
+Example 3|((()))()(((()|8|((()))() at positions 0-7
+Example 4|))))((()(    |2|()       at positions 6-7
+Example 5|()(()        |2|()       at positions 0-1 and 3-4
+2 matches|())(())      |4|(())     at positions 3-6
diff --git a/challenge-346/athanasius/perl/ch-2.pl b/challenge-346/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..954c50b7de
--- /dev/null
+++ b/challenge-346/athanasius/perl/ch-2.pl
@@ -0,0 +1,205 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 346
+=========================
+
+TASK #2
+-------
+*Magic Expression*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only digits and a target integer.
+
+Write a script to insert binary operators +, - and * between the digits in the
+given string that evaluates to target integer.
+
+Example 1
+
+  Input: $str = "123", $target = 6
+  Output: ("1*2*3", "1+2+3")
+
+Example 2
+
+  Input: $str = "105", $target = 5
+  Output: ("1*0+5", "10-5")
+
+Example 3
+
+  Input: $str = "232", $target = 8
+  Output: ("2*3+2", "2+3*2")
+
+Example 4
+
+  Input: $str = "1234", $target = 10
+  Output: ("1*2*3+4", "1+2+3+4")
+
+Example 5
+
+  Input: $str = "1001", $target = 2
+  Output: ("1+0*0+1", "1+0+0+1", "1+0-0+1", "1-0*0+1", "1-0+0+1", "1-0-0+1")
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string containing only digits is entered on the command-line, followed by
+   and integer.
+
+=cut
+#===============================================================================
+
+use v5.38.2;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my @OPS   => qw( * + - ), '';
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str> <target>
+  perl $0
+
+    <str>       A string containing only digits
+    <target>    A target integer
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 346, Task #2: Magic Expression (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($string, $target) = @ARGV;
+
+        $string =~ / ^ [0-9]* $ /x
+                        or error( qq["$string" is not a valid input string] );
+
+        $target =~ / ^ $RE{num}{int} $ /x
+                        or error( qq["$target" is not a valid target integer] );
+
+        print  qq[Input:  \$str = "$string", \$target = $target\n];
+
+        my $expressions = find_magic_expressions( $string, $target );
+
+        printf "Output: (%s)\n", join ', ', map { qq["$_"] } @$expressions;
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_magic_expressions
+#-------------------------------------------------------------------------------
+{
+    my ($str, $target) = @_;
+    my  $length_str    = length $str;
+    my  @expressions;
+
+    if    ($length_str == 0)
+    {
+      # @expressions is already empty;
+    }
+    elsif ($length_str == 1)
+    {
+        push @expressions, $str == $target ? $str : ();
+    }
+    else
+    {
+        my @stack = (0) x ($length_str - 1);
+
+        L_OUTER: for (my $level = $#stack; ; $level = $#stack)
+        {
+            my @chars = split //, $str;
+            my $exp   = $chars[0];
+               $exp  .= $OPS[ $stack[$_] ] . $chars[$_ + 1] for 0 .. $#stack;
+
+            # Discard any "solution" in which 2+ digits begin with a zero
+
+            push @expressions, $exp if $exp !~ /0\d/ && $target == eval $exp;
+
+            while (++$stack[ $level ] > $#OPS)
+            {
+                last L_OUTER if $level == 0;
+
+                $stack[ $level-- ] = 0;
+            }
+        }
+    }
+
+    return \@expressions;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $target, $expected_str) = split / \| /x, $line;
+
+        for ($test_name, $str, $target, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $expressions = find_magic_expressions( $str, $target );
+        my @expected    = split / \s+ /x, $expected_str;
+
+        is_deeply $expressions, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 123| 6|  1*2*3   1+2+3
+Example 2| 105| 5|  1*0+5    10-5
+Example 3| 232| 8|  2*3+2   2+3*2
+Example 4|1234|10|1*2*3+4 1+2+3+4
+Example 5|1001| 2|1+0*0+1 1+0+0+1 1+0-0+1 1-0*0+1 1-0+0+1 1-0-0+1
diff --git a/challenge-346/athanasius/raku/ch-1.raku b/challenge-346/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..9ed2c98279
--- /dev/null
+++ b/challenge-346/athanasius/raku/ch-1.raku
@@ -0,0 +1,199 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 346
+=========================
+
+TASK #1
+-------
+*Longest Parenthesis*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only ( and ).
+
+Write a script to find the length of the longest valid parenthesis.
+
+Example 1
+
+  Input: $str = '(()())'
+  Output: 6
+
+  Valid Parenthesis: '(()())'
+
+Example 2
+
+  Input: $str = ')()())'
+  Output: 4
+
+  Valid Parenthesis: '()()' at positions 1-4.
+
+Example 3
+
+  Input: $str = '((()))()(((()'
+  Output: 8
+
+  Valid Parenthesis: '((()))()' at positions 0-7.
+
+Example 4
+
+  Input: $str = '))))((()('
+  Output: 2
+
+  Valid Parenthesis: '()' at positions 6-7.
+
+Example 5
+
+  Input: $str = '()(()'
+  Output: 2
+
+  Valid Parenthesis: '()' at positions 0-1 and 3-4.
+
+=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, containing only left and right parentheses, is entered on
+   the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 346, Task #1: Longest Parenthesis (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str where { / ^ <[()]>* $ / }     #= A string containing only ( and )
+)
+#===============================================================================
+{
+    "Input:  \$str = '$str'".put;
+
+    my UInt $len = find-longest-paren-len( $str );
+
+    "Output: $len".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-longest-paren-len( Str:D $string where { / ^ <[()]>* $ / } --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my Str  $str      =  $string;
+            $str      ~~ s/ ^ \)+   //;
+            $str      ~~ s/   \(+ $ //;
+    my UInt $max-len  =  0;
+    my Int  $last-idx =  $str.chars - 1;
+    my UInt $start    =  0;
+    my Int  $last-end = -2;
+    my UInt $last-len =  0;
+
+    while $last-idx > $start
+    {
+        my UInt $count = 1;
+        my Bool $found = False;
+
+        for $start + 1 .. $last-idx -> UInt $end
+        {
+            if    $str.substr( $end, 1 ) eq '('
+            {
+                ++$count;
+            }
+            elsif --$count == 0        # Match found
+            {
+                my UInt $len  = $end - $start + 1;
+                        $len += $last-len if $start == $last-end + 1;
+
+                $max-len  = ($len, $max-len).max;
+                $last-end =  $end;
+                $last-len =  $len;
+                $found    =  True;
+                $start    =  $end + 1;
+
+                ++$start while $str.substr( $start, 1 ) eq ')';
+
+                last;
+            }
+        }
+
+        ++$start unless $found;        # No match: advance 1 char & search again
+    }
+
+    return $max-len;
+}
+
+#-------------------------------------------------------------------------------
+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 $len = find-longest-paren-len( $str );
+
+        is $len, $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|(()())       |6|(()())
+        Example 2|)()())       |4|()()     at positions 1-4
+        Example 3|((()))()(((()|8|((()))() at positions 0-7
+        Example 4|))))((()(    |2|()       at positions 6-7
+        Example 5|()(()        |2|()       at positions 0-1 and 3-4
+        2 matches|())(())      |4|(())     at positions 3-6
+        END
+}
+
+################################################################################
diff --git a/challenge-346/athanasius/raku/ch-2.raku b/challenge-346/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..cc13b621d3
--- /dev/null
+++ b/challenge-346/athanasius/raku/ch-2.raku
@@ -0,0 +1,193 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 346
+=========================
+
+TASK #2
+-------
+*Magic Expression*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only digits and a target integer.
+
+Write a script to insert binary operators +, - and * between the digits in the
+given string that evaluates to target integer.
+
+Example 1
+
+  Input: $str = "123", $target = 6
+  Output: ("1*2*3", "1+2+3")
+
+Example 2
+
+  Input: $str = "105", $target = 5
+  Output: ("1*0+5", "10-5")
+
+Example 3
+
+  Input: $str = "232", $target = 8
+  Output: ("2*3+2", "2+3*2")
+
+Example 4
+
+  Input: $str = "1234", $target = 10
+  Output: ("1*2*3+4", "1+2+3+4")
+
+Example 5
+
+  Input: $str = "1001", $target = 2
+  Output: ("1+0*0+1", "1+0+0+1", "1+0-0+1", "1-0*0+1", "1-0+0+1", "1-0-0+1")
+
+=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 string containing only digits is entered on the command-line, followed by
+   and integer.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my constant @OPS = |< * + - >, '';
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 346, Task #2: Magic Expression (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str where { / ^ <[0..9]>* $ / },   #= A string containing only digits
+    Int:D $target                             #= A target integer
+)
+#===============================================================================
+{
+    qq[Input:  \$str = "$str", \$target = $target].put;
+
+    my Str @expressions = find-magic-expressions( $str, $target );
+
+    "Output: (%s)\n".printf: @expressions.map( { qq["$_"] } ).join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-magic-expressions
+(
+    Str:D $str where { / ^ <[0..9]>* $ / },
+    Int:D $target
+--> List:D[Str:D]
+)
+#-------------------------------------------------------------------------------
+{
+    my Str  @expressions;
+    my UInt $length-str = $str.chars;
+
+    if    $length-str == 0
+    {
+      # @expressions is already empty;
+    }
+    elsif $length-str == 1
+    {
+        @expressions.push: $str == $target ?? $str !! ();
+    }
+    else
+    {
+        my UInt @stack = 0 xx ($length-str - 1);
+
+        L-OUTER: loop (my UInt $level = @stack.end; ; $level = @stack.end)
+        {
+            my Str @chars = $str.split: '', :skip-empty;
+            my Str $exp   = @chars[0];
+                   $exp  ~= @OPS[ @stack[$_] ] ~ @chars[$_ + 1]
+                                                            for 0 .. @stack.end;
+
+            # Discard any "solution" in which 2+ digits begin with a zero
+
+            @expressions.push: $exp if $exp !~~ /0\d/ && $target == EVAL $exp;
+
+            while (++@stack[ $level ] > @OPS.end)
+            {
+                last L-OUTER if $level == 0;
+
+                @stack[ $level-- ] = 0;
+            }
+        }
+    }
+
+    return @expressions;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $target, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $str, $target, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str @expressions = find-magic-expressions( $str, $target.Int );
+        my Str @expected    = $exp-str.split: / \s+ /, :skip-empty;
+
+        is-deeply @expressions, @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| 123| 6|  1*2*3   1+2+3
+        Example 2| 105| 5|  1*0+5    10-5
+        Example 3| 232| 8|  2*3+2   2+3*2
+        Example 4|1234|10|1*2*3+4 1+2+3+4
+        Example 5|1001| 2|1+0*0+1 1+0+0+1 1+0-0+1 1-0*0+1 1-0+0+1 1-0-0+1
+        END
+}
+
+################################################################################