Merge pull request #7554 from drbaggy/master

Finished the dir one - it's a been a busy week..

4 files changed, 90 insertions, 70 deletions

diff --git a/challenge-203/james-smith/README.md b/challenge-203/james-smith/README.md
index e6db9a634c..1726c3a39f 100644
--- a/challenge-203/james-smith/README.md
+++ b/challenge-203/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 201](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-201/james-smith) |
-[Next 203 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-203/james-smith)
+[< Previous 202](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-202/james-smith) |
+[Next 204 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-204/james-smith)
 
-# The Weekly Challenge 202
+# The Weekly Challenge 203
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,92 +13,55 @@ 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-202/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-203/james-smith
 
-# Task 1: Consecutive Odds
+# Task 1: Special Quadruplets
 
-***You are given an array of integers. Write a script to print `1` if there are **THREE** consecutive odss in the given array otherwise print `0`.***
+***You are given an array of integers. Write a script to find out the total special quadruplets for the given array. Special Quadruplets are such that satisfies the following 2 rules. `nums[a] + nums[b] + nums[c] == nums[d]` and `a < b < c < d`.***
 
 ## Solution
 
-We have to loop through a window of size 3 and check all three values are odd. We can do this with a single check. The 3 values will be ODD if and only if they all have the "0" bit set. So we can binary `&` them together and check the last bit by anding with `1`.
-
-So we loop through - check this is the case - and if not move to the next value.
+There isn't much to this one as it is just a case of brute forcing (4 nested loops) which gives us:
 
 ```perl
-sub odd3 {
-  return 0 unless @_>2;
-  my $p = shift, my $q = shift;
-  $p&$q&$_[0]&1 ? (return 1) : (($p,$q)=($q,shift)) while @_;
-  0;
-}
-```
-
-# Task 2:Widest Valley
-
-***Given a profile as a list of altitudes, return the leftmost widest valley. A valley is defined as a subarray of the profile consisting of two parts: the first part is non-increasing and the second part is non-decreasing. Either part can be empty.***
-
-## Solution
-
-So we need a decreasing sequence followed by an increasing sequence.
-
-Firstly we convert the valley heights into a string of difference (or more precisely whether that difference is `+1`, `-1` or `0`. We can use `<=>` to do that. We use `List::MoreUtils`'s `slide` method to do this.
-
-We look for a sequence which only contains `-1`s before `+1`s.
-
-We loop through all possible starts and see what the longest valley is.
-
-Finally we return that interval.
-
-```perl
-sub valley {
-  my( $L, $R, @d )=( 0, 0, slide { $b <=> $a } @_ );
-  for my $l ( 0 .. $#d-1) {
-    my($x,$t) = ( $d[$l] || -1, $l );
-    while($t++<$#d) {
-      $d[$t] && ( $d[$t]<$x ? last : ($x=$d[$t]) )
+sub special {
+  my $c = 0;
+  for my $i     (    0 .. $#_-3 ) {
+    for my $j   ( $i+1 .. $#_-2 ) {
+      my $t = $_[$i]+$_[$j];
+      for my $k ( $j+1 .. $#_-1 ) {
+        $t+$_[$k]==$_[$_] && $c++ for $k .. $#_;
+      }
     }
-    ($L,$R)=($l,$t) if $R-$L<$t-$l;
   }
-  @_[$L..$R];
+  $c;
 }
 ```
 
-## Scrub that!
-
-The previous solution is `O(n^2)`. But that is not optimal especially if we have a very large cross section. Can we write something which is `O(n)` or closer to `O(n)` - well yes we can - we can walk along the line to find the plateaux. A valley is defined to be the start of one plateau to the end of the next. Note the left and right hand points are defined to be plateaux for the purpose of the method.
+One slight optimization - we keep a copy of `nums[a]+nums[b]` to skip a sum at the end.
 
-So we keep some information:
+# Task 2: Copy Directory
 
- * current node is $_-1
- * `$pd` - the gradient to the left of the current node;
- * `$d`  - the gradient to the right of the current node;
- * `$s`  - the start of the left plateau;
- * `$s2` - the start of the right plateau;
- * `$S`  - start of largest valley;
- * `$E`  - end of largest valley;
+***You are given path to two folders, `$source` and `$target`. Write a script that recursively copy the directory from `$source` to `$target` except any files.***
 
-A plateau starts if `$pd > 0` && `$d <= 0`, and ends if `$d > 0` && `$pd >= 0`. At any point we need to track two plateaux - firstly the one on the left of the current valley, and the one on the right (this will become the one on the left of the next valley)...
+## Solution
 
-At the end of a plateau, we calculate the width of the valley as the distance from the current point to the start of the previous plateau. If it is greater than the previous best we update the start and end. We also set the start of the next "left hand side" plateau to the start of the right hand one.
+We look at a non-recursive solution here. We could get `copy_dir` to call iteself - but that means we have a function overhead AND have an overhead of checking conditions we know are true each time we call it.
 
-Finally there is one last plateau we haven't looked at - and that is the one at the right hand end - so we check to see if this last value is wider than any previous ones...
+Instead we use a "queue" to store the directories we wish to check and/or copy. Each time we come across a directory - we create it and then add it to the list of directories to scan..
 
 ```perl
-sub valley2 {
-  my( $pd, $s, $s2, $S, $E, $d ) = (0) x 5;
-  for( 0 .. $#_-1 ) {
-    $d  = $_[ $_+1 ] - $_[ $_ ];
-    $s2 = $_                                                        if $pd > 0 && $d  <= 0; ## Start of plateau
-    ( $_-$s > $E-$S ) && ( ( $S, $E ) = ( $s, $_ ) ) , ( $s = $s2 ) if $d  < 0 && $pd >= 0; ## End of plateau
-    $pd = $d;
+sub copy_dir {
+  my( $source, $target , @dir_paths )=(@_,'/');
+  return unless -d $source && -d $target;
+  while( my $path = shift @dir_paths ) {
+    opendir my $dh,       $source.$path;
+    $_ ne '.' && $_ ne '..'
+              && -d       $source.$path.$_
+              && mkdir(   $target.$path.$_.'/' )
+              && push @dir_paths, $path.$_.'/'
+      for readdir $dh;
+    closedir $dh;
   }
-  @_-$s2 > $E-$S+1 ? @_[ $s2 .. $#_ ] : @_[ $S .. $E ];
 }
 ```
-
-### Performance....
-
-For the set examples the performance is around `1.8x` to `1.9x` that of the `O(n^2)` method. This is what you would expect for the magnitude of the test strings.
-
-Adding in a very large entry shows how much better the 2nd algorithm is. We create a list of 330 points - the performance is approximately 40 times faster.
diff --git a/challenge-203/james-smith/blog.txt b/challenge-203/james-smith/blog.txt
new file mode 100644
index 0000000000..3ceb7cd8d5
--- /dev/null
+++ b/challenge-203/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/blob/master/challenge-203/james-smith/blog.txt
diff --git a/challenge-203/james-smith/perl/ch-1.pl b/challenge-203/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..78fbbbcd21
--- /dev/null
+++ b/challenge-203/james-smith/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+
+my @TESTS = (
+  [ [1,2,3,6],   1 ],
+  [ [1,1,1,3,5], 4 ],
+  [ [3,3,6,4,5], 0 ],
+);
+
+is( special( @{$_->[0]} ), $_->[1] ) for @TESTS;
+done_testing();
+
+## Nothing really to do here other than a bit of brute
+## force....
+
+sub special {
+  my $c = 0;
+  for my $i     (    0 .. $#_-3 ) {
+    for my $j   ( $i+1 .. $#_-2 ) {
+      my $t = $_[$i]+$_[$j];
+      for my $k ( $j+1 .. $#_-1 ) {
+        $t+$_[$k]==$_[$_] && $c++ for $k .. $#_;
+      }
+    }
+  }
+  $c;
+}
diff --git a/challenge-203/james-smith/perl/ch-2.pl b/challenge-203/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..56aae1b0ef
--- /dev/null
+++ b/challenge-203/james-smith/perl/ch-2.pl
@@ -0,0 +1,25 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+
+copy_dir( 't/a', 't/x/y' );
+
+## Rather than recursion we will use a directory path
+## queue - if we find a directory - we make the copy
+## and then queue it to see if it has any sub-directories
+
+sub copy_dir {
+  my( $from_dir, $to_dir , @path_queue ) = ( @_, '/' );
+  return unless -d $from_dir && -d $to_dir;
+  while( my $path = shift @path_queue ) {
+    opendir my $dh,      $from_dir.$path;
+    $_ ne '.' && $_ ne '..'
+              && -d      $from_dir.$path.$_
+              && mkdir(    $to_dir.$path.$_.'/' )
+              && push @path_queue, $path.$_.'/'
+      for readdir $dh;
+    closedir $dh;
+  }
+}