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

4 files changed, 738 insertions, 0 deletions

diff --git a/challenge-340/athanasius/perl/ch-1.pl b/challenge-340/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..bbec11553c
--- /dev/null
+++ b/challenge-340/athanasius/perl/ch-1.pl
@@ -0,0 +1,187 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 340
+=========================
+
+TASK #1
+-------
+*Duplicate Removals*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, consisting of lowercase English letters.
+
+Write a script to return the final string after all duplicate removals have been
+made. Repeat duplicate removals on the given string until we no longer can.
+
+    A duplicate removal consists of choosing two adjacent and equal letters and
+    removing them.
+
+Example 1
+
+  Input: $str = 'abbaca'
+  Output: 'ca'
+
+  Step 1: Remove 'bb' => 'aaca'
+  Step 2: Remove 'aa' => 'ca'
+
+Example 2
+
+  Input: $str = 'azxxzy'
+  Output: 'ay'
+
+  Step 1: Remove 'xx' => 'azzy'
+  Step 2: Remove 'zz' => 'ay'
+
+Example 3
+
+  Input: $str = 'aaaaaaaa'
+  Output: ''
+
+  Step 1: Remove 'aa' => 'aaaaaa'
+  Step 2: Remove 'aa' => 'aaaa'
+  Step 3: Remove 'aa' => 'aa'
+  Step 4: Remove 'aa' => ''
+
+Example 4
+
+  Input: $str = 'aabccba'
+  Output: 'a'
+
+  Step 1: Remove 'aa' => 'bccba'
+  Step 2: Remove 'cc' => 'bba'
+  Step 3: Remove 'bb' => 'a'
+
+Example 5
+
+  Input: $str = 'abcddcba'
+  Output: ''
+
+  Step 1: Remove 'dd' => 'abccba'
+  Step 2: Remove 'cc' => 'abba'
+  Step 3: Remove 'bb' => 'aa'
+  Step 4: Remove 'aa' => ''
+
+=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 of lowercase English letters 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 of lowercase English letters
+END
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 340, Task #1: Duplicate Removals (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str = $ARGV[0];
+
+        $str =~ / ^ [a-z]* $ /x or error( 'Invalid input string' );
+
+        print "Input:  \$str = '$str'\n";
+
+        my $no_dups = remove_duplicates( $str );
+
+        print "Output: '$no_dups'\n";
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub remove_duplicates
+#-------------------------------------------------------------------------------
+{
+    my ($str) = @_;
+
+    1 while $str =~ s/ (.) \1 //x;
+
+    return $str;
+}
+
+#-------------------------------------------------------------------------------
+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 $no_dups = remove_duplicates( $str );
+
+        is $no_dups, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|abbaca  |ca
+Example 2|azxxzy  |ay
+Example 3|aaaaaaaa|
+Example 4|aabccba |a
+Example 5|abcddcba|
diff --git a/challenge-340/athanasius/perl/ch-2.pl b/challenge-340/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..3fb5b4560f
--- /dev/null
+++ b/challenge-340/athanasius/perl/ch-2.pl
@@ -0,0 +1,192 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 340
+=========================
+
+TASK #2
+-------
+*Ascending Numbers*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, is a list of tokens separated by a single space.
+Every token is either a positive number consisting of digits 0-9 with no leading
+zeros, or a word consisting of lowercase English letters.
+
+Write a script to check if all the numbers in the given string are strictly
+increasing from left to right.
+
+Example 1
+
+  Input: $str = "The cat has 3 kittens 7 toys 10 beds"
+  Output: true
+
+  Numbers 3, 7, 10 - strictly increasing.
+
+Example 2
+
+  Input: $str = 'Alice bought 5 apples 2 oranges 9 bananas'
+  Output: false
+
+Example 3
+
+  Input: $str = 'I ran 1 mile 2 days 3 weeks 4 months'
+  Output: true
+
+Example 4
+
+  Input: $str = 'Bob has 10 cars 10 bikes'
+  Output: false
+
+Example 5
+
+  Input: $str = 'Zero is 0 one is 1 two is 2'
+  Output: true
+
+=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 is entered on the command-line. The string comprises a space-
+   separated list of words and numbers.
+
+Notes
+-----
+1. The requirement that a word token "consist[s] of lowercase English letters"
+   is contradicted by the first word in every Example. I have broadened the
+   requirement to just "English letters" (of either case).
+2. When an input token is found which does not match the requirements for either
+   a number or a word, a warning is issued and the token is ignored.
+   
+=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 comprising a space-separated list of words and numbers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 340, Task #2: Ascending Numbers (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str = $ARGV[0];
+
+        print  qq[Input:  \$str = "$str"\n];
+
+        my $ascending = check_ascending( $str );
+
+        printf "Output: %s\n", $ascending ? 'true' : 'false';
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub check_ascending
+#-------------------------------------------------------------------------------
+{
+    my ($str)     = @_;
+    my  $last_num = -1;
+
+    for my $token (split / \s+ /x, $str)
+    {
+        if    ($token =~ / ^ ( 0 | [1-9] \d* ) $ /x)
+        {
+            my $num = $1;
+
+            return '' unless $num > $last_num;
+
+            $last_num = $num;
+        }
+        elsif ($token !~ / ^ [A-Za-z]+ $ /x)
+        {
+            print qq[WARNING: Ignoring invalid token "$token"\n];
+        }
+    }
+
+    return 1;
+}
+
+#-------------------------------------------------------------------------------
+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 $ascending = check_ascending( $str );
+        my $asc_str   = $ascending ? 'true' : 'false';
+
+        is $asc_str, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|The cat has 3 kittens 7 toys 10 beds     |true
+Example 2|Alice bought 5 apples 2 oranges 9 bananas|false
+Example 3|I ran 1 mile 2 days 3 weeks 4 months     |true
+Example 4|Bob has 10 cars 10 bikes                 |false
+Example 5|Zero is 0 one is 1 two is 2              |true
diff --git a/challenge-340/athanasius/raku/ch-1.raku b/challenge-340/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..bf0e6f17f3
--- /dev/null
+++ b/challenge-340/athanasius/raku/ch-1.raku
@@ -0,0 +1,177 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 340
+=========================
+
+TASK #1
+-------
+*Duplicate Removals*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, consisting of lowercase English letters.
+
+Write a script to return the final string after all duplicate removals have been
+made. Repeat duplicate removals on the given string until we no longer can.
+
+    A duplicate removal consists of choosing two adjacent and equal letters and
+    removing them.
+
+Example 1
+
+  Input: $str = 'abbaca'
+  Output: 'ca'
+
+  Step 1: Remove 'bb' => 'aaca'
+  Step 2: Remove 'aa' => 'ca'
+
+Example 2
+
+  Input: $str = 'azxxzy'
+  Output: 'ay'
+
+  Step 1: Remove 'xx' => 'azzy'
+  Step 2: Remove 'zz' => 'ay'
+
+Example 3
+
+  Input: $str = 'aaaaaaaa'
+  Output: ''
+
+  Step 1: Remove 'aa' => 'aaaaaa'
+  Step 2: Remove 'aa' => 'aaaa'
+  Step 3: Remove 'aa' => 'aa'
+  Step 4: Remove 'aa' => ''
+
+Example 4
+
+  Input: $str = 'aabccba'
+  Output: 'a'
+
+  Step 1: Remove 'aa' => 'bccba'
+  Step 2: Remove 'cc' => 'bba'
+  Step 3: Remove 'bb' => 'a'
+
+Example 5
+
+  Input: $str = 'abcddcba'
+  Output: ''
+
+  Step 1: Remove 'dd' => 'abccba'
+  Step 2: Remove 'cc' => 'abba'
+  Step 3: Remove 'bb' => 'aa'
+  Step 4: Remove 'aa' => ''
+
+=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 of lowercase English letters is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 340, Task #1: Duplicate Removals (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A string of lowercase English letters
+
+    Str:D $str where { / ^ <.lower>* $ / }
+)
+#===============================================================================
+{
+    "Input:  \$str = '$str'".put;
+
+    my Str $no-dups = remove-duplicates( $str );
+
+    "Output: '$no-dups'".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub remove-duplicates( Str:D $str where { / ^ <.lower>* $ / } --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $no-dups = $str;
+
+    Nil while $no-dups ~~ s/ (.) $0 //;
+
+    return $no-dups;
+}
+
+#-------------------------------------------------------------------------------
+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 $no-dups = remove-duplicates( $str );
+
+        is $no-dups, $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|abbaca  |ca
+        Example 2|azxxzy  |ay
+        Example 3|aaaaaaaa|
+        Example 4|aabccba |a
+        Example 5|abcddcba|
+        END
+}
+
+################################################################################
diff --git a/challenge-340/athanasius/raku/ch-2.raku b/challenge-340/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..80b6ab93ad
--- /dev/null
+++ b/challenge-340/athanasius/raku/ch-2.raku
@@ -0,0 +1,182 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 340
+=========================
+
+TASK #2
+-------
+*Ascending Numbers*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, is a list of tokens separated by a single space.
+Every token is either a positive number consisting of digits 0-9 with no leading
+zeros, or a word consisting of lowercase English letters.
+
+Write a script to check if all the numbers in the given string are strictly
+increasing from left to right.
+
+Example 1
+
+  Input: $str = "The cat has 3 kittens 7 toys 10 beds"
+  Output: true
+
+  Numbers 3, 7, 10 - strictly increasing.
+
+Example 2
+
+  Input: $str = 'Alice bought 5 apples 2 oranges 9 bananas'
+  Output: false
+
+Example 3
+
+  Input: $str = 'I ran 1 mile 2 days 3 weeks 4 months'
+  Output: true
+
+Example 4
+
+  Input: $str = 'Bob has 10 cars 10 bikes'
+  Output: false
+
+Example 5
+
+  Input: $str = 'Zero is 0 one is 1 two is 2'
+  Output: true
+
+=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 is entered on the command-line. The string comprises a space-
+   separated list of words and numbers.
+
+Notes
+-----
+1. The requirement that a word token "consist[s] of lowercase English letters"
+   is contradicted by the first word in every Example. I have broadened the
+   requirement to just "English letters" (of either case).
+2. When an input token is found which does not match the requirements for either
+   a number or a word, a warning is issued and the token is ignored.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 340, Task #2: Ascending Numbers (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A string comprising a space-separated list of words and numbers
+
+    Str:D $str
+)
+#===============================================================================
+{
+    qq[Input:  \$str = "$str"].put;
+
+    my Bool $ascending = check-ascending( $str );
+
+    "Output: %s\n".printf: $ascending ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub check-ascending( Str:D $str --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my Int $last-num = -1;
+
+    for $str.split( / \s+ /, :skip-empty ) -> Str $token
+    {
+        if    $token  ~~ / ^ ( 0 || <[ 1..9 ]> \d* ) $ /
+        {
+            my UInt $num = $0.Int;
+
+            return False unless $num > $last-num;
+
+            $last-num = $num;
+        }
+        elsif $token !~~ / ^ <[ A..Z a..z ]>+ $ /
+        {
+            qq[WARNING: Ignoring invalid token "$token"].put;
+        }
+    }
+
+    return True;
+}
+
+#-------------------------------------------------------------------------------
+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 Bool $ascending = check-ascending( $str );
+        my Str  $asc-str   = $ascending ?? 'true' !! 'false';
+
+        is $asc-str, $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|The cat has 3 kittens 7 toys 10 beds     |true
+        Example 2|Alice bought 5 apples 2 oranges 9 bananas|false
+        Example 3|I ran 1 mile 2 days 3 weeks 4 months     |true
+        Example 4|Bob has 10 cars 10 bikes                 |false
+        Example 5|Zero is 0 one is 1 two is 2              |true
+        END
+}
+
+################################################################################