Merge pull request #8819 from boblied/master

Week 237 solutions and blog reference

4 files changed, 171 insertions, 3 deletions

diff --git a/challenge-237/bob-lied/README b/challenge-237/bob-lied/README
index f17c1f61f3..ca9b4d5e22 100644
--- a/challenge-237/bob-lied/README
+++ b/challenge-237/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 236 by Bob Lied
+Solutions to weekly challenge 237 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-236/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-236/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-237/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-237/bob-lied
diff --git a/challenge-237/bob-lied/blog.txt b/challenge-237/bob-lied/blog.txt
new file mode 100644
index 0000000000..e2b5379899
--- /dev/null
+++ b/challenge-237/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-237-maximise-greatness-57ib
diff --git a/challenge-237/bob-lied/perl/ch-1.pl b/challenge-237/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..c4234f8937
--- /dev/null
+++ b/challenge-237/bob-lied/perl/ch-1.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 237 Task 1 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# 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
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use DateTime;
+use DateTime::Duration;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub seizeTheDay(%day)
+{
+    my $dt = DateTime->new(year => $day{year}, month => $day{month}, day=>1);
+
+    my $lastDayOfMonth = DateTime->last_day_of_month( year => $day{year}, month => $day{month} );
+
+    # Move forward until we reach the right day of the week.
+    while ( $dt->day_of_week != $day{dow} )
+    {
+        $dt->add( days => 1);
+    }
+
+    # Move forward by weeks
+    my $weekOfMonth = 1;
+    while ( $weekOfMonth < $day{week} && $dt->day <= ($lastDayOfMonth->day - 7) )
+    {
+        $dt->add( days=> 7 );
+        $weekOfMonth++;
+    }
+
+    return ( $weekOfMonth == $day{week} ) ? $dt->day : 0;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( seizeTheDay( year=>2024, month=> 4, week=>3, dow=>2), 16, "Example 1");
+    is( seizeTheDay( year=>2025, month=>10, week=>2, dow=>4),  9, "Example 2");
+    is( seizeTheDay( year=>2026, month=> 8, week=>5, dow=>3),  0, "Example 3");
+
+    is( seizeTheDay( year=>2023, month=>10, week=>1, dow=>7),  1, "First sunday");
+    is( seizeTheDay( year=>2023, month=> 9, week=>5, dow=>6), 30, "Last saturday");
+
+    done_testing;
+}
diff --git a/challenge-237/bob-lied/perl/ch-2.pl b/challenge-237/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..9fd499fcaf
--- /dev/null
+++ b/challenge-237/bob-lied/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 237 Task 2 Maximise Greatness 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of integers.
+# Write a script to permute the give 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:
+#      [1] [3] 5 [2] [1] 3  1
+#       <   <  .  <   <  .  .
+#      [2] [5] 1 [3] [3] 1  1
+#
+# Example 2 Input: @ints = (1, 2, 3, 4)
+#           Output: 3
+#   One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
+#       [1] [2] [3]  4
+#        <   <   <   .
+#       [2] [3] [4]  1
+#
+# If we sort the list, we can match the smallest number with the first
+# one that achieves greatness, and then move right 
+#
+#    1    1    1    2    3    3    5
+#    +--------------^
+#         +--------------^
+#              +--------------+
+#                   +--------------^
+#
+#    1    1    1    2    3    3    5    7    8    9
+#    +--------------^
+#         +--------------^
+#              +--------------+
+#                   +--------------^
+#                        +--------------^
+#                             +---------------^
+#                                  +---------------^
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say maximizeGreatness(@ARGV);
+
+sub maximizeGreatness(@nums)
+{
+    my $greatness = 0;
+
+    # Work in a sorted array.
+    my @num = sort { $a <=> $b } @nums;
+
+    my $small = 0;
+    my $big = 0;
+
+    while ( ++$big <= $#num )
+    {
+        # Advance until we find a bigger number to pair with
+        if ( $num[$big] > $num[$small] )
+        {
+            say "Found num[$small], num[$big] = $num[$small], $num[$big]" if $Verbose;
+            $greatness++;
+            $small++;   # Move on to next smaller number
+        }
+    }
+    return $greatness;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( maximizeGreatness(1,3,5,2,1,3,1), 4, "Example 1");
+    is( maximizeGreatness(1,2,3,4      ), 3, "Example 2");
+
+    is( maximizeGreatness(             ), 0, "Empty array");
+    is( maximizeGreatness( 20          ), 0, "One element");
+    is( maximizeGreatness( 1,1,1,1     ), 0, "Opposite of great");
+    is( maximizeGreatness( 3,20,100    ), 2, "Bigger numbers, sort check");
+
+    done_testing;
+}