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

4 files changed, 835 insertions, 0 deletions

diff --git a/challenge-199/athanasius/perl/ch-1.pl b/challenge-199/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..46ba4df6c2
--- /dev/null
+++ b/challenge-199/athanasius/perl/ch-1.pl
@@ -0,0 +1,199 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 199
+=========================
+
+TASK #1
+-------
+*Good Pairs*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of integers, @list.
+
+Write a script to find the total count of Good Pairs.
+
+
+    A pair (i, j) is called good if list[i] == list[j] and i < j.
+
+
+Example 1
+
+  Input: @list = (1,2,3,1,1,3)
+  Output: 4
+
+  There are 4 good pairs found as below:
+  (0,3)
+  (0,4)
+  (3,4)
+  (2,5)
+
+Example 2
+
+  Input: @list = (1,2,3)
+  Output: 0
+
+Example 3
+
+  Input: @list = (1,1,1,1)
+  Output: 6
+
+  Good pairs are below:
+  (0,1)
+  (0,2)
+  (0,3)
+  (1,2)
+  (1,3)
+  (2,3)
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. Otherwise, if $VERBOSE is set to a true value, an explanation like that in
+   Examples 1 and 3 is appended to the solution.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TEST_FIELDS => 3;
+const my $VERBOSE     => 1;
+const my $USAGE       =>
+"Usage:
+  perl $0 [<list> ...]
+  perl $0
+
+    [<list> ...]    A list of 1 or more integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 199, Task #1: Good Pairs (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @list = @ARGV;
+
+        for (@list)
+        {
+            / ^ $RE{num}{int} $ /x
+                or die qq[ERROR: "$_" is not a valid integer\n$USAGE];
+        }
+
+        printf "Input:  \@list = (%s)\n", join ',', @list;
+
+        my $pairs = find_good_pairs( \@list );
+
+        printf "Output: %d\n", scalar @$pairs;
+
+        give_details( $pairs ) if $VERBOSE;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_good_pairs
+#------------------------------------------------------------------------------
+{
+    my ($list) = @_;
+    my  @pairs;
+
+    for my $i (0 .. $#$list - 1)
+    {
+        for my $j ($i + 1 .. $#$list)
+        {
+            if ($list->[ $i ] == $list->[ $j ])
+            {
+                push @pairs, [ $i, $j ];
+            }
+        }
+    }
+
+    return \@pairs;
+}
+
+#------------------------------------------------------------------------------
+sub give_details
+#------------------------------------------------------------------------------
+{
+    my ($pairs) = @_;
+    my  $count  = scalar @$pairs;
+
+    if    ($count == 0)
+    {
+        print  "\nThere are no good pairs in the list\n";
+    }
+    elsif ($count == 1)
+    {
+        printf "\nThere is 1 good pair in the list:\n(%s)\n",
+                join( ',', @{ $pairs->[ 0 ] });
+    }
+    else
+    {
+        print  "\nThere are $count good pairs in the list:\n";
+
+        print  '(', join( ',', @$_ ), ")\n" for @$pairs;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $input, $expected) = split /\|/, $line, $TEST_FIELDS;
+
+        $input    =~ s/ ^ \s* (.+?) \s* $ /$1/x;              # Trim whitespace
+        $expected =~ s/ ^ \s* (.+?) \s* $ /$1/x;
+        $expected =~ s/   \s+             / /gx;
+
+        my @list  = split / , \s* /x, $input;
+        my $pairs = find_good_pairs( \@list );
+        my $got   = scalar @$pairs;
+
+        is $got, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1| 1, 2, 3, 1, 1, 3|4
+Example 2| 1, 2, 3         |0
+Example 3| 1, 1, 1, 1      |6
+Negatives|-1,-2,-3,-1,-1,-3|4
diff --git a/challenge-199/athanasius/perl/ch-2.pl b/challenge-199/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..0e657665d2
--- /dev/null
+++ b/challenge-199/athanasius/perl/ch-2.pl
@@ -0,0 +1,223 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 199
+=========================
+
+TASK #2
+-------
+*Good Triplets*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers, @array and three integers $x,$y,$z.
+
+Write a script to find out total Good Triplets in the given array.
+
+A triplet array[i], array[j], array[k] is good if it satisfies the following
+conditions:
+
+  a) 0 <= i < j < k <= n (size of given array)
+  b) abs(array[i] - array[j]) <= x
+  c) abs(array[j] - array[k]) <= y
+  d) abs(array[i] - array[k]) <= z
+
+Example 1
+
+  Input: @array = (3,0,1,1,9,7) and $x = 7, $y = 2, $z = 3
+  Output: 4
+
+  Good Triplets are as below:
+  (3,0,1) where (i=0, j=1, k=2)
+  (3,0,1) where (i=0, j=1, k=3)
+  (3,1,1) where (i=0, j=2, k=3)
+  (0,1,1) where (i=1, j=2, k=3)
+
+Example 2
+
+  Input: @array = (1,1,2,2,3) and $x = 0, $y = 0, $z = 1
+  Output: 0
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line argument is given, the test suite is run. Otherwise:
+2. N.B.: $x, $y, $z must appear on the command line (in that order) BEFORE the
+   elements of @array.
+3. If $VERBOSE is set to a true value, an explanation like that in Example 1 is
+   appended to the solution.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TEST_FIELDS => 3;
+const my $VERBOSE     => 1;
+const my $USAGE       =>
+"Usage:
+  perl $0 <x> <y> <z> [<array> ...]
+  perl $0
+
+    <x>              An integer
+    <y>              An integer
+    <z>              An integer
+    [<array> ...]    A list of integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 199, Task #2: Good Triplets (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args <  3)
+    {
+        error( "Expected 0 or 3+ arguments, found $args" );
+    }
+    else
+    {
+        for (@ARGV)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+        }
+
+        my ($x, $y, $z, @array) = @ARGV;
+
+        printf "Input:  \@array = (%s) and \$x = %d, \$y = %d, \$z = %d\n",
+                join( ',', @array ), $x, $y, $z;
+
+        my $triplets = find_good_triplets( $x, $y, $z, \@array );
+
+        printf "Output: %d\n", scalar @$triplets;
+
+        give_details( \@array, $triplets ) if $VERBOSE;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_good_triplets
+#------------------------------------------------------------------------------
+{
+    my ($x, $y, $z, $array) = @_;
+    my  @triplets;
+
+    for my $i (0 .. $#$array - 2)
+    {
+        for my $j ($i + 1 .. $#$array - 1)
+        {
+            if (abs( $array->[ $i ] - $array->[ $j ] ) <= $x)
+            {
+                for my $k ($j + 1 .. $#$array)
+                {
+                    if (abs( $array->[ $j ] - $array->[ $k ] ) <= $y &&
+                        abs( $array->[ $i ] - $array->[ $k ] ) <= $z)
+                    {
+                        push @triplets, [ $i, $j, $k ];
+                    }
+                }
+            }
+        }
+    }
+
+    return \@triplets;
+}
+
+#------------------------------------------------------------------------------
+sub give_details
+#------------------------------------------------------------------------------
+{
+    my ($array, $triplets) = @_;
+    my  $count = scalar @$triplets;
+
+    if    ($count == 0)
+    {
+        print "\nThere are no good triplets in the array\n";
+    }
+    elsif ($count == 1)
+    {
+        print "\nThere is 1 good triplet in the array:\n";
+
+        my @indices = @{ $triplets->[ 0 ] };
+
+        printf "(%s) where (i=%d, j=%d, k=%d)\n",
+                join( ',', (@$array)[ @indices ] ), @indices;
+    }
+    else
+    {
+        print "\nThere are $count good triplets in the array:\n";
+
+        for (@$triplets)
+        {
+            printf "(%s) where (i=%d, j=%d, k=%d)\n",
+                    join( ',', (@$array)[ @$_ ] ), @$_;
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $in, $expected) = split / \| /x, $line, $TEST_FIELDS;
+
+        s/ ^ \s* (.+?) \s* $ /$1/x                            # Trim whitespace
+            for $test_name, $in, $expected;
+
+        my ($x, $y, $z, @array) = split / , /x, $in;
+
+        my  $triplets = find_good_triplets( $x, $y, $z, \@array );
+
+        is scalar @$triplets, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1|7,2,3,3,0,1,1,9,7|4
+Example 2|0,0,1,1,1,2,2,3  |0
+Single   |7,2,3,3,0,1      |1
diff --git a/challenge-199/athanasius/raku/ch-1.raku b/challenge-199/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..6d93d77e13
--- /dev/null
+++ b/challenge-199/athanasius/raku/ch-1.raku
@@ -0,0 +1,201 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 199
+=========================
+
+TASK #1
+-------
+*Good Pairs*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of integers, @list.
+
+Write a script to find the total count of Good Pairs.
+
+
+    A pair (i, j) is called good if list[i] == list[j] and i < j.
+
+
+Example 1
+
+  Input: @list = (1,2,3,1,1,3)
+  Output: 4
+
+  There are 4 good pairs found as below:
+  (0,3)
+  (0,4)
+  (3,4)
+  (2,5)
+
+Example 2
+
+  Input: @list = (1,2,3)
+  Output: 0
+
+Example 3
+
+  Input: @list = (1,1,1,1)
+  Output: 6
+
+  Good pairs are below:
+  (0,1)
+  (0,2)
+  (0,3)
+  (1,2)
+  (1,3)
+  (2,3)
+
+=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 the first argument is negative, it must be preceded by "--" to distin-
+   guish it from a command-line flag.
+3. If $VERBOSE is set to True, an explanation like that in Examples 1 and 3 is
+   appended to the solution.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+my UInt constant $TEST-FIELDS = 3;
+my Bool constant $VERBOSE     = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 199, Task #1: Good Pairs (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A list of 1 or more integers
+
+    *@list where { .elems >= 1 && .all ~~ Int:D }
+)
+#==============================================================================
+{
+    "Input:  \@list = (%s)\n".printf: @list.join: ',';
+
+    my Array[UInt] @pairs = find-good-pairs( @list );
+
+    "Output: %d\n".printf: @pairs.elems;
+
+    give-details( @pairs ) if $VERBOSE;
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-good-pairs( List:D[Int:D] $list --> List:D[List:D[UInt:D]])
+#------------------------------------------------------------------------------
+{
+    my Array[UInt] @pairs;
+
+    for 0 .. $list.end - 1 -> UInt $i
+    {
+        for $i + 1 .. $list.end -> UInt $j
+        {
+            if $list[ $i ] == $list[ $j ]
+            {
+                @pairs.push: Array[UInt].new: $i, $j;
+            }
+        }
+    }
+
+    return @pairs;
+}
+
+#------------------------------------------------------------------------------
+sub give-details( List:D[UInt:D] $pairs )
+#------------------------------------------------------------------------------
+{
+    my UInt $count = $pairs.elems;
+
+    if    $count == 0
+    {
+        "\nThere are no good pairs in the list".put;
+    }
+    elsif $count == 1
+    {
+        "\nThere is 1 good pair in the list:\n(%s)\n".printf:
+            @$pairs[ 0 ].join: ',';
+    }
+    else
+    {
+        "\nThere are $count good pairs in the list:".put;
+
+        ('(' ~ @$_.join( ',' ) ~ ')').put for @$pairs;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $input, $expected) =
+                $line.split: / \| /, $TEST-FIELDS;
+
+        $input    ~~ s/ ^ \s* (.+?) \s* $ /$0/;               # Trim whitespace
+        $expected ~~ s/ ^ \s* (.+?) \s* $ /$0/;
+        $expected ~~ s:g/ \s+ / /;
+
+        my Int         @list  = $input.split( / \, \s* / ).map: { .Int };
+        my Array[UInt] @pairs = find-good-pairs( @list );
+        my UInt        $got   = @pairs.elems;
+
+        is $got, $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| 1, 2, 3, 1, 1, 3|4
+        Example 2| 1, 2, 3         |0
+        Example 3| 1, 1, 1, 1      |6
+        Negatives|-1,-2,-3,-1,-1,-3|4
+        END
+}
+
+###############################################################################
diff --git a/challenge-199/athanasius/raku/ch-2.raku b/challenge-199/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..a13936da5d
--- /dev/null
+++ b/challenge-199/athanasius/raku/ch-2.raku
@@ -0,0 +1,212 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 199
+=========================
+
+TASK #2
+-------
+*Good Triplets*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers, @array and three integers $x,$y,$z.
+
+Write a script to find out total Good Triplets in the given array.
+
+A triplet array[i], array[j], array[k] is good if it satisfies the following
+conditions:
+
+  a) 0 <= i < j < k <= n (size of given array)
+  b) abs(array[i] - array[j]) <= x
+  c) abs(array[j] - array[k]) <= y
+  d) abs(array[i] - array[k]) <= z
+
+Example 1
+
+  Input: @array = (3,0,1,1,9,7) and $x = 7, $y = 2, $z = 3
+  Output: 4
+
+  Good Triplets are as below:
+  (3,0,1) where (i=0, j=1, k=2)
+  (3,0,1) where (i=0, j=1, k=3)
+  (3,1,1) where (i=0, j=2, k=3)
+  (0,1,1) where (i=1, j=2, k=3)
+
+Example 2
+
+  Input: @array = (1,1,2,2,3) and $x = 0, $y = 0, $z = 1
+  Output: 0
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. N.B.: $x, $y, $z must appear on the command line (in that order) BEFORE the
+   elements of @array.
+3. If the first argument is negative, it must be preceded by "--" to distin-
+   guish it from a command-line flag.
+4. If $VERBOSE is set to a true value, an explanation like that in Example 1 is
+   appended to the solution.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+my UInt constant $TEST-FIELDS = 3;
+my Bool constant $VERBOSE     = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 199, Task #2: Good Triplets (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    Int:D $x,                           #= An integer
+    Int:D $y,                           #= An integer
+    Int:D $z,                           #= An integer
+    *@array where { .all ~~ Int:D }     #= A list of integers
+)
+#==============================================================================
+{
+    "Input:  \@array = (%s) and \$x = %d, \$y = %d, \$z = %d\n".printf:
+        @array.join( ',' ), $x, $y, $z;
+
+    my Array[UInt] @triplets = find-good-triplets( $x, $y, $z, @array );
+
+    "Output: %d\n".printf: @triplets.elems;
+
+    give-details( @array, @triplets ) if $VERBOSE;
+}
+
+#==============================================================================
+multi sub MAIN()                                           # Run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-good-triplets
+(
+    Int:D         $x,
+    Int:D         $y,
+    Int:D         $z,
+    List:D[Int:D] $array
+--> List:D[List:D[UInt:D]]
+)
+#------------------------------------------------------------------------------
+{
+    my Array[UInt] @triplets;
+
+    for 0 .. $array.end - 2 -> UInt $i
+    {
+        for $i + 1 .. $array.end - 1 -> UInt $j
+        {
+            if ($array[ $i ] - $array[ $j ]).abs <= $x
+            {
+                for $j + 1 .. $array.end -> UInt $k
+                {
+                    if ($array[ $j ] - $array[ $k ]).abs <= $y &&
+                       ($array[ $i ] - $array[ $k ]).abs <= $z
+                    {
+                        @triplets.push: Array[UInt].new: $i, $j, $k;
+                    }
+                }
+            }
+        }
+    }
+
+    return @triplets;
+}
+
+#------------------------------------------------------------------------------
+sub give-details( List:D[Int:D] $array, List:D[List:D[UInt:D]] $triplets )
+#------------------------------------------------------------------------------
+{
+    my UInt $count = $triplets.elems;
+
+    if    $count == 0
+    {
+        "\nThere are no good triplets in the array".put;
+    }
+    elsif $count == 1
+    {
+        "\nThere is 1 good triplet in the array:\n".put;
+
+        "(%s) where (i=%d, j=%d, k=%d)\n".printf:
+            $array[ |$triplets[ 0 ] ].join( ',' ), |$triplets[ 0 ];
+    }
+    else
+    {
+        "\nThere are $count good triplets in the array:".put;
+
+        "(%s) where (i=%d, j=%d, k=%d)\n".printf:
+            $array[ @$_ ].join( ',' ), @$_ for @$triplets;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $input, $expected) =
+            $line.split: / \| /, $TEST-FIELDS;
+
+        s/ ^ \s* (.+?) \s* $ /$0/                             # Trim whitespace
+            for $test-name, $input, $expected;
+
+        my Int ($x, $y, $z, @array) =
+            $input.split( / \, /, :skip-empty ).map: { .Int };
+
+        my UInt $got = find-good-triplets( $x, $y, $z, @array ).elems;
+
+        is $got, $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|7,2,3,3,0,1,1,9,7|4
+        Example 2|0,0,1,1,1,2,2,3  |0
+        Single   |7,2,3,3,0,1      |1
+        END
+}
+
+###############################################################################