Merge pull request #8821 from PerlMonk-Athanasius/branch-for-challenge-237

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

4 files changed, 905 insertions, 0 deletions

diff --git a/challenge-237/athanasius/perl/ch-1.pl b/challenge-237/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..03d6c68447
--- /dev/null
+++ b/challenge-237/athanasius/perl/ch-1.pl
@@ -0,0 +1,266 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 237
+=========================
+
+TASK #1
+-------
+*Seize The Day*
+
+Submitted by: Mark Anderson
+
+Given a year, a month, a weekday of month, and a day of week
+(1 (Mon) .. 7 (Sun)), print the day.
+
+Example 1
+
+  Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2
+  Output: 16
+
+  The 3rd Tue of Apr 2024 is the 16th
+
+Example 2
+
+  Input: Year = 2025, Month = 10, Weekday of month = 2, day of week = 4
+  Output: 9
+
+  The 2nd Thu of Oct 2025 is the 9th
+
+Example 3
+
+  Input: Year = 2026, Month = 8, Weekday of month = 5, day of week = 3
+  Output: 0
+
+  There isn't a 5th Wed in Aug 2026
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+All dates are according to the Gregorian calendar (which first came into use on
+15th October, 1582 AD).
+
+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 default), the output is followed by a
+   short explanation, as given in the Examples.
+
+=cut
+#===============================================================================
+
+use v5.32.1;
+use warnings;
+use Const::Fast;
+use DateTime       qw( day_of_week month_length );
+use Getopt::Long;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE =>    1;
+const my $FIRSTYR => 1582;         # The Gregorian calendar began on 15-Oct-1582
+const my $FIRSTMN =>   10;
+const my $FIRSTDT =>   15;
+const my @MONTHS  => qw( January February  March     April    May    June   July
+                         August  September October   November December );
+const my @WKDAYS  => qw( Monday  Tuesday   Wednesday Thursday Friday Saturday
+                         Sunday );
+const my $USAGE   =>
+"Usage:
+  perl $0 [--year[=Int]] [--month[=Int]] [--week[=Int]] [--dow[=Int]]
+  perl $0
+
+    --year [=Int $FIRSTYR+]    Year in the Gregorian calendar
+    --month[=Int 1-12 ]    Month         (1 = January)
+    --week [=Int 1-5  ]    Week of month (1 = first week)
+    --dow  [=Int 1-7  ]    Day  of week  (1 = Monday)\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 237, Task #1: Seize The Day (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($year, $month, $week, $dow) = parse_command_line();
+
+        printf "Input:  Year = %d, Month = %d, Week = %d, Day of Week = %d\n",
+            $year, $month, $week, $dow;
+
+        my $day_of_month = find_day_of_month( $year, $month, $week, $dow );
+
+        print "Output: $day_of_month\n";
+
+        check_date( $year, $month, $day_of_month ) if $day_of_month > 0;
+
+        if ($VERBOSE)
+        {
+            if ($day_of_month == 0)
+            {
+                printf "\nThere isn\'t a %s %s in %s %s\n", ordinal( $week ),
+                        $WKDAYS[ $dow - 1 ], $MONTHS[ $month - 1 ],  $year;
+            }
+            else
+            {
+                printf "\nThe %s %s of %s %d is the %s\n",  ordinal( $week ),
+                        $WKDAYS[ $dow - 1 ], $MONTHS[ $month - 1 ],  $year,
+                        ordinal( $day_of_month );
+            }
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_day_of_month
+#-------------------------------------------------------------------------------
+{
+    my ($year, $month, $week, $dow) = @_;
+    my  $date      = DateTime->new( year => $year, month => $month, day => 1 );
+    my  $first_dow = $date->day_of_week;
+    my  $last_dom  = $date->month_length;
+    my  $offset    = $dow - $first_dow;
+        $offset   += 7 if $offset < 0;
+    my  $day       = 1 +  $offset + ($week - 1) * 7;
+
+    return $day <= $last_dom ? $day : 0;
+}
+
+#-------------------------------------------------------------------------------
+sub check_date
+#-------------------------------------------------------------------------------
+{
+    my ($year, $month, $day) = @_;
+
+    if ($year  <= $FIRSTYR &&
+       ($month <  $FIRSTMN || ($month == $FIRSTMN && $day < $FIRSTDT)))
+    {
+        my $date = sprintf '%4d-%02d-%02d', $year, $month, $day;
+
+        warn "\nWARNING: The date $date precedes the introduction of the " .
+               "Gregorian calendar\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub ordinal
+#-------------------------------------------------------------------------------
+{
+    my ($cardinal) = @_;
+    my  $suffix    = 'th';
+    my  $ones      = $cardinal % 10;
+    my  $tens      = int( $cardinal / 10 );
+
+    unless ($tens == 1)
+    {
+        $suffix = $ones == 1 ? 'st' :
+                  $ones == 2 ? 'nd' :
+                  $ones == 3 ? 'rd' : 'th';
+    }
+
+    return $cardinal . $suffix;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my ($year, $month, $week, $dow);
+
+    GetOptions
+    (
+        'year=i'  => \$year,
+        'month=i' => \$month,
+        'week=i'  => \$week,
+        'dow=i'   => \$dow,
+
+    ) or error( 'Invalid in command-line arguments' );
+
+    for ([ 'year',            $year  ],
+         [ 'month',           $month ],
+         [ 'week',            $week  ],
+         [ 'day of the week', $dow   ])
+    {
+        my ($name, $value) = @$_;
+
+        defined $value or error( "Missing $name" );
+
+        $value =~ / ^ $RE{num}{int} $ /x
+            or error( qq[$name "$value" is not a valid integer] );
+    }
+
+    $year >= $FIRSTYR or error( "$year precedes the introduction of the " .
+                                'Gregorian calendar' );
+    1 <= $month <= 12 or error( "$month is not a valid month" );
+    1 <= $week  <=  5 or error( "$week is not a valid week" );
+    1 <= $dow   <=  7 or error( "$dow is not a valid day of the week" );
+    scalar @ARGV == 0 or error( 'Unrecognised command-line argument' );
+
+    return ($year, $month, $week, $dow);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $year, $month, $week, $day, $expected) =
+             split / \| /x, $line;
+
+        for ($test_name, $year, $month, $week, $day, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $day_of_month = find_day_of_month( $year, $month, $week, $day );
+
+        is $day_of_month, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1             |2024| 4|3|2|16
+Example 2             |2025|10|2|4| 9
+Example 3             |2026| 8|5|3| 0
+Cook reached Australia|1770| 4|3|4|19
+D-Day                 |1944| 6|1|2| 6
diff --git a/challenge-237/athanasius/perl/ch-2.pl b/challenge-237/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b69e56bb19
--- /dev/null
+++ b/challenge-237/athanasius/perl/ch-2.pl
@@ -0,0 +1,195 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 237
+=========================
+
+TASK #2
+-------
+*Maximise Greatness*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to permute the given array such that you get the maximum possible
+greatness.
+
+    To determine greatness, nums[i] < perm[i] where 0 <= i < nums.length
+
+Example 1
+
+  Input: @nums = (1, 3, 5, 2, 1, 3, 1)
+  Output: 4
+
+  One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as
+  below:
+  nums[0] < perm[0]
+  nums[1] < perm[1]
+  nums[3] < perm[3]
+  nums[4] < perm[4]
+
+Example 2
+
+  Input: @ints = (1, 2, 3, 4)
+  Output: 3
+
+  One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
+  nums[0] < perm[0]
+  nums[1] < perm[1]
+  nums[2] < perm[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 default), the output is followed by
+   details of one possible permutation which gives the maximum greatness.
+
+=cut
+#===============================================================================
+
+use v5.32.1;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 [<nums> ...]
+  perl $0
+
+    [<nums> ...]    A non-empty list of integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 237, Task #2: Maximise Greatness (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @nums = @ARGV;
+
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+            for @nums;
+
+        printf "Input:  \@nums =  (%s)\n",  join ', ', @nums;
+
+        my ($max, $perm) = find_max_greatness( \@nums );
+
+        print  "Output: $max\n";
+
+        printf "\nOne permutation: (%s)\n", join ', ', @$perm if $VERBOSE;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_max_greatness
+#-------------------------------------------------------------------------------
+{
+    my ($nums) = @_;
+    my  $max   = 0;
+    my  @from  = sort { $a <=> $b } @$nums;
+    my  @to    = @from;
+    my  @perm  = (undef) x scalar @$nums;
+
+    while (@from)
+    {
+        my $from = pop @from;
+        my $to;
+
+        if ($to[ -1 ] > $from)
+        {
+            $to = pop   @to;
+            ++$max;
+        }
+        else
+        {
+            $to = shift @to;
+        }
+
+        for my $i (0 .. $#$nums)
+        {
+            next if defined $perm[ $i ];
+
+            if ($nums->[ $i ] == $from)
+            {
+                $perm[ $i ] = $to;
+                last;
+            }
+        }
+    }
+
+    return ($max, \@perm);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $num_str, $exp, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $num_str, $exp, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @nums = split / \s+ /x, $num_str;
+        my @exp  = split / \s+ /x, $exp_str;
+
+        my ($max, $perm) = find_max_greatness( \@nums );
+
+        is        $max,   $exp, $test_name . ': maximum greatness';
+        is_deeply $perm, \@exp, $test_name . ': permutation';
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 1  3  5  2 1  3 1|4| 3  5  1  3 2  1  1
+Example 2| 1  2  3  4       |3| 2  3  4  1
+Negatives|-1 -2 -3 -4       |3|-4 -1 -2 -3
+Mixed    | 0 -1  1 -2 2 -3 3|6| 1  0  2 -1 3 -2 -3
diff --git a/challenge-237/athanasius/raku/ch-1.raku b/challenge-237/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..8a11c2a62f
--- /dev/null
+++ b/challenge-237/athanasius/raku/ch-1.raku
@@ -0,0 +1,244 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 237
+=========================
+
+TASK #1
+-------
+*Seize The Day*
+
+Submitted by: Mark Anderson
+
+Given a year, a month, a weekday of month, and a day of week
+(1 (Mon) .. 7 (Sun)), print the day.
+
+Example 1
+
+  Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2
+  Output: 16
+
+  The 3rd Tue of Apr 2024 is the 16th
+
+Example 2
+
+  Input: Year = 2025, Month = 10, Weekday of month = 2, day of week = 4
+  Output: 9
+
+  The 2nd Thu of Oct 2025 is the 9th
+
+Example 3
+
+  Input: Year = 2026, Month = 8, Weekday of month = 5, day of week = 3
+  Output: 0
+
+  There isn't a 5th Wed in Aug 2026
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+All dates are according to the Gregorian calendar (which first came into use on
+15th October, 1582 AD).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If VERBOSE is set to True (the default), the output is followed by a short
+   explanation, as given in the Examples.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant VERBOSE = True;
+my UInt constant FIRSTYR = 1582;   # The Gregorian calendar began on 15-Oct-1582
+my UInt constant FIRSTMN =   10;
+my UInt constant FIRSTDT =   15;
+my      constant @MONTHS = Array[Str].new: < January February March April May
+                                             June July August September October
+                                             November December >;
+my      constant @WKDAYS = Array[Str].new: < Monday Tuesday Wednesday Thursday
+                                             Friday Saturday Sunday >;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 237, Task #1: Seize The Day (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    UInt:D :$year  where * >= FIRSTYR,         #= Year in the Gregorian calendar
+    UInt:D :$month where 1 <= * <= 12,         #= Month (1 = January)
+    UInt:D :$week  where 1 <= * <=  5,         #= Week of month (1 = first week)
+    UInt:D :$dow   where 1 <= * <=  7          #= Day of week (1 = Monday)
+)
+#===============================================================================
+{
+    "Input:  Year = %d, Month = %d, Week = %d, Day of Week = %d\n".printf:
+        $year, $month, $week, $dow;
+
+    my UInt  $day-of-month = find-day-of-month( $year, $month, $week, $dow );
+
+    "Output: $day-of-month".put;
+
+    check-date( $year, $month, $day-of-month ) if $day-of-month > 0;
+
+    if VERBOSE
+    {
+        if $day-of-month == 0
+        {
+            "\nThere isn\'t a %s %s in %s %s\n".printf:
+                ordinal( $week ), @WKDAYS[ $dow - 1 ], @MONTHS[ $month - 1 ],
+                $year;
+        }
+        else
+        {
+            "\nThe %s %s of %s %d is the %s\n".printf:
+                ordinal( $week ), @WKDAYS[ $dow - 1 ], @MONTHS[ $month - 1 ],
+                $year, ordinal( $day-of-month );
+        }
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-day-of-month
+(
+    UInt:D $year  where * >= FIRSTYR,          #= Year in the Gregorian calendar
+    UInt:D $month where 1 <= * <= 12,          #= Month (1 = January)
+    UInt:D $week  where 1 <= * <=  5,          #= Week of month (1 = first week)
+    UInt:D $dow   where 1 <= * <=  7           #= Day of week (1 = Monday)
+--> UInt:D
+)
+#-------------------------------------------------------------------------------
+{
+    my Date $date      = Date.new: $year, $month, 1;
+    my UInt $first-dow = $date.day-of-week;
+    my UInt $last-dom  = $date.days-in-month;
+    my Int  $offset    = $dow - $first-dow;
+            $offset   += 7 if $offset < 0;
+    my UInt $day       = 1 +  $offset + ($week - 1) * 7;
+
+    return  $day <= $last-dom ?? $day !! 0;
+}
+
+#-------------------------------------------------------------------------------
+sub check-date
+(
+    UInt:D $year  where * >= FIRSTYR,          #= Year in the Gregorian calendar
+    UInt:D $month where 1 <= * <= 12,          #= Month (1 = January)
+    UInt:D $day   where 1 <= * <= 31           #= Day of the month
+)
+#-------------------------------------------------------------------------------
+{
+    if $year  <= FIRSTYR &&
+      ($month <  FIRSTMN || ($month == FIRSTMN && $day < FIRSTDT))
+    {
+        my Str $date = '%4d-%02d-%02d'.sprintf: $year, $month, $day;
+
+        $*ERR.put: "\nWARNING: The date $date precedes the introduction of " ~
+                     'the Gregorian calendar';
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub ordinal( UInt:D $cardinal where 1 <= * <= 31 --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str  $suffix = 'th';
+    my UInt $ones   =  $cardinal % 10;
+    my UInt $tens   = ($cardinal / 10).floor;
+
+    unless  $tens == 1
+    {
+        $suffix = $ones == 1 ?? 'st' !!
+                  $ones == 2 ?? 'nd' !!
+                  $ones == 3 ?? 'rd' !! 'th';
+    }
+
+    return $cardinal ~ $suffix;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $year, $month, $week, $day, $expected) =
+                $line.split: / \| /;
+
+        for     $test-name, $year, $month, $week, $day, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt $day-of-month =
+                find-day-of-month( $year.Int, $month.Int, $week.Int, $day.Int );
+
+        is $day-of-month, $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             |2024| 4|3|2|16
+        Example 2             |2025|10|2|4| 9
+        Example 3             |2026| 8|5|3| 0
+        Cook reached Australia|1770| 4|3|4|19
+        D-Day                 |1944| 6|1|2| 6
+        END
+}
+
+################################################################################
diff --git a/challenge-237/athanasius/raku/ch-2.raku b/challenge-237/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..82f240c644
--- /dev/null
+++ b/challenge-237/athanasius/raku/ch-2.raku
@@ -0,0 +1,200 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 237
+=========================
+
+TASK #2
+-------
+*Maximise Greatness*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to permute the given array such that you get the maximum possible
+greatness.
+
+    To determine greatness, nums[i] < perm[i] where 0 <= i < nums.length
+
+Example 1
+
+  Input: @nums = (1, 3, 5, 2, 1, 3, 1)
+  Output: 4
+
+  One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as
+  below:
+  nums[0] < perm[0]
+  nums[1] < perm[1]
+  nums[3] < perm[3]
+  nums[4] < perm[4]
+
+Example 2
+
+  Input: @ints = (1, 2, 3, 4)
+  Output: 3
+
+  One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
+  nums[0] < perm[0]
+  nums[1] < perm[1]
+  nums[2] < perm[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 the first element in the input list is negative, it must be preceded by
+   "--" to distinguish it from a command-line flag.
+3. If VERBOSE is set to True (the default), the output is followed by details of
+   one possible permutation which gives the maximum greatness.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 237, Task #2: Maximise Greatness (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@nums where { .elems > 0 && .all ~~ Int:D } #= A non-empty list of integers
+)
+#===============================================================================
+{
+    "Input:  \@nums =  (%s)\n".printf: @nums.join: ', ';
+
+    my (UInt $max, Array[Int] $perm) = find-max-greatness( @nums );
+
+    "Output: $max".put;
+
+    "\nOne permutation: (%s)\n".printf: $perm.join: ', ' if VERBOSE;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-max-greatness( List:D[Int:D] $nums --> List:D[UInt:D, List:D[Int:D]] )
+#-------------------------------------------------------------------------------
+{
+    my UInt $max  = 0;
+    my Int  @from = $nums.sort;
+    my Int  @to   = @from;
+    my Int  @perm = Nil xx $nums.elems;
+
+    while @from
+    {
+        my Int $from = @from.pop;
+        my Int $to;
+
+        if @to[ *-1 ] > $from
+        {
+            $to = @to.pop;
+            ++$max;
+        }
+        else
+        {
+            $to = @to.shift;
+        }
+
+        for 0 .. $nums.end -> UInt $i
+        {
+            next if @perm[ $i ].defined;
+
+            if $nums[ $i ] == $from
+            {
+                @perm[ $i ] = $to;
+                last;
+            }
+        }
+    }
+
+    return $max, @perm;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $num-str, $exp, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $num-str, $exp, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @nums = $num-str.split( / \s+ / ).map: { .Int };
+        my Int @exp  = $exp-str.split( / \s+ / ).map: { .Int };
+
+        my (UInt $max, Array[Int] $perm) = find-max-greatness( @nums );
+
+        is        $max,  $exp.Int, $test-name ~ ': maximum greatness';
+        is-deeply $perm, @exp,     $test-name ~ ': permutation';
+    }
+
+    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| 1  3  5  2 1  3 1|4| 3  5  1  3 2  1  1
+        Example 2| 1  2  3  4       |3| 2  3  4  1
+        Negatives|-1 -2 -3 -4       |3|-4 -1 -2 -3
+        Mixed    | 0 -1  1 -2 2 -3 3|6| 1  0  2 -1 3 -2 -3
+        END
+}
+
+################################################################################