From 9708225cfd6d9d3aad0928f4b2c3e7d0618eabc0 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 10 Apr 2023 10:09:14 +0100 Subject: Create ch-1.pl --- challenge-212/james-smith/perl/ch-1.pl | 38 ++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 challenge-212/james-smith/perl/ch-1.pl 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..fb23119d75 --- /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 + return 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; -- cgit From 4c88aaa435186d13edef542aa20a629037e0a187 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 10 Apr 2023 10:10:29 +0100 Subject: Update ch-1.pl --- challenge-212/james-smith/perl/ch-1.pl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/challenge-212/james-smith/perl/ch-1.pl b/challenge-212/james-smith/perl/ch-1.pl index fb23119d75..c2914ec31e 100644 --- a/challenge-212/james-smith/perl/ch-1.pl +++ b/challenge-212/james-smith/perl/ch-1.pl @@ -13,10 +13,10 @@ my @TESTS = ( sub jumping_letters { # Stitch back into word - return join '', + join '', # Like ord below chr acts on $_ if no parameters # are passed... - map { chr } + 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 @@ -28,11 +28,11 @@ sub jumping_letters { # 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 } + map { (96&ord) | ( (31&ord) -1 + shift)%26 +1 } # Split into individual letters; - split //, + split //, ## This is the word we are "changing" - shift; + shift } is( jumping_letters( @{$_->[0]} ), $_->[1] ) for @TESTS; -- cgit From a83f8922a0e6ce512f4ad0cdd791ab06e6382367 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 10 Apr 2023 10:12:38 +0100 Subject: Create ch-2.pl --- challenge-212/james-smith/perl/ch-2.pl | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 challenge-212/james-smith/perl/ch-2.pl 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; -- cgit From fc75d111bc65a84e7e05b7e3039454071c70d9c3 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 10 Apr 2023 10:13:14 +0100 Subject: Create blog.txt --- challenge-212/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-212/james-smith/blog.txt 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 -- cgit From d564dc54ff2710d295542b0223e26158a033cec8 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 10 Apr 2023 13:27:29 +0100 Subject: Update README.md --- challenge-212/james-smith/README.md | 86 ++++++++++++++++++++----------------- 1 file changed, 47 insertions(+), 39 deletions(-) diff --git a/challenge-212/james-smith/README.md b/challenge-212/james-smith/README.md index fd356c934e..7db415495a 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,67 @@ 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 - ```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. - -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. - -If there is a difference we return `0`; - -If the are no differences we return `1`; - -# Task 2: Number Collision +# Task 2: ***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..*** ## Solution -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. - -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. +```perl +sub rearrange_groups { + my($s,%f) = -1+shift; + $f{$_}++ for @_; + for my $k ( sort {$a<=>$b} keys %f ) { + $f{$k}||next; + exists $f{$_} && $f{$_}>=$f{$k} ? $f{$_}-=$f{$k} : return -1 for $k+1..$k+$s; + } + [ map { ([$_..$_+$s]) x $f{$_} } sort { $a<=>$b } keys %f ] +} +``` +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. -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`. +We replace the inner loop with a map to allow us to replace the outer loop with a map also. +A trick here - we map `$_` -> `$'` by running the empty regex `//`. `$'` the after value +is assigned to whole of the unmatch string of `$_`. 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]`. -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. +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. ```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 ] } ``` -- cgit From 2b43f760389c39e50f8c9597b1de762ccf9b1fdc Mon Sep 17 00:00:00 2001 From: James Smith Date: Sat, 15 Apr 2023 07:54:17 +0100 Subject: Create README.md --- challenge-212/james-smith/README.md | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/challenge-212/james-smith/README.md b/challenge-212/james-smith/README.md index 7db415495a..39cc751c3a 100644 --- a/challenge-212/james-smith/README.md +++ b/challenge-212/james-smith/README.md @@ -22,6 +22,25 @@ Write a script to print the new word generated after jumping forward each letter ## 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 jumping_letters { join '', @@ -32,6 +51,11 @@ sub jumping_letters { } ``` +**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`. + +```perl + map { ( ( (31&ord) + shift )%26 || 26 ) | 96&ord } +``` # Task 2: ***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..*** -- cgit From 7dbc4c9e25c3ebbe11e8ad34fd6144d400bdc4a1 Mon Sep 17 00:00:00 2001 From: James Smith Date: Sat, 15 Apr 2023 08:11:08 +0100 Subject: Update README.md --- challenge-212/james-smith/README.md | 52 ++++++++++++++++++++++++++++--------- 1 file changed, 40 insertions(+), 12 deletions(-) diff --git a/challenge-212/james-smith/README.md b/challenge-212/james-smith/README.md index 39cc751c3a..4004bf624f 100644 --- a/challenge-212/james-smith/README.md +++ b/challenge-212/james-smith/README.md @@ -58,31 +58,61 @@ sub jumping_letters { ``` # Task 2: -***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..*** +***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`.*** ## Solution +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. + +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. + +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 @_; - for my $k ( sort {$a<=>$b} keys %f ) { - $f{$k}||next; - exists $f{$_} && $f{$_}>=$f{$k} ? $f{$_}-=$f{$k} : return -1 for $k+1..$k+$s; + $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{$_} } sort { $a<=>$b } keys %f ] + [ map { ([$_..$_+$s]) x $f{$_} } ## Now just output + sort { $a<=>$b } ## note ([...]) as o/w [...] is + keys %f ] ## handled as a string. } ``` + 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 replace the inner loop with a map to allow us to replace the outer loop with a map also. +We replace the inner loop with a `map` to allow us to replace the outer loop with a `map` also. + A trick here - we map `$_` -> `$'` by running the empty regex `//`. `$'` the after value -is assigned to whole of the unmatch string of `$_`. We then extract this as it is what we +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 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 we again use map to generate the list of lists - which in turn avoids us resorting the +list... ```perl sub rearrange_groups_one_liner { @@ -92,9 +122,7 @@ sub rearrange_groups_one_liner { map { ( //, $', $f{$'} && map { - $f{$_}//0>=$f{$'} - ? $f{$_}-=$f{$'} - : return -1 + $f{$_}//0>=$f{$'} ? $f{$_}-=$f{$'} : return -1 } $'+1..$'+$s )[1] } sort {$a<=>$b} -- cgit