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

4 files changed, 768 insertions, 0 deletions

diff --git a/challenge-275/athanasius/perl/ch-1.pl b/challenge-275/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..b343889cdb
--- /dev/null
+++ b/challenge-275/athanasius/perl/ch-1.pl
@@ -0,0 +1,190 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 275
+=========================
+
+TASK #1
+-------
+*Broken Keys*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a sentence, $sentence and list of broken keys @keys.
+
+Write a script to find out how many words can be typed fully.
+
+Example 1
+
+  Input: $sentence = "Perl Weekly Challenge", @keys = ('l', 'a')
+  Output: 0
+
+Example 2
+
+  Input: $sentence = "Perl and Raku", @keys = ('a')
+  Output: 1
+
+  Only Perl since the other word two words contain 'a' and can't be typed fully.
+
+Example 3
+
+  Input: $sentence = "Well done Team PWC", @keys = ('l', 'o')
+  Output: 2
+
+Example 4
+
+  Input: $sentence = "The joys of polyglottism", @keys = ('T')
+  Output: 2
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. 
+
+=cut
+#===============================================================================
+
+use v5.32.1;      # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my %TWIN_KEYS =>
+( 
+    '`' => '~',  1  => '!',  2  => '@',  3   => '#',  4  => '$', 5   => '%',
+     6  => '^',  7  => '&',  8  => '*',  9   => '(',  0  => ')', '-' => '_',
+    '=' => '+', '[' => '{', ']' => '}', '\\' => '|', ';' => ':', "'" => '"',
+    ',' => '<', '.' => '>', '/' => '?'
+);
+const my %TWIN  => %TWIN_KEYS, reverse %TWIN_KEYS;
+const my $USAGE => <<END;
+Usage:
+  perl $0 <sentence> <broken-keys>
+  perl $0
+
+    <sentence>       A sentence
+    <broken-keys>    A string comprising a list of broken keys
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 275, Task #1: Broken Keys (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($sentence, $broken_keys) = @ARGV;
+        my  @keys = split //, $broken_keys;
+
+        printf qq[Input:  \$sentence = "%s", \@keys = (%s)\n],
+               $sentence, join ', ', map { qq['$_'] } @keys;
+
+        my $count = can_be_typed( $sentence, \@keys );
+
+        print "Output: $count\n";
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub can_be_typed
+#-------------------------------------------------------------------------------
+{
+    my ($sentence, $keys) = @_;
+    my  $count            = 0;
+    my  @words            = split / \s+ /x, $sentence;
+    my  @broken_keys      = @$keys;
+
+    for my $key (@$keys)
+    {
+        push @broken_keys, $TWIN{ $key } if exists $TWIN{ $key };
+    }
+
+    my $re_str = join '|', map { "\Q$_\E" } @broken_keys;
+    my $broken = qr/ $re_str /ix;
+
+    for my $word (@words)
+    {
+        ++$count if $word =~ / \w /x && $word !~ $broken;
+    }
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $sentence, $keys_str, $expected) =
+             split / \| /x, $line;
+
+        for ($test_name, $sentence, $keys_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @keys  = split //, $keys_str;
+        my $count = can_be_typed( $sentence, \@keys );
+
+        is $count, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1  |Perl Weekly Challenge   |la|0
+Example 2  |Perl and Raku           |a |1
+Example 3  |Well done Team PWC      |lo|2
+Example 4  |The joys of polyglottism|T |2
+Twin keys 1|Perl1 Weekly@ Challenge |!2|1
+Twin keys 2|Perl! Weekly2 Challenge |@1|1
diff --git a/challenge-275/athanasius/perl/ch-2.pl b/challenge-275/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..e4b1ab943e
--- /dev/null
+++ b/challenge-275/athanasius/perl/ch-2.pl
@@ -0,0 +1,204 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 275
+=========================
+
+TASK #2
+-------
+*Replace Digits*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an alphanumeric string, $str, where each character is either a
+letter or a digit.
+
+Write a script to replace each digit in the given string with the value of the
+previous letter plus (digit) places.
+
+Example 1
+
+  Input: $str = 'a1c1e1'
+  Output: 'abcdef'
+
+  shift('a', 1) => 'b'
+  shift('c', 1) => 'd'
+  shift('e', 1) => 'f'
+
+Example 2
+
+  Input: $str = 'a1b2c3d4'
+  Output: 'abbdcfdh'
+
+  shift('a', 1) => 'b'
+  shift('b', 2) => 'd'
+  shift('c', 3) => 'f'
+  shift('d', 4) => 'h'
+
+Example 3
+
+  Input: $str = 'b2b'
+  Output: 'bdb'
+
+Example 4
+
+  Input: $str = 'a16z'
+  Output: 'abgz'
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. The input string must begin with a letter.
+2. Case is maintained when replacing digits. For example, in "a1" the "1" is
+   replaced with "b", but in "A1" the "1" is replaced with "B".
+3. Replacement letters "wrap" around from "z" back to "a". For example, in "v9"
+   the "9" is replaced with "e" (counting 9 places from "v": w-x-y-z-a-b-c-d-e).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single alphanumeric string, beginning with a letter, is entered as an
+   unnamed (positional) argument on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $LETTERS  => ord( 'Z' ) - ord( 'A' ) + 1;
+const my $ALPHA    => qr/   [a-z]               /ix;
+const my $DIGIT    => qr/   [0-9]               /x;
+const my $ALPHANUM => qr/   $ALPHA || $DIGIT    /x;
+const my $STRING   => qr/ ^ $ALPHA $ALPHANUM* $ /x;
+const my $USAGE    => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    An alphanumeric string beginning with a letter
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 275, Task #2: Replace Digits (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str =  $ARGV[ 0 ];
+           $str =~ $STRING or error( 'Invalid input string' );
+
+        print "Input: \$str = '$str'\n";
+
+        my $replaced = replace_digits( $str );
+
+        print "Output:       '$replaced'\n";
+    }
+    else
+    {
+        error( "Expected 0 or 1 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub replace_digits
+#-------------------------------------------------------------------------------
+{
+    my ($str)      =  @_;
+        $str       =~ $STRING or die 'Invalid string argument';
+    my  @chars     =  split //, $str;
+    my  $last_char =  $chars[ 0 ];
+
+    for my $i (1 .. $#chars)
+    {
+        my $char = $chars[ $i ];
+
+        if ($char =~ $ALPHA)
+        {
+            $last_char   = $char;
+        }
+        else
+        {
+            my $max_char = ('A' le $last_char le 'Z') ? 'Z' : 'z';
+            my $new_ord  = ord( $last_char ) + $char;
+               $new_ord -= $LETTERS if $new_ord > ord $max_char;
+
+            $chars[ $i ] = chr $new_ord;
+        }
+    }
+
+    return join '', @chars;
+}
+
+#-------------------------------------------------------------------------------
+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 $replaced = replace_digits( $str );
+
+        is $replaced, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1 |a1c1e1   |abcdef
+Example 2 |a1b2c3d4 |abbdcfdh
+Example 3 |b2b      |bdb
+Example 4 |a16z     |abgz
+Digit zero|a0e0i0o0u|aaeeiioou
+Wrap uc   |W57      |WBD
+Wrap lc   |w57      |wbd
diff --git a/challenge-275/athanasius/raku/ch-1.raku b/challenge-275/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..ea36ab31fe
--- /dev/null
+++ b/challenge-275/athanasius/raku/ch-1.raku
@@ -0,0 +1,181 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 275
+=========================
+
+TASK #1
+-------
+*Broken Keys*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a sentence, $sentence and list of broken keys @keys.
+
+Write a script to find out how many words can be typed fully.
+
+Example 1
+
+  Input: $sentence = "Perl Weekly Challenge", @keys = ('l', 'a')
+  Output: 0
+
+Example 2
+
+  Input: $sentence = "Perl and Raku", @keys = ('a')
+  Output: 1
+
+  Only Perl since the other word two words contain 'a' and can't be typed fully.
+
+Example 3
+
+  Input: $sentence = "Well done Team PWC", @keys = ('l', 'o')
+  Output: 2
+
+Example 4
+
+  Input: $sentence = "The joys of polyglottism", @keys = ('T')
+  Output: 2
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The input sentence is entered as an unnamed (positional) argument on the
+   command-line, followed by a string comprising a list of the broken keys.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my constant %TWIN-KEYS =
+{ 
+    '`' => '~',  1  => '!',  2  => '@',  3   => '#',  4  => '$', 5   => '%', 
+     6  => '^',  7  => '&',  8  => '*',  9   => '(',  0  => ')', '-' => '_',
+    '=' => '+', '[' => '{', ']' => '}', '\\' => '|', ';' => ':', "'" => '"',
+    ',' => '<', '.' => '>', '/' => '?'
+};
+my constant %TWIN = %TWIN-KEYS, %TWIN-KEYS.antipairs;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 275, Task #1: Broken Keys (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $sentence,                #= A sentence
+    Str:D $broken-keys              #= A string comprising a list of broken keys
+)
+#===============================================================================
+{
+    my Str @keys = $broken-keys.split: '', :skip-empty;
+
+    qq[Input:  \$sentence = "%s", \@keys = (%s)\n].printf:
+        $sentence, @keys.map( { qq['$_'] } ).join: ', ';
+
+    my UInt $count = can-be-typed( $sentence, @keys );
+
+    "Output: $count".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub can-be-typed( Str:D $sentence, List:D[Str:D] $keys --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $count       = 0;
+    my Str  @words       = $sentence.split: / \s+ /, :skip-empty;
+    my Str  @broken-keys = @$keys;
+
+    for @$keys -> Str $key
+    {
+        @broken-keys.push: %TWIN{ $key } if %TWIN{ $key }:exists;
+    }
+
+    my Str   $re-str = @broken-keys.map( { qq['$_'] } ).join: '||';
+    my Regex $broken = rx:i/ <$re-str> /;
+
+    for @words -> Str $word
+    {
+        ++$count if $word ~~ / \w / && $word !~~ $broken;
+    }
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $sentence, $keys-str, $expected) =
+                $line.split: / \| /;
+
+        for     $test-name, $sentence, $keys-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str  @keys  = $keys-str.split: '', :skip-empty;
+        my UInt $count = can-be-typed( $sentence, @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  |Perl Weekly Challenge   |la|0
+        Example 2  |Perl and Raku           |a |1
+        Example 3  |Well done Team PWC      |lo|2
+        Example 4  |The joys of polyglottism|T |2
+        Twin keys 1|Perl1 Weekly@ Challenge |!2|1
+        Twin keys 2|Perl! Weekly2 Challenge |@1|1
+        END
+}
+
+################################################################################
diff --git a/challenge-275/athanasius/raku/ch-2.raku b/challenge-275/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..ba48ee65f6
--- /dev/null
+++ b/challenge-275/athanasius/raku/ch-2.raku
@@ -0,0 +1,193 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 275
+=========================
+
+TASK #2
+-------
+*Replace Digits*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an alphanumeric string, $str, where each character is either a
+letter or a digit.
+
+Write a script to replace each digit in the given string with the value of the
+previous letter plus (digit) places.
+
+Example 1
+
+  Input: $str = 'a1c1e1'
+  Output: 'abcdef'
+
+  shift('a', 1) => 'b'
+  shift('c', 1) => 'd'
+  shift('e', 1) => 'f'
+
+Example 2
+
+  Input: $str = 'a1b2c3d4'
+  Output: 'abbdcfdh'
+
+  shift('a', 1) => 'b'
+  shift('b', 2) => 'd'
+  shift('c', 3) => 'f'
+  shift('d', 4) => 'h'
+
+Example 3
+
+  Input: $str = 'b2b'
+  Output: 'bdb'
+
+Example 4
+
+  Input: $str = 'a16z'
+  Output: 'abgz'
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. The input string must begin with a letter.
+2. Case is maintained when replacing digits. For example, in "a1" the "1" is
+   replaced with "b", but in "A1" the "1" is replaced with "B".
+3. Replacement letters "wrap" around from "z" back to "a". For example, in "v9"
+   the "9" is replaced with "e" (counting 9 places from "v": w-x-y-z-a-b-c-d-e).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single alphanumeric string, beginning with a letter, is entered as an
+   unnamed (positional) argument on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my UInt constant LETTERS = 'Z'.ord - 'A'.ord + 1;
+
+my regex alpha    {     :i <[ a .. z ]>     }
+my regex digit    {        <[ 0 .. 9 ]>     }
+my regex alphanum {   <alpha> || <digit>    }
+my regex string   { ^ <alpha> <alphanum>* $ }
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 275, Task #2: Replace Digits (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str where / <string> /     #= An alphanumeric string beginning with a
+                                      #= letter
+)
+#===============================================================================
+{
+    "Input: \$str = '$str'".put;
+
+    my Str $replaced = replace-digits( $str );
+
+    "Output:       '$replaced'".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub replace-digits( Str:D $str where / <string> / --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @chars     = $str.split: '', :skip-empty;
+    my Str $last-char = @chars[ 0 ];
+
+    for 1 .. @chars.end -> UInt $i
+    {
+        my Str $char = @chars[ $i ];
+
+        if $char ~~ / <alpha> /
+        {
+            $last-char = $char;
+        }
+        else
+        {
+            my Str  $max-char = ('A' le $last-char le 'Z') ?? 'Z' !! 'z';
+            my UInt $new-ord  = $last-char.ord + $char;
+                    $new-ord -= LETTERS if $new-ord > $max-char.ord;
+
+            @chars[ $i ] = $new-ord.chr;
+        }
+    }
+
+    return @chars.join: '';
+}
+
+#-------------------------------------------------------------------------------
+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 $replaced = replace-digits( $str );
+
+        is $replaced, $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 |a1c1e1   |abcdef
+        Example 2 |a1b2c3d4 |abbdcfdh
+        Example 3 |b2b      |bdb
+        Example 4 |a16z     |abgz
+        Digit zero|a0e0i0o0u|aaeeiioou
+        Wrap uc   |W57      |WBD
+        Wrap lc   |w57      |wbd
+        END
+}
+
+################################################################################