3 files changed, 93 insertions, 0 deletions
diff --git a/challenge-097/wlmb/blog.txt b/challenge-097/wlmb/blog.txt
new file mode 100644
index 0000000000..1eff92891c
--- /dev/null
+++ b/challenge-097/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/01/25/PWC097/
diff --git a/challenge-097/wlmb/perl/ch-1.pl b/challenge-097/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..20f827b4dd
--- /dev/null
+++ b/challenge-097/wlmb/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 097
+# Task 1: Caesar Cipher
+#
+# See https:/wlmb.github.io/2021/01/25/PWC097/#task-1-caesar-cipher
+use warnings;
+use strict;
+use v5.12;
+use Scalar::Util qw(looks_like_number);
+
+sub usage {
+    say <<END;
+    Usage:
+	./ch-1.pl S N
+    to encode string S using Casear's cipher with displacement N
+END
+    exit 1;
+}
+
+usage() unless @ARGV==2;
+my $string = uc shift @ARGV; # Allow lower case but convert to uppercase
+my $displacement=shift @ARGV;
+usage() unless looks_like_number($displacement);
+
+my @plain="A".."Z";
+my %translation_of=map {($plain[$_]=>$plain[($_-$displacement)%@plain])} 0..@plain-1;
+
+my $translated=join '', map {$translation_of{$_}//$_} split '', $string;
+say "Input:  \"$string\" $displacement\nOutput: \"$translated\"\n";
+say "Plain:\t", @plain, "\n",
+    "Cipher:\t", join '', @translation_of{sort keys %translation_of}, "\n",
+    "Displacement:\t$displacement\n",
+    "Plaintext:\t$string\n",
+    "Ciphertext:\t$translated",
diff --git a/challenge-097/wlmb/perl/ch-2.pl b/challenge-097/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..18805d1ea9
--- /dev/null
+++ b/challenge-097/wlmb/perl/ch-2.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 097
+# Task 1: Binary substrings
+#
+# See https:/wlmb.github.io/2021/01/25/PWC097/#task-2-binary-substrings
+use warnings;
+use strict;
+use v5.12;
+
+use List::Util qw(all reduce);
+use Scalar::Util qw(looks_like_number);
+use Memoize; # Just for fun
+# Check arguments
+usage() unless @ARGV==2;
+my $string = shift @ARGV;
+my $length=shift @ARGV;
+usage() unless looks_like_number($length) && $length>=1;
+
+my %binary=("0"=>1,"1"=>1); # Binary characters
+usage() unless all {$binary{$_}} split '', $string;
+
+my @substrings=grep {length $_ == $length} split /(\d{$length})/, $string;
+
+memoize('cost'); # Don't duplicate effort
+my @total_costs=map {total_cost($substrings[$_], @substrings)} 0..@substrings-1;
+my $best_index=reduce {$total_costs[$a]<=$total_costs[$b]?$a:$b} 0..@total_costs-1;
+my $target=$substrings[$best_index];
+my @costs=map {cost($target, $_)} @substrings;
+
+say "Input:\t\"$string\"\t$length\n",
+    "Output:\t$total_costs[$best_index]\n\n",
+    "Binary substrings\n",
+    map {"\"$substrings[$_]\": $costs[$_] flips to convert it to \"$target\"\n"}
+        0..@substrings-1;
+
+sub total_cost {
+    my $first=shift;
+    my $cost=0;
+    $cost+=cost($first,$_) foreach @_;
+    return $cost;
+}
+sub cost {
+    my @first=split '',shift;
+    my @second=split '',shift;
+    my $cost=0;
+    $cost += $first[$_]!=$second[$_]?1:0 foreach 0..@first-1;
+    return $cost;
+}
+
+sub usage {
+say <<END;
+ Usage:
+   ./ch-1.pl B S
+   to split binary string B into substrings of size S>=1
+   and then enumerate changes to make them the same
+END
+   exit 1;
+}