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

4 files changed, 784 insertions, 0 deletions

diff --git a/challenge-241/athanasius/perl/ch-1.pl b/challenge-241/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..67a1730f7b
--- /dev/null
+++ b/challenge-241/athanasius/perl/ch-1.pl
@@ -0,0 +1,245 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 241
+=========================
+
+TASK #1
+-------
+*Arithmetic Triplets*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array (3 or more members) of integers in increasing order and a
+positive integer.
+
+Write a script to find out the number of unique Arithmetic Triplets satisfying
+the following rules:
+
+  a) i < j < k
+  b) nums[j] - nums[i] == diff
+  c) nums[k] - nums[j] == diff
+
+Example 1
+
+  Input: @nums = (0, 1, 4, 6, 7, 10)
+         $diff = 3
+  Output: 2
+
+  Index (1, 2, 4) is an arithmetic triplet because both  7 - 4 == 3 and 4 - 1 ==
+  3.
+  Index (2, 4, 5) is an arithmetic triplet because both 10 - 7 == 3 and 7 - 4 ==
+  3.
+
+Example 2
+
+  Input: @nums = (4, 5, 6, 7, 8, 9)
+         $diff = 2
+  Output: 2
+
+  (0, 2, 4) is an arithmetic triplet because both 8 - 6 == 2 and 6 - 4 == 2.
+  (1, 3, 5) is an arithmetic triplet because both 9 - 7 == 2 and 7 - 5 == 2.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If $VERBOSE is set to a true value, the required output is followed by a list
+   of the arithmetic triplets found.
+3. If the first (non-difference) integer is negative, it must be preceded by
+   "--" to indicate that it is not a command-line flag.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 [--diff] [<nums> ...]
+  perl $0
+
+    --diff          Difference (integer > 0)
+    [<nums> ...]    A list of 3 or more integers in increasing order\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 241, Task #1: Arithmetic Triplets (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($nums, $diff) = parse_command_line();
+
+        printf "Input:  \@nums = (%s)\n", join ', ', @$nums;
+        print  "        \$diff =  $diff\n";
+
+        my $triplets = find_triplets( $nums, $diff );
+        my $count    = scalar @$triplets;
+
+        print "Output: $count\n";
+
+        if ($VERBOSE && $count > 0)
+        {
+            printf "\nArithmetic triplet%s: %s\n",
+                $count == 1 ? '' : 's',
+                join ', ', map { '(' . join( ', ', @$_ ) . ')' } @$triplets;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_triplets
+#-------------------------------------------------------------------------------
+{
+    my ($nums, $diff) = @_;
+    my  @triplets;
+
+    L_OUTER: for my $i (0 .. $#$nums - 2)
+    {
+        for my $j ($i + 1 .. $#$nums - 1)
+        {
+            if ((my $ji_diff = $nums->[ $j ] - $nums->[ $i ]) == $diff)
+            {
+                for my $k ($j + 1 .. $#$nums)
+                {
+                    if ((my $kj_diff = $nums->[ $k ] - $nums->[ $j ]) == $diff)
+                    {
+                        push @triplets, [ $i, $j, $k ];
+                        next L_OUTER;
+                    }
+                    elsif ($kj_diff > $diff)
+                    {
+                        next L_OUTER;
+                    }
+                }
+            }
+            elsif ($ji_diff > $diff)
+            {
+                next L_OUTER;
+            }
+        }
+    }
+
+    return \@triplets;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $diff;
+
+    GetOptions( 'diff=i' => \$diff )
+              or error( 'Invalid command line argument' );
+
+    defined $diff
+              or error( 'Difference is missing' );
+
+
+    $diff =~/ ^ $RE{num}{int} $ /x
+              or error( qq[Difference "$diff" is not a valid integer] );
+
+    $diff > 0 or error( qq[Difference "$diff" is not a positive integer] );
+
+    my @nums = @ARGV;
+
+    for (@nums)
+    {
+        / ^ $RE{num}{int} $ /x
+              or error( qq["$_" is not a valid integer] );
+    }
+
+    scalar @nums >= 3
+              or error( 'Too few input integers' );
+
+    increasing_order( \@nums )
+              or error( 'The input integers are not in increasing order' );
+
+    return (\@nums, $diff);
+}
+
+#-------------------------------------------------------------------------------
+sub increasing_order
+#-------------------------------------------------------------------------------
+{
+    my ($nums) = @_;
+
+    for my $i (1 .. $#$nums)
+    {
+        return 0 unless $nums->[ $i ] > $nums->[ $i - 1 ];
+    }
+
+    return 1;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $num_str, $diff, $expected) = split / \| /x, $line;
+
+        for ($test_name, $num_str, $diff, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @nums     = split / \s+ /x, $num_str;
+        my $triplets = find_triplets( \@nums, $diff );
+
+        is scalar @$triplets, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 0  1  4 6 7 10      |3|2
+Example 2| 4  5  6 7 8  9      |2|2
+Negatives|-5 -4 -1 0 1  3 4 5 7|4|3
diff --git a/challenge-241/athanasius/perl/ch-2.pl b/challenge-241/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..8dc37497d3
--- /dev/null
+++ b/challenge-241/athanasius/perl/ch-2.pl
@@ -0,0 +1,158 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 241
+=========================
+
+TASK #2
+-------
+*Prime Order*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of unique positive integers greater than 2.
+
+Write a script to sort them in ascending order of the count of their prime
+factors, tie-breaking by ascending value.
+
+Example 1
+
+  Input: @int = (11, 8, 27, 4)
+  Output: (11, 4, 8, 27)
+
+  Prime factors of 11 => 11
+  Prime factors of  4 => 2, 2
+  Prime factors of  8 => 2, 2, 2
+  Prime factors of 27 => 3, 3, 3
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 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::Util        qw( uniqnum );
+use Math::Prime::Util qw( factor );
+use Regexp::Common    qw( number );
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<int> ...]
+  perl $0
+
+    [<int> ...]  A non-empty list of unique positive integers greater than 2\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 240, Task #2: Prime Order (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $int = parse_command_line();
+
+        printf "Input:  \@int = (%s)\n", join ', ', @$int;
+
+        my $sorted = prime_sort( $int );
+
+        printf "Output:        (%s)\n",  join ', ', @$sorted;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub prime_sort
+#-------------------------------------------------------------------------------
+{
+    my ($int) = @_;
+    my  %count;
+        $count{ $_ } = scalar factor( $_ ) for @$int;
+
+    return [ sort { $count{ $a } <=> $count{ $b } || $a <=> $b } @$int ];
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+        $_ > 2                 or error( qq["$_" is not greater than 2]  );
+    }
+
+    scalar @ARGV == scalar uniqnum( @ARGV )
+        or error( 'Integers in the input list are not unique' );
+
+    return \@ARGV;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $int_str, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $int_str, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @integers = split / \s+ /x, $int_str;
+        my @expected = split / \s+ /x, $exp_str;
+        my $sorted   = prime_sort( \@integers );
+
+        is_deeply $sorted, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1  | 11   8  27   4            | 11   4   8  27
+Seq of 200s|207 208 209 210 211 212 213|211 209 213 207 212 210 208
diff --git a/challenge-241/athanasius/raku/ch-1.raku b/challenge-241/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..95328a5fde
--- /dev/null
+++ b/challenge-241/athanasius/raku/ch-1.raku
@@ -0,0 +1,223 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 241
+=========================
+
+TASK #1
+-------
+*Arithmetic Triplets*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array (3 or more members) of integers in increasing order and a
+positive integer.
+
+Write a script to find out the number of unique Arithmetic Triplets satisfying
+the following rules:
+
+  a) i < j < k
+  b) nums[j] - nums[i] == diff
+  c) nums[k] - nums[j] == diff
+
+Example 1
+
+  Input: @nums = (0, 1, 4, 6, 7, 10)
+         $diff = 3
+  Output: 2
+
+  Index (1, 2, 4) is an arithmetic triplet because both  7 - 4 == 3 and 4 - 1 ==
+  3.
+  Index (2, 4, 5) is an arithmetic triplet because both 10 - 7 == 3 and 7 - 4 ==
+  3.
+
+Example 2
+
+  Input: @nums = (4, 5, 6, 7, 8, 9)
+         $diff = 2
+  Output: 2
+
+  (0, 2, 4) is an arithmetic triplet because both 8 - 6 == 2 and 6 - 4 == 2.
+  (1, 3, 5) is an arithmetic triplet because both 9 - 7 == 2 and 7 - 5 == 2.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If VERBOSE is set to True, the required output is followed by a list of the
+   arithmetic triplets found.
+3. If the first (non-difference) integer is negative, it must be preceded by
+   "--" to indicate that it is not a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+my Bool constant VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 241, Task #1: Arithmetic Triplets (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Pos:D :$diff,                                    #= Difference (integer > 0)
+    *@nums where { .elems >= 3      &&               #= A list of 3 or more
+                   .all   ~~ Int:D  &&               #=   integers
+                   increasing-order( @nums ) }       #=   in increasing order
+)
+#===============================================================================
+{
+    "Input:  \@nums = (%s)\n".printf: @nums.join: ', ';
+    "        \$diff = $diff".put;
+
+    my Array[UInt] @triplets = find-triplets( @nums, $diff );
+
+    my UInt $count = @triplets.elems;
+
+    "Output: $count".put;
+
+    if VERBOSE && $count > 0
+    {
+        "\nArithmetic triplet%s: %s\n".printf:
+            $count == 1 ?? '' !! 's',
+            @triplets.map( { '(' ~ @$_.join( ', ' ) ~ ')' } ).join: ', ';
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-triplets
+(
+    List:D[Int:D] $nums,     #= A list of 3 or more integers in increasing order
+    Pos:D         $diff      #= The target difference
+--> List:D[List:D[UInt:D]]   #= A list of the arithmetic triplets found
+)
+#-------------------------------------------------------------------------------
+{
+    my Array[UInt] @triplets;
+
+    L-OUTER: for 0 .. $nums.end - 2 -> UInt $i
+    {
+        for $i + 1 .. $nums.end - 1 -> UInt $j
+        {
+            if (my UInt $ji-diff = $nums[ $j ] - $nums[ $i ]) == $diff
+            {
+                for $j + 1 .. $nums.end -> $k
+                {
+                    if (my UInt $kj-diff = $nums[ $k ] - $nums[ $j ]) == $diff
+                    {
+                        @triplets.push: Array[UInt].new: $i, $j, $k;
+                        next L-OUTER;
+                    }
+                    elsif $kj-diff > $diff
+                    {
+                        next L-OUTER;
+                    }
+                }
+            }
+            elsif $ji-diff > $diff
+            {
+                next L-OUTER;
+            }
+        }
+    }
+
+    return @triplets;
+}
+
+#-------------------------------------------------------------------------------
+sub increasing-order( List:D[Int:D] $nums --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    for 1 .. $nums.end -> UInt $i
+    {
+        return False unless $nums[ $i ] > $nums[ $i - 1 ];
+    }
+
+    return True;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $num-str, $diff, $expected) = $line.split: / \| /;
+
+        for     $test-name, $num-str, $diff, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int         @nums     = $num-str.split( / \s+ / ).map: { .Int };
+        my Array[UInt] @triplets = find-triplets( @nums, $diff.Int );
+
+        is @triplets.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| 0  1  4 6 7 10      |3|2
+        Example 2| 4  5  6 7 8  9      |2|2
+        Negatives|-5 -4 -1 0 1  3 4 5 7|4|3
+        END
+}
+
+################################################################################
diff --git a/challenge-241/athanasius/raku/ch-2.raku b/challenge-241/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..2931149192
--- /dev/null
+++ b/challenge-241/athanasius/raku/ch-2.raku
@@ -0,0 +1,158 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 241
+=========================
+
+TASK #2
+-------
+*Prime Order*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of unique positive integers greater than 2.
+
+Write a script to sort them in ascending order of the count of their prime
+factors, tie-breaking by ascending value.
+
+Example 1
+
+  Input: @int = (11, 8, 27, 4)
+  Output: (11, 4, 8, 27)
+
+  Prime factors of 11 => 11
+  Prime factors of  4 => 2, 2
+  Prime factors of  8 => 2, 2, 2
+  Prime factors of 27 => 3, 3, 3
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Prime::Factor;
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 241, Task #2: Prime Order (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of unique positive integers greater than 2
+
+    *@int where { .elems > 0       &&       # Non-empty
+                  .all   ~~ UInt:D &&       # Positive integers
+                  .all   > 2       &&       # Greater than 2
+                   uniq-list( @int ) }      # Unique
+)
+#===============================================================================
+{
+    "Input:  \@int = (%s)\n".printf: @int.join: ', ';
+
+    my UInt @sorted = prime-sort( @int );
+
+    "Output:        (%s)\n".printf: @sorted.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub prime-sort( List:D[UInt:D] $int --> Seq:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt %count{UInt};
+            %count{ $_ } = prime-factors( $_ ).elems for @$int;
+
+    return $int.sort: { %count{ $^a } <=> %count{ $^b } || $^a <=> $^b };
+}
+
+#-------------------------------------------------------------------------------
+sub uniq-list( List:D[UInt:D] $int --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    return $int.elems == $int.Set.elems;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $int-str, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $int-str, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt @integers = $int-str.split( / \s+ / ).map: { .Int };
+        my UInt @expected = $exp-str.split( / \s+ / ).map: { .Int };
+        my UInt @sorted   = prime-sort( @integers );
+
+        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 )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1  | 11   8  27   4            | 11   4   8  27
+        Seq of 200s|207 208 209 210 211 212 213|211 209 213 207 212 210 208
+        END
+}
+
+################################################################################