Merge pull request #11538 from PerlMonk-Athanasius/branch-for-challenge-307

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

4 files changed, 719 insertions, 0 deletions

diff --git a/challenge-307/athanasius/perl/ch-1.pl b/challenge-307/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..0f1659fa96
--- /dev/null
+++ b/challenge-307/athanasius/perl/ch-1.pl
@@ -0,0 +1,172 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 307
+=========================
+
+TASK #1
+-------
+*Check Order*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to re-arrange the given array in an increasing order and return
+the indices where it differs from the original array.
+
+Example 1
+
+  Input: @ints = (5, 2, 4, 3, 1)
+  Output: (0, 2, 3, 4)
+
+  Before: (5, 2, 4, 3, 1)
+  After : (1, 2, 3, 4, 5)
+
+  Difference at indices: (0, 2, 3, 4)
+
+Example 2
+
+  Input: @ints = (1, 2, 1, 1, 3)
+  Output: (1, 3)
+
+  Before: (1, 2, 1, 1, 3)
+  After : (1, 1, 1, 2, 3)
+
+  Difference at indices: (1, 3)
+
+Example 3
+
+  Input: @ints = (3, 1, 3, 2, 3)
+  Output: (0, 1, 3)
+
+  Before: (3, 1, 3, 2, 3)
+  After : (1, 2, 3, 3, 3)
+
+  Difference at indices: (0, 1, 3)
+
+=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 list of integers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 307, Task #1: Check Order (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+            for @ints;
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $indices = find_diff_indices( \@ints );
+
+        printf "Output: (%s)\n", join ', ', @$indices;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_diff_indices
+#-------------------------------------------------------------------------------
+{
+    my ($ints)  = @_;
+    my  @sorted = sort { $a <=> $b } @$ints;
+    my  @indices;
+
+    for my $i (0 .. $#$ints)
+    {
+        push @indices, $i unless $ints->[ $i ] == $sorted[ $i ];
+    }
+
+    return \@indices;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expd_str) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expd_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints     = split / \s+ /x, $ints_str;
+        my @expected = split / \s+ /x, $expd_str;
+        my $indices  = find_diff_indices( \@ints );
+
+        is_deeply $indices, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1 |5 2 4 3 1|0 2 3 4
+Example 2 |1 2 1 1 3|1 3
+Example 3 |3 1 3 2 3|0 1 3
+No changes|1 2 3 4 5|
diff --git a/challenge-307/athanasius/perl/ch-2.pl b/challenge-307/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..d00c9270d9
--- /dev/null
+++ b/challenge-307/athanasius/perl/ch-2.pl
@@ -0,0 +1,200 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 307
+=========================
+
+TASK #2
+-------
+*Find Anagrams*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of words, @words.
+
+Write a script to find any two consecutive words and if they are anagrams, drop
+the first word and keep the second. You continue this until there is no more
+anagrams in the given list and return the count of final list.
+
+Example 1
+
+  Input: @words = ("acca", "dog", "god", "perl", "repl")
+  Output: 3
+
+  Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god"
+      => ("acca", "god", "perl", "repl")
+  Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl"
+      => ("acca", "god", "repl")
+
+Example 2
+
+  Input: @words = ("abba", "baba", "aabb", "ab", "ab")
+  Output: 2
+
+  Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba"
+      => ("baba", "aabb", "ab", "ab")
+  Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb"
+      => ("aabb", "ab", "ab")
+  Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab"
+      => ("aabb", "ab")
+
+=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 list of words is entered on the command-line.
+3. If the input list is preceded by the "-i" flag, case is ignored. For example,
+   "Abc" and "CaB" are considered anagrams. Otherwise (the default), character-
+   comparisons are case-sensitive.
+4. If the input list is preceded by the "-v" flag, the contents of the final
+   list are also shown.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures and warnings
+use Const::Fast;
+use Getopt::Long;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [-i] [-v] [<words> ...]
+  perl $0
+
+    -i               Ignore case? [default: False]
+    -v               Show the final list? [default: False]
+    [<words> ...]    A non-empty list of words
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 307, Task #2: Find Anagrams (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($ignore_case, $verbose, $words) = parse_command_line();
+
+        printf "Case-\nsensitive?  %s\n",   $ignore_case ? 'No' : 'Yes';
+        printf "Input:      \@words = (%s)\n",
+                join ', ', map { qq["$_"] } @$words;
+
+        my $final_list = find_final_list( $words, $ignore_case );
+
+        printf "Output:     %d\n", scalar @$final_list;
+
+        printf "\nFinal list: (%s)\n", join ', ', map { qq["$_"] } @$final_list
+            if $verbose;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_final_list
+#-------------------------------------------------------------------------------
+{
+    my ($words, $ignore_case) = @_;
+    my  @new_list;
+
+    for my $i (0 .. $#$words - 1)
+    {
+        push @new_list, $words->[ $i ]
+            unless anagrams( $words->[ $i ], $words->[ $i + 1 ], $ignore_case );
+    }
+
+    push @new_list, $words->[ -1 ];
+
+    return \@new_list;
+}
+
+#-------------------------------------------------------------------------------
+sub anagrams
+#-------------------------------------------------------------------------------
+{
+    my ($word1, $word2, $ignore_case) = @_;
+    my  $w1 = join '', sort map { $ignore_case ? lc $_ : $_ } split //, $word1;
+    my  $w2 = join '', sort map { $ignore_case ? lc $_ : $_ } split //, $word2;
+
+    return $w1 eq $w2;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my ($ignore_case, $verbose);
+
+    GetOptions
+    (
+        i => \$ignore_case,
+        v => \$verbose
+    )                       or error( 'Error in command-line arguments' );
+
+    scalar @ARGV > 0        or error( 'The input list is empty' );
+
+    return ($ignore_case, $verbose, \@ARGV);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $words_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $words_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @words      = split / \s+ /x, $words_str;
+        my $final_list = find_final_list( \@words, 0 );
+
+        is scalar @$final_list, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|acca dog god perl repl|3
+Example 2|abba baba aabb ab ab  |2
diff --git a/challenge-307/athanasius/raku/ch-1.raku b/challenge-307/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..960a5c1553
--- /dev/null
+++ b/challenge-307/athanasius/raku/ch-1.raku
@@ -0,0 +1,164 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 307
+=========================
+
+TASK #1
+-------
+*Check Order*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to re-arrange the given array in an increasing order and return
+the indices where it differs from the original array.
+
+Example 1
+
+  Input: @ints = (5, 2, 4, 3, 1)
+  Output: (0, 2, 3, 4)
+
+  Before: (5, 2, 4, 3, 1)
+  After : (1, 2, 3, 4, 5)
+
+  Difference at indices: (0, 2, 3, 4)
+
+Example 2
+
+  Input: @ints = (1, 2, 1, 1, 3)
+  Output: (1, 3)
+
+  Before: (1, 2, 1, 1, 3)
+  After : (1, 1, 1, 2, 3)
+
+  Difference at indices: (1, 3)
+
+Example 3
+
+  Input: @ints = (3, 1, 3, 2, 3)
+  Output: (0, 1, 3)
+
+  Before: (3, 1, 3, 2, 3)
+  After : (1, 2, 3, 3, 3)
+
+  Difference at indices: (0, 1, 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 non-empty list of integers is entered on the command-line.
+3. If the first integer in the list is negative, it must be preceded by "--" to
+   indicate that it is not a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 307, Task #1: Check Order (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@ints where { .elems > 0 && .all ~~ Int:D } #= A non-empty list of integers
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my UInt @indices = find-diff-indices( @ints );
+
+    "Output: (%s)\n".printf: @indices.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-diff-indices( List:D[Int:D] $ints --> List:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+    my Int  @sorted = $ints.sort;
+    my UInt @indices;
+
+    for 0 .. $ints.end -> UInt $i
+    {
+        @indices.push: $i unless $ints[ $i ] == @sorted[ $i ];
+    }
+
+    return @indices;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $expd-str) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $expd-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int  @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my UInt @expd = $expd-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my UInt @idxs = find-diff-indices( @ints );
+
+        is-deeply @idxs, @expd, $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 |5 2 4 3 1|0 2 3 4
+        Example 2 |1 2 1 1 3|1 3
+        Example 3 |3 1 3 2 3|0 1 3
+        No changes|1 2 3 4 5|
+        END
+}
+
+################################################################################
diff --git a/challenge-307/athanasius/raku/ch-2.raku b/challenge-307/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..9de665613d
--- /dev/null
+++ b/challenge-307/athanasius/raku/ch-2.raku
@@ -0,0 +1,183 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 307
+=========================
+
+TASK #2
+-------
+*Find Anagrams*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of words, @words.
+
+Write a script to find any two consecutive words and if they are anagrams, drop
+the first word and keep the second. You continue this until there is no more
+anagrams in the given list and return the count of final list.
+
+Example 1
+
+  Input: @words = ("acca", "dog", "god", "perl", "repl")
+  Output: 3
+
+  Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god"
+      => ("acca", "god", "perl", "repl")
+  Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl"
+      => ("acca", "god", "repl")
+
+Example 2
+
+  Input: @words = ("abba", "baba", "aabb", "ab", "ab")
+  Output: 2
+
+  Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba"
+      => ("baba", "aabb", "ab", "ab")
+  Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb"
+      => ("aabb", "ab", "ab")
+  Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab"
+      => ("aabb", "ab")
+
+=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 list of words is entered on the command-line.
+3. If the input list is preceded by the "-i" flag, case is ignored. For example,
+   "Abc" and "CaB" are considered anagrams. Otherwise (the default), character-
+   comparisons are case-sensitive.
+4. If the input list is preceded by the "-v" flag, the contents of the final
+   list are also shown.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 307, Task #2: Find Anagrams (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Bool:D :i($ignore-case) = False,                #= Ignore case?
+    Bool:D :v($verbose)     = False,                #= Show the final list?
+             *@words where { .elems > 0 }           #= A non-empty list of words
+)
+#===============================================================================
+{
+    "Case-\nsensitive?  %s\n".printf: $ignore-case ?? 'No' !! 'Yes';
+    "Input:      \@words = (%s)\n".printf: @words.map( { qq["$_"] } ).join: ', ';
+
+    my Str @final = find-final-list( @words, $ignore-case );
+
+    "Output:     %d\n".printf: @final.elems;
+
+    "\nFinal list: (%s)\n".printf: @final.map( { qq["$_"] } ).join: ', '
+        if $verbose;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-final-list
+(
+    List:D[Str:D] $words,
+    Bool:D        $ignore-case = False
+--> List:D[Str:D]
+)
+#-------------------------------------------------------------------------------
+{
+    my Str @new-list;
+
+    for 0 .. $words.end - 1 -> UInt $i
+    {
+        @new-list.push: $words[ $i ]
+            unless anagrams( $words[ $i ], $words[ $i + 1 ], $ignore-case );
+    }
+
+    @new-list.push: $words[ *-1 ];
+
+    return @new-list;
+}
+
+#-------------------------------------------------------------------------------
+sub anagrams( Str:D $word1, Str:D $word2, Bool:D $ignore-case --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $w1 = $word1.split( '', :skip-empty )\
+                       .map( { $ignore-case ?? .lc !! $_ } ).sort.join;
+
+    my Str $w2 = $word2.split( '', :skip-empty )\
+                       .map( { $ignore-case ?? .lc !! $_ } ).sort.join;
+
+    return $w1 eq $w2;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $words-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $words-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str @words      = $words-str.split: / \s+ /, :skip-empty;
+        my Str @final-list = find-final-list( @words );
+
+        is @final-list.elems, $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|acca dog god perl repl|3
+        Example 2|abba baba aabb ab ab  |2
+        END
+}
+
+################################################################################