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

4 files changed, 716 insertions, 0 deletions

diff --git a/challenge-278/athanasius/perl/ch-1.pl b/challenge-278/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..0416f377ce
--- /dev/null
+++ b/challenge-278/athanasius/perl/ch-1.pl
@@ -0,0 +1,189 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 278
+=========================
+
+TASK #1
+-------
+*Sort String*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a shuffle string, $str.
+
+Write a script to return the sorted string.
+
+    A string is shuffled by appending word position to each word.
+
+Example 1
+
+  Input: $str = "and2 Raku3 cousins5 Perl1 are4"
+  Output: "Perl and Raku are cousins"
+
+Example 2
+
+  Input: $str = "guest6 Python1 most4 the3 popular5 is2 language7"
+  Output: "Python is the most popular guest language"
+
+Example 3
+
+  Input: $str = "Challenge3 The1 Weekly2"
+  Output: "The Weekly Challenge"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A "shuffle[d] string" is entered as a single argument on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    Shuffled string in which each word has its position appended
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 278, Task #1: Sort String (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 $sorted = sort_sentence( $str );
+
+        print qq[Output:       "$sorted"\n];
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub sort_sentence
+#-------------------------------------------------------------------------------
+{
+    my ($str)   = @_;
+    my  @words  = split / \s+ /x, $str;
+    my  @sorted = (undef) x scalar @words;
+
+    for my $shuffle_word (@words)
+    {
+        $shuffle_word =~ / ^ ( .* \D ) ( \d+ ) $ /x
+            or  error( qq[\n"$shuffle_word" is not a valid shuffle word] );
+
+        my ($word, $ord) = ($1, $2);
+
+        $ord =~ / ^ $RE{num}{int} $ /x
+            or  error( qq["$shuffle_word" does not end in a valid integer] );
+
+        $ord > 0
+            or  error( qq["$shuffle_word" does not end in a positive integer] );
+
+        defined $sorted[ $ord ]
+            and error( "Duplicate position $ord found" );
+
+        $sorted[ $ord ] = $word;
+    }
+
+    for my $i (1 .. $#sorted)
+    {
+        defined $sorted[ $i ]
+            or  error( "No word found for position $i" );
+    }
+
+    return join ' ', @sorted[ 1 .. $#sorted ];
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        while ($line =~ / \\ $ /x)
+        {
+            $line =~ s/ \\ $ / /x;
+
+            my $next = <DATA>;
+
+            $next =~ s/ ^ \s+ //x;
+            $line .= $next;
+        }
+
+        my  ($test_name, $str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $sorted = sort_sentence( $str );
+
+        is $sorted, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|and2 Raku3 cousins5 Perl1 are4|Perl and Raku are cousins
+Example 2|guest6 Python1 most4 the3 popular5 is2 language7                     \
+         |Python is the most popular guest language
+Example 3|Challenge3 The1 Weekly2|The Weekly Challenge
diff --git a/challenge-278/athanasius/perl/ch-2.pl b/challenge-278/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..15c40daf8c
--- /dev/null
+++ b/challenge-278/athanasius/perl/ch-2.pl
@@ -0,0 +1,176 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 278
+=========================
+
+TASK #2
+-------
+*Reverse Word*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a word, $word and a character, $char.
+
+Write a script to replace the substring up to and including $char with its
+characters sorted alphabetically. If the $char doesn't exist then DON'T do
+anything.
+
+Example 1
+
+  Input: $str = "challenge", $char = "e"
+  Output: "acehllnge"
+
+Example 2
+
+  Input: $str = "programming", $char = "a"
+  Output: "agoprrmming"
+
+Example 3
+
+  Input: $str = "champion", $char = "b"
+  Output: "champion"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. From Example 1 it appears that the substring to be sorted extends from the
+   start of $word up to (and including) the FIRST occurrence of $char ONLY.
+2. Character-matching is case-sensitive, so, e.g., "E" does NOT match "e".
+3. In alphabetical sorting, "Z" comes before "a".
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A word and a single character are entered as two positional arguments on the
+   command-line.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <word> <char>
+  perl $0
+
+    <word>    A word
+    <char>    A single character
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 278, Task #2: Reverse Word (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($word, $char) = @ARGV;
+
+        length $char == 1 or error( qq[Invalid character "$char"] );
+
+        print qq[Input: \$word = "$word", \$char = "$char"\n];
+
+        my $reversed = reverse_word( $word, $char );
+
+        print qq[Output:        "$reversed"\n];
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub reverse_word
+#-------------------------------------------------------------------------------
+{
+    my ($word, $char) = @_;
+
+    length $char == 1 or die qq[Invalid character "$char"];
+
+    my $reversed = $word;
+
+    if ($word =~ / ^ (.*? $char) (.*) $ /x)
+    {
+        $reversed = join( '', sort split '', $1 ) . $2;
+    }
+  # else leave the word unchanged
+
+    return $reversed;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $word, $char, $expected) = split / \| /x, $line;
+
+        for ($test_name, $word, $char, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $reversed = reverse_word( $word, $char );
+
+        is $reversed, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1 |challenge  |e|acehllnge
+Example 2 |programming|a|agoprrmming
+Example 3 |champion   |b|champion
+Final char|champagne  |e|aaceghmnp
+First char|xabc       |x|xabc
+Empty     |           |a|
+One char  |t          |t|t
+Reversed  |zyxwvutsrqp|p|pqrstuvwxyz
diff --git a/challenge-278/athanasius/raku/ch-1.raku b/challenge-278/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..3f3e4d1319
--- /dev/null
+++ b/challenge-278/athanasius/raku/ch-1.raku
@@ -0,0 +1,181 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 278
+=========================
+
+TASK #1
+-------
+*Sort String*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a shuffle string, $str.
+
+Write a script to return the sorted string.
+
+    A string is shuffled by appending word position to each word.
+
+Example 1
+
+  Input: $str = "and2 Raku3 cousins5 Perl1 are4"
+  Output: "Perl and Raku are cousins"
+
+Example 2
+
+  Input: $str = "guest6 Python1 most4 the3 popular5 is2 language7"
+  Output: "Python is the most popular guest language"
+
+Example 3
+
+  Input: $str = "Challenge3 The1 Weekly2"
+  Output: "The Weekly Challenge"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A "shuffle[d] string" is entered as a single argument on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 278, Task #1: Sort String (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str   #= Shuffled string in which each word has its position appended
+)
+#===============================================================================
+{
+    qq[Input: \$str = "$str"].put;
+
+    my Str $sorted = sort-sentence( $str );
+
+    qq[Output:       "$sorted"].put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub sort-sentence( Str:D $str --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @words = $str.split: / \s+ /, :skip-empty;
+    my Str @sorted;
+
+    for @words -> Str $shuffle-word
+    {
+        $shuffle-word ~~ / ^ ( .* \D ) ( \d+ ) $ /
+            or  error( qq["$shuffle-word" is not a valid shuffle word] );
+
+        my Str $word = ~$0;
+
+        +$1 ~~ Pos:D
+            or  error( qq["$shuffle-word" does not end in a positive integer] );
+        my UInt $ord = +$1;
+
+        @sorted[ $ord ]:exists
+            and error( "Duplicate position $ord found" );
+
+        @sorted[ $ord ] = $word;
+    }
+
+    for 1 .. @sorted.end -> UInt $i
+    {
+        @sorted[ $i ]:exists
+            or  error( "No word found for position $i" );
+    }
+
+    return @sorted[ 1 .. * ].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 $sorted = sort-sentence( $str );
+
+        is $sorted, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "\nERROR: $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|and2 Raku3 cousins5 Perl1 are4|Perl and Raku are cousins
+        Example 2|guest6 Python1 most4 the3 popular5 is2 language7             \
+                 |Python is the most popular guest language
+        Example 3|Challenge3 The1 Weekly2|The Weekly Challenge
+        END
+
+    $data ~~ s:g/ \\ \n \s* / /;                 # Concatenate backslashed lines
+
+    return $data;
+}
+
+################################################################################
diff --git a/challenge-278/athanasius/raku/ch-2.raku b/challenge-278/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..197bacde7e
--- /dev/null
+++ b/challenge-278/athanasius/raku/ch-2.raku
@@ -0,0 +1,170 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 278
+=========================
+
+TASK #2
+-------
+*Reverse Word*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a word, $word and a character, $char.
+
+Write a script to replace the substring up to and including $char with its
+characters sorted alphabetically. If the $char doesn't exist then DON'T do
+anything.
+
+Example 1
+
+  Input: $str = "challenge", $char = "e"
+  Output: "acehllnge"
+
+Example 2
+
+  Input: $str = "programming", $char = "a"
+  Output: "agoprrmming"
+
+Example 3
+
+  Input: $str = "champion", $char = "b"
+  Output: "champion"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. From Example 1 it appears that the substring to be sorted extends from the
+   start of $word up to (and including) the FIRST occurrence of $char ONLY.
+2. Character-matching is case-sensitive, so, e.g., "E" does NOT match "e".
+3. In alphabetical sorting, "Z" comes before "a".
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A word and a single character are entered as two positional arguments on the
+   command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 278, Task #2: Reverse Word (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $word,                                #= A word
+    Str:D $char where { .chars == 1 }           #= A single character
+)
+#===============================================================================
+{
+    qq[Input: \$word = "$word", \$char = "$char"].put;
+
+    my Str $reversed = reverse-word( $word, $char );
+
+    qq[Output:        "$reversed"].put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub reverse-word( Str:D $word, Str:D $char where { .chars == 1 } --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $reversed = $word;
+
+    if $word ~~ / ^ ( .*? $char ) ( .* ) $ /
+    {
+        $reversed = $0.split( '' ).sort.join ~ $1;
+    }
+  # else leave the word unchanged
+
+    return $reversed;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $word, $char, $expected) = $line.split: / \| /;
+
+        for     $test-name, $word, $char, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $reversed = reverse-word( $word, $char );
+
+        is $reversed, $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 )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1 |challenge  |e|acehllnge
+        Example 2 |programming|a|agoprrmming
+        Example 3 |champion   |b|champion
+        Final char|champagne  |e|aaceghmnp
+        First char|xabc       |x|xabc
+        Empty     |           |a|
+        One char  |t          |t|t
+        Reversed  |zyxwvutsrqp|p|pqrstuvwxyz
+        END
+}
+
+################################################################################