Merge pull request #7448 from drbaggy/master

Sorry hadn't got round to submit.. hopefully write up later...

5 files changed, 134 insertions, 145 deletions

diff --git a/challenge-199/james-smith/README.md b/challenge-199/james-smith/README.md
index 77c550d2b6..b4670b096a 100644
--- a/challenge-199/james-smith/README.md
+++ b/challenge-199/james-smith/README.md
@@ -1,7 +1,7 @@
 [< Previous 198](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith) |
 [Next 200 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith)
 
-# The Weekly Challenge 198
+# The Weekly Challenge 199
 
 You can find more information about this weeks, and previous weeks challenges at:
 
diff --git a/challenge-200/james-smith/README.md b/challenge-200/james-smith/README.md
index 77c550d2b6..c73cbf1efe 100644
--- a/challenge-200/james-smith/README.md
+++ b/challenge-200/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 198](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith) |
-[Next 200 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith)
+[< 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)
 
-# The Weekly Challenge 198
+# The Weekly Challenge 200
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,162 +13,71 @@ 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-199/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith
 
-# Task 1 - Good Pairs
+# Task 1: Arithmetic Slices
 
-***You are given a list of integers, `@list`. Write a script to find the total count of Good Pairs. A pair `(i, j)` is called good if `list[i] == list[j]` and `i < j`.***
+***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.***
 
 ## Solution
 
-This problem can be reduced to a simpler problem - We note for any number - the contribution will be equal to the number of distinct pairs of the number - so if it has a frequence of `n` - then the number of good pairs containing that number are `n(n-1)`. We add these up and then divide by `2` as each pair is counted twice..
-
-We use a hash as a simple way to count each number! We then throw away the keys and add the computed values up and then return the value!
+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.
 ```perl
-sub good_pairs {
-  my($c,%f);
-  $f{$_}++ for @_;
-  $c+=$_*($_-1) for values %f;
-  $c/2;
-}
-```
-
-Note we could have used an external `freq` and `sum` method. To simplify this to:
-
-```
-sub good_pairs_fn {
-  ( sum map{$_*($_-1)} values %{freq(@_)} ) /2;
-}
-```
-# Task 2 - Good Triplets
-
-***You are given an array of integers, `@array` and three integers `$x`,`$y`,`$z`. Write a script to find out total Good Triplets in the given array. 
-A triplet `array[i]`, `array[j]`, `array[k]` is good if it satisfies the following conditions:***
-
-  * `0 <= i < j < k <= n`
-  * `abs(array[i] - array[j]) <= x`
-  * `abs(array[j] - array[k]) <= y`
-  * `abs(array[i] - array[k]) <= z`
-
-## Solution
-
-If you look in the source code you will find a few different methods - but I will outline a few places where gains are made and then include the fastest solution.
-
-One naive approach could be:
-
-```perl
-sub good_triples_naive {
-  my($c,$x,$y,$z) = (0,splice @_, 0, 3 );
-  for my $i ( 0..$#_-2 ) {
-    for my $j ( $i+1..$#_-1 ) {
-      for ( $j+1..$#_ ) {
-        $c++ if abs($_[$i]-$_[$j])<= $x
-             && abs($_[$j]-$_[$_])<= $y
-             && abs($_[$i]-$_[$_])<= $z;
-      }
+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 );
     }
   }
-  $c;
+  ## Now we find all the start ends and return the series of each of these subsequences.
+  return [ map { [ @_[ $_->[0] .. $_->[1] ] ] } @pairs ];
 }
 ```
 
-The things we note:
- 1. We perform the check `abs($_[$i]-$_[$j])<= $x` everytime in the inner loop
- 2. We use a lot of array references `$_[$i]``, `$_[$j]`...
- 3. We use a built in function `abs`
-
-All these slow us down.
-
-So **1** is easy to solve we move that condition into an if to avoid the inner loop. For tidyness we invert the condition and use `next`...
-
-**2** we can copy `$_[$i]`, `$_[$j]`, `$_[$_]` into variables - there is an overhead in this - replacing `$_[$i]` & `$_[$j]` improves performance but the inner one slows things down (overhead of "copy" vs overhead of reference)
-
-**3** we can convert the `abs` condition into a range. `abs($_1-$_2) <= $x`
-
-can be written as `-$x <= $_1-$_2 && $_1-$_2 <= $x`
+# Task 2: Seven Segment 200
 
-can be written as `$_1-$x<=$_ && $_2<=$_1+$x`
-
-This just doesn't remove the call to `abs` but aslo a subtraction - as we can precompute `$_1-$x` & `$_1+$x`.
-
-This gives us
-
-```perl
-sub good_triples_range_2 {
-  my($c,$x,$y,$z,$_1,$_2,$lx,$ux,$lz,$uz,$ly,$uy)=(0,splice@_,0,3);
-  for my $i ( 0..$#_-2 ) {
-    ($lx,$ux,$lz,$uz) = (($_1 = $_[$i])-$x, $_1+$x,$_1-$z,$_1+$z);
-    for my $j ( $i+1..$#_-1 ) {
-      $_2 = $_[$j];
-      next if $_2 < $lx || $_2 > $ux;
-      ($ly,$uy) = ($lz>$_2-$y?$lz:$_2-$y,$uz<$_2+$y?$uz:$_2+$y);
-      for ( $j+1..$#_ ) {
-        $c++ if $ly <= $_[$_] && $_[$_] <= $uy;
-      }
-    }
-  }
-  $c;
-}
+***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:***
 ```
+my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>;
+```
+***For example, `$truth[1] = ‘bc’`. The digit 1 would have segments ‘b’ and ‘c’ enabled.***
 
-Note in the inner loop we merge the ranges so reducing the comparisons even further.
-
-### Bonus - how can we get this faster
-
-How can we get this faster - This O(3) whatever happens can we reduce the time in anyway...
-
-Other than what we've done - the only way to improved performance is to reduce the number of times we loop. Well the inner loop we can't change - the outer loop we can't change - but what about the inner loop... Heuristically the efficiency of the filter is proportional to `$x`. So if we chose the smallest `$x` we get the best result..
-
-We can't change order but we can choose the *order* of the loops. This gives us the code from hell...
+## Solution
 
 ```perl
-sub good_triples_fastest {
-  my($c,$xy,$yz,$xz,$l,$u,$lx,$ux,$ly,$uy,$lz,$uz,$i,$j,$k,$x,$y,$z)=(0,splice@_,0,3);
-
-  if($xy<=$xz&&$xy<=$yz){
-    for $i ( 0 .. $#_-2 ) {
-      ( $ly, $uy, $lz, $uz ) = ( ($x=$_[$i])-$xy, $x+$xy, $x-$xz, $x+$xz );
-      for $j ( $i+1 .. $#_-1 ) {
-        next if ($y=$_[$j]) < $ly || $uy<$y;
-        ( $l, $u ) = ( $lz > $y-$yz ? $lz : $y-$yz, $uz < $y+$yz ? $uz : $y+$yz );
-        $l <= $_[$_] && $_[$_] <= $u && $c++ for $j+1 .. $#_
-      }
-    }
-  } elsif ( $yz<=$xz ) {
-    for $j ( 1 .. $#_-1 ) {
-      ( $lz, $uz, $lx, $ux ) = ( ($y=$_[$j])-$yz, $y+$yz, $y-$xy, $y+$xy );
-      for $k ( $j+1 .. $#_ ) {
-        next if ($z=$_[$k]) < $lz || $uz < $z;
-        ( $l, $u ) = ( $lx > $z-$xz ? $lx : $z-$xz, $ux < $z+$xz ? $ux : $z+$xz );
-        $l <= $_[$_] && $_[$_] <= $u && $c++ for 0 .. $j-1
-      }
-    }
-  } else {
-    for $i ( 0..$#_-2 ) {
-      ( $ly, $uy, $lz, $uz ) = ( ($x=$_[$i])-$xy, $x+$xy, $x-$xz, $x+$xz );
-      for $k ( $i+2..$#_ )  {
-        next if ($z=$_[$k]) <$lz || $uz < $z;
-        ( $l, $u ) = ( $ly > $z-$yz ? $ly : $z-$yz, $uy < $z+$yz ? $uy : $z+$yz );
-        $l <= $_[$_] && $_[$_] <= $u && $c++ for $i+1 .. $k-1;
-      }
+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 );
   }
-  $c;
-}
-```
-
-Looks nasty - but it is just three copies of the code above - the first called if `$x` is smallest, the second if `$y` is smallest and lastly when `$z` is the smallest.
-
-### Performance
-
-When the list is short it doesn't really matter about performance - but with the tests above with the longer list we have:
-
-|          |   Rate | naive |  opt | copy_1 | range_1 | copy_2 | range_2 | fastest |
-| -------- | -----: | ----: | ---: | -----: | ------: | -----: | ------: | ------: |
-| naive    | 14.6/s |    -- | -43% |   -50% |    -52% |   -57% |    -64% |    -85% |
-| opt      | 25.6/s |   75% |   -- |   -12% |    -15% |   -24% |    -36% |    -73% |
-| copy_1   | 29.1/s |   99% |  13% |     -- |     -4% |   -14% |    -28% |    -70% |
-| range_1  | 30.2/s |  106% |  18% |     4% |      -- |   -10% |    -25% |    -69% |
-| copy_2   | 33.6/s |  130% |  31% |    16% |     11% |     -- |    -17% |    -65% |
-| range_2  | 40.3/s |  176% |  57% |    39% |     33% |    20% |      -- |    -58% |
-| fastest  | 96.3/s |  558% | 275% |   231% |    219% |   186% |    139% |      -- |
+  ## Render!
+  say for @out;
+}```
diff --git a/challenge-200/james-smith/blog.txt b/challenge-200/james-smith/blog.txt
new file mode 100644
index 0000000000..55f0073b75
--- /dev/null
+++ b/challenge-200/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith
diff --git a/challenge-200/james-smith/perl/ch-1.pl b/challenge-200/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..5025939f0a
--- /dev/null
+++ b/challenge-200/james-smith/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+
+my @TESTS = (
+  [ [1..4],    '(1,2,3), (1,2,3,4), (2,3,4)' ],
+  [ [1,3,4,5], '(3,4,5)' ],
+  [ [1,2,3,5,6,7,9,0,-4,-8], '(0,-4,-8), (1,2,3), (5,6,7)' ],
+  [ [1,1,1,1,2,3,4,6,8,10,15,20,25,50,100,125,150,175,200], '(1,1,1), (1,1,1), (1,1,1,1), (1,2,3), (1,2,3,4), (10,15,20), (10,15,20,25), (100,125,150), (100,125,150,175), (100,125,150,175,200), (125,150,175), (125,150,175,200), (15,20,25), (150,175,200), (2,3,4), (4,6,8), (4,6,8,10), (6,8,10)' ],
+  [ [2],    "" ],
+  [ [1,2,4,8,16,32],    "" ],
+);
+is( a_slices( @{$_->[0]}), $_->[1] ) foreach @TESTS;
+done_testing();
+
+## Display an array of arrays compactly...
+sub d_slices { return join ', ', map { '('.join(',', @{$_}).')' } @{$_[0]}; }
+
+
+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 ];
+}
+
diff --git a/challenge-200/james-smith/perl/ch-2.pl b/challenge-200/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..4edf36dff1
--- /dev/null
+++ b/challenge-200/james-smith/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+
+## Our provided truth table...
+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 );
+  }
+  ## Render!
+  say for @out;
+}
+
+display(200);
+display(314159265358979);