Merge pull request #8829 from robbie-hatley/237

Robbie Hatley's Perl solutions for The Weekly Challenge #237.

3 files changed, 283 insertions, 0 deletions

diff --git a/challenge-237/robbie-hatley/blog.txt b/challenge-237/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..3850f52a6f
--- /dev/null
+++ b/challenge-237/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2023/10/robbie-hatleys-solutions-to-weekly.html
\ No newline at end of file
diff --git a/challenge-237/robbie-hatley/perl/ch-1.pl b/challenge-237/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..87b0c6968b
--- /dev/null
+++ b/challenge-237/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,160 @@
+#!/usr/bin/perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 237-1.
+Written by Robbie Hatley on Fri Oct 06, 2023.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+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
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I am soooooo not going to pull in all of the heavy artillery from my "day-of-week.pl" script; it's just not
+needed for this. I'll use "use Time::Local 'timelocal_modern';" and "localtime" instead, and I'll use this
+algorithm:
+1. Start with day-of-month set to zero, then enter this loop:
+2. Loop while dow-counter < weekday-of-month, else skip to step 9 below.
+3. Increment day-of-month.
+4. If day-of-month is now invalid, set it to 0 and exit loop.
+5. Get seconds-since-epoch for current day-of-month (using "timelocal_modern")
+6. Get current-day-of-week from seconds-since-epoch (using "localtime"       )
+7. Increment dow-counter if current dow == target dow.
+8. Loop back to step 2.
+9. Print results.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument,
+which must be a single-quoted array of arrays of 4 integers, with each inner array being
+(year, month, weekday-of-month, day-of-week), with month and weekday-of-month being 1-indexed,
+and with day-of-week being 0-indexed-except-for-Sunday-which-is-7, in proper Perl syntax, like so:
+./ch-1.pl '([2023,1,5,2],[5337,8,4,5],[16847,7,3,7],[547892,5,4,4])'
+
+Output is to STDOUT and will be each input array followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS AND MODULES USED:
+
+use v5.38;
+use strict;
+use warnings;
+use utf8;
+use warnings FATAL => 'utf8';
+use Sys::Binmode;
+use Time::HiRes 'time';
+use Time::Local 'timelocal_modern';
+
+# ------------------------------------------------------------------------------------------------------------
+# START TIMER:
+our $t0; BEGIN {$t0 = time}
+
+# ------------------------------------------------------------------------------------------------------------
+# CONSTANTS:
+
+my @Months
+   = qw(January   February  March     April     May       June
+        July      August    September October   November  December);
+
+my @DaysOfWeek
+   = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+sub is_leap_year ($year) {
+   if    ( 0 == $year%4 && 0 != $year%100 ) {return 1;}
+   elsif ( 0 == $year%400                 ) {return 1;}
+   else                                     {return 0;}
+} # end sub is_leap_year
+
+sub days_per_month ($year, $month) {
+   state @dpm = (31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+   if ( 2 == $month ) { return (is_leap_year($year) ? 29 : 28);}
+   else {return $dpm[$month];}
+} # end sub days_per_month
+
+sub suffix ($x) {
+   if    ( 1 == $x ) {return 'st'}
+   elsif ( 2 == $x ) {return 'nd'}
+   elsif ( 3 == $x ) {return 'rd'}
+   else              {return 'th'}
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Inputs:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   [2024,  4, 3, 2],
+   [2025, 10, 2, 4],
+   [2026,  8, 5, 3],
+);
+
+# Main loop:
+for my $aref (@arrays) {
+   my $year = $$aref[0];                                    # Year.
+   my $mnth = $$aref[1]-1;                                  # Month (converted to zero-indexed).
+   my $wdom = $$aref[2];                                    # Weekday-of-month (one-indexed).
+   my $tdow = $$aref[3]%7;                                  # Target day-of-week (converted to zero-indexed).
+   my $dyom = 0;                                            # Day-of-month counter for while loop.
+   my $dowc = 0;                                            # Day-of-week  counter for while loop.
+   while ( $dowc < $wdom ) {                                # Loop while dow counter < weekday-of-month.
+      ++$dyom;                                              # Increment day-of-month.
+      if ($dyom > days_per_month($year,$mnth) ) {           # If day-of-month becomes invalid,
+         $dyom = 0;                                         # set it to zero
+         last;                                              # and exit while loop.
+      }
+      my $epoc = timelocal_modern(0,0,0,$dyom,$mnth,$year); # Epoch (seconds since 00:00:00 on Jan 1, 1970).
+      my @time = localtime($epoc);                          # Date info for epoch.
+      my $cdow = $time[6];                                  # Current day-of-week.
+      if ($cdow == $tdow) {++$dowc}                         # Increment counter if current dow == target dow.
+   }
+   say '';
+   if ( 0 == $dyom ) {
+      say "There are not $wdom $DaysOfWeek[$tdow]s in $Months[$mnth] $year";
+   }
+   else {
+      my $wsuf = suffix($wdom);
+      my $dsuf = suffix($dyom);
+      say "The $wdom$wsuf $DaysOfWeek[$tdow] in $Months[$mnth] $year is $Months[$mnth] $dyom$dsuf";
+   }
+}
+exit;
+
+# ------------------------------------------------------------------------------------------------------------
+# DETERMINE AND PRINT EXECUTION TIME:
+END {
+   my $µs = 1000000 * (time - $t0);
+   printf("\nExecution time was %.0fµs.\n", $µs);
+}
+__END__
diff --git a/challenge-237/robbie-hatley/perl/ch-2.pl b/challenge-237/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..9cd1e40687
--- /dev/null
+++ b/challenge-237/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 237-2.
+Written by Robbie Hatley on Fri Oct 06, 2023.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 2: Maximize 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]
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I've no time to re-invent yet-another array-permutations subroutine this weekend so I'll use CPAN module
+"Math::Combinatorics", which has come to my aid in so many of these weekly challenges. Then it's just a
+matter of checking the "greatness" of every possible permutation of a given array and keeping track of
+"maximum greatness found so far".
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+single-quoted array of arrays of integers in proper Perl syntax, like so:
+./ch-2.pl '([3,7,8,4,1,6,2,5],[9,3,62,-8])'
+
+Output is to STDOUT and will be each input array followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS AND MODULES USED:
+
+use v5.38;
+use strict;
+use warnings;
+use utf8;
+use warnings FATAL => 'utf8';
+use Sys::Binmode;
+use Time::HiRes 'time';
+use Math::Combinatorics;
+
+# ------------------------------------------------------------------------------------------------------------
+# START TIMER:
+our $t0; BEGIN {$t0 = time}
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+sub greatness ($a1ref, $a2ref) {
+   my $g = 0; # greatness
+   for ( my $i = 0 ; $i <= $#$a1ref && $i <= $#$a2ref ; ++$i ) {
+      ++$g if ($$a1ref[$i] < $$a2ref[$i])
+   }
+   return $g;
+}
+
+sub max_greatness ($aref) {
+   my $g  = 0; # greatness
+   my $mg = 0; # max greatness
+   my $perms = Math::Combinatorics->new(count => $#$aref, data => $aref);
+   while ( my @perm = $perms->next_permutation ) {
+      $g = greatness($aref, \@perm);
+      $mg = $g if $g > $mg;
+   }
+   return $mg
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Inputs:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   [1, 3, 5, 2, 1, 3, 1],
+   [1, 2, 3, 4],
+);
+
+# Main loop:
+for my $aref (@arrays) {
+   my $mg = max_greatness($aref);
+   say '';
+   say 'Array = (', join(', ', @$aref), ')';
+   say "Max greatness = $mg";
+}
+exit;
+
+# ------------------------------------------------------------------------------------------------------------
+# DETERMINE AND PRINT EXECUTION TIME:
+END {
+   my $ms = 1000 * (time - $t0);
+   printf("\nExecution time was %.3fms.\n", $ms)
+}
+__END__