Week 151: Perl solutions

2 files changed, 76 insertions, 0 deletions

diff --git a/challenge-151/abigail/perl/ch-1.pl b/challenge-151/abigail/perl/ch-1.pl
new file mode 100644
index 0000000000..73296d77c3
--- /dev/null
+++ b/challenge-151/abigail/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!/opt/perl/bin/perl
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+
+#
+# See https://theweeklychallenge.org/blog/perl-weekly-challenge-151
+#
+
+#
+# Run as: perl ch-1.pl < input-file
+#
+
+#
+# We'll store the tree in a triangular 2-d array, with
+# the children on node on position [$d, $k] on positions
+# [$d + 1, 2 * $k] and [$d + 1, 2 * $k + 1].
+#
+# Finding the first node without children is trivial.
+#
+TREE: while (<>) {
+    chomp;
+    my @tree = map {[map {$_ ne '*'} /\S+/g]} split /\|/;
+    foreach my $d (keys @tree) {
+        foreach my $i (keys @{$tree [$d]}) {
+            if ($tree [$d] [$i] && !$tree [$d + 1] [2 * $i]
+                                && !$tree [$d + 1] [2 * $i + 1]) {
+                say $d + 1;
+                next TREE;
+            }
+        }
+    }
+}
diff --git a/challenge-151/abigail/perl/ch-2.pl b/challenge-151/abigail/perl/ch-2.pl
new file mode 100644
index 0000000000..263bede352
--- /dev/null
+++ b/challenge-151/abigail/perl/ch-2.pl
@@ -0,0 +1,37 @@
+#!/opt/perl/bin/perl
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+
+#
+# See https://theweeklychallenge.org/blog/perl-weekly-challenge-151
+#
+
+#
+# Run as: perl ch-2.pl < input-file
+#
+
+use List::Util qw [max];
+
+#
+# An algorithm we've seen many times before. For each house, we either
+# rob it, or skip it. And we always have to skip the next house.
+# Skipping more than two houses in succession is never a good idea, but
+# work we'll do extra in the beginning (by skipping more than two house)
+# we get back later on, as we're caching all results.
+#
+sub best;
+sub best ($vals, $i = 0) {
+    state $cache;
+    $i or $cache = [];
+    $$cache [$i] ||= $$vals [$i] + max 0, map {best $vals, $_} $i + 2 .. $#$vals
+}
+
+
+say best [/[0-9]+/g] while <>;