Solve PWC209

3 files changed, 59 insertions, 0 deletions

diff --git a/challenge-209/wlmb/blog.txt b/challenge-209/wlmb/blog.txt
new file mode 100644
index 0000000000..a1bfa8bd88
--- /dev/null
+++ b/challenge-209/wlmb/blog.txt
@@ -0,0 +1,2 @@
+https://wlmb.github.io/2023/03/20/PWC209/
+
diff --git a/challenge-209/wlmb/perl/ch-1.pl b/challenge-209/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..a2ce3b90a4
--- /dev/null
+++ b/challenge-209/wlmb/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 209
+# Task 1:  Special Bit Characters
+#
+# See https://wlmb.github.io/2023/03/20/PWC209/#task-1-special-bit-characters
+use v5.36;
+my %patterns;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 S1 [S2...]
+    to decode the binary sequences S1 S2
+    using the code 0->a, 10->b 11->c
+    FIN
+
+@patterns{qw(0 10 11)}=qw(a b c);
+for(@ARGV){
+    my $last;
+    die "Not a binary pattern: $_\n" unless /^(0|1)+/; #Check input
+    say " $_ -> ",
+        (
+	 map {$last=$patterns{$_}}
+	 grep {length $_}
+	 split /(1.|0)/
+	),
+	" -> ",
+	$last eq "a"?1:0;
+}
diff --git a/challenge-209/wlmb/perl/ch-2.pl b/challenge-209/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..50a270aecd
--- /dev/null
+++ b/challenge-209/wlmb/perl/ch-2.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 209
+# Task 2:  Merge Account
+#
+# See https://wlmb.github.io/2023/03/20/PWC209/#task-2-merge-account
+use v5.36;
+use English;
+my %merge_to;
+my %line_of;
+my @names;
+while(<>){
+    chomp;
+    my ($name, @addresses)=split / /;
+    $names[$INPUT_LINE_NUMBER] = $name;
+    for(@addresses){
+	$merge_to{$INPUT_LINE_NUMBER} =
+	    defined $merge_to{$line_of{$_}}
+	        ?$merge_to{$line_of{$_}}          # previously merged
+	        :$line_of{$_}                     # or first time merge
+            if defined $line_of{$_};              # address has been seen before
+        $line_of{$_}//=$INPUT_LINE_NUMBER;        # map to current line if not seen before
+    }
+    $merge_to{$.}//=$INPUT_LINE_NUMBER;           # merge to itself if not already merged
+}
+my @addresses = keys %line_of;                    # distinct addresses
+my %merged;                                       # merged accounts
+push @{$merged{$merge_to{$line_of{$_}}}}, $_      # add addresses to merged accounts
+    for @addresses;
+# output account name, (one of its) line number(s), addresses
+say join " ", $names[$_], "($_):", sort {$a cmp $b} @{$merged{$_}}
+    for sort {$names[$a] cmp $names[$b] || $a <=> $b} keys %merged;