4 files changed, 89 insertions, 0 deletions
diff --git a/challenge-151/wlmb/perl/ch-1a.pl b/challenge-151/wlmb/perl/ch-1a.pl
new file mode 100755
index 0000000000..06855301cc
--- /dev/null
+++ b/challenge-151/wlmb/perl/ch-1a.pl
@@ -0,0 +1,42 @@
+#!/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-1a.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 {
+        my $old='';
+      ROW:
+	foreach(@rows){
+	    s/((\S)+)/$2/g; # replace contiguous characters by first
+	    s/\s+//g; # remove spaces
+	    die "A row is too long in $tree\n"
+		if length > 2**$depth; # row can't be larger than 2**depth
+	    $_.=("*" x(2**$depth-length)); # Fill row with asterisks if necessary
+	    my $new=$_;
+	    # A non-empty node below an empty one is an error.
+	    while(s/^((\*\*)*)([^\*].|.[^\*])/$1\*\*/){
+	        die "An empty node may not have descendants in $tree\n"
+		   if substr($old,length($1)/2,1) eq "*";
+	    }
+	    # Two empty nodes below a non-empty node mean the search is over.
+	    $_=$new;
+	    while(s/^((..)*)\*\*/$1../){
+		last ROW unless substr($old,length($1)/2,1) eq "*";
+	    }
+	    $old=$new;
+	    ++$depth;
+      }
+	say "Input: $tree\nOutput: $depth";
+    }
+    catch { say $_;}
+}
diff --git a/challenge-156/wlmb/blog.txt b/challenge-156/wlmb/blog.txt
new file mode 100644
index 0000000000..9dac6f78ab
--- /dev/null
+++ b/challenge-156/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/03/14/PWC156/
diff --git a/challenge-156/wlmb/perl/ch-1.pl b/challenge-156/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..5e377911de
--- /dev/null
+++ b/challenge-156/wlmb/perl/ch-1.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 156
+# Task 1: Pernicious numbers
+#
+# See https://wlmb.github.io/2022/03/14/PWC156/#task-1-pernicious-numbers
+use v5.12;
+use warnings;
+use bigint;
+use Math::Prime::Util qw(is_prime);
+use List::Util qw(sum0);
+my $N=shift//10; # How many pernicious numbers to calculate
+my $candidate=0;
+my @pernicious;
+for(1..$N){
+    push(@pernicious, $candidate), next
+        if is_prime(sum0 split "", sprintf "%b", ++$candidate);
+    redo
+}
+say "The first $N pernicious numbers are ", join ", ",  @pernicious;
diff --git a/challenge-156/wlmb/perl/ch-2.pl b/challenge-156/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..f874b52464
--- /dev/null
+++ b/challenge-156/wlmb/perl/ch-2.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 156
+# Task 2: Weird number
+#
+# See https://wlmb.github.io/2022/03/14/PWC156/#task-2-weird-number
+use v5.12;
+use warnings;
+use Math::Prime::Util qw(divisors);
+use Algorithm::Combinatorics qw(subsets);
+use List::Util qw(sum0);
+die "Usage: ./ch-2.pl N1 N2... to test numbers N1, N2... for weirdness"
+    unless @ARGV;
+my $is_weird;
+ WEIRD:
+    for my $N(@ARGV){
+        say("Arguments must be larger than 1"), next unless $N>=2;
+        my @divisors=divisors($N);
+        pop @divisors; # keep only proper divisors
+        $is_weird=0, next WEIRD unless sum0(@divisors)>$N; # Overabundant?
+        my @subsets=subsets(\@divisors);
+        for(@subsets){
+            $is_weird=0, next WEIRD if sum0(@$_)==$N; #Semiperfect, fail
+        }
+        $is_weird=1;
+} continue {
+    say "$N ", $is_weird?"is":"is not", " weird";
+}