Merge pull request #8103 from drbaggy/master

Finally got around to writing this up!

4 files changed, 279 insertions, 87 deletions

diff --git a/challenge-217/james-smith/README.md b/challenge-217/james-smith/README.md
index d686150756..f003241b4b 100644
--- a/challenge-217/james-smith/README.md
+++ b/challenge-217/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 215](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-215/james-smith) |
-[Next 217 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-217/james-smith)
+[< Previous 216](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-216/james-smith) |
+[Next 218 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-218/james-smith)
 
-# The Weekly Challenge 6^3
+# The Weekly Challenge 217
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,108 +13,99 @@ 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-216/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-217/james-smith
 
-# TASK #1: Registration Number
+# TASK #1: Sorted Matrix
 
-***You are given a list of words and a random registration number. Write a script to find all the words in the given list that has every letter in the given registration number.***
+***You are given a n x n matrix where n >= 2. Write a script to find `3rd smallest` element in the sorted matrix.***
 
-## Solution
+## Solutions
+
+### Naive solution
+
+Our naive solution is to unravel the matrix into a single list `map{@$_}@_`, sort it and find the 3rd entry (index `2`). We then have a nice one liner....
 
 ```perl
-sub reg_number {
-  my (%l,%x) = map { /[a-z]/ ? ($_=>1) : () }
-               split //,
-               lc
-               shift;
-  grep {
-    %x=%l;
-    delete $x{$_} for split//;
-    !%x
-  } @_
+sub sorted_matrix {
+  [ sort { $a <=> $b } map {@{$_}} @_ ]->[2]
 }
 ```
 
-Firstly we get a list of the lower-cased letters in the number plate. Then for each word in turn we:
- * copy this hash into a temporary hash;
- * remove any letters from hash which rea in the word;
- * Check to see if the hash is now empty - if it is we include the word.
+This is good because it uses a built in method `sort` which will be faster than writing it in perl code - and it is `O(n.log n)` which is good. But it is still `O(n.log n)`. As we are looking for the 3rd smallest entry we can scan the matrix and just keep track of the smallest ones - this would be `O(n)`, but obviously more computationally expensive for each loop. But how much...
 
-# TASK #2: Word Stickers
+### Second solution:
 
-***You are given a list of word stickers and a target word. Write a script to find out how many word stickers is needed to make up the given target word.***
+We again flatten the matrix, but this time we take the first three entries and sort into order.
+Then we loop through all the other values, and replace any values in this list by the new value
+if required.
 
-## Solution
-
-Interestingly this task uses the trick - copy hash and delete elements - within it's core.
-
-We note we:
- * are looking for fewest stickers so:
-    * this suggests a depth first solution;
-    * once we have found a solution it is by definition the best one;
-    * queue solutions work well in these cases;
- * use a count based solution
-    * we count every letter in the target word;
- * check that all of these are available on the sticker:
-    * if not we return a "0" value
- * initialise the queue with an element:
-    * where we have not used any stickers;
-    * the last sticker we have "chosen" is the first one;
-    * the counts are the inital counts we calculated above
- * for every element of the queue:
-    * we loop through the stickers;
-    * for each sticker we loop through the letters;
-    * and if we need that letter we make a note we have removed a letter and reduce the count of that letter by one (if the count goes to zero we remove it);
-    * if the counts array is empty we return the size
-    * if we have removed a letter we push the new values back on to the queue;
-    * **Note** when looping through the stickers we start with the last one we used and loop to the end. This avoids duplicates and greatly reduces the search space.
-    * we loop till the queue is empty - actually we don't because we will exit the loop with the count array check above before we exhaust the queue.
-
-Here is the code that the describes....
+If we compare the performance against the naive solution we find that the naive solution is better then this method for the small matrices in the the example. BUT if we increase the size of the matrix to 10x10 then we find they are comparable in performance. If we then go up to 20x20 we can see the advantage of this solution.
 
 ```perl
-sub word_stickers {
-  my( %f, %s, $n, $l, $x );
-  $f{$_}++ for split //, shift;
-  my @q = [ 1, 0, my %t = %f ];
-  map { delete $t{$_} } split // for @_;
-  return 0 if keys %t;
-  while( ( $n, $l, %f ) = @{ shift @q } ) {
-    push @q, map {
-      $x = 0, %t = %f;
-      exists $t{$_} && ( $x=1, --$t{$_} || delete $t{$_} )
-        for split//, $_[$_];
-      !%t ? return $n : $x ? [ $n+1, $_, %t ] : ()
-    } $l..$#_;
-  }
+sub sorted_matrix_x {
+  @_=map{ @{$_} } @_;
+
+  my( $x, $y ,$z ) = splice @_,0,3; ## Grab 3 values;
+
+  ( $x, $y     ) = ( $y, $x ) if $y<$x;
+  $z < $x ? ($x,$y,$z) = ($z,$x,$y) : $z < $y && ( ($y,$z)=($z,$y) );
+
+  $_<$z && (
+      $_<$x ?  ( $x, $y, $z ) = ( $_, $x, $y )
+    : $_<$y ?  (     $y, $z ) = (     $_, $y )
+    :          (         $z   =           $_ )
+  ) for @_;
+  $z
 }
 ```
 
-And to know what bit does what - here it is with comments:
+### Third solution:
+
+But can we go faster - what can slow us down. One thing we still do is flatten the matrix - that is a relatively expensive operation, but it does need slightly more code around it - mainly related to the calculation of the first 3 values.
+
+But we can work around it - we shift of values from the first row of the array, and if that list is empty - we move on to the next row... and the next...
+Finally we loop through each row of the array (including the remains of this row) and perform the same insertion step as above...
+
+Although more complex - is it faster? yes - the break even point against the first technique is around `5x5`. The extra work means this method performance increases linearly even to the 2nd method...
 
 ```perl
-sub word_stickers {
-  my( %f, %s, $n, $l, $x );
-  $f{$_}++ for split //, shift; # count for letters
-  my %t = %f; # Check all letters on stickers
-  # Initialise queue - no stickers, initial freq.
-  my @q = [ 1, 0, my %t = %f ]; # Check can solve?
-  map { delete $t{$_} } split // for @_;
-  return 0 if keys %t; # if not return 0
-  my @q = [ 1, 0, %f ]; # [ $no+1, $last, %freqs ]
-  while( ($n,$l,%f) = @{ shift @q } ) {
-    push @q, map {
-      # Make copy of frequencies, set flag ($x)
-      # true once we use a letter on sticker,
-      # remove letters we have used up
-      $x = 0, %t = %f;
-      exists $t{$_} && ( $x=1, --$t{$_} || delete $t{$_} )
-        for split//, $_[$_];
-      # If none left return $n OR push entry onto
-      # queue, increasing count and setting new last
-      !%t ? return $n : $x ? [ $n+1, $_, %t ] : ()
-      # Loop from last used to remove duplicates
-    } $l..$#_;
+sub sorted_matrix_xx {
+  my @row = @{pop()};
+
+  my $x = pop @row; @row = @{pop()} unless @row;
+  my $y = pop @row; @row = @{pop()} unless @row;
+  my $z = pop @row;
+
+  ( $x, $y     ) = ( $y, $x ) if $y<$x;
+  $z < $x ? ($x,$y,$z) = ($z,$x,$y) : $z < $y && ( ($y,$z)=($z,$y) );
+  for(\@row,@_) {
+    $_<$z && (
+        $_<$x ?  ( $x, $y, $z ) = ( $_, $x, $y )
+      : $_<$y ?  (     $y, $z ) = (     $_, $y )
+      :          (         $z   =           $_ )
+    ) for @{$_};
   }
+  $z;
 }
 ```
+Firstly we get a list of the lower-cased letters in the number plate. Then for each word in turn we:
+ * copy this hash into a temporary hash;
+ * remove any letters from hash which rea in the word;
+ * Check to see if the hash is now empty - if it is we include the word.
+
+### Performance
+
+For small arrays (<3) then the `sort` and pick is the fastest method, at which point method 3 passes it, and around 7-10 method 2 also passes it, showing the overhead of the "copy" of the matrix. The difference between methods 2 and 3. By the time we get to a 20x20 matrix, method 2 is twice the speed of the sort and method 3 is 6 times the speed of the sort.
+
+# TASK #2: Max Number
+
+***You are given a list of positive integers. Write a script to concatenate the integers to form the highest possible value.***
+
+## Solution
+
+A naive solution would be to just (string) sort the elements ans stitch them together - but that isn't the case as if you stitch `1` & `10` together in alphabetical order you get `10`` not `110`. So instead we compare `$a.$b` with `$b.$a` which resolves this.
+
+```perl
+sub max_number      { join '', sort { $b.$a cmp $a.$b } @_ }
+```
+You can get the right answer with a numeric comparison - but the string comparison is between 10% & 20% faster.
diff --git a/challenge-217/james-smith/blog.txt b/challenge-217/james-smith/blog.txt
new file mode 100644
index 0000000000..201df08d6e
--- /dev/null
+++ b/challenge-217/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-217/james-smith/blog.txt
diff --git a/challenge-217/james-smith/perl/ch-2.pl b/challenge-217/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..6bda9dd725
--- /dev/null
+++ b/challenge-217/james-smith/perl/ch-2.pl
@@ -0,0 +1,32 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese);
+use Data::Dumper qw(Dumper);
+
+my @TESTS = (
+ [ [1,23],231],
+ [ [10,3,2],3210],
+ [ [31,2,4,10] ,431210],
+ [ [5,11,4,1,2], 542111],
+ [ [1,10],110 ],
+ [ [1,10,110,9,90,900],'990900111010' ],
+ [ [900,1,9,10,90,110],'990900111010' ],
+);
+
+
+sub max_number      { join '', sort { $b.$a cmp $a.$b } @_ }
+sub max_number_n    { join '', sort { $b.$a <=> $a.$b } @_ }
+
+is( max_number( @{$_->[0]} )       , $_->[1] ) for @TESTS;
+is( max_number_n( @{$_->[0]} )       , $_->[1] ) for @TESTS;
+done_testing();
+
+cmpthese( 5_000_000, {
+  'cmp' => sub { max_number(    @{$_->[0]} ) for @TESTS },
+  '<=>' => sub { max_number_n(  @{$_->[0]} ) for @TESTS },
+});
+
diff --git a/challenge-217/james-smith/perl/ch1.pl b/challenge-217/james-smith/perl/ch1.pl
new file mode 100644
index 0000000000..2eb9cb642d
--- /dev/null
+++ b/challenge-217/james-smith/perl/ch1.pl
@@ -0,0 +1,168 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese);
+use Data::Dumper qw(Dumper);
+
+my @TESTS = (
+ [ [[2,1],[4,5]],4],
+ [ [[1,0,3],[0,0,0],[1,2,1]],0],
+ [ [[3,1,2],[5,2,4],[0,1,3]],1],
+ [ [[reverse 5..9],[reverse 2..6],[reverse 3..7],[reverse 4..8],[reverse 1..5]],2],
+ [ [[reverse 7..13],[reverse 2..8],[reverse 3..9],[reverse 4..10],[reverse 5..11],[reverse 6..12],[reverse 1..7]],2],
+ [ [
+[ 7,9,4,5,6,5,6,8,1,9 ],
+[ 6,2,8,8,6,2,1,9,2,7 ],
+[ 9,7,1,5,8,8,3,5,6,5 ],
+[ 9,1,6,4,4,4,5,9,5,5 ],
+[ 4,4,9,8,4,2,6,4,3,6 ],
+[ 7,4,4,4,3,1,9,8,8,9 ],
+[ 5,8,6,8,1,8,3,8,8,2 ],
+[ 7,4,7,9,3,7,2,5,7,4 ],
+[ 6,4,9,1,8,5,7,4,7,6 ],
+[ 0,2,3,0.5,0.25,0.1,4,3,1,4]], 0.25
+],
+ [ [
+[ 8,1,5,6,1,6,4,5,2,9,3,4,4,1,3,2,4,6,4,6,3,5,2,7,9,9,3,2,1,5 ],
+[ 9,9,4,4,3,9,7,3,4,1,7,9,3,2,4,6,4,7,4,9,2,8,1,9,3,5,4,4,2,3 ],
+[ 8,2,3,6,2,7,3,1,4,6,4,7,7,8,6,6,9,8,9,1,3,8,4,7,5,7,2,6,9,7 ],
+[ 3,4,1,3,5,2,2,8,3,7,8,8,5,7,5,5,6,3,5,7,4,7,6,4,1,1,5,5,2,6 ],
+[ 5,4,5,3,1,2,9,2,1,8,1,7,2,4,8,7,3,7,1,6,9,8,3,1,4,8,6,7,9,8 ],
+[ 9,7,9,6,8,8,9,1,1,3,6,1,4,4,8,3,6,1,8,7,3,4,3,3,8,6,8,2,8,3 ],
+[ 9,7,5,5,6,4,4,8,3,5,2,9,9,6,4,5,9,4,4,6,9,5,6,8,3,5,4,7,3,7 ],
+[ 4,2,7,1,9,4,5,1,9,4,1,1,4,1,8,6,9,6,1,3,2,8,3,8,7,2,8,5,9,8 ],
+[ 8,8,4,8,2,3,7,5,2,8,9,2,8,1,7,9,4,2,3,2,9,4,7,6,3,8,8,3,7,4 ],
+[ 1,1,4,5,3,5,4,2,4,6,7,1,3,1,8,7,6,3,9,7,7,9,1,7,2,9,5,5,6,4 ],
+[ 3,3,8,8,5,2,4,9,7,7,8,4,3,6,5,7,6,6,7,2,7,5,7,3,3,5,8,8,8,4 ],
+[ 5,5,3,7,9,2,9,6,7,5,2,1,9,4,4,9,6,4,8,1,5,3,6,8,1,3,4,8,6,6 ],
+[ 1,9,4,5,5,2,7,1,3,7,9,7,1,8,3,1,2,6,6,6,2,1,8,8,6,6,7,8,9,9 ],
+[ 1,1,7,6,3,8,4,4,3,6,9,4,5,1,4,7,6,1,6,2,5,9,3,2,1,3,7,4,3,9 ],
+[ 8,3,7,5,7,8,5,6,1,4,1,2,4,9,4,6,3,6,8,5,9,2,2,2,3,7,6,8,8,9 ],
+[ 3,3,9,8,2,2,1,3,6,5,7,1,3,5,1,4,3,7,4,5,8,4,3,5,3,7,4,9,1,6 ],
+[ 7,2,4,1,6,1,8,2,4,5,1,9,6,3,7,5,3,1,2,6,7,8,6,6,2,8,9,7,4,6 ],
+[ 5,2,3,9,5,6,3,5,7,8,9,1,4,8,5,1,8,6,2,3,6,6,2,8,3,6,8,6,8,1 ],
+[ 1,1,7,9,3,8,4,3,8,7,3,2,9,3,3,2,7,1,2,2,2,8,9,3,3,5,6,8,7,5 ],
+[ 8,6,8,7,4,5,7,1,5,6,1,5,1,9,9,8,8,1,1,4,1,6,1,5,4,9,2,6,1,6 ],
+[ 9,2,1,5,5,8,9,6,4,2,6,2,2,6,3,3,2,4,5,9,2,2,9,5,5,4,5,8,7,4 ],
+[ 6,9,6,6,2,7,5,8,5,9,8,9,9,4,9,5,2,7,3,3,4,2,2,6,5,8,6,6,2,3 ],
+[ 9,6,2,7,8,4,4,3,5,8,8,2,6,4,1,7,8,2,1,1,3,9,3,5,9,1,7,1,4,9 ],
+[ 2,3,8,1,4,3,3,6,9,8,9,1,3,6,9,4,5,2,1,1,6,3,2,9,1,6,9,1,5,2 ],
+[ 4,8,6,9,5,4,3,5,3,9,4,6,1,5,9,8,4,5,4,5,7,3,8,3,9,9,3,4,7,8 ],
+[ 6,3,1,3,1,8,4,5,7,7,8,6,8,5,5,6,4,9,1,7,3,9,1,8,6,9,7,4,1,6 ],
+[ 5,3,6,3,8,6,7,1,1,9,7,7,3,2,2,5,5,4,5,2,3,1,7,6,1,1,8,3,6,7 ],
+[ 8,2,2,6,6,1,6,3,9,1,9,1,4,5,2,9,2,9,4,4,7,6,3,2,7,9,7,6,5,6 ],
+[ 4,9,7,7,5,1,4,9,2,6,4,8,6,7,5,6,3,8,2,9,7,5,3,1,3,4,7,6,7,1 ],
+[ 1,2,3,1,0,1,2,0.5,0,1,2,1,3,5,6,1,4,9,1,2,3,0.2,0.1,0.05,1,4,5,1,9,10] ], 0.05 ],
+[ [
+[ 3,4,4,3,1,4,1,4,5,3,3,1,5,2,5,7,1,2,4,6 ],
+[ 1,2,4,6,2,6,8,8,3,1,1,4,3,3,4,7,4,1,2,8 ],
+[ 6,2,8,4,7,1,9,8,7,2,2,5,8,9,8,3,4,5,4,5 ],
+[ 9,2,9,8,7,6,7,7,2,3,8,4,1,3,5,3,9,4,6,5 ],
+[ 5,9,1,1,8,6,9,4,2,6,5,5,4,9,5,9,9,2,3,8 ],
+[ 9,5,2,6,2,4,4,1,3,1,2,5,8,9,3,5,2,4,3,8 ],
+[ 9,7,5,8,6,1,4,6,1,8,9,9,4,1,8,1,2,3,4,4 ],
+[ 1,2,7,9,3,3,4,8,3,9,9,6,6,7,9,9,8,1,5,7 ],
+[ 5,1,2,2,1,9,9,1,9,7,6,6,1,3,5,2,1,2,7,8 ],
+[ 8,5,2,2,4,8,7,5,5,7,2,8,1,2,9,8,7,7,1,4 ],
+[ 9,8,9,5,6,1,5,5,4,4,1,9,9,3,7,7,4,3,9,6 ],
+[ 7,5,6,5,2,9,8,7,9,4,2,8,8,2,8,4,9,8,4,1 ],
+[ 4,1,2,4,9,9,6,6,3,3,9,8,1,3,6,9,5,7,5,5 ],
+[ 4,6,2,6,5,2,1,6,4,3,9,7,7,3,9,9,9,3,7,9 ],
+[ 6,8,5,2,9,9,9,9,4,6,9,9,9,7,2,1,8,3,3,1 ],
+[ 2,4,1,1,5,2,3,7,8,9,7,4,1,3,7,2,3,6,5,1 ],
+[ 9,1,9,3,9,8,7,8,5,3,7,5,1,1,2,3,2,9,9,3 ],
+[ 9,8,2,5,1,5,7,7,9,3,7,1,7,7,1,2,1,6,9,4 ],
+[ 6,4,3,6,3,3,3,3,8,5,1,4,2,6,4,3,8,1,5,7 ],
+[ 0,1,3,1,0.5,0.25,0.1,1,3,4,5,6,9,0.05,1,3,4,5,6,7]],0.1 ],
+);
+
+sub sorted_matrix {
+  [ sort { $a <=> $b } map {@{$_}} @_ ]->[2]
+}
+
+sub sorted_matrix_x {
+  @_=map{ @{$_} } @_;
+
+  my( $x, $y ,$z ) = splice @_,0,3; ## Grab 3 values;
+
+  ( $x, $y     ) = ( $y, $x ) if $y<$x;
+  $z < $x ? ($x,$y,$z) = ($z,$x,$y) : $z < $y && ( ($y,$z)=($z,$y) );
+
+  $_<$z && (
+      $_<$x ?  ( $x, $y, $z ) = ( $_, $x, $y )
+    : $_<$y ?  (     $y, $z ) = (     $_, $y )
+    :          (         $z   =           $_ )
+  ) for @_;
+  $z
+}
+
+sub sorted_matrix_xx {
+  my @row = @{pop()};
+
+  my $x = pop @row; @row = @{pop()} unless @row;
+  my $y = pop @row; @row = @{pop()} unless @row;
+  my $z = pop @row;
+
+  ( $x, $y     ) = ( $y, $x ) if $y<$x;
+  $z < $x ? ($x,$y,$z) = ($z,$x,$y) : $z < $y && ( ($y,$z)=($z,$y) );
+  for(\@row,@_) {
+    $_<$z && (
+        $_<$x ?  ( $x, $y, $z ) = ( $_, $x, $y )
+      : $_<$y ?  (     $y, $z ) = (     $_, $y )
+      :          (         $z   =           $_ )
+    ) for @{$_};
+  }
+  $z;
+}
+
+is( sorted_matrix(    @{$_->[0]} ) , $_->[1] ) for @TESTS;
+is( sorted_matrix_x(  @{$_->[0]} ) , $_->[1] ) for @TESTS;
+is( sorted_matrix_xx( @{$_->[0]} ) , $_->[1] ) for @TESTS;
+
+done_testing();
+
+warn "ALL";
+cmpthese( -2, {
+  'sort' => sub { sorted_matrix(    @{$_->[0]} ) for @TESTS },
+  'cmp'  => sub { sorted_matrix_x(  @{$_->[0]} ) for @TESTS },
+  'nest' => sub { sorted_matrix_xx( @{$_->[0]} ) for @TESTS },
+});
+warn "30";
+cmpthese( -2, {
+  'sort' => sub { sorted_matrix(    @{$_->[0]} ) for @TESTS[6] },
+  'cmp'  => sub { sorted_matrix_x(  @{$_->[0]} ) for @TESTS[6] },
+  'nest' => sub { sorted_matrix_xx( @{$_->[0]} ) for @TESTS[6] },
+});
+warn "20";
+cmpthese( -2, {
+  'sort' => sub { sorted_matrix(    @{$_->[0]} ) for @TESTS[7] },
+  'cmp'  => sub { sorted_matrix_x(  @{$_->[0]} ) for @TESTS[7] },
+  'nest' => sub { sorted_matrix_xx( @{$_->[0]} ) for @TESTS[7] },
+});
+warn "10";
+cmpthese( -2, {
+  'sort' => sub { sorted_matrix(    @{$_->[0]} ) for @TESTS[5] },
+  'cmp'  => sub { sorted_matrix_x(  @{$_->[0]} ) for @TESTS[5] },
+  'nest' => sub { sorted_matrix_xx( @{$_->[0]} ) for @TESTS[5] },
+});
+warn "7";
+cmpthese( -2, {
+  'sort' => sub { sorted_matrix(    @{$_->[0]} ) for @TESTS[4] },
+  'cmp'  => sub { sorted_matrix_x(  @{$_->[0]} ) for @TESTS[4] },
+  'nest' => sub { sorted_matrix_xx( @{$_->[0]} ) for @TESTS[4] },
+});
+warn "5";
+cmpthese( -2, {
+  'sort' => sub { sorted_matrix(    @{$_->[0]} ) for @TESTS[3] },
+  'cmp'  => sub { sorted_matrix_x(  @{$_->[0]} ) for @TESTS[3] },
+  'nest' => sub { sorted_matrix_xx( @{$_->[0]} ) for @TESTS[3] },
+});
+warn "2/3";
+cmpthese( -2, {
+  'sort' => sub { sorted_matrix(    @{$_->[0]} ) for @TESTS[0..2] },
+  'cmp'  => sub { sorted_matrix_x(  @{$_->[0]} ) for @TESTS[0..2] },
+  'nest' => sub { sorted_matrix_xx( @{$_->[0]} ) for @TESTS[0..2] },
+});