Merge pull request #5628 from wlmb/challenges

Solve PWC151

3 files changed, 54 insertions, 0 deletions

diff --git a/challenge-151/wlmb/blog.txt b/challenge-151/wlmb/blog.txt
new file mode 100644
index 0000000000..0c0f83d0a1
--- /dev/null
+++ b/challenge-151/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/02/07/PWC151/
diff --git a/challenge-151/wlmb/perl/ch-1.pl b/challenge-151/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..e1389128ed
--- /dev/null
+++ b/challenge-151/wlmb/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 151
+# Task 1: Binary tree depth
+#
+# See https://wlmb.github.io/2022/02/07/PWC151/#task-1-binary-tree-depth
+use v5.12;
+use warnings;
+use Try::Tiny;
+die "Usage: ./ch-1.pl T1 [T2]...\n"
+    . "where Ti are trees of the form 'R1 | R2...'\n"
+    . "and each row consists of nodes (strings) or an asterisk * (empty node)\n"
+    unless @ARGV;
+for my $tree (@ARGV){
+    my @rows=split /\s*\|\s*/, $tree; # separate into rows.
+    my $depth=0;   # Depth of first row is 1. This is above the first row
+    try {
+	foreach(@rows){
+	    s/((\S)+)/$2/g; # replace contiguous characters by first
+	    s/\s+//g; # remove spaces
+	    die "\n" if length > 2**$depth; # row can't be larger than 2**depth
+	    $_.=("*" x(2**$depth-length)); # Fill row with asterisks if necessary
+	    # Two consecutive asterisks at even-odd position mean we are below a leave
+	    # so we have finished our search;
+	    last if m/^(..)*(\*\*)/;
+	    ++$depth;  # increase and iterate
+	}
+	say "Input: $tree\nOutput: $depth";
+    }
+    catch { say "A row is too long in $tree";}
+}
diff --git a/challenge-151/wlmb/perl/ch-2.pl b/challenge-151/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..28fe08d2e2
--- /dev/null
+++ b/challenge-151/wlmb/perl/ch-2.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 151
+# Task 2: Rob the house
+#
+# See https://wlmb.github.io/2022/02/07/PWC151/#task-2-rob-the-house
+use v5.12;
+use warnings;
+die "Usage: ./ch-1.pl V0 [V1]...\n"
+    . "to optimize the robery of houses 0, 1,... with valuables V0, V1..."
+    unless @ARGV;
+my ($value,@houses)=optimize(0,@ARGV);
+say "Output: $value Houses: ", join ", ", @houses;
+sub optimize {
+    my ($this, $value, @rest)=@_;
+    return (0) unless defined $value; # No more houses
+    return ($value, $this) unless @rest; # Only one house left
+    my ($v1, @h1)=optimize($this+1, @rest); # what if I skip this house?
+    my ($v2, @h2)=optimize($this+2, @rest[1..@rest-1]); # what if I rob this and skip next?
+    my $v3=$value+$v2;
+    $v3>$v1 # which option is best?
+	?($v3, $this, @h2) # This one and skip next
+	:($v1, @h1); # or skip this one
+}