Merge pull request #7346 from drbaggy/master

First pass - no write up yet!!

4 files changed, 139 insertions, 57 deletions

diff --git a/challenge-198/james-smith/README.md b/challenge-198/james-smith/README.md
index f6212bf7cd..9ba480f98e 100644
--- a/challenge-198/james-smith/README.md
+++ b/challenge-198/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 196](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-196/james-smith) |
-[Next 198 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith)
+[< Previous 197](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-197/james-smith) |
+[Next 199 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-199/james-smith)
 
-# The Weekly Challenge 197
+# The Weekly Challenge 198
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,77 +13,61 @@ 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-196/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith
 
-# Task 1 - Move Zero
+# Task 1 - Max Gap
 
-***You are given a list of integers, `@list`. Write a script to move all zero, if exists, to the end while maintaining the relative order of non-zero elements.***
+***You are given a list of integers, `@list`. Write a script to find the total pairs in the sorted list where 2 consecutive elements has the max gap. If the list contains less then 2 elements then return 0.***
 
 ## Solution
-I looked at a number of solutions for this - but it turns out that perl grep seems to be the best...
-
 ```perl
-sub move_zero{
-  grep({$_}@_),grep{!$_}@_
+sub max_gap_sort {
+  return 0 unless $#_;
+  @_ = sort { $a <=> $b } @_;
+  my $p = shift;
+  @_ = sort { $b <=> $a } map { ($_-$p,$p=$_)[0] } @_;
+  $_[0]==$_[$_] || return $_ for 1..$#_;
+  1*@_
 }
 ```
-Using `$_` and `!$_` to pull the lists apart. Anything more complex in the grep slows it down more than you lose by doing the second `grep`.
-
-# Task 2 - Wiggle sort
-
-***You are given a list of integers, `@list`. Write a script to perform Wiggle Sort on the given list. Wiggle sort would be such as:***
-
-```
-list[0] < list[1] > list[2] < list[3]…
-```
-
-## Solution
-
-OK if we relax the condition with `<=`/`=>` rather than `<`/`>` we can always come up with a solution. The simplest way to do this is to split the list in two (using `splice` and then stitching them back together. (If it has an odd length we keep the first list as the longest!)
 
 ```perl
-sub ws_lax {
-  return @_ if @_<2; ## Always works if 0/1 element.
-  my@q=splice @_,0,$#_/2+1;
-  map{$_,@_?shift:()}@q
+sub max_gap_nosort {
+  return 0 unless $#_;
+  @_ = sort { $a <=> $b } @_;
+  my($p,$b,$c)=(shift,0,0);
+  $_-$p>$b ? ($b,$c)=($_-$p,1) : $_-$p==$b && $c++, $p=$_ for @_;
+  $c;
 }
 ```
 
-If we wish to perform the strict version we have to test conditions for which there are no solution...
+# Task 2 - Prime Count
 
- * If we have more than half (if even length) or *half + 1* (if odd) of the lowest digit we have no solution.
- * o/w if we have exactly half (if even length) or *half + 1* (if odd) of the lowest digit we have a solution.
- * o/w if we have more than half (if even length) or *half - 1* (if odd) of the highest digit we have no solution
- * o/w if we have exactly than half (if even length) or *half - 1* (if odd) of the highest digit we have no solution
- * o/w if we have half or more (if even length) or *half - 1* or more (if odd) of any other digit we have no solution
- * o/w we have a solution
+***You are given an integer `$n > 0`. Write a script to print the count of primes less than `$n`.***
 
-This leads us to:
+## Solution
 
 ```perl
-sub _ws {
-## Does wiggle sort by splicing and interleaving sorted list...
-  my@q=splice @_,0,$#_/2+1;map{$_,@_?shift:()}@q
-}
-
-sub ws_strict {
-## Return "wiggle sorted list" or error message indicating if
-## the problem number is the first number, last number or one
-## of the other numbers...
-
-  return @_ if @_<2;
-  @_=sort{$a<=>$b} @_;
-  return $_[0]  == $_[$#_/2+1] ?                 'Bottom' # We can't have more than ceil(n/2) of the first number
-       : $_[0]  == $_[$#_/2  ] ?                 _ws(@_)  # But we can have ceil(n/2) of the first number
-       : $_[-1] == $_[$#_/2  ] ?                 'Top'    # We can't have more than floor(n/2) of the last number
-       : $_[-1] == $_[$#_/2+1] ?                 _ws(@_)  # But we can have floor(n/2) of it
-       : (grep{$_[$_]==$_[$_+$#_/2]}0..@_/2-1) ? 'Middle' # We can't have equal or more than floor(n/2) of any other number
-       :                                         _ws(@_)
-       ;
+sub n_primes_compact {
+  return 0if(my$n=shift)<3;
+  @_=2;
+  //,(grep{($'%$_)||next}@_),push@_,$_ for 3..$n-1;
+  1*@_
 }
+```
 
-sub ws_lax {
-## Return "wiggle sorted list" - note we are using the lax <= => check here
-  @_<2?@_:_ws(sort{$a<=>$b}@_)
+```perl
+sub n_primes_fast { # for all tests 0.066 seconds
+  return 0 if (my $n=shift) <3;
+  my @p = (my $q=2);
+  O: for( my $i=3; $i<$n; $i+=2 ) {
+    $q++ if $i>$q*$q;
+    for(@p) {
+      next O unless $i%$_;
+      last if $_>$q;
+    }
+    push @p, $i;
+  }
+  scalar @p
 }
 ```
diff --git a/challenge-198/james-smith/blog.txt b/challenge-198/james-smith/blog.txt
new file mode 100644
index 0000000000..d95c1d210d
--- /dev/null
+++ b/challenge-198/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith
diff --git a/challenge-198/james-smith/perl/ch-1.pl b/challenge-198/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..371a2c4d13
--- /dev/null
+++ b/challenge-198/james-smith/perl/ch-1.pl
@@ -0,0 +1,47 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+
+my @TESTS = (
+  [ [2,5,8,1                         ], 2 ],
+  [ [3                               ], 0 ],
+  [ [1..9,21..25, map { 2*$_ } 5..10 ], 5 ],
+  [ [(1) x 10                        ], 9 ],
+  [ [ 1..10                          ], 9 ],
+  [ [ 2.9 , 3..10                    ], 7],
+  [ [ 1..8,8.1                       ], 7],
+  [ [ 1, 3..10                       ], 1 ],
+  [ [ 1..8, 10                       ], 1 ],
+  [ [ 1..999, 1001                   ], 1 ],
+  [ [ 1..999, 999.1                  ], 998 ],
+);
+
+is( max_gap_sort(    @{$_->[0]} ), $_->[1] ) for @TESTS;
+is( max_gap_nosort(  @{$_->[0]} ), $_->[1] ) for @TESTS;
+done_testing();
+
+cmpthese( -10, {
+  'sort'   => sub { max_gap_sort(   @{$_->[0]} ) for @TESTS }, # 1700/s
+  'nosort' => sub { max_gap_nosort( @{$_->[0]}) for @TESTS },  # 3535/s
+} );
+
+sub max_gap_sort {
+  return 0 unless $#_;
+  @_ = sort { $a <=> $b } @_;
+  my $p = shift;
+  @_ = sort { $b <=> $a } map { ($_-$p,$p=$_)[0] } @_;
+  $_[0]==$_[$_] || return $_ for 1..$#_;
+  1*@_
+}
+
+sub max_gap_nosort {
+  return 0 unless $#_;
+  @_ = sort { $a <=> $b } @_;
+  my($p,$b,$c)=(shift,0,0);
+  $_-$p>$b ? ($b,$c)=($_-$p,1) : $_-$p==$b && $c++, $p=$_ for @_;
+  $c;
+}
diff --git a/challenge-198/james-smith/perl/ch-2.pl b/challenge-198/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..fd7ac85569
--- /dev/null
+++ b/challenge-198/james-smith/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+
+my @TESTS = (
+  [       1,     0 ],
+  [       3,     1 ],
+  [       5,     2 ],
+  [      10,     4 ],
+  [      15,     6 ],
+  [      25,     9 ],
+  [   1_000,   168 ],
+  [ 100_000, 9_592 ],
+);
+
+
+is( n_primes_compact( $_->[0] ), $_->[1] ) for @TESTS;
+is( n_primes_fast(    $_->[0] ), $_->[1] ) for @TESTS;
+done_testing();
+
+cmpthese( -10, {
+  'compact' => sub { n_primes_compact( $_->[0] ) for @TESTS },
+  'fast'    => sub { n_primes_fast(    $_->[0] ) for @TESTS },
+} );
+
+sub n_primes_compact { # for all tests 9.28 seconds
+  return 0if(my$n=shift)<3;
+  @_=2;
+  //,(grep{($'%$_)||next}@_),push@_,$_ for 3..$n-1;
+  1*@_
+}
+
+sub n_primes_fast { # for all tests 0.066 seconds
+  return 0 if (my $n=shift) <3;
+  my @p = (my $q=2);
+  O: for( my $i=3; $i<$n; $i+=2 ) {
+    $q++ if $i>$q*$q;
+    for(@p) {
+      next O unless $i%$_;
+      last if $_>$q;
+    }
+    push @p, $i;
+  }
+  scalar @p
+}
+