Merge pull request #5198 from boblied/w138

W138

3 files changed, 192 insertions, 2 deletions

diff --git a/challenge-138/bob-lied/README b/challenge-138/bob-lied/README
index 1383134251..c231e3a589 100644
--- a/challenge-138/bob-lied/README
+++ b/challenge-138/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 137 by Bob Lied
+Solutions to weekly challenge 138 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-137/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
diff --git a/challenge-138/bob-lied/perl/ch-1.pl b/challenge-138/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..2ad0703e09
--- /dev/null
+++ b/challenge-138/bob-lied/perl/ch-1.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl
+#=============================================================================
+# Copyright (c) 2021, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge, Week 138, Task #1 Workdays
+# You are given a year, $year in 4-digits form.  Write a script to calculate
+# the total number of workdays in the given year.  For the task, we consider,
+# Monday - Friday as workdays.
+#=============================================================================
+
+use strict;
+use warnings;
+use v5.32;
+
+use DateTime;
+
+use experimental qw/ signatures /;
+no warnings "experimental::signatures";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+# Assuming a modern Gregorian calendar of 365 or 366 days,
+# with regular leap years, there are 52 weeks (52*7 = 364)
+# of five work days, and one or two extra days.  In a 365-day
+# year, the 365th day will be the same day of the week as the
+# 1st day.  In a 366-day week, the two extra days will be the
+# same day as 1st and 2nd..
+#
+# So there are two cases.  For 365-day years, a year that starts
+# on a workday will end on the same workday, for a total of 261.
+# A year that starts on Saturday or Sunday will end on Saturday
+# or Sunday for a total of 260.
+#
+# For a leap year, if it starts on Monday through Thursday, days
+# 365 and 366 will also be work days.  If it starts on Friday,
+# day 365 will be a work day, but 366 is on a Saturday.  If it
+# starts on Saturday, days 365 and 366 will be a weekend.  If it
+# starts on a Sunday, day 365 will be Sunday, but 366 will be
+# a Monday.
+#
+# The extra days can be summarized in a 2x7 table, where the first
+# index is 0 or 1 for leap year or not; and columns 1 to 7 correspond
+# to days of the week with 1 == Monday. (Ignoring index 0 because
+# this 1-through-7 is the way that DateTime counts.)
+
+my @extraDays = (
+  #   x  M  T  W  T  F  S S
+    [ 0, 1, 1, 1, 1, 1, 0, 0 ],    # 0 == not a leap year
+    [ 0, 2, 2, 2, 2, 1, 0, 1 ],    # 1 == leap year
+);
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+my $Year = shift;
+die "Usage: $0 YYYY" unless $Year;
+
+say workDays($Year);
+
+
+sub isLeapYear($year)
+{
+    return ( ($year % 400 == 0) || ( $year % 4 == 0 && $year % 100 != 0 ) ) ? 1 : 0;
+}
+
+sub workDays($year)
+{
+    my $jan1 = DateTime->new(year => $year, month => 1, day => 1);
+    my $dayOfWeek = $jan1->day_of_week(); # Returns 1==Monday, 7==Sunday
+    my $isLeapYear = isLeapYear($year);
+    return 260 + $extraDays[$isLeapYear][$dayOfWeek];
+}
+
+sub runTest
+{
+    use Test::More;
+
+    is( workDays(1900), 261, "Monday    1900");
+    is( workDays(2002), 261, "Tuesday   2002");
+    is( workDays(2003), 261, "Wednesday 2003");
+    is( workDays(2004), 262, "Thursday  2004");
+    is( workDays(2021), 261, "Friday    2021");
+    is( workDays(1938), 260, "Saturday  1938");
+    is( workDays(1989), 260, "Sunday    1989");
+
+    is( workDays(1968), 262, "Monday    1968 LY");
+    is( workDays(1952), 262, "Tuesday   1958 LY");
+    is( workDays(1908), 262, "Wednesday 1908 LY");
+    is( workDays(2004), 262, "Thursday  2004 LY");
+    is( workDays(1960), 261, "Friday    1960 LY");
+    is( workDays(1972), 260, "Saturday  1972 LY");
+    is( workDays(1928), 261, "Sunday    1928 LY");
+
+    done_testing;
+}
+
diff --git a/challenge-138/bob-lied/perl/ch-2.pl b/challenge-138/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..b54491bd96
--- /dev/null
+++ b/challenge-138/bob-lied/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl
+#=============================================================================
+# Copyright (c) 2021, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge, Week 138, TASK #2 › Split Number
+# You are given a perfect square.  Write a script to figure out if the square
+# root the given number is same as sum of 2 or more splits of the given number.  #=============================================================================
+
+use strict;
+use warnings;
+use v5.32;
+
+use experimental qw/ signatures /;
+no warnings "experimental::signatures";
+
+use List::Util;
+use Data::Dumper;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+my $N = shift;
+
+sub _splitN($prefix, $rest, $sqrtN, $depth, $splits)
+{
+    my $tab = " " x ($depth*4); # Debugging aid
+    my $len = length $rest;
+    for my $p ( 1 .. ($len-1) )
+    {
+        my $pre  = substr($rest, 0, $p);
+        my $rest = substr($rest, $p);
+        say STDERR "$tab [ $prefix ][ $pre ][ $rest ]" if $Verbose;
+        my $split = [ $prefix, $pre, $rest ];
+        push @$splits, $split;
+        return 1 if List::Util::sum(@$split) == $sqrtN ||
+            _splitN("$prefix$pre", $rest, $sqrtN, $depth+1, $splits) == 1;
+
+    }
+}
+
+sub splitNumber($n)
+{
+    my $sqrtN = sqrt($n);
+    my @splits;
+    my $len = length($n);
+    for my $p ( 1 .. ($len-1) )
+    {
+        my $prefix = substr($n, 0, $p);
+        my $rest   = substr($n, $p);
+        push @splits, [ $prefix, $rest ];
+        say STDERR "[ $prefix ][ $rest ]" if $Verbose;
+        return 1 if ( ($prefix + $rest) == $sqrtN ) ||
+            _splitN($prefix, $rest, $sqrtN, 1, \@splits) == 1;
+
+    }
+    if ( $Verbose ) { say "@$_" for @splits; }
+    return 0;
+}
+
+say splitNumber($N);
+
+#for my $n ( map { $_*$_ } ( 4..100 ) )
+#{ 
+#    say "$n (", sqrt($n), ") ", splitNumber($n);
+#}
+
+sub runTest
+{
+    use Test::More;
+
+    is(splitNumber(   25), 0, "N =    25,   5 = __");
+    is(splitNumber(   81), 1, "N =    81,   9 =   8 +  1");
+    is(splitNumber(  100), 1, "N =   100,  10 =  10 +  0 + 0");
+    is(splitNumber(  484), 0, "N =   484,  22 =  __");
+    is(splitNumber( 1296), 1, "N =  1296,  36 =   1 + 29 + 6");
+    is(splitNumber( 4900), 0, "N =  4900,  70 =  __");
+    is(splitNumber( 9801), 1, "N =  9810,  99 =  98 +  1 + 0");
+    is(splitNumber(10000), 1, "N = 10000, 100 = 100 +  0 + 0");
+
+    done_testing;
+}
+