Merge pull request #7775 from wlmb/challenges

Solve PWC209

3 files changed, 56 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..ff3285d04a
--- /dev/null
+++ b/challenge-209/wlmb/perl/ch-2.pl
@@ -0,0 +1,28 @@
+#!/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;
+use List::Util qw(uniq);
+my %line_of;
+my %addresses_of;
+my @names;
+while(<>){
+    chomp;
+    # Assume input is of the form: name address1 address2...
+    my ($name, @addresses)=split ' ';
+    next unless $name; # skip empty lines
+    $names[$INPUT_LINE_NUMBER]=$name;
+    my @merged=grep {defined $_} map {$line_of{$_}} @addresses; # lines to merge with current
+    push @addresses, map {@{$addresses_of{$_}}} @merged;        # add their addresses
+    @addresses=uniq @addresses;                                 # avoid repetitions
+    delete $addresses_of{$_} for @merged;                       # delete merged lines
+    @line_of{@addresses}=($INPUT_LINE_NUMBER) x @addresses;     # map addresses to line
+    $addresses_of{$INPUT_LINE_NUMBER}=[@addresses];             # map line to addresses
+}
+# Output. Sort by account name and line number, and sort addresses
+say "$names[$_] ($_): ", join " ",
+    sort {$a cmp $b} @{$addresses_of{$_}}
+    for sort {$names[$a] cmp $names[$b] || $a <=>$b} keys %addresses_of;