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

4 files changed, 761 insertions, 0 deletions

diff --git a/challenge-331/athanasius/perl/ch-1.pl b/challenge-331/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..268de3f6db
--- /dev/null
+++ b/challenge-331/athanasius/perl/ch-1.pl
@@ -0,0 +1,159 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 331
+=========================
+
+TASK #1
+-------
+*Last Word*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string.
+
+Write a script to find the length of last word in the given string.
+
+Example 1
+
+  Input: $str = "The Weekly Challenge"
+  Output: 9
+
+Example 2
+
+  Input: $str = "   Hello   World    "
+  Output: 5
+
+Example 3
+
+  Input: $str = "Let's begin the fun"
+  Output: 3
+
+=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.
+
+Assumption
+----------
+All non-word characters, including punctuation, are to be handled like the
+whitespace in the Examples.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    A string
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 331, Task #1: Last Word (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 $length = find_last_word_len( $str );
+
+        print "Output: $length\n";
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_last_word_len
+#-------------------------------------------------------------------------------
+{
+    my ($str) = @_;
+
+    $str =~ / (\w+) \W* $ /x;
+
+    return length( $1 // '' );
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, undef, $expected) = split / \| /x, $line;
+
+        for ($test_name, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $length = find_last_word_len( $str );
+
+        is $length, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|The Weekly Challenge|               | 9
+Example 2|   Hello   World    |               | 5
+Example 3|Let's begin the fun|                | 3
+Question |Is this a good question?|           | 8
+Empty    ||                                   | 0
+No words |. ### //??? * &&& ! #/?*|           | 0
+Long word|Supercalifragilisticexpialidocious!||34
diff --git a/challenge-331/athanasius/perl/ch-2.pl b/challenge-331/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..599bc68653
--- /dev/null
+++ b/challenge-331/athanasius/perl/ch-2.pl
@@ -0,0 +1,235 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 331
+=========================
+
+TASK #2
+-------
+*Buddy Strings*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two strings, source and target.
+
+Write a script to find out if the given strings are Buddy Strings.
+
+  If swapping of a letter in one string make them same as the other then they
+  are `Buddy Strings`.
+
+Example 1
+
+  Input: $source = "fuck"
+         $target = "fcuk"
+  Output: true
+
+  The swapping of 'u' with 'c' makes it buddy strings.
+
+Example 2
+
+  Input: $source = "love"
+         $target = "love"
+  Output: false
+
+Example 3
+
+  Input: $source = "fodo"
+         $target = "food"
+  Output: true
+
+Example 4
+
+  Input: $source = "feed"
+         $target = "feed"
+  Output: true
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. Two strings are entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;        # Enables strictures
+use warnings;
+use Const::Fast;
+use Devel::Assert qw( on );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <source> <target>
+  perl $0
+
+    <source>    First string
+    <target>    Second string
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 331, Task #2: Buddy Strings (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($source, $target) =  @ARGV;
+
+        print qq[Input:  \$source = "$source"\n];
+        print qq[        \$target = "$target"\n];
+
+        my $buddies = are_buddies( $source, $target );
+
+        printf "Output: %s\n", $buddies ? 'true' : 'false';
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub are_buddies
+#-------------------------------------------------------------------------------
+{
+    my ($source, $target) = @_;
+    my  $result = '';
+
+    if (same_chars( $source, $target ))
+    {
+        my $diffs = count_diffs( $source, $target );
+
+        $result = $diffs == 0 ? has_duplicates( $source ) :
+                  $diffs == 2;
+    }
+
+    return $result;
+}
+
+#-------------------------------------------------------------------------------
+sub same_chars
+#-------------------------------------------------------------------------------
+{
+    my ($source, $target) = @_;
+    my  $result = '';
+
+    if (length $source == length $target)
+    {
+        my $source_norm = join '', sort split '', $source;
+        my $target_norm = join '', sort split '', $target;
+
+        $result = $source_norm eq $target_norm;
+    }
+
+    return $result;
+}
+
+#-------------------------------------------------------------------------------
+sub count_diffs
+#-------------------------------------------------------------------------------
+{
+    my ($source, $target) = @_;
+
+    assert length $source == length $target;
+
+    my @source_chars = split '', $source;
+    my @target_chars = split '', $target;
+    my $differences  = 0;
+
+    for my $i (0 .. $#source_chars)
+    {
+        ++$differences if $source_chars[ $i ] ne $target_chars[ $i ];
+    }
+
+    return $differences;
+}
+
+#-------------------------------------------------------------------------------
+sub has_duplicates
+#-------------------------------------------------------------------------------
+{
+    my ($string) = @_;
+    my  $result  = '';
+    my  %char_count;
+      ++$char_count{ $_ } for split '', $string;
+
+    for my $count (values %char_count)
+    {
+        if ($count > 1)
+        {
+            $result = 1;
+            last;
+        }
+    }
+
+    return $result;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $source, $target, $expected) = split / \| /x, $line;
+
+        for ($test_name, $source, $target, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $buddies = are_buddies( $source, $target ) ? 'true' : 'false';
+
+        is $buddies, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1   |fuck|fcuk |true
+Example 2   |love|love |false
+Example 3   |fodo|food |true
+Example 4   |feed|feed |true
+Diff lengths|Perl|Pearl|false
diff --git a/challenge-331/athanasius/raku/ch-1.raku b/challenge-331/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..173fcc6437
--- /dev/null
+++ b/challenge-331/athanasius/raku/ch-1.raku
@@ -0,0 +1,146 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 331
+=========================
+
+TASK #1
+-------
+*Last Word*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string.
+
+Write a script to find the length of last word in the given string.
+
+Example 1
+
+  Input: $str = "The Weekly Challenge"
+  Output: 9
+
+Example 2
+
+  Input: $str = "   Hello   World    "
+  Output: 5
+
+Example 3
+
+  Input: $str = "Let's begin the fun"
+  Output: 3
+
+=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.
+
+Assumption
+----------
+All non-word characters, including punctuation, are to be handled like the
+whitespace in the Examples.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 331, Task #1: Last Word (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str                           #= A string
+)
+#===============================================================================
+{
+    qq[Input:  \$str = "$str"].put;
+
+    my UInt $length = find-last-word-len( $str );
+
+    "Output: $length".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-last-word-len( Str:D $str --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    $str ~~ / (\w+) \W* $ /;
+
+    return ($0 // '').chars;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $ignore, $expected) = $line.split: / \| /;
+
+        for     $test-name, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt $length = find-last-word-len( $str );
+
+        is $length, $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|The Weekly Challenge|               | 9
+        Example 2|   Hello   World    |               | 5
+        Example 3|Let's begin the fun|                | 3
+        Question |Is this a good question?|           | 8
+        Empty    ||                                   | 0
+        No words |. ### //??? * &&& ! #/?*|           | 0
+        Long word|Supercalifragilisticexpialidocious!||34
+        END
+}
+
+################################################################################
diff --git a/challenge-331/athanasius/raku/ch-2.raku b/challenge-331/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..74484244cd
--- /dev/null
+++ b/challenge-331/athanasius/raku/ch-2.raku
@@ -0,0 +1,221 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 331
+=========================
+
+TASK #2
+-------
+*Buddy Strings*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two strings, source and target.
+
+Write a script to find out if the given strings are Buddy Strings.
+
+  If swapping of a letter in one string make them same as the other then they
+  are `Buddy Strings`.
+
+Example 1
+
+  Input: $source = "fuck"
+         $target = "fcuk"
+  Output: true
+
+  The swapping of 'u' with 'c' makes it buddy strings.
+
+Example 2
+
+  Input: $source = "love"
+         $target = "love"
+  Output: false
+
+Example 3
+
+  Input: $source = "fodo"
+         $target = "food"
+  Output: true
+
+Example 4
+
+  Input: $source = "feed"
+         $target = "feed"
+  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. Two strings are entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 331, Task #2: Buddy Strings (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $source,                       #= First  string
+    Str:D $target                        #= Second string
+)
+#===============================================================================
+{
+    qq[Input:  \$source = "$source"].put;
+    qq[        \$target = "$target"].put;
+
+    my Bool $buddies = are-buddies( $source, $target );
+
+    "Output: %s\n".printf: $buddies ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub are-buddies( Str:D $source, Str:D $target --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my Bool $result = False;
+
+    if same-chars( $source, $target )
+    {
+        my UInt $diffs = count-diffs( $source, $target );
+
+        $result = $diffs == 0 ?? has-duplicates( $source ) !!
+                  $diffs == 2;
+    }
+
+    return $result;
+}
+
+#-------------------------------------------------------------------------------
+sub same-chars( Str:D $source, Str:D $target --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my Bool $result = False;
+
+    if $source.chars == $target.chars
+    {
+        my Str $source-norm = $source.split( '', :skip-empty ).sort.join;
+        my Str $target-norm = $target.split( '', :skip-empty ).sort.join;
+
+        $result = $source-norm eq $target-norm;
+    }
+
+    return $result;
+}
+
+#-------------------------------------------------------------------------------
+sub count-diffs
+(
+    Str:D $source,
+    Str:D $target where { .chars == $source.chars }
+--> UInt:D
+)
+#-------------------------------------------------------------------------------
+{
+    my Str  @source-chars = $source.split: '', :skip-empty;
+    my Str  @target-chars = $target.split: '', :skip-empty;
+    my UInt $differences  = 0;
+
+    for 0 .. @source-chars.end -> UInt $i
+    {
+        ++$differences if @source-chars[ $i ] ne @target-chars[ $i ];
+    }
+
+    return $differences;
+}
+
+#-------------------------------------------------------------------------------
+sub has-duplicates( Str:D $str --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my Bool $result = False;
+    my UInt %char-count;
+          ++%char-count{ $_ } for $str.split: '', :skip-empty;
+
+    for %char-count.values -> UInt $count
+    {
+        if $count > 1
+        {
+            $result = True;
+            last;
+        }
+    }
+
+    return $result;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $source, $target, $expected) = $line.split: / \| /;
+
+        for     $test-name, $source, $target, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $buddies = are-buddies( $source, $target ) ?? 'true' !! 'false';
+
+        is $buddies, $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   |fuck|fcuk |true
+        Example 2   |love|love |false
+        Example 3   |fodo|food |true
+        Example 4   |feed|feed |true
+        Diff lengths|Perl|Pearl|false
+        END
+}
+
+################################################################################