rjt's week 138 solutions

3 files changed, 85 insertions, 8 deletions

diff --git a/challenge-138/ryan-thompson/README.md b/challenge-138/ryan-thompson/README.md
index 3dd1e955d3..c98d897bdf 100644
--- a/challenge-138/ryan-thompson/README.md
+++ b/challenge-138/ryan-thompson/README.md
@@ -1,19 +1,15 @@
 # Ryan Thompson
 
-## Week 110 Solutions
+## Week 138 Solutions
 
-### Task 1 › Phone Number Validation
+### Task 1 › Workdays
 
  * [Perl](perl/ch-1.pl)
- * [Raku](raku/ch-1.raku)
 
-### Task 2 › Transpose CSV File
+### Task 2 › Split Number
 
  * [Perl](perl/ch-2.pl)
- * [Raku](raku/ch-2.raku)
 
 ## Blogs
 
- * [Phone Number Validation](https://ry.ca/2021/04/phone-number-validation)
- * [Transpose CSV File](https://ry.ca/2021/04/transpose-csv-file)
-
+None this week.
diff --git a/challenge-138/ryan-thompson/perl/ch-1.pl b/challenge-138/ryan-thompson/perl/ch-1.pl
new file mode 100755
index 0000000000..8aaaeb0c83
--- /dev/null
+++ b/challenge-138/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Workdays
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+
+use Time::Local; # Core
+
+my $year = $ARGV[0] // die "Usage: $0 year\n";
+my $time = timelocal(0,0,0,1,0,$year); # Jan 1
+
+my $weekdays = 0;
+while(1) {
+    my (undef, undef, undef, undef, undef, $yyyy, $wday) = localtime($time);
+    last if $yyyy != $year - 1900;
+    $time += 86403; # 1 day, and account for leap seconds
+    $weekdays++ if $wday > 0 and $wday < 6;
+}
+
+say $weekdays;
diff --git a/challenge-138/ryan-thompson/perl/ch-2.pl b/challenge-138/ryan-thompson/perl/ch-2.pl
new file mode 100755
index 0000000000..be8f85278a
--- /dev/null
+++ b/challenge-138/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Split number
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+use Carp;
+no warnings 'uninitialized';
+
+die "Usage: $0 square_number\n" if @ARGV == 0;
+split_num($ARGV[0]);
+
+# Takes a perfect square and outputs all possible partitionings of that
+# number which sum to its square root. For example 99*99 = 9801
+# 98 + 0 + 1 = 99.
+# The task description asked for only a boolean return if any partitions
+# satisfied the requirement, but I've arbitrarily decided to spice things
+# up by printing out all matching partitions. This adds a bit of housekeeping
+# to the code, but it's not that bad.
+sub split_num {
+    my $sq = shift;
+    my $n = sqrt($sq);
+    croak "$sq is not a perfect square" if $n != int $n;
+
+    # The splits can be represented by a binary number of length($n)-1,
+    # where 0 = don't split, and 1 = split
+    my $bits = length($sq)-1;
+    my $max = 2**$bits;
+
+    # Start at 1 because 0 would not give us "two or more" splits
+BIN:for my $bin (1..$max) {
+        my $sum = 0; # Track partial sum for optimization
+        my $num = '';
+        my @sum;
+        for my $bit (0..$bits) {
+            next if $num eq '0'; # No leading zeroes
+            $num .= substr $sq, $bit, 1;
+
+            if ($bin & (1 << $bit)) {
+                push @sum, $num;
+                $sum += $num;
+                next BIN if $sum > $n;
+                $num = '';
+            }
+        }
+        push @sum, $num;
+        $sum += $num;
+        next if $sum != $n;
+
+        printf "%30s = %10d\n", join(' + ', @sum), $sum
+            if $sum = $n;
+    }
+}