Merge pull request #9588 from PerlMonk-Athanasius/branch-for-challenge-256

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

4 files changed, 762 insertions, 0 deletions

diff --git a/challenge-256/athanasius/perl/ch-1.pl b/challenge-256/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..b4424ea4b2
--- /dev/null
+++ b/challenge-256/athanasius/perl/ch-1.pl
@@ -0,0 +1,238 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 256
+=========================
+
+TASK #1
+-------
+*Maximum Pairs*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of distinct words, @words.
+
+Write a script to find the maximum pairs in the given array. The words $words[i]
+and $words[j] can be a pair one is reverse of the other.
+
+Example 1
+
+  Input: @words = ("ab", "de", "ed", "bc")
+  Output: 1
+
+  There is one pair in the given array: "de" and "ed"
+
+Example 2
+
+  Input: @words = ("aa", "ba", "cd", "ed")
+  Output: 0
+
+Example 3
+
+  Input: @words = ("uv", "qp", "st", "vu", "mn", "pq"))
+  Output: 2
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If --case-sensitive is entered on the command-line (or simply omitted), "xy"
+   and "XY" (for example) are treated as different words, so "xy" and "YX" do
+   NOT form a pair; but if --nocase-sensitive is entered on the command-line,
+   "xy" DOES pair with "YX".
+3. If --palindromes is entered on the command-line, palindromes such as "a",
+   "aba", and "CDEDC" pair with themselves; otherwise (i.e., if it is omitted or
+   if --nopalindromes is entered on the command-line), they do not, as per
+   Example 2.
+4. If $VERBOSE is set to a true value, the required output (number of pairs
+   found) is followed by a list of the pairs themselves.
+
+=cut
+#===============================================================================
+
+use v5.32.1;             # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Test::More;
+
+const my $CASE_SENSITIVE => 1;
+const my $PALINDROMES    => 0;
+const my $VERBOSE        => 1;
+const my $USAGE          => <<END;
+Usage:
+  perl $0 [--[no]case-sensitive] [--[no]palindromes] [<words> ...]
+  perl $0
+
+    [<words> ...]    A non-empty array of distinct words
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 256, Task #1: Maximum Pairs (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($words, $case_sensitive, $palindromes) = parse_command_line();
+
+        printf "Input:  \@words = (%s)\n", join ', ', map { qq["$_"] } @$words;
+
+        my $pairs = count_pairs( $words, $case_sensitive, $palindromes );
+
+        printf "Output: %d\n", scalar @$pairs;
+
+        if ($VERBOSE)
+        {
+            printf "\nPair%s%s\n", scalar @$pairs == 1 ? ':   ' : 's:  ',
+                join ', ', map { $_->[ 0 ] . '|' . $_->[ 1 ] } @$pairs;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub count_pairs
+#-------------------------------------------------------------------------------
+{
+    my ($words, $case_sensitive, $palindromes) = @_;
+    my  @pairs;
+    my  %seen = map { $_ => 0 } @$words;
+
+    for my $lhs (sort @$words)
+    {
+        if (!$seen{ $lhs })
+        {
+            for my $rhs (sort @$words)
+            {
+                next if $seen{ $rhs } || (!$palindromes && $lhs eq $rhs);
+
+                if (($case_sensitive &&    $lhs eq reverse    $rhs) ||
+                   (!$case_sensitive && lc $lhs eq reverse lc $rhs))
+                {
+                    push @pairs, [ $lhs => $rhs ];
+
+                    $seen{ $lhs } = 1;
+                    $seen{ $rhs } = 1;
+                }
+            }
+        }
+    }
+
+    return \@pairs;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $case_sensitive = $CASE_SENSITIVE;
+    my $palindromes    = $PALINDROMES;
+
+    GetOptions
+    (
+        'case_sensitive!' => \$case_sensitive,
+        'palindromes!'    => \$palindromes,
+
+    )   or error( 'Error in command line arguments' );
+
+    my @words = @ARGV;
+
+    scalar @words > 0
+        or error( 'No input words found' );
+
+    are_distinct( \@words, $case_sensitive )
+        or error( 'The input words are not distinct' );
+
+    return (\@words, $case_sensitive, $palindromes);
+}
+
+#-------------------------------------------------------------------------------
+sub are_distinct
+#-------------------------------------------------------------------------------
+{
+    my ($words, $case_sensitive) = @_;
+    my  %dict;
+
+    for (@$words)
+    {
+        my $word = $case_sensitive ? $_ : lc;
+
+        return 0 if ++$dict{ $word } > 1;
+    }
+
+    return 1;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $words_str, $expected, $case_sensitive_str,
+             $palindromes_str) = split / \| /x, $line;
+
+        for ($test_name, $words_str, $expected, $case_sensitive_str,
+             $palindromes_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $case_sensitive = $case_sensitive_str eq 'True';
+        my $palindromes    = $palindromes_str    eq 'True';
+
+        my @words = split / \s+ /x, $words_str;
+        my $pairs = count_pairs( \@words, $case_sensitive, $palindromes );
+
+        is scalar @$pairs, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1    |ab de ed bc      |1|     |
+Example 2    |aa ba cd ed      |0|     |
+Example 3    |uv qp st vu mn pq|2|     |
+Palindromes 1|aba ab ba cd ef g|3|     |True
+Palindromes 2|aba ab ba cd ef g|1|     |False
+Case 1       |ab BA cD dC ef gh|2|False|
+Case 2       |ab BA cD dC ef gh|0|True |
diff --git a/challenge-256/athanasius/perl/ch-2.pl b/challenge-256/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..67688b1fb7
--- /dev/null
+++ b/challenge-256/athanasius/perl/ch-2.pl
@@ -0,0 +1,156 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 256
+=========================
+
+TASK #2
+-------
+*Merge Strings*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two strings, $str1 and $str2.
+
+Write a script to merge the given strings by adding in alternative order start-
+ing with the first string. If a string is longer than the other then append the
+remaining at the end.
+
+Example 1
+
+  Input: $str1 = "abcd", $str2 = "1234"
+  Output: "a1b2c3d4"
+
+Example 2
+
+  Input: $str1 = "abc", $str2 = "12345"
+  Output: "a1b2c345"
+
+Example 3
+
+  Input: $str1 = "abcde", $str2 = "123"
+  Output: "a1b2c3de"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;        # Enables strictures
+use warnings;
+use Const::Fast;
+use List::MoreUtils qw( mesh );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+Usage:
+  perl $0 <str1> <str2>
+  perl $0
+
+    <str1>    A string
+    <str2>    Another string
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 256, Task #2: Merge Strings (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($str1, $str2) = @ARGV;
+
+        print qq[Input:  \$str1 = "$str1", \$str2 = "$str2"\n];
+
+        my $merged = merge_strings( $str1, $str2 );
+
+        print qq[Output: "$merged"\n];
+    }
+    else
+    {
+        error( "Expected 0 or 2 arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub merge_strings
+#-------------------------------------------------------------------------------
+{
+    my ($str1, $str2) = @_;
+
+    my @chars1 = split //, $str1;
+    my @chars2 = split //, $str2;
+    my @merged = grep { defined } mesh @chars1, @chars2;
+
+    return join '', @merged;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str1, $str2, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str1, $str2, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $merged = merge_strings( $str1, $str2 );
+
+        is $merged, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|abcd |1234 |a1b2c3d4
+Example 2|abc  |12345|a1b2c345
+Example 3|abcde|123  |a1b2c3de
diff --git a/challenge-256/athanasius/raku/ch-1.raku b/challenge-256/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..85c27c350a
--- /dev/null
+++ b/challenge-256/athanasius/raku/ch-1.raku
@@ -0,0 +1,227 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 256
+=========================
+
+TASK #1
+-------
+*Maximum Pairs*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of distinct words, @words.
+
+Write a script to find the maximum pairs in the given array. The words $words[i]
+and $words[j] can be a pair one is reverse of the other.
+
+Example 1
+
+  Input: @words = ("ab", "de", "ed", "bc")
+  Output: 1
+
+  There is one pair in the given array: "de" and "ed"
+
+Example 2
+
+  Input: @words = ("aa", "ba", "cd", "ed")
+  Output: 0
+
+Example 3
+
+  Input: @words = ("uv", "qp", "st", "vu", "mn", "pq"))
+  Output: 2
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If --case-sensitive is omitted or set to True, "xy" and "XY" (for example)
+   are treated as different words, so "xy" and "YX" do NOT form a pair; but if
+   --case-sensitive=False is entered on the command-line, "xy" DOES pair with
+   "YX".
+3. If --palindromes is entered on the command-line, palindromes such as "a",
+   "aba", and "CDEDC" pair with themselves; otherwise, they do not, as per
+   Example 2.
+4. If VERBOSE is set to True, the required output (number of pairs found) is
+   followed by a list of the pairs themselves.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant CASE-SENSITIVE = True;
+my Bool constant PALINDROMES    = False;
+my Bool constant VERBOSE        = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 256, Task #1: Maximum Pairs (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Bool:D :$case-sensitive = CASE-SENSITIVE,
+    Bool:D :$palindromes    = PALINDROMES,
+
+    #| A non-empty array of distinct words
+
+    *@words where { .elems > 0 && are-distinct( @words, $case-sensitive ) }
+)
+#===============================================================================
+{
+    "Input:  \@words = (%s)\n".printf: @words.map( { qq["$_"] } ).join: ', ';
+
+    my Pair @pairs = count-pairs( @words, $case-sensitive, $palindromes );
+
+    "Output: %d\n".printf: @pairs.elems;
+
+    if VERBOSE
+    {
+        "\nPair%s%s\n".printf: @pairs.elems == 1 ?? ':   ' !! 's:  ',
+            @pairs.map( { .key ~ '|' ~ .value } ).join: ', ';
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub count-pairs
+(
+    List:D[Str:D] $words,
+    Bool:D        $case-sensitive,
+    Bool:D        $palindromes
+--> List:D[Pair:D]
+)
+#-------------------------------------------------------------------------------
+{
+    my Pair @pairs;
+    my Bool %seen = @$words.map: { $_ => False };
+
+    for @$words.sort -> Str $lhs
+    {
+        if !%seen{ $lhs }
+        {
+            for @$words.sort -> Str $rhs
+            {
+                next if %seen{ $rhs } || (!$palindromes && $lhs eq $rhs);
+
+                if ($case-sensitive && $lhs    eq $rhs.flip) ||
+                  (!$case-sensitive && $lhs.lc eq $rhs.lc.flip)
+                {
+                    @pairs.push: $lhs => $rhs;
+
+                    %seen{ $lhs } = True;
+                    %seen{ $rhs } = True;
+                }
+            }
+        }
+    }
+
+    return @pairs;
+}
+
+#-------------------------------------------------------------------------------
+sub are-distinct( List:D[Str:D] $words, Bool:D $case-sensitive --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt %dict;
+
+    for @$words
+    {
+        my Str $word = $case-sensitive ?? $_ !! .lc;
+
+        return False if ++%dict{ $word } > 1;
+    }
+
+    return True;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $words-str, $expected, $case-sensitive-str,
+                $palindromes-str) = $line.split: / \| /;
+
+        for     $test-name, $words-str, $expected, $case-sensitive-str,
+                $palindromes-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Bool $case-sensitive = $case-sensitive-str eq 'True';
+        my Bool $palindromes    = $palindromes-str    eq 'True';
+
+        my Str  @words = $words-str.split: / \s+ /, :skip-empty;
+        my Pair @pairs = count-pairs( @words, $case-sensitive, $palindromes );
+
+        is @pairs.elems, $expected.Int, $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    |ab de ed bc      |1|     |
+        Example 2    |aa ba cd ed      |0|     |
+        Example 3    |uv qp st vu mn pq|2|     |
+        Palindromes 1|aba ab ba cd ef g|3|     |True
+        Palindromes 2|aba ab ba cd ef g|1|     |False
+        Case 1       |ab BA cD dC ef gh|2|False|
+        Case 2       |ab BA cD dC ef gh|0|True |
+        END
+}
+
+################################################################################
diff --git a/challenge-256/athanasius/raku/ch-2.raku b/challenge-256/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..4d09c12e92
--- /dev/null
+++ b/challenge-256/athanasius/raku/ch-2.raku
@@ -0,0 +1,141 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 256
+=========================
+
+TASK #2
+-------
+*Merge Strings*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two strings, $str1 and $str2.
+
+Write a script to merge the given strings by adding in alternative order start-
+ing with the first string. If a string is longer than the other then append the
+remaining at the end.
+
+Example 1
+
+  Input: $str1 = "abcd", $str2 = "1234"
+  Output: "a1b2c3d4"
+
+Example 2
+
+  Input: $str1 = "abc", $str2 = "12345"
+  Output: "a1b2c345"
+
+Example 3
+
+  Input: $str1 = "abcde", $str2 = "123"
+  Output: "a1b2c3de"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 256, Task #2: Merge Strings (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str1,                       #= A string
+    Str:D $str2                        #= Another string
+)
+#===============================================================================
+{
+    qq[Input:  \$str1 = "$str1", \$str2 = "$str2"].put;
+
+    my Str $merged = merge-strings( $str1, $str2 );
+
+    qq[Output: "$merged"].put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub merge-strings( Str:D $str1, Str:D $str2 --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @chars1 = $str1.split: '', :skip-empty;
+    my Str @chars2 = $str2.split: '', :skip-empty;
+    my Str @merged = roundrobin @chars1, @chars2, :slip;
+
+    return @merged.join;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str1, $str2, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str1, $str2, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $merged = merge-strings( $str1, $str2 );
+
+        is $merged, $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|abcd |1234 |a1b2c3d4
+        Example 2|abc  |12345|a1b2c345
+        Example 3|abcde|123  |a1b2c3de
+        END
+}
+
+################################################################################