Merge pull request #7999 from drbaggy/master

Bit quicker this time

4 files changed, 106 insertions, 125 deletions

diff --git a/challenge-215/james-smith/README.md b/challenge-215/james-smith/README.md
index babc174789..b5ed43623f 100644
--- a/challenge-215/james-smith/README.md
+++ b/challenge-215/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 213](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-213/james-smith) |
-[Next 215 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-215/james-smith)
+[< Previous 214](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-214/james-smith) |
+[Next 216 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-216/james-smith)
 
-# The Weekly Challenge 214 - Another one rides the bus!
+# The Weekly Challenge 215
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,150 +13,64 @@ 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-214/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-215/james-smith
 
-# TASK #1: Rank Score
+# TASK #1: Odd one Out
 
-***You are given a list of scores (>=1). Write a script to rank each score in descending order. First three will get medals i.e. G (Gold), S (Silver) and B (Bronze). Rest will just get the ranking number.***
+***You are given a list of words (alphabetic characters only) of same size. Write a script to remove all words not sorted alphabetically and print the number of words in the list that are not alphabetically sorted.***
 
 ## Solution
 
-```perl
-sub rank {
-  map { ['','G','S','B']->[$_] || $_ }
-  map { //; 1 + grep { $_ > $' } @_ }
-  @_
-}
-```
+To solve this problem we loop though each string to make sure the letters in alphabetical order.
 
-Simple solution we get the rank for each value by counting the number of elements greater than it and then coverting 1,2,3 to GSB
+We note that if the words are less than 3 characters long then they will be default in alphabetical order so we return 0.
 
-## Complex solution
+Looping through the letters - we start by getting the signum of the difference between the first two letters (and store in `$f`). We then loop through the remaining letters comparing letter by letter.
+
+ * If the letters are the same we do nothing;
+ * If the first two letter are different then we update the update the value of `$f` with the difference between the letter
+ * If we find that `$f` has a different signum then wer add 1 to the count and jump to the end of the loop
 
 ```perl
-sub rank2 {
-  my $pos=0;
-  @_ = sort { $b->[0] <=> $a->[0] }
-       map  { [$_,$pos++,1]       }
-            @_;
-  $_[$_][2] = $_[$_][0] == $_[$_-1][0]
-            ? $_[$_-1][2]
-            : $_ + 1                   for 1..$#_;
-  map  {  ['','G','S','B']->[$_->[2]] || $_->[2] }
-  sort { $a->[1] <=> $b->[1]                     }
-       @_
+sub non_alpha {
+  my $c = 0;
+  return 0 if length $_[0] <3;
+  for(@_) {
+    my($f,$s,@rest)=split//;
+    $f = $f cmp $s;
+    ($s ne $_) && ($f ||= $s cmp $_) != ($s cmp $_) ? ($c++,last)
+                                                    : ($s=$_)
+      for @rest;
+  }
+  $c
 }
+
 ```
 
-We effectively use a modified schwartzian transform. But instead of computing one index and sorting by it we then use  2nd index and sort by it.
+# TASK #2: Number Placement
 
- * Add to each element and attribute which is additional position & a second which is going to be used for rank {we initialise as 1};
- * Sort based on value so highest is first;
- * Set the rank column - based on order;
-   * The first rank is 1 - subsequent ranks are the position in the list if different from the previous number OR the rank of the previous number.
- * Sort again but this time on original position
-   * to put numbers back where they were;
- * Finally extract the rank from the triple and map 1,2,3 to G,S,B
+***You are given a list of numbers having just 0 and 1. You are also given placement count (>=1). Write a script to find out if it is possible to replace 0 with 1 in the given list. The only condition is that you can only replace when there is no 1 on either side. Print 1 if it is possible otherwise 0.***
 
-# TASK #2: Collect Points
+*Question - there are two intepretations o the question - whether the placements are done simultaneously or one after the other*
 
-***You are given a list of numbers. You will perform a series of removal operations. For each operation, you remove from the list N (one or more) equal and consecutive numbers, and add to your score N × N. Determine the maximum possible score.***
+*In the former case any run of 3+ zeros can have `n-2` updates, but if it is the former it `(n-1)/2`
 
 ## Solution
 
-A brute force approach is the easiet here - we look for sequences of digits - remove from the list and add the "collect" call on the list with the sequence removed.. And we collect the best score. But this is not particularly fast especially as the list grows.
-
-```perl
-sub collect {   ## We will use recursion here. we take out each number in
-                ## turn and pass it back to the function
-  return 0 unless @_;                         ## The score for an empty list is 0
-  my $m = 0;                                  ## Create a variable for the max value
-  for ( my $e = my $o = 0; $o<@_; ) {         ## Loop from start to finish - 
-                                              ## there is no inc as the $o = $e at
-                                              ## the does the same think
-    my $e = $o;                               ## Reset the end of the list to the start
-    $e++ while $_[$o]==$_[$e];                ## Increment until we get to a different value
-    sub { $m=$_[0] if $m<$_[0] }->(           ## Use and IIFE to collect max value
-      ($e-$o)**2 +                            ## Add square of elements to value 
-      collect( @_[ 0..$o-1, $e..$#_ ]         ## for the reduced list
-    ), $o = $e; 
-  }
-  $m;
-}
-```
-
-## Cacheing
-
-By simply caching the result we can get a significant improvement in the examples we see around a 20-25x improvement, better improvements happen with larger examples, until at some point the cache will start eating into swap.. And things will tail off dramatically!
-
-```perl
-sub collect {   ## We will use recursion here. we take out each number in
-                ## turn and pass it back to the function
-  return 0 unless @_;                         ## The score for an empty list is 0
-  my $k = "@_";                               ##+++  Generate key for cache
-  return $cache->{$k} if exists $cache->{$k}; ##+++  Return cache value if exists
-  my $m = 0;                                  ## Create a variable for the max value
-  for ( my $e = my $o = 0; $o<@_; ) {         ## Loop from start to finish - 
-                                              ## there is no inc as the $o = $e at
-                                              ## the does the same think
-    my $e = $o;                               ## Reset the end of the list to the start
-    $e++ while $_[$o]==$_[$e];                ## Increment until we get to a different value
-    sub { $m=$_[0] if $m<$_[0] }->(           ## Use and IIFE to collect max value
-      ($e-$o)**2 +                            ## Add square of elements to value 
-      collect( @_[ 0..$o-1, $e..$#_ ]         ## for the reduced list
-    ), $o = $e; 
-  }
-  $cache->{$k} = $m                           ##+++  Cache value & return
-}
-```
-
-## Improving the algorithm
+Both solutions are the same except for the calculation at the heart to compute the count.
 
-Here we work out a minimum best score - removing all numbers except for the most frequent and that leaves us with the best score of `f * f + ( n - f)`.
-We also at each stage work out the possible maximum score - this is `score + sum(f*f)` over the remaining frequences. If this is lower than the
-current max score we do not progress any futher...
+We loop through the numbers if we see a 1 we check to see how many previous 0's we've had and compute the number of insertions. If it is 0 we increment the count of 0's in a row. Note to make sure we include any last sequence of 0's we add a 1 on to the end of the list we are search.
 
 ```perl
-sub _collect_fast {
-  my $s = shift;
-  return $s unless @_;  ## Empty list return score
-  
-  ## same digits.
-  for ( my $e = my $o = 0; $o<@_; ) { ## We loop through
-    my $e = $o;                ## the list for each                                    
-    $e++ while $_[$o]==$_[$e]; ## sequence of same no.
-
-    ## Compute the score so far $s + length of seq^2
-    ## Compute max poss. score this + sum of squared
-    ## counts of other number frequencies
-
-    my $ms = my $ts = $s + ($e-$o)**2;
-    my %f = ($_[$o] => $o-$e);
-    $f{$_}++ for @_;
-    $ms += $_ ** 2 for values %f;
-
-    ## If the max possible score is > $m we compute
-    ## actual score and update max if > $m
-
-    if($ms>$m) {
-      $ts = _collect_fast( $ts, @_[ 0..$o-1, $e..$#_ ] );
-      ## And if it is greater than $m we update $m
-      $m = $ts if $ts > $m;
-    }
-    $o = $e;
-  }
+sub insert_zero {
+   my($s,$c) = (0,shift);
+   $_ ? ( $c-= $s>2 &&  int(($s-1)/2), $s=0 ) : $s++ for @_,1;
+   $c>0?0:1;
 }
 
-sub collect_fast {
-  return 0 unless @_;
-  my %f;
-  $m=0;
-  $f{$_}++ for @_;                  ## compute freq
-  $_>$m && ( $m=$_ ) for values %f; ## find largest
-  $m = $m*$m + @_-$m;  ## Compute minimum-maximum
-                       ## square of max freq -
-                       ## count of remaining
-  _collect_fast(0,@_); ## Now do the real work
-  $m                   ## Return max (global variable)
+sub insert_zero_simultaneous {
+  my($s,$c) = (0,shift);
+  $_ ? ( $c-= $s>2 && $s-2, $s=0 ) : $s++ for @_,1;
+  $c>0?0:1
 }
 ```
diff --git a/challenge-215/james-smith/blog.txt b/challenge-215/james-smith/blog.txt
new file mode 100644
index 0000000000..3075c4480e
--- /dev/null
+++ b/challenge-215/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-215/james-smith/blog.txt
diff --git a/challenge-215/james-smith/perl/ch-1.pl b/challenge-215/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..cf18bf5ca0
--- /dev/null
+++ b/challenge-215/james-smith/perl/ch-1.pl
@@ -0,0 +1,36 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+
+my @TESTS = (
+ [ ['abc', 'xyz', 'tsu'], 1 ],
+ [ ['rat', 'cab', 'dad'], 3 ],
+ [ ['baa', 'ill', 'zzy', 'abc' ], 0 ],
+ [ ['x', 'y', 'z'],       0 ]
+);
+
+my @TESTS2 = (
+ [ [ 1, [1,0,0,0,1] ], 1 ],
+ [ [ 2, [1,0,0,0,1] ], 0 ],
+ [ [ 3, [1,0,0,0,0,0,0,0,1] ], 1 ],
+ [ [ 3, [1,0,0,0,0,0,0,0] ], 1],
+);
+
+sub non_alpha {
+  my $c = 0;
+  return 0 if length $_[0] <3;
+  for(@_) {
+    my($f,$s,@rest)=split//;say $_;
+    $f = $f cmp $s;
+      ($s ne $_) && ($f ||= $s cmp $_) != ($s cmp $_)
+    ? ($c++,last)
+    : ($s=$_)           for @rest;
+  }
+  $c
+}
+
+is( non_alpha( @{$_->[0]} ), $_->[1] ) for @TESTS;
+done_testing();
diff --git a/challenge-215/james-smith/perl/ch-2.pl b/challenge-215/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..f01950dbd8
--- /dev/null
+++ b/challenge-215/james-smith/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+
+my @TESTS = (
+ [ [ 1, [1,0,0,0,1] ], 1 ],
+ [ [ 2, [1,0,0,0,1] ], 0 ],
+ [ [ 3, [1,0,0,0,0,0,0,0,1] ], 1 ],
+ [ [ 3, [1,0,0,0,0,0,0,0] ], 1],
+);
+
+sub insert_zero {
+  my($s,$c) = (0,shift);
+  $_ ? ( $c-= $s>2 && int( ($s-1)/2 ), $s=0 ) : $s++ for @_,1;
+  $c>0?0:1;
+}
+
+sub insert_zero_simultaneous {
+  my($s,$c) = (0,shift);
+  $_ ? ( $c-= $s>2 && $s-2, $s=0 ) : $s++ for @_,1;
+  $c>0?0:1
+}
+
+is( insert_zero( $_->[0][0], @{$_->[0][1]} ), $_->[1] ) for @TESTS;
+is( insert_zero_simultaneous( $_->[0][0], @{$_->[0][1]} ), $_->[1] ) for @TESTS;
+
+done_testing();