Merge pull request #7181 from drbaggy/master

193 solutions

4 files changed, 174 insertions, 89 deletions

diff --git a/challenge-193/james-smith/README.md b/challenge-193/james-smith/README.md
index e509b7da91..e62ff12914 100644
--- a/challenge-193/james-smith/README.md
+++ b/challenge-193/james-smith/README.md
@@ -1,7 +1,7 @@
-[< 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)
+[< Previous 192](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-192/james-smith) |
+[Next 194 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-194/james-smith)
 
-# The Weekly Challenge 192
+# The Weekly Challenge 193
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,124 +13,117 @@ 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-190/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-193/james-smith
 
-# Task 1 - Binary Flip
+# Task 1 - Binary string
 
-***You are given a positive integer, `$n`. Write a script to find the binary flip.***
+***You are given an integer, `$n > 0`. Write a script to find all possible binary numbers of size `$n`.***
 
 ## Solution
 
-### Use maths...
+This weeks task 1 is relatively simple. (1) We need to work out what the minimum and maximum
+integers are and then just print them padded to the right length. Thankfully Perl is great
+at this as it is integral to it's design.
 
-This isn't as simple as using `~` as this will flip ALL the bits including those before the first 1.
-
-We need to therefore work through bit by bit reducing the number until we have reach zero.
-
-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
-
-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.
+The largest value is '(2^n)-1' and the template for `sprintf` is '`%0{n}b`'. Which gives us
 
 ```perl
-sub binary_flip {
-   my($r,$k,$n) = (0,0,shift);
-   $r|=(~$n&1)<<$k++,$n>>=1 while $n;
-   $r;
-}
-```
-
-### Use strings...
-
-This can also be done by converting to a string and then coverting back again.
-
-```
-sub string_flip {
-  $_[0] ? oct '0b'.sprintf('%b',$_[0])=~tr/01/10/r : 0;
-}
+sub all_binary {                             ## Make a template so we don't have
+  my $t = "%0$_[0]b";                        ## to do interpolation everytime
+  map { sprintf $t, $_ } 0 .. (1<<$_[0])-1   ## Need brackets as - is actioned                                         
+}                                            ## before <<.
 ```
+# Task 2 - Odd String
 
-We use `tr` with the `r` option to return the result of the translation...
-
-Note we have to check whether the input is `0` as in this case the output is also `0` as there is no leading 1.
+***You are given a list of strings of same length, `@s`. Write a script to find the odd string in the given list. Use positional value of alphabet starting with 0, i.e. `a = 0`, `b = 1`, ... `z = 25`.***
 
-### Performance...
+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`
 
-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.
+## Solution
 
-### Let's try again...
+First pass - we compute a signature for each string, and store them in arrays, keyed by the signature... We use "100 * first difference + second difference".
 
-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.
+Once we have the hash - we find the value {array} with only 1 element in it - and return that value...
 
-```C
-int c_flip(int n) {
-  int r=0;
-  int k=0;
-  while(n) {
-    r|=(1^n&1)<<k++;
-    n>>=1;
-  }
-  return r;
+```perl
+sub odd_string_array {
+  my %x;
+  ## Keyed by signature - so one key will have
+  push @{$x{
+      ord( substr $_, 1 ) *  99
+    + ord( substr $_, 2 )
+    - ord( $_           ) * 100
+  }}, $_ for @_;
+  [ grep { @{$_}==1 } values %x ]->[0][0]
 }
 ```
 
-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.
+### Faster solution..
 
-A further re-write of the C gives:
+We note (1) this takes a lot of memory!, (2) we need to compute the signature of each number...
 
-```C
-int c2(int n) {
-  int o = n;
-  int m = 0;
-  while(o) {
-    m<<=1;
-    m++;
-    o>>=1
-  }
-  return n^m;
-}
-```
+So can we do better... First we note that we will need to compute the signatures of at least 3 entries. As we need to find two the same and one different.
 
-Here we compute a mask of `1`s as long as the binary representation of the number so for `25` = `11001` we have a mask of `11111` and so doing a bitwize XOR operation gives us `00110` or `6`. Which is even faster as it only does the XOR (`^`) once. {approx 5 times faster than the regex version}
+So we do this for the first three strings. If all strings have the same signature we need to loop through the remainder of the list to find one which is different.
 
-# Task 2 - Equal Distribution
+If they are not - we just use logic to work out which is different.
 
-***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`***
+  * first two the same - it must be the third
+  * first and third the same - must be second
+  * o/w first.
 
-## Solution
+We will try three different methods:
+ 
+  * Calculate each difference on the fly
+  * Store the score for adjacent letters - and look up in a hash {hash size 676}
+  * Store a "score" for each triple - and look up in a a hash {hash size 17,576}
+
+The logic of all three code bases is the same - just how the "signature" is calculated. You can see this by the structure of the code
 
 ```perl
-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;
+sub odd_string_ord {
+  my($x1,$x2) = (   ord($_[0]) - ord(substr$_[0],1),          ord($_[0]) - ord(substr$_[0],2) );
+  return $_[ $x1 == ord($_[2]) - ord(substr$_[2],1) && $x2 == ord($_[2]) - ord(substr$_[2],2) ]
+      if     $x1 != ord($_[1]) - ord(substr$_[1],1) || $x2 != ord($_[1]) - ord(substr$_[1],2);
+  splice@_,0,2;
+  (          $x1 != ord($_   ) - ord(substr$_,1)    || $x2 != ord($_)    - ord(substr$_,2   ) ) && return $_ for @_;
 }
-```
 
-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.
+my %map2  = map { my $a=$_; map { 
+  ("$a$_" => ord($a)-ord($_))
+} 'a'..'z' } 'a'..'z';
 
-So first thing we do is work out the sum and see if it is divisible by the length.
+sub odd_string_map_2 {
+  my($x1,$x2) = (   $map2{ substr $_[0],0,2 },          $map2{ substr $_[0],1,2 } );
+  return $_[ $x1 == $map2{ substr $_[2],0,2 } && $x2 == $map2{ substr $_[2],1,2 } ]
+      if     $x1 != $map2{ substr $_[1],0,2 } || $x2 != $map2{ substr $_[1],1,2 };
+  splice@_,0,2;
+  (          $x1 != $map2{ substr $_,   0,2 } || $x2 != $map2{ substr $_,   1,2 } ) && return $_ for @_;
+}
 
-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.
+my %map3  = map { my $b = $_; map { my $a=$_; map {
+  ("$a$b$_" => ord($a)*99-ord($b)*100+ord($_))
+} 'a'..'z' } 'a'..'z' } 'a'..'z';
 
-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.
+sub odd_string_map_3 {
+  my         $x =  $map3{ $_[0] };
+  return $_[ $x == $map3{ $_[2] } ]
+      if     $x != $map3{ $_[1] };
+  splice@_,0,2;
+             $x == $map3{ $_    } || return $_ for @_;
+}
+```
 
-### A minor optimization
+### Performance
 
-We can do away with the array - and just use a scalar for the "size" of the next bin - giving us:
+How much faster are these... depends on how far along the list you need to go until you find the unique element.
+Testing a list of strings with the odd one in a random location - we saw:
 
-```perl
-sub equal_dis2 {
-  my($av,$k,$f) = (0,0,$_[0]);
-  $av+=$_ for @_;
-  return -1 if $av%@_;
-  $av/=@_;
-  $k+=abs($av-$f),$f=$_[$_]-$av+$f for 1..$#_;
-  $k;
-}
-```
+| Method    | Speed up |
+| --------- | -------: |
+| 2-chr map |   x  3.3 |
+| Ord       |   x  4.3 |
+| 3-chr map |   x 10.1 |
 
+I think the overhead of the `substr` and hash lookup for the 2-chr map is greater the `ord` lookups. But avoiding
+doing the `substr` makes the 3-chr map substantially faster...
diff --git a/challenge-193/james-smith/blog.txt b/challenge-193/james-smith/blog.txt
new file mode 100644
index 0000000000..36bac2d0cc
--- /dev/null
+++ b/challenge-193/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-193/james-smith
diff --git a/challenge-193/james-smith/perl/ch-1.pl b/challenge-193/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..fe0ffaa757
--- /dev/null
+++ b/challenge-193/james-smith/perl/ch-1.pl
@@ -0,0 +1,14 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+
+say join ', ', all_binary($_) for 1..10;
+
+sub all_binary {                             ## Make a template so we don't have
+  my $t = "%0$_[0]b";                        ## to do interpolation everytime
+  map { sprintf $t, $_ } 0 .. (1<<$_[0])-1   ## Need brackets as - is actioned                                         
+}                                            ## before <<.
+
diff --git a/challenge-193/james-smith/perl/ch-2.pl b/challenge-193/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..e4877da7b9
--- /dev/null
+++ b/challenge-193/james-smith/perl/ch-2.pl
@@ -0,0 +1,77 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+
+my $SIZE = 100;
+
+my %map2  = map { my $a=$_; map { ("$a$_" => ord($a)-ord($_)) } 'a'..'z' } 'a'..'z';
+my %map3  = map { my $b = $_; map { my $a=$_; map { ("$a$b$_" => ord($a)*99-ord($b)*100+ord($_)) } 'a'..'z' } 'a'..'z' } 'a'..'z';
+
+my @list  = map { chr(97+rand(26)) x 3 } 1..$SIZE;
+
+my @TESTS = (
+  [ [qw(adc wzy abc)], 'abc' ],
+  [ [qw(bob bbb ccc ddd)], 'bob' ],
+  [ [qw(aaa bob ccc ddd)], 'bob' ],
+  [ [qw(aaa bbb bob ddd)], 'bob' ],
+  [ [qw(aaa bbb ccc bob)], 'bob' ],
+  ## Put "bob" in every position within the list...
+  map { my $t = [ @list ]; $t->[$_]='bob'; [ $t, 'bob' ] } 0..$SIZE-1
+);
+
+is( odd_string_array(  @{$_->[0]} ), $_->[1] ) for @TESTS;
+is( odd_string_ord(    @{$_->[0]} ), $_->[1] ) for @TESTS;
+is( odd_string_map_2(  @{$_->[0]} ), $_->[1] ) for @TESTS;
+is( odd_string_map_3(  @{$_->[0]} ), $_->[1] ) for @TESTS;
+
+sub odd_string {
+  my %x;
+  ## Keyed by signature - so one key will have
+  push @{$x{
+      ord( substr $_, 1 ) *  99
+    + ord( substr $_, 2 )
+    - ord( $_           ) * 100
+  }}, $_ for @_;
+  [ grep { @{$_}==1 } values %x ]->[0][0]
+}
+
+sub odd_string_ord {
+  my($x1,$x2) = (   ord($_[0]) - ord(substr$_[0],1),          ord($_[0]) - ord(substr$_[0],2) );
+  ## The first two characters are different - so we need to check the first against the third
+  ## If it is the same then the character we want is the second character o/w the first
+  ## Note the comparison returns 1 if true & 0 if false so can use that as the index to @_
+  return $_[ $x1 == ord($_[2]) - ord(substr$_[2],1) && $x2 == ord($_[2]) - ord(substr$_[2],2) ]
+      if     $x1 != ord($_[1]) - ord(substr$_[1],1) || $x2 != ord($_[1]) - ord(substr$_[1],2);
+  ## We remove the first two strings as we don't need to compare them...
+  splice@_,0,2;
+  ## Compare all strings {we will end up with an answer as we know there is a unique string
+  (          $x1 != ord($_   ) - ord(substr$_,1)    || $x2 != ord($_)    - ord(substr$_,2   ) ) && return $_ for @_;
+  ## in the list...
+}
+
+## Pre compute `ord($a) - ord($b)` for two letters [keyed with the string `"$a$b"`] and use
+## this to avoid the repeated ord calculation.... (676 entries)
+## This isn't as efficient as the ord calculation tho!
+sub odd_string_map_2 {
+  my($x1,$x2) = (   $map2{ substr $_[0],0,2 },          $map2{ substr $_[0],1,2 } );
+  return $_[ $x1 == $map2{ substr $_[2],0,2 } && $x2 == $map2{ substr $_[2],1,2 } ]
+      if     $x1 != $map2{ substr $_[1],0,2 } || $x2 != $map2{ substr $_[1],1,2 };
+  splice@_,0,2;
+  (          $x1 != $map2{ substr $_,   0,2 } || $x2 != $map2{ substr $_,   1,2 } ) && return $_ for @_;
+}
+
+## Pre compute the signature for all triples (17,576 entries)
+## this to avoid the repeated ord calculation...., and now the `substr` operation
+## as well - this gives us the simpler code....
+
+sub odd_string_map_3 {
+  my         $x =  $map3{ $_[0] };
+  return $_[ $x == $map3{ $_[2] } ]
+      if     $x != $map3{ $_[1] };
+  splice@_,0,2;
+             $x == $map3{ $_    } || return $_ for @_;
+}
+