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

4 files changed, 733 insertions, 0 deletions

diff --git a/challenge-305/athanasius/perl/ch-1.pl b/challenge-305/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..b8ff87ef72
--- /dev/null
+++ b/challenge-305/athanasius/perl/ch-1.pl
@@ -0,0 +1,181 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 305
+=========================
+
+TASK #1
+-------
+*Binary Prefix*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a binary array.
+
+Write a script to return an array of booleans where the partial binary number up
+to that point is prime.
+
+Example 1
+
+  Input: @binary = (1, 0, 1)
+  Output: (false, true, true)
+
+  Sub-arrays (base-10):
+  (1): 1 - not prime
+  (1, 0): 2 - prime
+  (1, 0, 1): 5 - prime
+
+Example 2
+
+  Input: @binary = (1, 1, 0)
+  Output: (false, true, false)
+
+  Sub-arrays (base-10):
+  (1): 1 - not prime
+  (1, 1): 3 - prime
+  (1, 1, 0): 6 - not prime
+
+Example 3
+
+  Input: @binary = (1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1)
+  Output: (false, true, true, false, false, true, false, false, false, false,
+  false, false, false, false, false, false, false, false, false, true)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty binary string is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;            # Enables strictures
+use warnings;
+use Const::Fast;
+use Math::Prime::Util qw( is_prime );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  Usage:
+  perl $0 <digits>
+  perl $0
+
+    <digits>    A non-empty string of binary digits
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 305, Task #1: Binary Prefix (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $digits = $ARGV[ 0 ];
+
+        $digits =~ / ^ [01]+ $ /x
+               or error( qq["$digits" is not a valid string of binary digits] );
+
+        my @binary = split //, $digits;
+
+        printf "Input:  \@binary = (%s)\n", join ', ', @binary;
+
+        my $prime = binary_prefix( \@binary );
+
+        printf "Output: (%s)\n",
+                join ', ', map { $_ ? 'true' : 'false' } @$prime;
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub binary_prefix
+#-------------------------------------------------------------------------------
+{
+    my ($binary) = @_;
+    my  $bin_str = '';
+    my  @prime;
+
+    for my $digit (@$binary)
+    {
+        $bin_str .= $digit;
+
+        my $decimal = oct "0b$bin_str";
+
+        push @prime, is_prime( $decimal ) ? 1 : 0;
+    }
+
+    return \@prime;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $bin_str, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $bin_str, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @binary   = split //, $bin_str;
+        my @expected = split //, $exp_str;
+        my $prime    = binary_prefix( \@binary );
+
+        is_deeply $prime, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|101                 |011
+Example 2|110                 |010
+Example 3|11110100001010010001|01100100000000000001
diff --git a/challenge-305/athanasius/perl/ch-2.pl b/challenge-305/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..4f10b9b700
--- /dev/null
+++ b/challenge-305/athanasius/perl/ch-2.pl
@@ -0,0 +1,189 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 305
+=========================
+
+TASK #2
+-------
+*Alien Dictionary*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of words and alien dictionary character order.
+
+Write a script to sort lexicographically the given list of words based on the
+alien dictionary characters.
+
+Example 1
+
+  Input: @words = ("perl", "python", "raku")
+         @alien = qw/h l a b y d e f g i r k m n o p q j s t u v w x c z/
+  Output: ("raku", "python", "perl")
+
+Example 2
+
+  Input: @words = ("the", "weekly", "challenge")
+         @alien = qw/c o r l d a b t e f g h i j k m n p q s w u v x y z/
+  Output: ("challenge", "the", "weekly")
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. The alien dictionary comprises a subset of the printable ASCII character set,
+   and may include upper- and lower-case letters, digits, and punctuation, but
+   not the space or tab characters.
+2. Sorting is case-sensitive. For example, if "A" and "a" both appear in the
+   list of words to be sorted, they must have separate entries in the alien
+   dictionary.
+3. Duplicate characters in the alien dictionary are ignored; only the first such
+   character is used in establishing the lexicographical order.
+4. The words to be sorted must be composed entirely of characters in the alien
+   dictionary.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string comprising the alien dictionary is entered on the command-line,
+   followed by a non-empty list of words to be sorted. Whitespace within the
+   alien dictionary string is optional, and will be ignored.
+
+=cut
+#===============================================================================
+
+use v5.32;       # Enables strictures and warnings
+use Const::Fast;
+use List::Util   qw( max );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <alien> [<words> ...]
+  perl $0
+
+    <alien>          A string comprising an alien dictionary
+    [<words> ...]    A non-empty list of words to be sorted
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 305, Task #2: Alien Dictionary (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        error( "Expected 0 or 2+ command-line arguments, found 1" )
+    }
+    else
+    {
+        my ($alien, @words) = @ARGV;
+
+        my @alien = grep { / ^ \S $ /x } split '', $alien;
+
+        printf "Input: \@words = (%s)\n",   join ', ', map { qq["$_"] } @words;
+        printf "       \@alien = qw/%s/\n", join ' ',  @alien;
+
+        my $sorted = alien_sort( \@alien, \@words );
+
+        printf "Output: (%s)\n", join ', ', map { qq["$_"] } @$sorted;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub alien_sort
+#-------------------------------------------------------------------------------
+{
+    my ($alien, $words) = @_;
+    my  $index = 1;
+    my  %char_dict;
+
+    exists $char_dict{ $_ } or $char_dict{ $_ } = $index++ for @$alien;
+
+    my $alt     = join '|', @$alien;
+    my $max_len = max( map { length } @$words );
+    my %word_dict;
+
+    for my $word (@$words)
+    {
+        $word =~ / ^ (?: $alt )+ $ /x or
+            error( qq[Invalid character found in word "$word"] );
+
+        my $score  = '';
+           $score .= sprintf '%03s', $char_dict{ $_ } for split //, $word;
+           $score .= '000' for 1 .. $max_len - length $word;
+
+        $word_dict{ $word } = $score;
+    }
+
+    return [ sort { $word_dict{ $a } <=> $word_dict{ $b } } @$words ];
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $words_str, $alien_str, $exptd_str) =
+             split / \| /x, $line;
+
+        for ($test_name, $words_str, $alien_str, $exptd_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @alien    = grep { / ^ \S $ /x } split //, $alien_str;
+        my @words    = split / \s+ /x, $words_str;
+        my @expected = split / \s+ /x, $exptd_str;
+        my $sorted   = alien_sort( \@alien, \@words );
+
+        is_deeply $sorted, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|perl python raku    |hlabydefgirkmnopqjstuvwxcz|raku python perl
+Example 2|the weekly challenge|corldabtefghijkmnpqswuvxyz|challenge the weekly
+Lengths  |butte but butter    |rtube                     |but butte butter
diff --git a/challenge-305/athanasius/raku/ch-1.raku b/challenge-305/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..4f45edeb0e
--- /dev/null
+++ b/challenge-305/athanasius/raku/ch-1.raku
@@ -0,0 +1,167 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 305
+=========================
+
+TASK #1
+-------
+*Binary Prefix*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a binary array.
+
+Write a script to return an array of booleans where the partial binary number up
+to that point is prime.
+
+Example 1
+
+  Input: @binary = (1, 0, 1)
+  Output: (false, true, true)
+
+  Sub-arrays (base-10):
+  (1): 1 - not prime
+  (1, 0): 2 - prime
+  (1, 0, 1): 5 - prime
+
+Example 2
+
+  Input: @binary = (1, 1, 0)
+  Output: (false, true, false)
+
+  Sub-arrays (base-10):
+  (1): 1 - not prime
+  (1, 1): 3 - prime
+  (1, 1, 0): 6 - not prime
+
+Example 3
+
+  Input: @binary = (1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1)
+  Output: (false, true, true, false, false, true, false, false, false, false,
+  false, false, false, false, false, false, false, false, false, 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 non-empty binary string is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset BinStr of Str where / ^ <[ 0 1 ]>+ $ /;
+subset Bin    of Int where 0 | 1;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 305, Task #1: Binary Prefix (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    BinStr:D $digits,          #= A non-empty string of binary digits
+)
+#===============================================================================
+{
+    my Bin @binary = $digits.split( '', :skip-empty ).map: { .Int };
+
+    "Input:  \@binary = (%s)\n".printf: @binary.join: ', ';
+
+    my Bool @prime = binary-prefix( @binary );
+
+    "Output: (%s)\n".printf: @prime.map( { $_ ?? 'true' !! 'false' } )\
+                                   .join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub binary-prefix( List:D[Bin:D] $binary --> List:D[Bool:D] )
+#-------------------------------------------------------------------------------
+{
+    my Bool @prime;
+    my Str  $bin-str = '';
+
+    for @$binary -> Bin $digit
+    {
+        $bin-str ~= $digit;
+
+        my UInt $decimal = ":2<$bin-str>".Int;
+
+        @prime.push: $decimal.is-prime;
+    }
+
+    return @prime;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $bin-str, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $bin-str, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Bin  @binary  = $bin-str.split( '', :skip-empty ).map: { .Int };
+        my Bool @expectd = $exp-str.split( '', :skip-empty ).map: { $_ eq '1' };
+        my Bool @prime   = binary-prefix( @binary );
+
+        is-deeply @prime, @expectd, $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|101                 |011
+        Example 2|110                 |010
+        Example 3|11110100001010010001|01100100000000000001
+        END
+}
+
+################################################################################
diff --git a/challenge-305/athanasius/raku/ch-2.raku b/challenge-305/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..ac53023e64
--- /dev/null
+++ b/challenge-305/athanasius/raku/ch-2.raku
@@ -0,0 +1,196 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 305
+=========================
+
+TASK #2
+-------
+*Alien Dictionary*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of words and alien dictionary character order.
+
+Write a script to sort lexicographically the given list of words based on the
+alien dictionary characters.
+
+Example 1
+
+  Input: @words = ("perl", "python", "raku")
+         @alien = qw/h l a b y d e f g i r k m n o p q j s t u v w x c z/
+  Output: ("raku", "python", "perl")
+
+Example 2
+
+  Input: @words = ("the", "weekly", "challenge")
+         @alien = qw/c o r l d a b t e f g h i j k m n p q s w u v x y z/
+  Output: ("challenge", "the", "weekly")
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. The alien dictionary comprises a subset of the printable ASCII character set,
+   and may include upper- and lower-case letters, digits, and punctuation, but
+   not the space or tab characters.
+2. Sorting is case-sensitive. For example, if "A" and "a" both appear in the
+   list of words to be sorted, they must have separate entries in the alien
+   dictionary.
+3. Duplicate characters in the alien dictionary are ignored; only the first such
+   character is used in establishing the lexicographical order.
+4. The words to be sorted must be composed entirely of characters in the alien
+   dictionary.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string comprising the alien dictionary is entered on the command-line,
+   followed by a non-empty list of words to be sorted. Whitespace within the
+   alien dictionary string is optional, and will be ignored.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Char of Str where { / ^ \S $ / };
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 305, Task #2: Alien Dictionary (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $alien,                     #= A string comprising an alien dictionary
+         *@words where { .elems > 0 } #= A non-empty list of words to be sorted
+)
+#===============================================================================
+{
+    my Char @alien = $alien.split( '', :skip-empty ).grep: { $_ ~~ Char:D };
+
+    "Input: \@words = (%s)\n"\ .printf: @words.map( { qq["$_"] } ).join: ', ';
+    "       \@alien = qw/%s/\n".printf: @alien.join: ' ';
+
+    my Str @sorted = alien-sort( @alien, @words );
+
+    "Output: (%s)\n".printf: @sorted.map( { qq["$_"] } ).join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub alien-sort( List:D[Char:D] $alien, List:D[Str:D] $words --> Seq:D[Str:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt $index = 1;
+    my UInt %char-dict{Char};
+            %char-dict{ $_ }:exists or %char-dict{ $_ } = $index++ for @$alien;
+
+    my Str  $alt     = $alien.join: '|';
+    my UInt $max-len = $words.map( { .chars } ).max;
+    my UInt %word-dict{Str};
+
+    for @$words -> Str $word
+    {
+        $word ~~ / ^ [ <{ $alt }> ]+ $ / or
+            error( qq[Invalid character found in word "$word"] );
+
+        my Str $score  = '';
+               $score ~= '%03s'.sprintf: %char-dict{ $_ }
+                                               for $word.split: '', :skip-empty;
+               $score ~= '000' for 1 .. $max-len - $word.chars;
+
+        %word-dict{ $word } = $score.Int;
+    }
+
+    return $words.sort: { %word-dict{ $^a } <=> %word-dict{ $^b } };
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $words-str, $alien-str, $exptd-str) =
+                $line.split: / \| /;
+
+        for     $test-name, $words-str, $alien-str, $exptd-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Char @alien    = $alien-str.split( '', :skip-empty )\
+                                      .grep: { $_ ~~ Char:D };
+        my Str  @words    = $words-str.split: / \s+ /, :skip-empty;
+        my Str  @expected = $exptd-str.split: / \s+ /, :skip-empty;
+        my Str  @sorted   = alien-sort( @alien, @words );
+
+        is-deeply @sorted, @expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $data = q:to/END/;
+        Example 1|perl python raku    |hlabydefgirkmnopqjstuvwxcz              \
+                 |raku python perl
+        Example 2|the weekly challenge|corldabtefghijkmnpqswuvxyz              \
+                 |challenge the weekly
+        Lengths  |butte but butter    |rtube                                   \
+                 |but butte butter
+        END
+
+    return S:g/ \s* \\ \n \s* // given $data;
+}
+
+################################################################################