Add solution for week 209.

Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>

4 files changed, 291 insertions, 0 deletions

diff --git a/challenge-209/jeanluc2020/blog-1.txt b/challenge-209/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..dee1c81e7b
--- /dev/null
+++ b/challenge-209/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-209-1.html
diff --git a/challenge-209/jeanluc2020/blog-2.txt b/challenge-209/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..e324ea0d15
--- /dev/null
+++ b/challenge-209/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-209-2.html
diff --git a/challenge-209/jeanluc2020/perl/ch-1.pl b/challenge-209/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..8451905f3d
--- /dev/null
+++ b/challenge-209/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-209/#TASK1
+#
+# Task 1: Special Bit Characters
+# ==============================
+#
+# You are given an array of binary bits that ends with 0.
+#
+# Valid sequences in the bit string are:
+#
+## [0] -decodes-to-> "a"
+## [1, 0] -> "b"
+## [1, 1] -> "c"
+#
+# Write a script to print 1 if the last character is an “a” otherwise print 0.
+#
+## Example 1
+##
+## Input: @bits = (1, 0, 0)
+## Output: 1
+##
+## The given array bits can be decoded as 2-bits character (10) followed by
+#1-bit character (0).
+#
+## Example 2
+##
+## Input: @bits = (1, 1, 1, 0)
+## Output: 0
+##
+## Possible decode can be 2-bits character (11) followed by 2-bits character
+#(10) i.e. the last character is not 1-bit character.
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# We walk the array from start to end. If the current element is 1, we
+# also take the next one, decode into the character and go on. If the
+# last character we found was an "a", we return 1, otherwise 0.
+
+use strict;
+use warnings;
+
+special_bit_characters(1, 0, 0);
+special_bit_characters(1, 1, 1, 0);
+
+sub special_bit_characters {
+   my @bits = @_;
+   print "Input: (" . join(", ", @bits) . ")\n";
+   # the state we have consist of the last bit (either set to 1  or
+   # undef) and the current character (undef or one of a, b, c)
+   my $last_bit = undef;
+   my $char = undef;
+   foreach my $bit (@bits) {
+      # if the last bit was set, we either have a b or a c
+      if($last_bit) {
+         if($bit) {
+            $char = "c";
+         } else {
+            $char = "b";
+         }
+         # make sure we reset the state of the last bit so we're ready
+         # to read the next bit
+         $last_bit = undef;
+      } else {
+         # last bit was not set, so either we start a new 2-bits character
+         # or we have the 1-bit character "a"
+         if($bit) {
+            $last_bit = 1;
+            $char = undef;
+         } else {
+            $char = "a";
+         }
+      }
+   }
+   # Now we just need to check whether the last character was the 1-bit
+   # character "a" or not
+   if($char eq "a") {
+      print "Output: 1\n";
+      return 1;
+   } else {
+      print "Output: 0\n";
+      return 0;
+   }
+}
diff --git a/challenge-209/jeanluc2020/perl/ch-2.pl b/challenge-209/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..852a490a5d
--- /dev/null
+++ b/challenge-209/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,202 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-209/#TASK2
+#
+# Task 2: Merge Account
+# =====================
+#
+# You are given an array of accounts i.e. name with list of email addresses.
+#
+# Write a script to merge the accounts where possible. The accounts can only be merged if they have at least one email address in common.
+#
+# Example 1:
+#
+# Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                      ["B", "b1@b.com"],
+#                      ["A", "a3@a.com", "a1@a.com"] ]
+#
+# Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
+#           ["B", "b1@b.com"] ]
+#
+# Example 2:
+#
+# Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                      ["B", "b1@b.com"],
+#                      ["A", "a3@a.com"],
+#                      ["B", "b2@b.com", "b1@b.com"] ]
+#
+# Output: [ ["A", "a1@a.com", "a2@a.com"],
+#           ["A", "a3@a.com"],
+#           ["B", "b1@b.com", "b2@b.com"] ]
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# This is a bit a tricky one. When we walk through the input,
+# we can either merge directly to a previous element in the
+# output, or we have to append a new element to the output.
+# Since corner cases are not considered, there are a few funny
+# ones. What do we do if there is no common email address for
+# two elements with the same name, but a third element in the
+# list has an email address in common with both previous elements?
+# We can then either merge with the first, or we could merge all
+# three elements - since the task is unclear here, let's implement
+# both solutions as alternatives
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+my @accounts = (
+   ["A", "a1\@a.com", "a2\@a.com"],
+   ["B", "b1\@b.com"],
+   ["A", "a3\@a.com", "a1\@a.com"]
+);
+merge_accounts(@accounts);
+merge_accounts_full(@accounts);
+
+@accounts = (
+   ["A", "a1\@a.com", "a2\@a.com"],
+   ["B", "b1\@b.com"],
+   ["A", "a3\@a.com"],
+   ["B", "b2\@b.com", "b1\@b.com"]
+);
+merge_accounts(@accounts);
+merge_accounts_full(@accounts);
+
+@accounts = (
+   ["A", "a1\@a.com", "a2\@a.com"],
+   ["B", "b1\@b.com"],
+   ["A", "a3\@a.com"],
+   ["B", "b2\@b.com", "b1\@b.com"],
+   ["A", "a3\@a.com", "a2\@a.com"],
+);
+merge_accounts(@accounts);
+merge_accounts_full(@accounts);
+
+# helper function: merge the accounts in the given array
+# this doesn't merge fully, only if an element already
+# has a matching email address in a previous element
+# returns the merged array
+# This function only does the actual merging, nothing else
+sub merge_accounts_ {
+   my $accounts = shift;
+   my $result = [];
+   foreach my $elem (@$accounts) {
+      my $did_merge = 0;
+      # if there is an element in the current result set
+      # that we can merge to, we do that, otherwise we'll
+      # just add a new element to the result
+      foreach my $i (0..$#$result) {
+         if (can_merge_to($elem, $result->[$i])) {
+            $result->[$i] = merge($result->[$i], $elem);
+            $did_merge = 1;
+            last;
+         }
+      }
+      push @$result, $elem unless $did_merge;
+   }
+   return $result;
+}
+
+# helper function to do the actual merging
+# Just add each email address to the first
+# element unless it's there
+# The name will also not be added because it's
+# already there, no need for special treatment here
+sub merge {
+   my ($elem1, $elem2) = @_;
+   my $seen;
+   map { $seen->{$_} = 1 } @$elem1;
+   foreach my $part (@$elem2) {
+      next if $seen->{$part};
+      push @$elem1, $part;
+   }
+   return $elem1;
+}
+
+# check whether we can merge two elements
+# first, we need to check that name is the same
+# then we need to find at least one matching email address
+sub can_merge_to {
+   my ($elem1, $elem2) = @_;
+   my $seen;
+   map { $seen->{$_} = 1 } @$elem1;
+   my $name = $elem2->[0];
+   return 0 unless $name eq $elem1->[0];
+   foreach my $part (@$elem2) {
+      next if $part eq $name;
+      return 1 if $seen->{$part};
+   }
+   return 0;
+}
+
+# merge accounts from list when possible, not doing the deep
+# re-merge if possible. This function does some output and
+# otherwise calls merge_accounts_ for the actual work
+sub merge_accounts {
+   my $accounts = [ @_ ];
+   print "Input: [";
+   foreach my $elem (@$accounts) {
+      print " [" . join(", ", @$elem) . "]\n";
+   }
+   print "]\n";
+
+   my $merged = merge_accounts_($accounts);
+
+   print "Output: [";
+   foreach my $elem (@$merged) {
+      print " [" . join(", ", @$elem) . "]\n";
+   }
+   print "]\n";
+}
+
+# this is the "full merge" option. We simply merge as before,
+# but this time, as long as input and output of the actual
+# merge step differ, we will start over with the current output
+# as the new input. So we merge unless there is no more possibilty
+# to merge anything
+sub merge_accounts_full {
+   my $accounts = [ @_ ];
+   print "Input: [";
+   foreach my $elem (@$accounts) {
+      print " [" . join(", ", @$elem) . "]\n";
+   }
+   print "]\n";
+
+   my $merged = merge_accounts_($accounts);
+
+   while(is_same_deeply($accounts, $merged) == 0) {
+      $accounts = $merged;
+      $merged = merge_accounts_($accounts);
+   }
+
+   print "Output: [";
+   foreach my $elem (@$merged) {
+      print " [" . join(", ", @$elem) . "]\n";
+   }
+   print "]\n";
+}
+
+# helper function
+# check if two nested arrays have the same elements at the bottom
+sub is_same_deeply {
+   my ($list1, $list2) = @_;
+   if(scalar(@$list1) != scalar(@$list2)) {
+      return 0;
+   }
+   # two empty lists are the same
+   return 1 unless @$list1;
+   foreach my $i (0..$#$list1) {
+      if(ref($list1->[$i]) ne ref($list2->[$i])) {
+         return 0;
+      }
+      if(ref($list1->[$i]) eq "ARRAY") {
+         return 0 unless is_same_deeply($list1->[$i], $list2->[$i]);
+      }
+   }
+   return 1;
+}
+