Challenge 209 solutions in Perl by Matthias Muth

4 files changed, 215 insertions, 110 deletions

diff --git a/challenge-209/matthias-muth/README.md b/challenge-209/matthias-muth/README.md
index 075f8b59f2..48176245df 100644
--- a/challenge-209/matthias-muth/README.md
+++ b/challenge-209/matthias-muth/README.md
@@ -1,133 +1,107 @@
-# Juggling with indexes.
-*Challenge 208 solutions in Perl by Matthias Muth*
+# Bits and addresses
+*Challenge 209 solutions in Perl by Matthias Muth*
 
-## Task 1: Minimum Index Sum
+## Task 1: Special Bit Characters
 
-> You are given two arrays of strings.<br/>
-> Write a script to find out all common strings in the given two arrays with minimum index sum. If no common strings found returns an empty list.
+> You are given an array of binary bits that ends with 0.<br/>
+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.
 
-Let's take one step at a time for this one:
+Oh. Looks like another one-liner!
 
-'All common strings':<br/>
-For checking whether a string is contained in both arrays, we use a typical Perl pattern and create an 'existence' hash from the first array's strings.
-Later we can go through the strings from the second array
-and check for each one whether it exists in the first array
-by simply checking the existence of a hash entry for that string.<br/>
-The typical Perl pattern to create that hash looks like this:
+The examples suggest that the bit strings are given as input in the form of an array of `0`s and `1`s.<br/>
+No problem for Perl to convert the values given to the function into a character string, like so:
 ```perl
-    my %index1 = map { ( $list1[$_] => 1 ) } 0..$#list1;
+    join( "", @_ )
 ```
-Actually, as we will also need the strings *index* within the first array later, we don't store the typical `1`, but that index value:
+And then we use a regular expression for checking the validity.<br/>
+The string must consist of a sequence of `0` (for `a`), `10` (for `b`) or `11` (for `c`), as many of them as we like,
+but then it must be followed by a `0` (for `a`) as the last character.<br/>
+And that's it!<br/>
+As in Perl, the binary result of the regular expression comparison is `1` for true or `""` for false, 
+we translate a 'false' into a `0` as requested.<br/>
+Here we go!
 ```perl
-    my %index1 = map { ( $list1[$_] => $_ ) } 0..$#list1;
+sub special_bit_characters {
+    return join( "", @_ ) =~ /^ ( 0 | 10 | 11 )* 0 $/x || 0;
+}
 ```
-We only need to create this hash for the first array of strings.
-For the second one we can loop over the strings, using the second string index as the loop index.
+# Merge Address
 
-'Minimum index sum':<br/>
-So we need the sum of the two indexes into the first and the second array for every string,
-and we need to store all those sums to later find their minimum.<br/>
-And we need to keep the information about which string generated each sum.<br/>
-So why don't we create another hash, this time using the *sum* as the key, and the string as the value?<br/>
-For finding the minimum in the end, we then can do `min( keys %strings_by_index_sum )`.<br/>
-And the strings to be returned are the `value` of that minimum's hash entry.<br/>
-String**s**? Plural?<br/>
-Oh, yes, the same index sum can be generated by more that one string (this case exists in the examples!).
-So we should not store a string as the value, but an arrayref,
-onto which we push whichever string generates that index sum.
-Looks like this:
+> You are given an array of accounts i.e. name with list of email addresses.<br/>
+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.
+
+The existing accounts are given in an 'array_ref' parameter. 
 ```perl
-    my %strings_by_index_sum;
-    for ( 0..$#list2 ) {
-        if ( exists $index1{ $list2[$_] } ) {
-            my $index_sum = $index1{ $list2[$_] } + $_;
-            push @{$strings_by_index_sum{$index_sum}}, $list2[$_];
-        }
-    }
+sub merge_accounts {
+    my ( $input_accounts ) = $_[0];
 ```
-
-Now it's time to return what we found.<br/>
-As already explained, we get the minimum of the keys of our special hash, and return the strings in that hash entry.<br/>
-To avoid an empty list in the `min(...)` call (which leads to a warning),
-we guard this computation by checking whether anything was found at all, returning an empty list if not.<br/>
-So:
+We create an array for those accounts that we merge into, should any other
+account have an address in common with this one.
 ```perl
-    return
-        %strings_by_index_sum
-        ? sort @{$strings_by_index_sum{ min( keys %strings_by_index_sum ) } }
-        : ();
+    my @merged_accounts;
 ```
-Putting everything together:
-
+For any address, we keep track of the account into which this address wil be merged into
+in %merged_accounts_by_address:
 ```perl
-sub min_index_sum {
-    my @list1 = @{$_[0]};
-    my @list2 = @{$_[1]};
-    my %index1 = map { ( $list1[$_] => $_ ) } 0..$#list1;
-    my %strings_by_index_sum;
-    for ( 0..$#list2 ) {
-        if ( exists $index1{ $list2[$_] } ) {
-            my $index_sum = $index1{ $list2[$_] } + $_;
-            push @{$strings_by_index_sum{$index_sum}}, $list2[$_];
-        }
-    }
-    return
-        %strings_by_index_sum
-        ? sort @{$strings_by_index_sum{ min( keys %strings_by_index_sum ) } }
-        : ();
-}
+    my %merged_accounts_by_address;
 ```
-
-## Task 2: Duplicate and Missing
-
->You are given an array of integers in sequence with one missing and one duplicate.<br/>
-Write a script to find the duplicate and missing integer in the given array. Return -1 if none found.<br/>
-For the sake of this task, let us assume the array contains no more than one duplicate and missing.
-
-In this task, for finding a duplicate value we need to go through the array and compare every value to the previous one.<br/>
-This immediately makes me think of using `List::Util`'s `reduce` function,
-which already does the job of looping over the array for us,
-as well as the job of handing us two values at a time (the `$a`and `$b` special variables) for use in a code block that we supply.
-
-Within that code block, we can check for a duplicate value and set a variable if we found one,
-Similarly, we can also check for a missing value between the previous entry and the current one:
+Now we split up the addresses of all existing accounts into 'merged accounts',
+creating a new 'merged account' whenever there is an account that cannot be merged
+into another one from before.
 ```perl
-    reduce {
-        $dup     = $b     if $b == $a;
-        $missing = $b - 1 if $a < $b - 1;
-        $b;
-    } @_;
+    for ( @$input_accounts ){
+        # The first entry is the name of the account,
+        # all following entries a mail address.
+        my ( $name, @addresses ) = @$_;
+
+        # Check whether we already have another account for any one of our
+        # addresses.
+        my $merged_account =
+            ( map $merged_accounts_by_address{$_},
+                grep $merged_accounts_by_address{$_}, @addresses )[0];
+
+        # If no other account so far had any of our addresses, our account will
+        # be the one that will be merged into further on, if there are addresses
+        # in common with other accounts. We therefore create a new entry into
+        # @merged_accounts.
+        # If we did find an already existing account for at least one of our
+        # addresses, we use that one.
+        # These 'merged accounts' remain with no addresses until later,
+        # but we keep track of the addresses in %merged_accounts_by_address.
+        # This way, we immediately know the account to merge for any address
+        # we encounter.
+        push @merged_accounts, $merged_account = [ $name ]
+            unless $merged_account;
+        $merged_accounts_by_address{$_} = $merged_account
+            for @addresses;
+    }
 ```
-(We mustn't forget to return `$b` from the code block, it will be the next iteration's `$a`.)
-
-There is a special case where we might 'miss' the missing value:<br/>
-When the duplicate values happen to be at the end of the array,
-the 'missing' value is the one that is now hidden by the repeated value in the last position.
-
-We can assume that that value is the missing one if we know that there is a duplicate
-(and the rules state that there will be *at maximum* one duplicate),
-and if we haven't detected a missing value before.<br/>
-If we did *not* find a duplicate when we arrive there, we need to return `-1` anyways,
-so in that case we don't need to worry about whether we have a missing value, and which one, at all.
-
-To summarize this solution:
-
+Now it's time to really fill our 'merged accounts' with addresses:
+```perl
+    # Add the addresses to the accounts they belong to.
+    # Sorted, so that they look nice on output.
+    push @{$merged_accounts_by_address{$_}}, $_
+        for sort keys %merged_accounts_by_address;
+````
+And do some cosmetics before we return the result:
 ```perl
-use List::Util qw( reduce );
+    # Also for output, sort the merged accounts by name and their first address.
+    @merged_accounts =
+        sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] }
+            @merged_accounts;
 
-sub dup_and_missing {
-    my ( $dup, $missing );
-    reduce {
-        $dup     = $b     if $a == $b;
-        $missing = $b - 1 if $a < $b - 1;
-        $b;
-    } @_;
-    return
-        defined $dup
-        ? ( $dup, $missing // ( $_[-1] + 1 ) )
-        : -1;
+    return \@merged_accounts;
 }
 ```
 
-**Thank you for the challenge!**
+Funny that I found it more difficult to describe the process than to implement it!<br/>
+Maybe it will help me if I ever read my own code again... :-)
 
+**Thank you for the challenge!**
diff --git a/challenge-209/matthias-muth/blog.txt b/challenge-209/matthias-muth/blog.txt
new file mode 100644
index 0000000000..9f97d47435
--- /dev/null
+++ b/challenge-209/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-209/challenge-209/matthias-muth#readme
diff --git a/challenge-209/matthias-muth/perl/ch-1.pl b/challenge-209/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..0ab89b7afc
--- /dev/null
+++ b/challenge-209/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 209 Task 1: Special Bit Characters
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+
+sub special_bit_characters {
+    return join( "", @_ ) =~ /^ ( 10 | 01 )* 0 $/x || 0;
+}
+
+
+use Test::More;
+
+my @tests = (
+    [ special_bit_characters => [
+        { INPUT => [ 1, 0, 0 ],    EXPECTED => [ 1 ] },
+        { INPUT => [ 1, 1, 1, 0 ], EXPECTED => [ 0 ] },
+    ] ],
+);
+
+for ( @tests ) {
+    my $sub_name = $_->[0];
+    my $sub = \&$sub_name;
+    for ( @{$_->[1]} ) {
+        my $test_name = $_->{TEST_NAME}
+            // ( "$sub_name( "
+                . join( " ", @{$_->{INPUT}} )
+                . " ) -> "
+                . join( " ", @{$_->{EXPECTED}} ) );
+        is_deeply [ special_bit_characters( @{$_->{INPUT}} ) ],
+            $_->{EXPECTED},
+            $test_name;
+    }
+}
+
+done_testing;
+
+1;
\ No newline at end of file
diff --git a/challenge-209/matthias-muth/perl/ch-2.pl b/challenge-209/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..03d0c8cb96
--- /dev/null
+++ b/challenge-209/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 209 Task 2: Merge Account
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+
+sub merge_accounts {
+    my ( $input_accounts ) = $_[0];
+
+    my @merged_accounts;
+    # For every address, this will contain all accounts that contain that address.
+    my %merged_accounts_by_address;
+
+    for ( @$input_accounts ){
+        # The first entry is the name of the account,
+        # all following entries a mail address.
+        my ( $name, @addresses ) = @$_;
+
+        # Check whether we already have another account for any one of our
+        # addresses.
+        my $merged_account =
+            ( map $merged_accounts_by_address{$_},
+                grep $merged_accounts_by_address{$_}, @addresses )[0];
+        # If no other account so far had any of our addresses, our account will
+        # be the one that will be merged into further on, if there are addresses
+        # in common with other accounts. We therefore create a new entry into
+        # @merged_accounts.
+        # If we did find an already existing account for at least one of our
+        # addresses, we use that one.
+        # These 'merged accounts' remain with no addresses until later,
+        # but we keep track of the addresses in %merged_accounts_by_address.
+        # This way, we immediately know the account to merge for any address
+        # we have encountered
+        push @merged_accounts, $merged_account = [ $name ]
+            unless $merged_account;
+        $merged_accounts_by_address{$_} = $merged_account
+            for @addresses;
+    }
+
+    # Add the addresses to the accounts they belong to.
+    # Sorted, so that they look nice on output.
+    push @{$merged_accounts_by_address{$_}}, $_
+        for sort keys %merged_accounts_by_address;
+
+    # Also for output, sort the merged accounts by name and their first address.
+    @merged_accounts =
+        sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] }
+            @merged_accounts;
+
+    return \@merged_accounts;
+}
+
+
+use Test::More;
+
+my @tests = (
+    { TEST_NAME => "Example 1",
+      INPUT    => [ [ 'A', 'a1@a.com', 'a2@a.com' ],
+                    [ 'B', 'b1@b.com' ],
+                    [ 'A', 'a3@a.com', 'a1@a.com' ] ],
+      EXPECTED => [ [ 'A', 'a1@a.com', 'a2@a.com', 'a3@a.com' ],
+                    [ 'B', 'b1@b.com' ] ] },
+    { TEST_NAME => "Example 2",
+      INPUT    => [ [ 'A', 'a1@a.com', 'a2@a.com' ],
+                    [ 'B', 'b1@b.com' ],
+                    [ 'A', 'a3@a.com'],
+                    [ 'B', 'b2@b.com', 'b1@b.com' ] ],
+      EXPECTED => [ [ 'A', 'a1@a.com', 'a2@a.com' ],
+                    [ 'A', 'a3@a.com'],
+                    [ 'B', 'b1@b.com', 'b2@b.com' ] ] },
+);
+
+for ( @tests ) {
+    is_deeply
+        merge_accounts( $_->{INPUT} ), $_->{EXPECTED}, $_->{TEST_NAME};
+}
+
+done_testing;