Challenge 137 Done!

3 files changed, 117 insertions, 0 deletions

diff --git a/challenge-137/dave-jacoby/blog.txt b/challenge-137/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..ab97ea3038
--- /dev/null
+++ b/challenge-137/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/11/01/2020-was-a-long-year-the-weekly-challenge-137.html
diff --git a/challenge-137/dave-jacoby/perl/ch-1.pl b/challenge-137/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..2a93667f0d
--- /dev/null
+++ b/challenge-137/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say state postderef signatures };
+no warnings qw{ experimental };
+
+use DateTime;
+
+# This table shows how this will work for any given year
+#
+# dow  => day of week (numerical)
+# leap => is a leap year (bool)
+# woy  => week of year (1, 52, 53)
+#
+#      dow     leap    woy      day
+#   ---------------------------------------
+#       1       0       1       Monday
+#       1       1       1       Monday
+#       2       0       1       Tuesday
+#       2       1       1       Tuesday
+#       3       0       1       Wednesday
+#       3       1       1       Wednesday
+#       4       0       53      Thursday
+#       4       1       53      Thursday
+#       5       0       52      Friday
+#       5       1       53      Friday
+#       6       0       52      Saturday
+#       6       1       52      Saturday
+#       7       0       52      Sunday
+#       7       1       52      Sunday
+
+my @years;
+for my $year ( 1900 .. 2100 ) {
+    my $dt = DateTime->new(
+        month => 12,
+        day   => 31,
+        year  => $year,
+    );
+    my ( undef, $week_of_year ) = $dt->week;
+    my $dow     = $dt->day_of_week;
+    my $nam     = $dt->day_name;
+    my $is_leap = $dt->is_leap_year;
+    push @years, $year if $week_of_year == 53;
+}
+
+my @x;
+while (@years) {
+    push @x, shift @years;
+    if ( scalar @x == 5 ) {
+        say join ', ', @x, '';
+        @x = ();
+    }
+}
+
+say join ', ', @x;
diff --git a/challenge-137/dave-jacoby/perl/ch-2.pl b/challenge-137/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..a6ad0430c2
--- /dev/null
+++ b/challenge-137/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use Math::BigInt;
+use Getopt::Long;
+use List::Util qw{uniq};
+
+my @examples;
+my @numbers;
+my $lychrel = 0;
+GetOptions(
+    'number=i' => \@numbers,
+    'lychrel'  => \$lychrel,
+);
+
+if ( scalar @numbers ) {
+    @examples = uniq sort { $a <=> $b } @numbers;
+}
+else { @examples = ( 10 .. 1000 ); }
+
+for my $e (@examples) {
+    my $l = is_lychrel($e);
+    next if !$l && $lychrel;
+    say <<"END";
+        Input:  \$n = $e
+        Output: $l
+END
+}
+
+exit;
+
+sub is_lychrel($e) {
+    my $n = $e;
+    my $c = 0;
+    while ( !is_palindrome($n) ) {
+        $n = lychrel($n);
+        $c++;
+        return 1 if $c >= 500;
+    }
+    return 0;
+}
+
+sub lychrel( $n ) {
+    my $bign = Math::BigInt->new($n);
+    my $u    = join '', reverse split //, $n;
+    my $bigu = Math::BigInt->new($u);
+    my $new  = $bign->badd($bigu);
+    return $new;
+}
+
+sub is_palindrome ($n) {
+    my $u = join '', reverse split //, $n;
+    $u =~ s/^0+//mix;
+    return $u eq $n ? 1 : 0;
+}
+