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

4 files changed, 800 insertions, 0 deletions

diff --git a/challenge-284/athanasius/perl/ch-1.pl b/challenge-284/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..8d8b58b1b8
--- /dev/null
+++ b/challenge-284/athanasius/perl/ch-1.pl
@@ -0,0 +1,171 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 284
+=========================
+
+TASK #1
+-------
+*Lucky Integer*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to find the lucky integer if found otherwise return -1. If there
+are more than one then return the largest.
+
+    A lucky integer is an integer that has a frequency in the array equal to its
+    value.
+
+Example 1
+
+  Input: @ints = (2, 2, 3, 4)
+  Output: 2
+
+Example 2
+
+  Input: @ints = (1, 2, 2, 3, 3, 3)
+  Output: 3
+
+Example 3
+
+  Input: @ints = (1, 1, 1, 3)
+  Output: -1
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+Negative integers are excluded.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of unsigned 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 list of unsigned (i.e., non-negative) integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 284, Task #1: Lucky Integer (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        for (@ints)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+
+            $_ >= 0                or error( "$_ is negative" );
+            $_ += 0;               # Normalize the elements (e.g. +5 --> 5)
+        }
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $lucky_int = find_lucky_int( \@ints );
+
+        print  "Output: $lucky_int\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_lucky_int
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+    my  %freq;
+      ++$freq{ $_ } for @$ints;
+
+    # "If there are more than one [lucky number] then return the largest." To
+    # accomplish this, the elements are tested in reverse order (highest first).
+
+    for my $n (sort { $b <=> $a } @$ints)
+    {
+        return $n if $n == $freq{ $n };
+    }
+
+    return -1;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints      = split / \s+ /x, $ints_str;
+        my $lucky_int = find_lucky_int( \@ints );
+
+        is $lucky_int, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1     |2 2 3 4    | 2
+Example 2     |1 2 2 3 3 3| 3
+Example 3     |1 1 1 3    |-1
+Ex 2 reordered|3 3 3 2 2 1| 3
diff --git a/challenge-284/athanasius/perl/ch-2.pl b/challenge-284/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..17fb2c14b2
--- /dev/null
+++ b/challenge-284/athanasius/perl/ch-2.pl
@@ -0,0 +1,231 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 284
+=========================
+
+TASK #2
+-------
+*Relative Sort*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two list of integers, @list1 and @list2. The elements in the
+@list2 are distinct and also in the @list1.
+
+Write a script to sort the elements in the @list1 such that the relative order
+of items in @list1 is same as in the @list2. Elements that is missing in @list2
+should be placed at the end of @list1 in ascending order.
+
+Example 1
+
+  Input: @list1 = (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5)
+         @list2 = (2, 1, 4, 3, 5, 6)
+  Output: (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)
+
+Example 2
+
+  Input: @list1 = (3, 3, 4, 6, 2, 4, 2, 1, 3)
+         @list2 = (1, 3, 2)
+  Output: (1, 3, 3, 3, 2, 2, 4, 4, 6)
+
+Example 3
+
+  Input: @list1 = (3, 0, 5, 0, 2, 1, 4, 1, 1)
+         @list2 = (1, 0, 3, 2)
+  Output: (1, 1, 1, 0, 0, 3, 2, 4, 5)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 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. Each string contains a list of
+   integers separated by whitespace. The integers in the second list are unique
+   within that list, and each is also an element of the first list.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures and warnings
+use Const::Fast;
+use List::Util     qw( any );
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <list1> <list2>
+  perl $0
+
+    <list1>    String of whitespace-separated integers
+    <list2>    String of whitespace-separated distinct integers also in list1
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 284, Task #2: Relative Sort (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($list1, $list2) = parse_command_line();
+
+        printf "Input: \@list1 = (%s)\n", join ', ', @$list1;
+        printf "       \@list2 = (%s)\n", join ', ', @$list2;
+
+        my $sorted = relative_sort( $list1, $list2 );
+
+        printf "Output:         (%s)\n",  join ', ', @$sorted;
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub relative_sort
+#-------------------------------------------------------------------------------
+{
+    my ($list1, $list2) = @_;
+    my (@sorted, @missing);
+    my  %dict;
+
+    for my $n (@$list1)
+    {
+        if (any { $_ == $n } @$list2)
+        {
+            ++$dict{ $n };
+        }
+        else
+        {
+            push @missing, $n;
+        }
+    }
+
+    for my $m (@$list2)
+    {
+        push @sorted, $m for 1 .. $dict{ $m };
+    }
+
+    push @sorted, sort { $a <=> $b } @missing;
+
+    return \@sorted;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my ($list1, $list2) = @ARGV;
+    my (@list1, @list2);
+
+    trim_strs( $list1, $list2 );
+
+    for my $s (split / \s+ /x, $list1)
+    {
+        $s =~ / ^ $RE{num}{int} $ /x
+            or error( qq["$s" is not a valid integer] );
+
+        push @list1, $s + 0;                   # Normalize $s
+    }
+
+    my %dict1;
+     ++$dict1{ $_ } for @list1;
+
+    for my $t (split / \s+ /x, $list2)
+    {
+        $t =~ / ^ $RE{num}{int} $ /x
+            or error( qq["$t" is not a valid integer] );
+
+        push @list2, $t + 0;                   # Normalize $t
+    }
+
+    my %dict2;
+     ++$dict2{ $_ } for @list2;
+
+    for my $n (@list2)
+    {
+        $dict2{ $n } == 1   or error( "Element $n is not unique in \@list2"  );
+        exists $dict1{ $n } or error( "\@list2 element $n is not in \@list1" );
+    }
+
+    return (\@list1, \@list2);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $list1_str, $list2_str, $expected_str) =
+             split / \| /x, $line;
+
+        trim_strs( $test_name, $list1_str, $list2_str, $expected_str );
+
+        my @list1    = split / \s+ /x, $list1_str;
+        my @list2    = split / \s+ /x, $list2_str;
+        my @expected = split / \s+ /x, $expected_str;
+        my $sorted   = relative_sort( \@list1, \@list2 );
+
+        is_deeply $sorted, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub trim_strs
+#-------------------------------------------------------------------------------
+{
+    for (@_)
+    {
+        s/ ^ \s+   //x;
+        s/   \s+ $ //x;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|2 3 9 3 1 4 6 7 2 8 5|2 1 4 3 5 6|2 2 1 4 3 3 5 6 7 8 9
+Example 2|3 3 4 6 2 4 2 1 3    |1 3 2      |1 3 3 3 2 2 4 4 6
+Example 3|3 0 5 0 2 1 4 1 1    |1 0 3 2    |1 1 1 0 0 3 2 4 5
diff --git a/challenge-284/athanasius/raku/ch-1.raku b/challenge-284/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..76d39d7b63
--- /dev/null
+++ b/challenge-284/athanasius/raku/ch-1.raku
@@ -0,0 +1,161 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 284
+=========================
+
+TASK #1
+-------
+*Lucky Integer*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to find the lucky integer if found otherwise return -1. If there
+are more than one then return the largest.
+
+    A lucky integer is an integer that has a frequency in the array equal to its
+    value.
+
+Example 1
+
+  Input: @ints = (2, 2, 3, 4)
+  Output: 2
+
+Example 2
+
+  Input: @ints = (1, 2, 2, 3, 3, 3)
+  Output: 3
+
+Example 3
+
+  Input: @ints = (1, 1, 1, 3)
+  Output: -1
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+Negative integers are excluded.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of unsigned integers is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 284, Task #1: Lucky Integer (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A list of unsigned (i.e., non-negative) integers
+
+    *@ints where { .elems > 0 && .all ~~ UInt:D }
+)
+#===============================================================================
+{
+    my Int @ints_ = @ints;             # Make a copy, then
+           @ints_.map: { $_ += 0 };    # Normalize the elements (e.g., +5 --> 5)
+
+    "Input:  \@ints = (%s)\n".printf: @ints_.join: ', ';
+
+    my Int $lucky-int = find-lucky-int( @ints_ );
+
+    "Output: $lucky-int".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-lucky-int( List:D[UInt:D] $ints --> Int:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt %freq{UInt};
+          ++%freq{ $_ } for @$ints;
+
+    # "If there are more than one [lucky number] then return the largest." To
+    # accomplish this, the elements are tested in reverse order (highest first).
+
+    for @$ints.sort: { $^b <=> $^a } -> UInt $n
+    {
+        return $n if $n == %freq{ $n };
+    }
+
+    return -1;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @ints      = $ints-str.split( / \s+ / ).map: { .Int };
+        my Int $lucky-int = find-lucky-int( @ints );
+
+        is $lucky-int, $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     |2 2 3 4    | 2
+        Example 2     |1 2 2 3 3 3| 3
+        Example 3     |1 1 1 3    |-1
+        Ex 2 reordered|3 3 3 2 2 1| 3
+        END
+}
+
+################################################################################
diff --git a/challenge-284/athanasius/raku/ch-2.raku b/challenge-284/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..77c2ebb983
--- /dev/null
+++ b/challenge-284/athanasius/raku/ch-2.raku
@@ -0,0 +1,237 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 284
+=========================
+
+TASK #2
+-------
+*Relative Sort*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two list of integers, @list1 and @list2. The elements in the
+@list2 are distinct and also in the @list1.
+
+Write a script to sort the elements in the @list1 such that the relative order
+of items in @list1 is same as in the @list2. Elements that is missing in @list2
+should be placed at the end of @list1 in ascending order.
+
+Example 1
+
+  Input: @list1 = (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5)
+         @list2 = (2, 1, 4, 3, 5, 6)
+  Output: (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)
+
+Example 2
+
+  Input: @list1 = (3, 3, 4, 6, 2, 4, 2, 1, 3)
+         @list2 = (1, 3, 2)
+  Output: (1, 3, 3, 3, 2, 2, 4, 4, 6)
+
+Example 3
+
+  Input: @list1 = (3, 0, 5, 0, 2, 1, 4, 1, 1)
+         @list2 = (1, 0, 3, 2)
+  Output: (1, 1, 1, 0, 0, 3, 2, 4, 5)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 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. Each string contains a list of
+   integers separated by whitespace. The integers in the second list are unique
+   within that list, and each is also an element of the first list.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 284, Task #2: Relative Sort (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $list1,    #= String of whitespace-separated integers
+    Str:D $list2     #= String of whitespace-separated distinct integers also in
+                     #= list1
+)
+#===============================================================================
+{
+    my Array[Int] @lists = parse-command-line( $list1, $list2 );
+
+    my Int (@list1, @list2) := @lists;            # ":=" is the binding operator
+
+    "Input: \@list1 = (%s)\n".printf: @list1.join: ', ';
+    "       \@list2 = (%s)\n".printf: @list2.join: ', ';
+
+    my Int @sorted = relative-sort( @list1, @list2 );
+
+    "Output:         (%s)\n".printf: @sorted.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub relative-sort
+(
+    List:D[Int:D] $list1,
+    List:D[Int:D] $list2
+--> List:D[Int:D]
+)
+#-------------------------------------------------------------------------------
+{
+    my Int (@sorted, @missing);
+    my UInt %dict{Int};
+
+    for @$list1 -> Int $n
+    {
+        if $n ∈ $list2
+        {
+            ++%dict{ $n };
+        }
+        else
+        {
+            @missing.push: $n;
+        }
+    }
+
+    for @$list2 -> Int $m
+    {
+        @sorted.push( $m ) for ^%dict{ $m };
+    }
+
+    @sorted.append: @missing.sort;            # Note: append() flattens the list
+
+    return @sorted;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-command-line
+(
+    Str:D $list1,
+    Str:D $list2
+--> List:D[ List:D[Int:D], List:D[Int:D] ]
+)
+#-------------------------------------------------------------------------------
+{
+    my Int (@list1, @list2);
+
+    for $list1.split: / \s+ /, :skip-empty -> Str $s
+    {
+        +$s ~~ Int:D or error( qq["$s" is not a valid integer] );
+        @list1.push: +$s;
+    }
+
+    my UInt %dict1{Int};
+          ++%dict1{ $_ } for @list1;
+
+    for $list2.split: / \s+ /, :skip-empty -> Str $t
+    {
+        +$t ~~ Int:D or error( qq["$t" is not a valid integer] );
+        @list2.push: +$t;
+    }
+
+    my UInt %dict2{Int};
+          ++%dict2{ $_ } for @list2;
+
+    for @list2 -> Int $n
+    {
+        %dict2{ $n } == 1   or error( "Element $n is not unique in \@list2"  );
+        %dict1{ $n }:exists or error( "\@list2 element $n is not in \@list1" );
+    }
+
+    return @list1, @list2;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $list1-str, $list2-str, $expected-str) =
+                $line.split: / \| /;
+
+        for     $test-name, $list1-str, $list2-str, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @list1    = str-to-ints( $list1-str );
+        my Int @list2    = str-to-ints( $list2-str );
+        my Int @expected = str-to-ints( $expected-str );
+        my Int @sorted   = relative-sort( @list1, @list2 );
+
+        is-deeply @sorted, @expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub str-to-ints( Str:D $string --> Seq:D[Int:D] )
+#-------------------------------------------------------------------------------
+{
+    return $string.split( / \s+ /, :skip-empty ).map: { .Int };
+}
+
+#-------------------------------------------------------------------------------
+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|2 3 9 3 1 4 6 7 2 8 5|2 1 4 3 5 6|2 2 1 4 3 3 5 6 7 8 9
+        Example 2|3 3 4 6 2 4 2 1 3    |1 3 2      |1 3 3 3 2 2 4 4 6
+        Example 3|3 0 5 0 2 1 4 1 1    |1 0 3 2    |1 1 1 0 0 3 2 4 5
+        END
+}
+
+################################################################################