Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

6 files changed, 217 insertions, 38 deletions

diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md
index 60038de5c3..47a6bbcd83 100644
--- a/challenge-209/james-smith/README.md
+++ b/challenge-209/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 207](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-207/james-smith) |
-[Next 209 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith)
+[< Previous 208](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith) |
+[Next 210 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-210/james-smith)
 
-# The Weekly Challenge 208
+# ED-209: The Weekly Challenge
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,64 +13,77 @@ submit solutions in whichever language you feel comfortable with.
 
 You can find the solutions here on github at:
 
-https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-208/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith
 
-# Task 1: Minimum Index Sum
+# Task 1: Special Bit Characters
 
-***You are given two arrays of strings. 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`. Valid sequences in the bit string are:
+`[0]` decodes to `"a"`, `[1, 0]` to `"b"`, `[1, 1]` to `"c"`. Write a script to print `1` if the last character is an `"a"` otherwise print `0`.***
 
 ## Solution
 
-We proceed to do a pass of each array. 
+Firstly we quickly check the last entry is a `0` if it isn't we return `-1` "error". We then look through each bit in turn - if it is `0` we go to the next bit; if it is a `1` we skip one bit and go to the next. We loop through to the end of the array. We loop till the array has `0` or `1` elements left - if we have one element left then the last character is an "a" if we have none it is not. So we can just return scalar @a`.
 ```perl
-sub min_index_sum {
-  my( $b, %x, $t, $s, @best ) = ( 1e99,                #0
-    map { $_[0][$_] => $_ } reverse ( 0 .. $#{$_[0]} ) #1
-  );
-  exists $x{$t = $_[1][$_]} &&                         #3
-    ( $b > ($s=$x{$t}+$_) ?  ($b,@best) = ( $s,$t )    #4
-    : $b == $s            && push @best, $t )          #5
-    for 0 .. $#{$_[1]};                                #2
-  \@best                                               #6
+sub special_bit_chars {
+  return 0 if $_[-1];
+  ($_[0]&&shift), shift until @_<2;
+  scalar @_
 }
 ```
+## Solution 2
 
-First we start with the first array and find the lowest index for each word in it - and store them in the hash `%x`. Note we work backwards through the list to ensure that it is the lowest index if the word is duplicated. This is the `map` in line 1.
+As well as tracking from the front we can track from the back.
 
-We then loop through the second list of strings (`#2`) looking for words which are in the first list (`#3`). If it has a lower index sum that the best so far we record this and reset the list of words (`#4`). If it has the same we just push it onto the list. (`#5`)
+First we need to note:
 
-At the end we just return the current list of words (which could be empty if there are no duplicates). (`#6`)
+ * Last character must be a `0`
+ * If there is string ending in a `0` then we can ignore anything up to this, as `0` is always at the right hand character in a string;
+ * Additionally if the last two characters are 0 then we know that the answer is true.
+ * So breaking this down we need to work out whether the value is true or false if the list ends: `.....,1,0`. If the string consists of series of `n` pairs of `1`s then this converts to "...CCA" and so the last character is `A` so we return 0; If it is an odd number of 1s we have the string "...CCB" so the return value is false.
 
-Note we set the initial best index sum (`#0`) as `10^99` as the index sum will be no where near this and so we can treat this as effectively infinity...
-
-# Task 2: Duplicate and Missing
+```perl
+sub special_bit_chars_reverse {
+  my$f,pop?return 0:pop||return 1;
+  $f++,pop||last while@_;
+  1&$f
+}
+```
+# Task 2: Merge Account
 
 Try all combinations and 
-***You are given an array of integers in sequence with one missing and one duplicate. Write a script to find the duplicate and missing integer in the given array. Return `-1` if none found. For the sake of this task, let us assume the array contains no more than one duplicate and missing.***
+***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.***
 
 ## Observation
 
-It is not 100% clear in the desciption - but we have assumed that it means a list of integers from `n` ... `m` with a step of `1`.
+It is not 100% clear in the desciption - whether or not to assume the name must be the same - I am going to assume it isn't and that we chose one name from the list.
 
 ## Solution
 
-We loop through looking for a duplicate `$p[n+1]==$p[$n]` or gap `$p[n+1]!=$p[$n]+1`.
+The first pass at a solution, keeps a track of which emails that we have seen and links together an account with the current one if we have already seen the email address. This works most of the time - but it can go wrong - when there are three accounts with overlapping emails BUT they have no common email address.  This is the `for my $acc` loop below. To resolve this we can allow ourselves to do multiple passes reducing the list each time.
 
-We have two special cases - if there are no duplicates return -1 
+Now 
 
 ```perl
-sub dup_missing {
-  my($p,$d,$m) = shift;
-  ($_==$p ? ($d=$_) : $_ == $p+2 && ($m=$_-1)), $p=$_ for @_;
-  defined $d ? ( defined $m ? [ $d, $m ] : [ $d,$p+1  ] ): [-1]
+sub merge_accounts {
+  my($in,$out,%seen,$t) = ([],shift);
+  while(@{$out}!=@{$in}) {
+    ($in,$out,%seen) = ($out,[]);
+    O: for my $acc (@{$in}) {
+      my( $name, @e )=@{ $acc };
+      for(@e) {
+        if( exists $seen{$_} ) {
+          my( $m, @f ) = @{ $out->[ $t = $seen{$_} ] };
+          my %T        = map { $_=>1 } @e, @f;
+          $seen{$_}    = $t for keys %T;
+          $out->[ $t ] = [ $m, keys %T ];
+          next O;
+        }
+      }
+      $seen{$_} = @{$out} for @e;
+      push @{$out},$acc;
+    }
+  }
+  $out
 }
-
 ```
-We note that if the two neighbouring values are the same we have found the duplicate, and if the difference is `2` we've found the missing value.
-
-At the end of the loop we have 3 cases:
-
- 1) We have not found the duplicate (`$d` is undefined) - so we return `[-1]`;
- 2) We have found the duplicate and we've found the missing value as well so we return `[$d,$m]`;
- 3) We have found the duplicate BUT we haven't found the missing value - there is no solution here - the missing value is at one end or other of the list. As at this point we know what the last value of the list is (but not the first - we threw that away) we just return last value + 1.
 
diff --git a/challenge-209/james-smith/blog.txt b/challenge-209/james-smith/blog.txt
new file mode 100644
index 0000000000..e43621c16f
--- /dev/null
+++ b/challenge-209/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-209/james-smith/blog.txt
diff --git a/challenge-209/james-smith/perl/ch-1.pl b/challenge-209/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..7539610ef9
--- /dev/null
+++ b/challenge-209/james-smith/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+
+my @TESTS = (
+  [ [1,0,0]   =>  1 ],
+  [ [1,1,1,0] =>  0 ],
+  [ [1,1,1]   =>  0 ],
+);
+
+sub special_bit_chars {
+  return 0 if $_[-1];
+  ($_[0]&&shift),shift until @_<2;
+  scalar @_
+}
+
+sub special_bit_chars_reverse {
+  my$f,pop?return 0:pop||return 1;
+  $f++,pop||last while@_;
+  1&$f
+}
diff --git a/challenge-209/james-smith/perl/ch-2.pl b/challenge-209/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..458f0b80ca
--- /dev/null
+++ b/challenge-209/james-smith/perl/ch-2.pl
@@ -0,0 +1,57 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+
+my @ACC = (
+ [ ['A', 'a1@a.com', 'a2@a.com'],
+   ['B', 'b1@b.com'],
+   ['A', 'a3@a.com', 'a1@a.com'] ],
+ [ ['A', 'a1@a.com', 'a2@a.com'],
+   ['B', 'b1@b.com'],
+   ['A', 'a3@a.com'],
+   ['B', 'b2@b.com', 'b1@b.com'] ],
+ [ ['A', 'a1@a.com', 'a2@a.com'],
+   ['A', 'a3@a.com', 'a4@a.com'],
+   ['A', 'a2@a.com', 'a4@a.com'] ],
+ [ ['A', 'a1@a.com', 'a2@a.com'],
+   ['A', 'a2@a.com', 'a3@a.com'],
+   ['A', 'a3@a.com', 'a4@a.com'],
+   ['A', 'a4@a.com', 'a5@a.com'],
+   ['A', 'a5@a.com', 'a6@a.com'] ],
+ [ ['A', 'a1@a.com', 'a2@a.com'],
+   ['A', 'a3@a.com', 'a4@a.com'],
+   ['A', 'a5@a.com', 'a6@a.com'],
+   ['A', 'a7@a.com', 'a8@a.com'],
+   ['A', 'a1@a.com', 'a3@a.com'],
+   ['A', 'a5@a.com', 'a7@a.com'],
+   ['A', 'a1@a.com', 'a5@a.com'] ],
+);
+
+say Dumper(merge_accounts( $_ )) for @ACC;
+
+sub merge_accounts {
+  my($in,$out,%seen,$t) = ([],shift);
+  while(@{$out}!=@{$in}) {
+    ($in,$out,%seen) = ($out,[]);
+    O: for my $acc (@{$in}) {
+      my( $name, @e )=@{ $acc };
+      for(@e) {
+        if( exists $seen{$_} ) {
+          my( $m, @f ) = @{ $out->[ $t = $seen{$_} ] };
+          my %T        = map { $_=>1 } @e, @f;
+          $seen{$_}    = $t for keys %T;
+          $out->[ $t ] = [ $m, keys %T ];
+          next O;
+        }
+      }
+      $seen{$_} = @{$out} for @e;
+      push @{$out},$acc;
+    }
+  }
+  $out
+}
diff --git a/challenge-209/mark-anderson/raku/ch-1.raku b/challenge-209/mark-anderson/raku/ch-1.raku
new file mode 100644
index 0000000000..1584ebecc2
--- /dev/null
+++ b/challenge-209/mark-anderson/raku/ch-1.raku
@@ -0,0 +1,20 @@
+#!/usr/bin/env raku
+use Test;
+
+ok  special-bit-chars(0);
+ok  special-bit-chars(1,0,0);
+ok  special-bit-chars(1,0,1,1,0);
+ok  special-bit-chars(0,0,0,0,0,0);
+ok  special-bit-chars(0,1,0,1,0,0);
+ok  special-bit-chars(0,1,0,1,0,0);
+
+nok special-bit-chars(1,1,1,0);
+nok special-bit-chars(1,1,1,1,1,0);
+nok special-bit-chars(1,1,0,0,1,0);
+nok special-bit-chars(1,0,1,0,1,0);
+nok special-bit-chars(0,0,0,0,1,0);
+
+sub special-bit-chars(+$a)
+{
+    $a.join ~~ /^ [ 0 | 10 | 11 ]* 0 $/
+}
diff --git a/challenge-209/mark-anderson/raku/ch-2.raku b/challenge-209/mark-anderson/raku/ch-2.raku
new file mode 100644
index 0000000000..b84ffb5aae
--- /dev/null
+++ b/challenge-209/mark-anderson/raku/ch-2.raku
@@ -0,0 +1,63 @@
+#!/usr/bin/env raku
+use Test;
+
+is-deeply merge-accounts([ 
+                           [<A a1@a.com a2@a.com>],
+                           [<B b1@b.com>],
+                           [<A a3@a.com a1@a.com>] 
+                         ]),
+                         [ 
+                           [<A a1@a.com a2@a.com a3@a.com>],
+                           [<B b1@b.com>]
+                         ];
+
+is-deeply merge-accounts([ 
+                           [<A a1@a.com a2@a.com>],
+                           [<B b1@b.com>],
+                           [<A a3@a.com>],
+                           [<B b2@b.com b1@b.com>] 
+                         ]),
+                         [
+                           [<A a1@a.com a2@a.com>],
+                           [<A a3@a.com>],
+                           [<B b1@b.com b2@b.com>]
+                         ];;
+
+is-deeply merge-accounts([
+                           [<C c2@c.com>],
+                           [<C c1@c.com c4@c.com>], 
+                           [<A a1@a.com a2@a.com>],
+                           [<B b1@b.com>],
+                           [<A a3@a.com>],
+                           [<B b4@b.com b5@b.com b6@b.com>],
+                           [<C c1@c.com c3@c.com>],
+                           [<B b2@b.com b1@b.com>],
+                           [<A a3@a.com a4@a.com>],
+                           [<B b3@b.com>];
+                         ]),
+                         [
+                           [<A a1@a.com a2@a.com>],
+                           [<A a3@a.com a4@a.com>],
+                           [<B b4@b.com b5@b.com b6@b.com>],
+                           [<B b1@b.com b2@b.com>],
+                           [<B b3@b.com>],
+                           [<C c2@c.com>],
+                           [<C c1@c.com c3@c.com c4@c.com>]
+                         ];
+
+sub merge-accounts(@accounts)
+{
+    my @a = @accounts.classify({ .[0] }, :as{ .[1..*] });
+
+    .Array given gather for @a.sort(*.key)  
+    {
+        my @value = .value>>.Array;
+
+        while @value.shift -> @v
+        {
+             my $k = @value.first({ $_ (&) @v }, :k);
+             $k.defined ?? (@value[$k] = [(@value[$k] (|) @v).keys]) 
+                        !! take [(.key, @v.sort.Slip)];
+        }
+    }  
+}