Merge pull request #7486 from drbaggy/master

Finally had to time to write this up!

4 files changed, 194 insertions, 56 deletions

diff --git a/challenge-201/james-smith/README.md b/challenge-201/james-smith/README.md
index c73cbf1efe..d8445e1324 100644
--- a/challenge-201/james-smith/README.md
+++ b/challenge-201/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 199](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-199/james-smith) |
-[Next 201 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-201/james-smith)
+[< Previous 200](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith) |
+[Next 202 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-202/james-smith)
 
-# The Weekly Challenge 200
+# The Weekly Challenge 201
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,71 +13,121 @@ 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-200/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-201/james-smith
 
-# Task 1: Arithmetic Slices
+# Task 1: Missing Numbers
 
-***You are given an array of integers. Write a script to find out all Arithmetic Slices for the given array of integers. An integer array is called arithmetic if it has at least 3 elements and the differences between any three consecutive elements are the same.***
+***You are given an array of unique numbers. Write a script to find out all missing numbers in the range 0..$n where $n is the array size.***
 
 ## Solution
 
-There are a number of solutions.. I will start with the first "optimal" one I have... if I have time I'll write up a more compact one.
+First we note for the problem as defined there will only ever be one missing number.
+
+Second we note if we add the numbers up we have a total of `n(n+1)/2 - {missing number}`.
+
+This leads us to two quite compact solutions:
+
 ```perl
-sub a_slices {
-  ## Less than 1 value return...
-  return unless $#_;
-  ## Set start of sequence to 0, d - the difference between entry 1 and entry 0
-  my($st,$d,@pairs)=(0,$_[1]-$_[0]);
-  ## Loop through all end points
-  for(my$en=1;$en<@_;$en++) {
-    ## If the gap is different - update gap (and start) and continute through loop
-    if($_[$en]-$_[$en-1] != $d) {
-      ($st,$d)=($en-1,$_[$en]-$_[$en-1])
-    ## If it is the same add it and all alternative entries
-    } else {
-      ## We only store the start/end of the runs not the whole sequence
-      push( @pairs, map { [$_,$en] } $st..$en-2 );
-    }
-  }
-  ## Now we find all the start ends and return the series of each of these subsequences.
-  return [ map { [ @_[ $_->[0] .. $_->[1] ] ] } @pairs ];
-}
+sub missing { my $t = @_*(@_+1)/2; $t-=$_ for @_; $t }
+sub missing_sum { @_*(@_+1)/2 - sum0 @_ }
 ```
 
-# Task 2: Seven Segment 200
+Where we take `sum0` from `List::Util`.
+
+### Performance
+
+We compared the two methods - in each case the `sum0` solution was faster - we will come back to this in task 2!
+
+What was interesting was relativee performance *vs* size of list. For short lists, the gain was a modest 25-30%, for medium size lists about 1,000 - 10,000 the gain was around 350%, but for larger lists again 100,000+ this dropped back down to 150-160%. This is probably the overhead of passing arrays around.
+
+# Task 2: Penny Piles
 
-***A seven segment display is an electronic component, usually used to display digits. The segments are labeled 'a' through 'g' as shown: The encoding of each digit can thus be represented compactly as a truth table:***
+***You are given an integer, `$n > 0`. Write a script to determine the number of ways of putting `$n` pennies in a row of piles of ascending heights from left to right.***
+
+## Solution
+
+This is a simple recursive search at any point we have `n` coins which we have to layout with a maximum height of `m` - we start where `m` is equal `n`.
+
+For performance sake we will cache our results as there are lots of cache hits!.
+
+So if `n` is 0 then we have found a solution - so we count 1, otherwise we make each possible sized pile and pass back to the function....
+
+This gives us:
+
+```perl
+sub piles {
+  my($count,$n,$m)=(0,@_);
+  return 1 unless $n;                                ## We have found *A* solution
+  $m//=$n;                                           ## First time we don't pass in $m -
+                                                     ## so set it to $n
+  return $cache{"$n,$m"} if exists $cache{"$n,$m"};  ## If we have seen this combo return
+  $count += piles($n-$_,$_) for 1 .. ($m>$n?$n:$m);  ## Otherwise loop through possible coin
+                                                     ## counts and add a stack of that size
+                                                     ## this is limited by (a) the number of
+                                                     ## coins and (b) the height of the
+                                                     ## previous stack.
+  $cache{"$n,$m"} ||= $count;                        ## cache result and return
+}
 ```
-my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>;
+
+Now we always like to simplify things - and in this case we return a cache value if
+exists AND then compute the value and cache it - and return the cache value.
+
+This is because we have to run a for loop to do the sum. If we can avoid that then we
+can simplify the code...
+
+Method (1) We replace the summation by a second function which encapsulates that 
+value.
+
+Method (2) We use `sum0` from `List::Util`
+```perl
+sub piles_2 {
+  my($count,$n,$m)=(0,@_);
+  return 1 unless $n;
+  $m//=$n;
+  $cache{"$n,$m"}//= sum_piles_2( $n, $m );
+}
+
+sub sum_piles_2 {
+  my $count = 0;
+  $count += piles_2($_[0]-$_,$_) for 1 .. ($_[1]>$_[0]?$_[0]:$_[1]);
+  $count;
+}
+
+sub piles_0 {
+  return 1 unless $_[0];
+  $_[1]//=$_[0];
+  $cache{"@_"}//= sum0 map { piles_0( $_[0]-$_,$_ ) } 1 .. ($_[0]>$_[1]?$_[1]:$_[0]);
+}
 ```
-***For example, `$truth[1] = ‘bc’`. The digit 1 would have segments ‘b’ and ‘c’ enabled.***
 
-## Solution
+Finally we try a further method without recursion but using a stack. Now this is much
+harder to write - and also impossible to write a sensible cacheing algorithm for. We
+will see that this is a bad idea in a moment:
 
 ```perl
-my @truth = qw(abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg);
-my @blank = map { '    ' } 0..6;
-
-## A mapper for segment to what to draw... The rows are represented by pairs of bits 0->blank, 1->LHS, 2->RHS, 3->bar
-my %parts = ( 'a' => 0x0003, 'b' => 0x0028, 'c' => 0x0a00, 'd' => 0x3000, 'e' => 0x0500, 'f' => 0x0014, 'g' => 0x00c0, );
-## The four "pictures"!
-my @parts = ( '    ', '|   ', '   |', ' -- ' );
-
-sub display {
-  ## Grab number & initialise output as empty.
-  my( $n, @out ) = ( shift, map {''} @blank );
-  while( $n ) {
-    ## Get the last digit & set the display for the digit to blank.
-    my( $d, @dig ) = ( $n%10, @blank );
-    ## Use our truth table along with part mapping to generate values for each number
-    for my $bar ( map { $parts{$_} } split //, $truth[$d] ) {
-      $dig[ $_ ] |= $parts[ $bar&3 ], $bar >>= 2 for 0 .. $#blank
-    }
-    ## Add to the display...
-    $out[ $_ ] = $dig[ $_ ].' '.$out[ $_ ] for 0..$#blank;
-    ## Update N...
-    $n = int( $n / 10 );
+sub piles_q {
+  my($count,$n,@q,$v)=(0,$_[0],[1,$_[0]]);
+  while($v = shift @q) {
+    $count++ if $v->[1]>=$v->[0];
+    push @q, map { [$_,$v->[1]-$_] } $v->[0]..$v->[1]-1;
   }
-  ## Render!
-  say for @out;
-}```
+  $count;
+}
+```
+
+### Performance
+
+We got some results we didn't expect! So for our test sets (`$n` ranging from 5 to 50) we got:
+
+| method     | runs per s  | Rel performance |
+| :--------- |  ---------: | --------------: |
+| piles_q    | 0.482/s     |         0.002 x |
+| piles_0    |   253/s     |         0.842 x |
+| piles      |   301/s     |         1.000 x |
+| piles_2    |   326/s     |         1.114 x |
+
+We note that the queue method is difficult to write and optimal solution for... But the other three methods we get subtly different performances.
+
+Although in task 1 using `sum0` was better than not this time it's worse. Why is this? not sure - but it may be that in task 1 we summing an actual array but in this
+case we are summing a list {the result of the `map`}. The two function method `piles_2` was slightly faster - I think because of merging the test for existance and allocation of the value to the cache using `//=`.
diff --git a/challenge-201/james-smith/blog.txt b/challenge-201/james-smith/blog.txt
new file mode 100644
index 0000000000..ac6080fb30
--- /dev/null
+++ b/challenge-201/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-201/james-smith
diff --git a/challenge-201/james-smith/perl/ch-1.pl b/challenge-201/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..3f215cc0ba
--- /dev/null
+++ b/challenge-201/james-smith/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use List::Util qw(sum0);
+
+my @TESTS = (
+  [ [0,1,3], 2 ],
+  [ [0,1],   2 ],
+  [ [0..99,101..199], 100 ],
+  [ [0..9999,10001..19999], 10000 ],
+  [ [0..999999,1000001..1999999], 1000000 ],
+  [ [0..9999999,10000001..19999999], 10000000 ],
+);
+is( missing( @{$_->[0]}), $_->[1] ) for @TESTS;
+is( missing_sum( @{$_->[0]}), $_->[1] ) for @TESTS;
+cmpthese( -10, {
+  'missing'     => sub { missing(    @{$_}) for @TESTS },
+  'missing_sub' => sub { missing_sub(@{$_}) for @TESTS },
+});
+
+sub missing { my $t = @_*(@_+1)/2; $t-=$_ for @_; $t }
+sub missing_sum { @_*(@_+1)/2 - sum0 @_ }
diff --git a/challenge-201/james-smith/perl/ch-2.pl b/challenge-201/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..64a80fcb84
--- /dev/null
+++ b/challenge-201/james-smith/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use List::Util qw(sum0);
+
+my @TESTS = ([5,7],[10,42],[15,176],[20,627],[25,1958],[30,5604],[35,14883],[40,37338],[45,89134],[50,204226]);
+my %cache;
+
+(%cache=()), is( piles(   $_->[0]), $_->[1] ) for @TESTS;
+(%cache=()), is( piles_0( $_->[0]), $_->[1] ) for @TESTS;
+(%cache=()), is( piles_2( $_->[0]), $_->[1] ) for @TESTS;
+(%cache=()), is( piles_q( $_->[0]), $_->[1] ) for @TESTS;
+done_testing();
+
+cmpthese( -2, {
+  'piles'   => sub { %cache=();   piles( $_->[0] ) for @TESTS },
+  'piles_0' => sub { %cache=(); piles_0( $_->[0] ) for @TESTS },
+  'piles_2' => sub { %cache=(); piles_2( $_->[0] ) for @TESTS },
+  'piles_q' => sub { %cache=(); piles_q( $_->[0] ) for @TESTS },
+});
+
+sub piles {
+  my($count,$n,$m)=(0,@_);
+  return 1 unless $n;
+  $m//=$n;
+  return $cache{"$n,$m"} if exists $cache{"$n,$m"};
+  $count += piles($n-$_,$_) for 1 .. ($m>$n?$n:$m);
+  $cache{"$n,$m"}||=$count;
+}
+
+sub piles_0 {
+  return 1 unless $_[0];
+  $_[1]//=$_[0];
+  $cache{"@_"}//= sum0 map { piles_0( $_[0]-$_,$_ ) } 1 .. ($_[0]>$_[1]?$_[1]:$_[0]);
+}
+
+sub piles_2 {
+  my($count,$n,$m)=(0,@_);
+  return 1 unless $n;
+  $m//=$n;
+  $cache{"$n,$m"}//= sum_piles_2( $n, $m );
+}
+
+sub sum_piles_2 {
+  my $count = 0;
+  $count += piles_2($_[0]-$_,$_) for 1 .. ($_[1]>$_[0]?$_[0]:$_[1]);
+  $count;
+}
+
+sub piles_q {
+  my($count,$n,@q,$v)=(0,$_[0],[1,$_[0]]);
+  while($v = shift @q) {
+    $count++ if $v->[1]>=$v->[0];
+    push @q, map { [$_,$v->[1]-$_] } $v->[0]..$v->[1]-1;
+  }
+  $count;
+}