Merge pull request #7126 from drbaggy/master

Flip!

5 files changed, 146 insertions, 244 deletions

diff --git a/challenge-191/james-smith/README.md b/challenge-191/james-smith/README.md
index 6aa5575439..8bb07b095b 100644
--- a/challenge-191/james-smith/README.md
+++ b/challenge-191/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 189](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/james-smith) |
-[Next 191 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-191/james-smith)
+[< Previous 190](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-190/james-smith) |
+[Next 192 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-192/james-smith)
 
-# The Weekly Challenge 190
+# The Weekly Challenge 191
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -114,49 +114,35 @@ These observations lead us to the following code...
 my %cache;
 
 sub cute {
-    ## (0) Clear cache...
-  %cache=();
-    ## (1) If n is 1 short cut and return 1
-  $_[0]==1 ? 1 : _cute_count( 0,
-      ## (2) Just keep the lists
-    map  { $_->[1] }
-      ## (3) Sort so the shortest lists are first - then sort by integer
-    sort { @{$a->[1]} <=> @{$b->[1]} ||
-             $a->[0]  <=>   $b->[0]
-         }
-      ## (4) Find all values between 1 & n which are either a factor or
-      ##     multiple. Store each as pair, of the number + all values.
-    map  {[ ($a=$_), [
-           grep { !( $_%$a && $a%$_ ) } 1 .. $_[0]
-         ] ]}
-      ## (5) Looping over 1 to n
-         1 .. $_[0]
+  %cache=();                             ##  (0) Clear cache...
+  $_[0]==1 ? 1 : _cute( 0,               ##  (1) If n is 1 short cut and return 1
+    map  { $_->[1] }                     ##  (2) Just keep the lists
+    sort { @{$a->[1]} <=> @{$b->[1]} ||  ##  (3) Sort so the shortest lists are
+             $a->[0]  <=>   $b->[0]      ##      first - then sort by integer
+         }                               ##  (4) Find all values between 1 & n
+    map  {[ ($a=$_), [                   ##      which are either a factor
+           grep { !( $_%$a && $a%$_ ) }  ##      or multiple, store each as pair
+                1 .. $_[0]               ##      of number and list of values
+         ] ]}                            ##
+         1 .. $_[0]                      ##  (5) Looping over 1 to n
   )
 }
-
-sub _cute_count {
-  ## (6) We shift of the index number of seen numbers
-  ##     and also the next group of possible numbers...
-  my( $seen, $next ) = ( shift, shift );
-    ## (7) If we have already computed the value return...
-    ## (8) otherwise we loop over the values possible in the
-    ##     "nth" position (this is loose as they aren't ordered directly)
-    ##     by " but by the count {we are only counting so don't need to
-    ##     produce numbers}
-  $cache{$seen} //= sum0 map {
-    ## (9) We sum up the value for each value in this list which hasn't
-    ##     been seen (and return it!)
-      ($seen & 1<<$_) ? 0
-    ## (10) If there is only 1 number left in the list we count 1
-    ##     (as all numbers can be in the last position)
-    : @_ < 2          ? 1
-    ## (11) o/w we call this method again after knocking out the number
-    :                   _cute_count( $seen | 1<<$_ , @_ )
-  } @{$next}
-}
-    ## Note we don't use a string as a key - but use a bit mast -
-    ## #9 & #11 using "|" to set a bit & "&" to check it has
-    ## been set.
+sub _cute {
+  my( $seen, $next ) = ( shift, shift ); ##  (6) We shift of the index number of seen numbers
+                                         ##      and also the next group of possible numbers...
+  $cache{$seen} //= sum0 map {           ##  (7) If we have already computed the value return...
+                                         ##  (8) otherwise we loop over the values possible in the
+                                         ##      "nth" position (this is loose as they aren't
+                                         ##      ordered directly) by " but by the count {we are
+                                         ##      only counting so don't need to produce numbers}
+                                         ##  (9) We sum up the value for each value in this list
+      ($seen & 1<<$_) ? 0                ##      which hasn't been seen (and return it!)
+    : @_ < 2          ? 1                ## (10) If there is only 1 number left in the list we
+                                         ##      count 1 (as all numbers can be in the last position)
+    :   _cute( $seen | 1<<$_ , @_ )      ## (11) o/w we call this method again after tagging number seen
+  } @{$next}                             ## Note we don't use a string as a key - but use a bit mast -
+}                                        ##      #9 & #11 using "|" to set a bit & "&" to check
+                                         ##      it has been set.
 ```
 
 or without comments:
diff --git a/challenge-192/james-smith/README.md b/challenge-192/james-smith/README.md
index 6aa5575439..7c47f95f78 100644
--- a/challenge-192/james-smith/README.md
+++ b/challenge-192/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 189](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/james-smith) |
-[Next 191 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-191/james-smith)
+[< Previous 191](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-191/james-smith) |
+[Next 193 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-193/james-smith)
 
-# The Weekly Challenge 190
+# The Weekly Challenge 192
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -15,233 +15,87 @@ You can find the solutions here on github at:
 
 https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-190/james-smith
 
-# Task 1 - Twice Largest
+# Task 1 - Binary Flip
 
-***You are given list of integers, `@list`. Write a script to find out whether the largest item in the list is at least twice as large as each of the other items.***
+***You are given a positive integer, `$n`. Write a script to find the binary flip.***
 
 ## Solution
 
-We can simplify the condition to that the largest number is at least twice the value of the second largest number.
+### Use maths...
 
-Our naive approach could be to sort the numbers and check `$list[-1] >= 2*$list[-2]`.
+This isn't as simple as using `~` as this will flip ALL the bits including those before the first 1.
 
-```perl
-sub is_double_sort {
-  sub {$_[0]>=2*$_[1]||-1}->(sort {$b<=>$a} @_)
-}
-```
+We need to therefore work through bit by bit reducing the number until we have reach zero.
 
-But this isn't efficient if the list is large (but how large is large we will find out later) - instead we will just track the two largest numbers.
+We use the right shift operator to reduce `$n` each time. We have to push the values back onto the
+answer. We can do this with addition - actually as we using bit-operators elsewhere we use the `|` operator
 
- * We grab the first two numbers, and store the largest one in $f and the other one in $s.
- * For each other number ($_):
-   * $_ <= $s - ignore do nothing
-   * $s < $_ && $_ <= $f - replace 2nd number $s with $_
-   * $f < $_ - replace 2nd number $s with $f, and replace $f with $_
- * Return is based on whether `$f >= 2*$s`
+If the last digit is `1` we do nothing, if the last digit is `0` where add `2^$k` where $k is the
+position we are currently checking. Note as we are right-shifting we have to increase `$k` each time.
 
 ```perl
-sub is_double {
-  my( $f, $s ) = ( shift, shift );           # First two numbers
-  ( $f, $s ) = ( $s, $f ) if $f < $s;        # Switch if 1st < 2nd
-  $_>$f ? ( ( $f, $s ) = ( $_, $f ) )        # For each number
-        : ( $_ > $s && ( $s = $_ ) ) for @_; #   if > 1st
-                                             #     demote 1st to 2nd
-                                             #     replace 1st
-                                             #   if > 2nd
-                                             #     demote 2nd
-  $f >= 2*$s ? 1 : -1                        # Check condition
+sub binary_flip {
+   my($r,$k,$n) = (0,0,shift);
+   $r|=(~$n&1)<<$k++,$n>>=1 while $n;
+   $r;
 }
 ```
 
-### How large is large
-
-Some experiments with a longer and longer list seem to indicate that the breakeven point is about 200 - so sorting lists of less than 200 numbers is more efficient than the perl above, but over 200 the max strategy is best...
-
-# Task 2 - Cute List
-
-***You are given an integer, `0 < $n <= 15`. Write a script to find the number of orderings of numbers that form a cute list.***
-
-***With an input `@list = (1, 2, 3, .. $n)` for positive integer `$n`, an ordering of `@list` is cute if for every entry, indexed with a base of 1, either:***
-
- * ***`$list[$i]` is evenly divisible by `$i`***
- * ***`$i` is evenly divisible by `$list[$i]`***
-
-## Solution
-
-Again this weeks task 2 is a much more interesting challenge. And has a number of different approaches we can find.
-
- * Do we use recursion - or - interation?
- * Do we memoize or not? if so what key do we use?
- * Are there any simple optimizations - how to make the loop fail earlier?
+### Use strings...
 
-Firstly - we could use permutations - but this screams out initially at least for recursion.
+This can also be done by converting to a string and then coverting back again.
 
-Before we start some observations:
+```
+sub string_flip {
+  oct '0b'.sprintf('%b',$_[0])=~tr/01/10/r;
+```
 
- * We can pre-compute which numbers can be at which position to give us an array like:
+We use `tr` with the `r` option to return the result of the translation...
 
-   * `[1,2,3,4,5,6,7]`, `[1,2,4,6]`, `[1,3,6]`, `[1,2,4]`, `[1,5]`, `[1,2,3,6]`, `[1,7]`
+### Performance...
 
- * When we search we can re-order the lists to fill in numbers from the short lists first
+Well this is where Perl is uber fast when it comes to strings - the string solution is faster than the bit manipulation. This is probably due to the overhead of each separate operation in the numeric version. For a test example of "12345678" (`1011 1100 0110 0001 0100 1110`) the string method is 8x faster than the binary method.
 
-   * `[1,5]`, `[1,7]`, `[1,3,6]`, `[1,2,4]`, `[1,2,4,6]`, `[1,2,3,6]`, `[1,2,3,4,5,6,7]`
+### Let's try again...
 
- * As a bonus - this reduces the search space further as the last list will ALWAYS contain
-   a valid digit. So we always know that will return a single value. This allows us the
-   shortenings (#1 & #10)
+Annoyed with the fact the elegant {bit operator based} solution is slower than the "hacky" string one - let's revisit the code using inline C - effectively it is EXACTLY the same algortihm as our first perl method.
 
- * Our keys are all integers and less than 64. We can therefore use a bit mask as the keys
-   for the cache... {#9 & #11)
+```C
+int c_flip(int n) {
+  int r=0;
+  int k=0;
+  while(n) {
+    r|=(1^n&1)<<k++;
+    n>>=1;
+  }
+  return r;
+}
+```
 
-   Already placed `2`, `4`, `7` they key would be `10010100`
+Now - when comparing this to the other two: The C version is 4.5 times faster than the string version OR 35x faster than the equivalent Perl version.
 
- * Using a cache can greatly reduce the number of calls (at the expense of memory) see
-   #0 & #7. Note we use the `//=` operator here rather than the '||=' as a 0 value
-   being cached is as important as a non-zero value and `//=` is a defined check
-   rather than a check for true {which `0` would faile}
 
- * #2, #3 & #4 use a similar {but sort of inverted logic} to a schwartzian transform,
-   which we carry over a variable which is important for the sort as a value in an
-   array ref only to throw it away with an extra `map`.
+# Task 2 - Equal Distribution
 
- * #8 - we steal `sum0` from `List::Util` but we could equally write our own - to
-   avoid the library `sub sum0 { my $t=0; $t+=$_ for @_; $t }`
+***You are given a list of integers greater than or equal to zero, `@list`. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print `-1`***
 
-These observations lead us to the following code...
+## Solution
 
 ```perl
-my %cache;
-
-sub cute {
-    ## (0) Clear cache...
-  %cache=();
-    ## (1) If n is 1 short cut and return 1
-  $_[0]==1 ? 1 : _cute_count( 0,
-      ## (2) Just keep the lists
-    map  { $_->[1] }
-      ## (3) Sort so the shortest lists are first - then sort by integer
-    sort { @{$a->[1]} <=> @{$b->[1]} ||
-             $a->[0]  <=>   $b->[0]
-         }
-      ## (4) Find all values between 1 & n which are either a factor or
-      ##     multiple. Store each as pair, of the number + all values.
-    map  {[ ($a=$_), [
-           grep { !( $_%$a && $a%$_ ) } 1 .. $_[0]
-         ] ]}
-      ## (5) Looping over 1 to n
-         1 .. $_[0]
-  )
-}
-
-sub _cute_count {
-  ## (6) We shift of the index number of seen numbers
-  ##     and also the next group of possible numbers...
-  my( $seen, $next ) = ( shift, shift );
-    ## (7) If we have already computed the value return...
-    ## (8) otherwise we loop over the values possible in the
-    ##     "nth" position (this is loose as they aren't ordered directly)
-    ##     by " but by the count {we are only counting so don't need to
-    ##     produce numbers}
-  $cache{$seen} //= sum0 map {
-    ## (9) We sum up the value for each value in this list which hasn't
-    ##     been seen (and return it!)
-      ($seen & 1<<$_) ? 0
-    ## (10) If there is only 1 number left in the list we count 1
-    ##     (as all numbers can be in the last position)
-    : @_ < 2          ? 1
-    ## (11) o/w we call this method again after knocking out the number
-    :                   _cute_count( $seen | 1<<$_ , @_ )
-  } @{$next}
+sub equal_dis {
+  my($av,$k) = (0,0);
+  $av+=$_ for @_;
+  return -1 if $av%@_;
+  $av/=@_;
+  $k+=abs($av-$_[0]),$_[1]-=$av-shift while @_>1;
+  $k;
 }
-    ## Note we don't use a string as a key - but use a bit mast -
-    ## #9 & #11 using "|" to set a bit & "&" to check it has
-    ## been set.
 ```
 
-or without comments:
+The first thing to realise is that we only have a solution if the digits up to a multiple of the length of the list.
 
-```perl
-sub cute {
-  %cache=();
-  $_[0]==1 ? 1 : _cute_count( 0,
-    map  { $_->[1] }
-    sort { @{$a->[1]} <=> @{$b->[1]} ||
-             $a->[0]  <=>   $b->[0]
-         }
-    map  {[ ($a=$_), [
-           grep { !( $_%$a && $a%$_ ) } 1 .. $_[0]
-         ] ]}
-         1 .. $_[0]
-  )
-}
+So first thing we do is work out the sum and see if it is divisible by the length.
 
-sub _cute_count {
-  my( $seen, $next ) = ( shift, shift );
-  $cache{$seen} //= sum0 map {
-      ($seen & 1<<$_) ? 0
-    : @_ < 2          ? 1
-    :                   _cute_count( $seen | 1<<$_ , @_ )
-  } @{$next}
-}
-```
-### Performance
-
-We compared this algorithm with various ones with ordering and without we have the following timings:
-
-| Method                      | Rate    | Gain |
-| :-------------------------- | ------: | ---: |
-| No-cache, no-ordering trick |  1.19/s |      |
-| No-cache, ordering trick    |  7.29/s |   6x |
-| Cache, no-ordering trick    |  17.4/s |  15x |
-| Cache, ordering trick       |  97.0/s |  80x |
-
-The difference expands rapdily as N increases - for `n=20` the optimal solution takes around 0.162 seconds - where the non-optimal solution 96, for an approximately `600x` speed up - this is approx `12x` for the ordering trick & `50x` for the cacheing.
-
-### Timings for increasing `$N`
-
-The original challenge asked us to compute values up to `n=15` - the cumulative time for this is between 1.05 and 1.30 seconds. We can continue on to `n=30` taking around 19 seconds.
-
-The script finally crashes after `n=39` (with a count of around 5.5 trillion) - when the cache memory usage exceeds 7GBytes (the capacity of the machine) and starts to swap. {Note although this machine has more memory it also has a slower processor - so the times are approximately 30% longer than on the box used for the timings above}
-
-| ind |             Count | Time loop  | Cumul time |
-| --: | ----------------: | ---------: | ---------: |
-|   1 |                 1 |   0.000010 |   0.000011 |
-|   2 |                 2 |   0.000018 |   0.000076 |
-|   3 |                 3 |   0.000016 |   0.000105 |
-|   4 |                 8 |   0.000022 |   0.000136 |
-|   5 |                10 |   0.000028 |   0.000175 |
-|   6 |                36 |   0.000067 |   0.000251 |
-|   7 |                41 |   0.000085 |   0.000346 |
-|   8 |               132 |   0.000177 |   0.000533 |
-|   9 |               250 |   0.000241 |   0.000790 |
-|  10 |               700 |   0.000493 |   0.001299 |
-|  11 |               750 |   0.000601 |   0.001916 |
-|  12 |             4,010 |   0.001535 |   0.003466 |
-|  13 |             4,237 |   0.001722 |   0.005206 |
-|  14 |            10,680 |   0.002893 |   0.008116 |
-|  15 |            24,679 |   0.005721 |   0.013854 |
-|  16 |            87,328 |   0.009010 |   0.022884 |
-|  17 |            90,478 |   0.010208 |   0.033113 |
-|  18 |           435,812 |   0.020486 |   0.053620 |
-|  19 |           449,586 |   0.023270 |   0.076913 |
-|  20 |         1,939,684 |   0.078741 |   0.155676 |
-|  21 |         3,853,278 |   0.125847 |   0.281549 |
-|  22 |         8,650,900 |   0.173449 |   0.455045 |
-|  23 |         8,840,110 |   0.224917 |   0.680006 |
-|  24 |        60,035,322 |   0.359825 |   1.039877 |
-|  25 |        80,605,209 |   0.511679 |   1.551599 |
-|  26 |       177,211,024 |   0.663506 |   2.215148 |
-|  27 |       368,759,752 |   1.033414 |   3.248616 |
-|  28 |     1,380,348,224 |   2.533999 |   5.782659 |
-|  29 |     1,401,414,640 |   2.951694 |   8.734403 |
-|  30 |     8,892,787,136 |  10.241124 |  18.975582 |
-|  31 |     9,014,369,784 |  11.076978 |  30.052606 |
-|  32 |    33,923,638,848 |  13.505877 |  43.558524 |
-|  33 |    59,455,553,072 |  20.499038 |  64.057609 |
-|  34 |   126,536,289,568 |  23.903329 |  87.960986 |
-|  35 |   207,587,882,368 |  57.064045 | 145.025074 |
-|  36 | 1,495,526,775,088 |  99.565625 | 244.590748 |
-|  37 | 1,510,769,105,288 | 109.442520 | 354.033321 |
-|  38 | 3,187,980,614,208 | 134.032712 | 488.066089 |
-|  39 | 5,415,462,995,568 | 175.846131 | 663.912274 |
+Second is how to work out the number of steps. This is easier than you think. We only have to consider the case where we move numbers right to left or left to right, starting at the left. We are not bothered whether any number becomes negative.
+
+So (1) how much do we need to move? This is simply `$av - $A[$p]`. So we borrow it from the next number so `$A[$p+1] = $A[$p+1] - $av + $A[$p]` and the number of steps is just `abs($av-$A[$p])`. Giving the code above.
diff --git a/challenge-192/james-smith/blog.txt b/challenge-192/james-smith/blog.txt
new file mode 100644
index 0000000000..a6f33b7883
--- /dev/null
+++ b/challenge-192/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-192/james-smith
diff --git a/challenge-192/james-smith/perl/ch-1.pl b/challenge-192/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..b2e18ab4be
--- /dev/null
+++ b/challenge-192/james-smith/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Inline 'C';
+
+my @TESTS = (  [5,2],[4,3],[6,1] );
+
+is( binary_flip( $_->[0] ), $_->[1] ) for @TESTS;
+is( string_flip( $_->[0] ), $_->[1] ) for @TESTS;
+is( c_flip(      $_->[0] ), $_->[1] ) for @TESTS;
+done_testing();
+
+sub string_flip {
+  oct '0b'.sprintf('%b',$_[0])=~tr/01/10/r;
+}
+
+sub binary_flip {
+  my($r,$k,$n) = (0,1,shift);
+  $r|=(~$n&1)<<$k++, $n>>=1 while $n;
+  $r;
+}
+
+__END__
+__C__
+int c_flip(int n) {
+  int r=0;
+  int k=0;
+  while(n) {
+    r|=(1^n&1)<<k++;
+    n>>=1;
+  }
+  return r;
+}
diff --git a/challenge-192/james-smith/perl/ch-2.pl b/challenge-192/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..36b2dc27dc
--- /dev/null
+++ b/challenge-192/james-smith/perl/ch-2.pl
@@ -0,0 +1,23 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+
+my @TESTS = ( [ [1,0,5], 4 ], [ [0,2,0],-1], [ [0,3,0], 2 ] );
+
+is( equal_dis(  @{$_->[0]} ), $_->[1] ) for @TESTS;
+done_testing();
+
+sub equal_dis {
+  my($av,$k) = (0,0);
+  $av+=$_ for @_;
+  return -1 if $av%@_;
+  $av/=@_;
+  $k+=abs($av-$_[0]),$_[1]-=$av-shift while @_>1;
+  $k;
+}