Merge pull request #7904 from drbaggy/master

Finally got round to writing up the methods...

4 files changed, 166 insertions, 35 deletions

diff --git a/challenge-212/james-smith/README.md b/challenge-212/james-smith/README.md
index fd356c934e..4004bf624f 100644
--- a/challenge-212/james-smith/README.md
+++ b/challenge-212/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 210](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-210/james-smith) |
-[Next 212 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-212/james-smith)
+[< Previous 211](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-211/james-smith) |
+[Next 213 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-213/james-smith)
 
-# The Weekly Challenge 211
+# The Weekly Challenge 212
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,59 +13,119 @@ 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-211/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-212/james-smith
 
-# Task 1: Toeplitz Matrix
+# Task 1: Jumping Letters
 
-***You are given a matrix `m` x `n`. Write a script to find out if the given matrix is Toeplitz Matrix. A matrix is Toeplitz if every diagonal from top-left to bottom-right has the same elements.***
+***You are given a word having alphabetic characters only, and a list of positive integers of the same length. 
+Write a script to print the new word generated after jumping forward each letter in the given word by the integer in the list. The given list would have exactly the number as the total alphabets in the given word.***
 
 ## Solution
 
+The solution below is compact - but by chaining `map`s we can break up the functionality.
+
+ * `shift` - grab the first parameter - the string.
+ * `split //` - split this into single characters
+ * `map { (96&ord) | ( (31&ord) -1 + shift)%26 +1 }` - loop through each letter
+   * (96&ord) - get the 2 & 3 bits of the representation - uppercase have only the first bit set, lowercase both.
+     * Note `ord` without any parameters acts on $_ or the loop variable - in this case the characters of the sting.
+   * `|` - we **or** this back with the result of the second calculation, this means the character will keep it's case
+   * `((31&ord) -1 + shift)%26+1` computes the letter shift
+     * `31&ord` gets the last 5 bits of the character - this gives the same for the upper/lower case version of a letter, and is the 1-based position of the letter in the alphabet.
+     * `-1` converts this to the 0-based position (easier to work with)
+     * `+ shift` adds the next element of the parameter list to this - applying the shift.
+     * `( .. )%26` wraps this to map back to the alphabet [hence need for 0-based position]
+     * `+1` converts back to the 1-based position.
+ * `chr` converts back to the character (again no parameter uses `$_`
+ * `join ''` joins the string back together
+
+We have no `return` here as perl by default returns the last value computed.... similarly no trailing `;` as one isn't needed for a `}`.
 
 ```perl
-sub toeplitz {
-  return if @_ > @{$_[0]};                   ## unclear but no diagonals...
-  my @st = @{$_[0]}[ 0 .. @{$_[0]} - @_ ];
-  for my $r ( 1 .. $#_ ) {
-    $st[$_] == $_[$r][$r+$_] || return 0 for 0 .. $#st;
-  }
-  1
+sub jumping_letters {
+  join '',
+  map { chr }
+  map { (96&ord) | ( (31&ord) -1 + shift)%26 +1 }
+  split //,
+  shift
 }
 ```
 
-Firstly we check to see if we have more rows than columns (there are no full diagonals) so there is no result.
+**Note:** An alternative version of the long `map` is available at the same length - which doesn't rely on shifting to `0-based` numbers but converts `0` to `26` by means of an `||26`.
 
-Then we grab the first row of each of the diagonal - the number of possible diagonals is `columns - rows + 1`.
-We then loop through each other row - and find the chunk of the row on the diagonal - and compare it with the first row.
+```perl
+  map { ( ( (31&ord) + shift )%26 || 26 ) | 96&ord }
+```
+# Task 2: 
 
-If there is a difference we return `0`;
+***You are given a list of integers and group size greater than zero. Write a script to split the list into equal groups of the given size where integers are in sequential order. If it can’t be done then print `-1`.***
 
-If the are no differences we return `1`;
+## Solution
 
-# Task 2: Number Collision
+We make the following observations:
+ * the order of the numbers is irrelevant - so it can help us by sorting the numbers;
+ * not only that but just keeping the count of each number is sufficient.
 
-***You are given an array of integers. Write a script to find out if the given can be split into two separate arrays whose average are the same..***
+We therefore compute the counts and loop through these in numeric order:
+ * We check to see if the count for the next "n-1" numbers are greater than the count for the current one.
+   * If they are we reduce the count and continue.
+   * If not we return `-1` as there is no solution.
 
-## Solution
+Again we make the observations:
+ * We can reduce the number of the subsequent numbers within the loop that checks as we can be "destructive" in the approach - we return `-1` in the only case this would be bad.
+ * We don't store `$n` but `$n` as we never use `$n` without using `$s`
+ * We only have to keep track of the first element of each list which starts a sequence - and it's count. Well this is a by-product of the approach. It is what is left in the frequency table...
+
+Notes:
+ * Really only one here - that we have to be careful in the last map `[...] x $x` returns `('Array(0x..)','Array(0x..)',...)`, so we have to wrap it in `()` to convert it into an array of scalars to get it to return `([...],[...],...)`.
+### Solution 1 - multi-liner...
+
+```perl
+sub rearrange_groups {
+  my($s,%f) = -1+shift;
+  $f{$_}++ for @_;                         ## Get counts
+  for my $k ( sort {$a<=>$b} keys %f ) {   ## Loop through numbers
+    $f{$k}||next;                          ## Next unless defined and non-zero
+      exists $f{$_} && $f{$_}>=$f{$k}      ## Loop through the next $s numbers
+    ? $f{$_}-=$f{$k}                       ## If defined & greater than $f{$k}
+    : return -1                            ## we update o/w return -1
+      for $k+1..$k+$s;
+  }
+  [ map  { ([$_..$_+$s]) x $f{$_} }        ## Now just output
+    sort { $a<=>$b }                       ## note ([...]) as o/w [...] is
+    keys %f ]                              ## handled as a string.
+}
+```
 
-First we compute the overall average of the sets of numbers (or at least the sum and the count). We then loop through all subsets of numbers to see if we can find a subset with the same average.
+Now with some "craft" the main function can be rewritten as a series of maps to
+generate a single statement for everything after we produce the list of frequences.
 
-We can enumerate sub sets by using a binary mask to choose elements - For every solution there are two sets one whic includes the first number and one that doesn't - as we only need to calculate one set - then we can always assume that the first entry is NOT in the set we are summing.
+We replace the inner loop with a `map` to allow us to replace the outer loop with a `map` also.
 
-To compare the means we could use `TOTAL_all / COUNT_all == TOTAL_subset / COUNT_subset` but this involves division which isn't good - but we can rewrite this as:
-`TOTAL_all * COUNT_subset == TOTAL_subset * COUNT_all`.
+A trick here - we map `$_` -> `$'` by running the empty regex `//`. `$'` the after value
+is assigned to whole of the unmatch string of `$_`. Interestingly `//` appears again - but this
+time not an empty regex but as the "*or if defined*" operator.
 
-We enumerate the sets from `1` to `2^(n-1) - 1` the bits representing whether or not the number is in one set or the other.
+We then extract this as it is what we
+need by by returning it in the 2nd value of the array and accessing with `[1]`.
+
+This leaves the hash `%f` containing the frequence of each list starting at a given point.
+
+Which we again use map to generate the list of lists - which in turn avoids us resorting the
+list...
 
 ```perl
-sub equal_split {
-  my( $t, $c ) = ( 0, scalar @_ );
-  $t += $_ for @_;
-  for my $x ( 1 .. ( 1 << $c-1 ) -1 ) {
-    my( $m, $n ) = ( 0, 0 );
-    ( $x & 1 ) && ( $m += $_[$_], $n++ ), $x >>= 1 for 1 .. $c-1;
-    return 1 unless $n*$t-$m*$c;
-  }
-  0
+sub rearrange_groups_one_liner {
+  my($s,%f) = -1+shift;
+  $f{$_}++ for @_;
+  [ map { ([$_..$_+$s]) x $f{$_} }
+    map { ( //,
+            $',
+            $f{$'} && map {
+              $f{$_}//0>=$f{$'} ? $f{$_}-=$f{$'} : return -1
+            } $'+1..$'+$s
+          )[1] }
+    sort {$a<=>$b}
+    keys %f ]
 }
 ```
diff --git a/challenge-212/james-smith/blog.txt b/challenge-212/james-smith/blog.txt
new file mode 100644
index 0000000000..bc02572eb5
--- /dev/null
+++ b/challenge-212/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-212/james-smith/blog.txt
diff --git a/challenge-212/james-smith/perl/ch-1.pl b/challenge-212/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..c2914ec31e
--- /dev/null
+++ b/challenge-212/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;
+
+my @TESTS = (
+  [ ['Perl',2,22,19,9], 'Raku' ],
+  [ ['Raku',24,4,7,17], 'Perl' ],
+);
+
+
+sub jumping_letters {
+                         # Stitch back into word
+  join '',
+                         # Like ord below chr acts on $_ if no parameters
+                         # are passed...
+  map { chr }
+                         # Do the maths.... now this is where things get
+                         # a little cheeky.... ord acts on $_ which is the
+                         # letter, shift returns the next value of @_ which
+                         # is the shift!
+                         # 96&ord| .... preserves the 64 & 32 bit - it is
+                         # the 32 represents upper or lowercase
+                         # the 64 indicates that this is a letter (sort of)
+                         # 31&ord removes these and returns the numeric
+                         # position of the number in the alphabet - we subtract
+                         # one to get the zero based position + shift it
+                         # wrap and them move back to a one based position.
+  map { (96&ord) | ( (31&ord) -1 + shift)%26 +1 }
+                         # Split into individual letters;
+  split //,
+                         ## This is the word we are "changing"
+  shift
+}
+
+is( jumping_letters( @{$_->[0]} ), $_->[1] ) for @TESTS;
diff --git a/challenge-212/james-smith/perl/ch-2.pl b/challenge-212/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..bded4d01f3
--- /dev/null
+++ b/challenge-212/james-smith/perl/ch-2.pl
@@ -0,0 +1,32 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use feature qw(say);
+use Test::More;
+
+my @TESTS = (
+  [ [3,  1,2,3,5,1,2,7,6,3], '(1,2,3), (1,2,3), (5,6,7)' ],
+  [ [2,  1,2,3            ], -1 ],
+  [ [3,  1,2,4,3,5,3      ], '(1,2,3), (3,4,5)' ],
+  [ [2,  1,2,4,3,5,3      ], -1 ],
+  [ [3  ,1,5,2,6,4,7      ], -1 ],
+);
+
+sub rearrange_groups {
+  my($s,%f,@res) = shift;
+  return -1 if @_%$s;
+  $s--;
+  $f{$_}++ for @_;
+  for my $k ( sort {$a<=>$b} keys %f ) {
+    $f{$k} ? push @res, [$k,$f{$k}] : next;
+    exists $f{$_} && $f{$_}>=$f{$k} ? ( $f{$_}-=$f{$k} ) : (return -1) for $k+1..$k+$s;
+  }
+  [map { ([$_->[0]..$_->[0]+$s]) x $_->[1] } @res]
+}
+
+sub d {
+  ref $_[0] ? '('.join( '), (', map { join(',',@{$_}) } @{$_[0]} ).')' : $_[0];
+}
+
+is( d( rearrange_groups( @{$_->[0]} ) ), $_->[1] ) for @TESTS;