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

4 files changed, 710 insertions, 0 deletions

diff --git a/challenge-341/athanasius/perl/ch-1.pl b/challenge-341/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..3f3d6e2bbe
--- /dev/null
+++ b/challenge-341/athanasius/perl/ch-1.pl
@@ -0,0 +1,184 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 341
+=========================
+
+TASK #1
+-------
+*Broken Keyboard*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing English letters only and also you are given
+broken keys.
+
+Write a script to return the total words in the given sentence can be typed
+completely.
+
+Example 1
+
+  Input: $str = 'Hello World', @keys = ('d')
+  Output: 1
+
+  With broken key 'd', we can only type the word 'Hello'.
+
+Example 2
+
+  Input: $str = 'apple banana cherry', @keys = ('a', 'e')
+  Output: 0
+
+Example 3
+
+  Input: $str = 'Coding is fun', @keys = ()
+  Output: 3
+
+  No keys broken.
+
+Example 4
+
+  Input: $str = 'The Weekly Challenge', @keys = ('a','b')
+  Output: 2
+
+Example 5
+
+  Input: $str = 'Perl and Python', @keys = ('p')
+  Output: 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 is entered on the command-line, followed by a list of broken keys.
+   The string comprises English letters and whitespace; each broken key is a
+   single English letter.
+
+=cut
+#===============================================================================
+
+use v5.38.2;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str> [<keys> ...]
+  perl $0
+
+    <str>           A single string of English letters (with whitespace)
+    [<keys> ...]    A list of broken keys
+END
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 341, Task #1: Broken Keyboard (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($str, @keys) = @ARGV;
+
+        $str =~  / ^ [A-Za-z\s]* $ /x or error( qq[Invalid string "$str"] );
+
+        for my $key (@keys)
+        {
+            $key =~ / ^ [A-Za-z] $ /x or error( qq[Invalid key "$key"] );
+        }
+
+        printf "Input:  \$str = '$str', \@keys = (%s)\n",
+                join ', ', map { "'$_'" } @keys;
+
+        my $count = count_typeable_words( $str, \@keys );
+
+        print  "Output: $count\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub count_typeable_words
+#-------------------------------------------------------------------------------
+{
+    my ($str, $keys) = @_;
+    my  $count       = 0;
+    my  @words       = split / \s+ /x, $str;
+
+    L_WORDS:
+    for my $word (@words)
+    {
+        for my $key (@$keys)
+        {
+            next L_WORDS if $word =~ / $key /ix;
+        }
+
+        ++$count;
+    }
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $keys_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $keys_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @keys  = split / \s+ /x, $keys_str;
+        my $count = count_typeable_words( $str, \@keys );
+
+        is $count, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|Hello World         |d  |1
+Example 2|apple banana cherry |a e|0
+Example 3|Coding is fun       |   |3
+Example 4|The Weekly Challenge|a b|2
+Example 5|Perl and Python     |p  |1
diff --git a/challenge-341/athanasius/perl/ch-2.pl b/challenge-341/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..494d24d7a6
--- /dev/null
+++ b/challenge-341/athanasius/perl/ch-2.pl
@@ -0,0 +1,176 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 341
+=========================
+
+TASK #2
+-------
+*Reverse Prefix*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str and a character in the given string, $char.
+
+Write a script to reverse the prefix upto the first occurrence of the given
+$char in the given string $str and return the new string.
+
+Example 1
+
+  Input: $str = "programming", $char = "g"
+  Output: "gorpramming"
+
+  Reverse of prefix "prog" is "gorp".
+
+Example 2
+
+  Input: $str = "hello", $char = "h"
+  Output: "hello"
+
+Example 3
+
+  Input: $str = "abcdefghij", $char = "h"
+  Output: "hgfedcbaij"
+
+Example 4
+
+  Input: $str = "reverse", $char = "s"
+  Output: "srevere"
+
+Example 5
+
+  Input: $str = "perl", $char = "r"
+  Output: "repl"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+Characters are case-sensitive.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty string is entered on the command-line, followed by a single
+   character in the given string.
+   
+=cut
+#===============================================================================
+
+use v5.38.2;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str> <char>
+  perl $0
+
+    <str>     A non-empty string
+    <char>    A character in the given string
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 341, Task #2: Reverse Prefix (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($str, $char) = @ARGV;
+
+        length( $str  ) >  0 or error( 'The input string is empty' );
+        length( $char ) == 1 or error( qq["$char" is not a character] );
+
+        $str =~ /$char/
+            or error( qq["$char" is not a character in the string "$str"] );
+
+        print qq[Input: \$str = "$str", \$char = "$char"\n];
+
+        my $rev = reverse_prefix( $str, $char );
+
+        print qq[Output:       "$rev"\n];
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub reverse_prefix
+#-------------------------------------------------------------------------------
+{
+    my ($str, $char)   = @_;
+    my ($first, $last) = split /$char/, $str, 2;
+
+    return $char . reverse( $first ) . $last;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $char, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $char, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $rev = reverse_prefix( $str, $char );
+
+        is $rev, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|programming|g|gorpramming
+Example 2|hello      |h|hello
+Example 3|abcdefghij |h|hgfedcbaij
+Example 4|reverse    |s|srevere
+Example 5|perl       |r|repl
diff --git a/challenge-341/athanasius/raku/ch-1.raku b/challenge-341/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..ce9e33ced5
--- /dev/null
+++ b/challenge-341/athanasius/raku/ch-1.raku
@@ -0,0 +1,182 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 341
+=========================
+
+TASK #1
+-------
+*Broken Keyboard*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing English letters only and also you are given
+broken keys.
+
+Write a script to return the total words in the given sentence can be typed
+completely.
+
+Example 1
+
+  Input: $str = 'Hello World', @keys = ('d')
+  Output: 1
+
+  With broken key 'd', we can only type the word 'Hello'.
+
+Example 2
+
+  Input: $str = 'apple banana cherry', @keys = ('a', 'e')
+  Output: 0
+
+Example 3
+
+  Input: $str = 'Coding is fun', @keys = ()
+  Output: 3
+
+  No keys broken.
+
+Example 4
+
+  Input: $str = 'The Weekly Challenge', @keys = ('a','b')
+  Output: 2
+
+Example 5
+
+  Input: $str = 'Perl and Python', @keys = ('p')
+  Output: 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 is entered on the command-line, followed by a list of broken keys.
+   The string comprises English letters and whitespace; each broken key is a
+   single English letter.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 341, Task #1: Broken Keyboard (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A single string of English letters (with whitespace)
+
+    Str:D $str  where {         / ^ <[ A..Z a..z \s ]>* $ / },
+
+    #| A list of broken keys
+
+         *@keys where { .all ~~ / ^ <[ A..Z a..z    ]>  $ / }
+)
+#===============================================================================
+{
+    "Input:  \$str = '$str', \@keys = (%s)\n".printf:
+              @keys.map( { "'$_'" } ).join: ', ';
+
+    my UInt $count = count-typeable-words( $str, @keys );
+
+    "Output: $count".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub count-typeable-words
+(
+    Str:D         $str  where {         / ^ <[ A..Z a..z \s ]>* $ / },
+    List:D[Str:D] $keys where { .all ~~ / ^ <[ A..Z a..z    ]>  $ / }
+--> UInt:D
+)
+#-------------------------------------------------------------------------------
+{
+    my UInt $count = 0;
+    my Str  @words = $str.split: / \s+ /, :skip-empty;
+
+    L-WORDS:
+    for @words -> Str $word
+    {
+        for @$keys -> Str $key
+        {
+            next L-WORDS if $word ~~ / :i $key /;
+        }
+
+        ++$count;
+    }
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $keys-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $keys-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str  @keys  = $keys-str.split: / \s+ /, :skip-empty;
+        my UInt $count = count-typeable-words( $str, @keys );
+
+        is $count, $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|Hello World         |d  |1
+        Example 2|apple banana cherry |a e|0
+        Example 3|Coding is fun       |   |3
+        Example 4|The Weekly Challenge|a b|2
+        Example 5|Perl and Python     |p  |1
+        END
+}
+
+################################################################################
diff --git a/challenge-341/athanasius/raku/ch-2.raku b/challenge-341/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..5b980ab89c
--- /dev/null
+++ b/challenge-341/athanasius/raku/ch-2.raku
@@ -0,0 +1,168 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 341
+=========================
+
+TASK #2
+-------
+*Reverse Prefix*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str and a character in the given string, $char.
+
+Write a script to reverse the prefix upto the first occurrence of the given
+$char in the given string $str and return the new string.
+
+Example 1
+
+  Input: $str = "programming", $char = "g"
+  Output: "gorpramming"
+
+  Reverse of prefix "prog" is "gorp".
+
+Example 2
+
+  Input: $str = "hello", $char = "h"
+  Output: "hello"
+
+Example 3
+
+  Input: $str = "abcdefghij", $char = "h"
+  Output: "hgfedcbaij"
+
+Example 4
+
+  Input: $str = "reverse", $char = "s"
+  Output: "srevere"
+
+Example 5
+
+  Input: $str = "perl", $char = "r"
+  Output: "repl"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+Characters are case-sensitive.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty string is entered on the command-line, followed by a single
+   character in the given string.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 341, Task #2: Reverse Prefix (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty string
+
+    Str:D $str  where { .chars >  0 },
+
+    #| A character in the given string
+
+    Str:D $char where { .chars == 1 && $str ~~ / $char / }
+)
+#===============================================================================
+{
+    qq[Input: \$str = "$str", \$char = "$char"].put;
+
+    my Str $rev = reverse-prefix( $str, $char );
+
+    qq[Output:       "$rev"].put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub reverse-prefix
+(
+    Str:D $str  where { .chars >  0 },
+    Str:D $char where { .chars == 1 && $str ~~ / $char / }
+--> Str:D
+)
+#-------------------------------------------------------------------------------
+{
+    my Str ($first, $last) = $str.split: $char, 2;
+
+    return $char ~ $first.flip ~ $last;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $char, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $char, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $rev = reverse-prefix( $str, $char );
+
+        is $rev, $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|programming|g|gorpramming
+        Example 2|hello      |h|hello
+        Example 3|abcdefghij |h|hgfedcbaij
+        Example 4|reverse    |s|srevere
+        Example 5|perl       |r|repl
+        END
+}
+
+################################################################################