by Arne Sommer

# Sequential Squares with Raku and Perl

 Published 13. June 2021.

This is my response to the Perl Weekly Challenge #116.

## Challenge #116.1: Number Sequence

You are given a number `\$N >= 10`.

Write a script to split the given number such that the difference between two consecutive numbers is always 1 and it shouldn’t have leading 0.

Print the given number if it impossible to split the number.

Example: ```Input: \$N = 1234 Output: 1,2,3,4 Input: \$N = 91011 Output: 9,10,11 Input: \$N = 10203 Output: 10203 as it is impossible to split satisfying the conditions. ```

Let us start with a simpler program, that gives us a list of possible ways of splitting the number. I'll start with the end result this time:

```\$ ./number-sequence-test 191 ([1 9 1] [1 91] [19 1] ) \$ ./number-sequence-test 1918 ([1 9 1 8] [1 9 18] [1 91 8] [1 918] [19 1 8] [19 18] [191 8] ) ```

The content of the sublists is a list, printed here with a space between the values by Raku (when we `say` the list (sequence, really)).

Note the final entry, with all the digits. This one is the answer if all else fails.

Then the program, using `gather`/`take` as well as recursion to set up a sequence:

File: number-sequence-test ```#! /usr/bin/env raku unit sub MAIN (Int \$N where \$N >= 10, :v(:\$verbose)); #  my \$seq := gather #  { get-val( (), \$N); #  sub get-val (@done is copy, \$todo is copy) #  { for 1 .. \$todo.chars -> \$size #  { my @done2 = @done.clone; #  my \$val = \$todo.substr(0, \$size); #  my \$todo2 = \$todo.substr(\$size); #  @done2.push(\$val); #  say ": Done: @done2[] { \$todo2 ?? "Todo: \$todo2" !! ""}" if \$verbose; \$todo2.chars #  ?? get-val(@done2, \$todo2) # [10a] !! take @done2; # [10b] } } } say \$seq; ```

 Ensure a positive integer with at least two digits.

 Set it up as a Sequence.

 Off we go, recursively. The first argument is a list if values that we have processed (initially none), and the second is the remainder of the string (that we have not processed yet).

 Note `is copy` so that we have local copies that we can change without messing up.

 Start with 1 digit at a time, and go on until we get them all in one go.

 Get a copy of this one (with `clone`), as the next iteration of the loop should have the unchanged version (which we got in ).

 The digit(s) for this iteration.

 Remove the digits we just fetched (in ).

 Add the digit(s) to the done list.

 Do we have any nore unprocessed digits? If so, recursively go on [10a]. If not, we have a result and we return it (so to speak) with `take` [10b].

See docs.raku.org/routine/clone for more information about `clone`.

See my Raku Gather, I Take article or docs.raku.org/syntax/gather take for more information about `gather`/`take`.

Then the full program, where we do the numeric lookup as requested by the challenge:

File: number-sequence ```#! /usr/bin/env raku unit sub MAIN (Int \$N where \$N >= 10, :v(:\$verbose)); my \$seq := gather { get-val( (), \$N); sub get-val (@done is copy, \$todo is copy) { for 1 .. \$todo.chars -> \$size { my @done2 = @done.clone; my \$val = \$todo.substr(0, \$size); my \$todo2 = \$todo.substr(\$size); next if \$val.starts-with('0'); @done2.push(\$val); say ": Done: @done2[] { \$todo2 ?? "Todo: \$todo2" !! ""}" if \$verbose; \$todo2.chars ?? get-val(@done2, \$todo2) !! take @done2; } } } for \$seq -> @list #  { if is-consecutive(@list) #  { say @list.join(","); # [2a] last; # [2b] } } sub is-consecutive (*@list is copy) #  { my \$first = @list.shift; #  my \$second; #  while (@list) #  { \$second = @list.shift; #  return False unless \$second == \$first + 1; #  \$first = \$second; #  } return True; #  } ```

 The sequence (in `\$seq`) is as described in the previous program. Here we iterate over the values.

 I have factored out this decision to a helper procedure. If the numbers are conecutive, print them [2a] and exit [2b].

 Note the `is copy` as we are going to change the array (in  and ).

 Get the first value.

 The second value will go here.

 As long as there are more values,

 • get the next one.

 • return `False` if the two values are not consecutive.

 • discard the first value, and move the second one up to first base (ready for the next iteration).

 If it does not fail, we have a success.

Running it:

```\$ ./number-sequence 1234 1,2,3,4 \$ ./number-sequence 91011 9,10,11 \$ ./number-sequence 10203 10203 ```

Looking good.

With verbose mode:

```\$ ./number-sequence -v 1234 : Done: 1 Todo: 234 : Done: 1 2 Todo: 34 : Done: 1 2 3 Todo: 4 : Done: 1 2 3 4 1,2,3,4 \$ ./number-sequence -v 91011 : Done: 9 Todo: 1011 : Done: 9 1 Todo: 011 : Done: 9 10 Todo: 11 : Done: 9 10 1 Todo: 1 : Done: 9 10 1 1 : Done: 9 10 11 9,10,11 \$ ./number-sequence -v 10203 : Done: 1 Todo: 0203 : Done: 10 Todo: 203 : Done: 10 2 Todo: 03 : Done: 10 20 Todo: 3 : Done: 10 20 3 : Done: 10 203 : Done: 102 Todo: 03 : Done: 1020 Todo: 3 : Done: 1020 3 : Done: 10203 10203 ```

The second example shows that the program is done when it finds a match (and does not go on looking).

The program handles leading zeroes in the input (by printing nothing):

```\$ ./number-sequence 0123 ```

### Zipper Bonus

It is possible to do this with a single loop. The idea is to construct a binary value that we can merge with the original number. A '1' in the binary number indicates a new value (and is replaced with '|'), and '0' is discarded (and is removed after a short period as a space character).

If we have 4 digits, the binary value are in the range «001» to «111» and they are merged (zipper like; one value from each with `roundrobin`) with the initial value.

An example may help, applied to the value «1234»:

```Binary: 001 011 100 110 111 Result: 123|4 12|3|4 1|234 1|2|34 1|2|3|4 ```

The '|' character represents a value boundary.

The whole number (`\$N`) is not a candidate this time, so we must explicitly print it if all else fails (as we start with «1» and not «0»). Also note that the check for an initial zero has been moved to «is-consecutive».

I will not explain the rest of the program. Try to follow the logic bulding up the binary mask. Uncommenting the `say` lines may help.

See docs.raku.org/routine/roundrobin for more information about `roundrobin`.

File: number-sequence-zip ```#! /usr/bin/env raku unit sub MAIN (Int \$N where \$N >= 10, :v(:\$verbose)); exit if \$N.starts-with('0'); my \$base = 1 x \$N.chars -1 ; my \$size = \$base.chars; my \$dec = \$base.parse-base(2); # say " \$base - \$dec"; my @values = \$N.comb; for 1 .. \$dec -> \$zip { # say \$zip.fmt('%0' ~ \$size ~ "b"); my @mask = \$zip.fmt('%0' ~ \$size ~ "b").comb.map({ \$_ == 1 ?? '|' !! ' ' }); # say ":: \$zip -> @mask[]"; my \$candidate = roundrobin(@values, @mask).join.trans(' ' => ''); say ": Candidate: \$candidate" if \$verbose; my @c = \$candidate.split('|'); if is-consecutive(@c) { say @c.join(','); exit; } } say \$N; sub is-consecutive (*@list is copy) { my \$first = @list.shift; return False if \$first.starts-with('0'); my \$second; while (@list) { \$second = @list.shift; return False if \$second.starts-with('0'); return False unless \$second == \$first + 1; \$first = \$second; } return True; } ```

The candidates come in a different order than the previous program, as shown below.

```\$ ./number-sequence-zip -v 1234 : Candidate: 123|4 : Candidate: 12|34 : Candidate: 12|3|4 : Candidate: 1|234 : Candidate: 1|23|4 : Candidate: 1|2|34 : Candidate: 1|2|3|4 1,2,3,4 \$./number-sequence-zip -v 91011 : Candidate: 9101|1 : Candidate: 910|11 : Candidate: 910|1|1 : Candidate: 91|011 : Candidate: 91|01|1 : Candidate: 91|0|11 : Candidate: 91|0|1|1 : Candidate: 9|1011 : Candidate: 9|101|1 : Candidate: 9|10|11 9,10,11 \$ ./number-sequence-zip -v 10203 : Candidate: 1020|3 : Candidate: 102|03 : Candidate: 102|0|3 : Candidate: 10|203 : Candidate: 10|20|3 : Candidate: 10|2|03 : Candidate: 10|2|0|3 : Candidate: 1|0203 : Candidate: 1|020|3 : Candidate: 1|02|03 : Candidate: 1|02|0|3 : Candidate: 1|0|203 : Candidate: 1|0|20|3 : Candidate: 1|0|2|03 : Candidate: 1|0|2|0|3 10203 ```

### A Perl Version

Here is a version of the (initial) test program, printing the combinations. Perl does not have «gather/take», but pushing to an array works just as well:

File: number-sequence-test-perl ```#! /usr/bin/env perl use strict; use warnings; use feature 'say'; use feature 'signatures'; no warnings qw(experimental::signatures); my \$verbose = 0; my \$N = shift(@ARGV); die "Specify a positive integer with at least two digits" unless \$N =~ /^[1-9]\d+\$/; my @result; get_val(undef, \$N); sub get_val (\$done, \$todo) { my @done = \$done ? @\$done : (); for my \$size (1 .. length(\$todo)) { my @done2 = @done; my \$val = substr(\$todo, 0, \$size); my \$todo2 = substr(\$todo, \$size); push(@done2, \$val); length(\$todo2) ? get_val(\@done2, \$todo2) : push(@result, \@done2); } } for my \$res (@result) { say join(",", @\$res); } ```

Running it:

```\$ ./number-sequence-test-perl 1234 1,2,3,4 1,2,34 1,23,4 1,234 12,3,4 12,34 123,4 1234 \$ ./number-sequence-test-perl 91011 9,1,0,1,1 9,1,0,11 9,1,01,1 9,1,011 9,10,1,1 9,10,11 9,101,1 9,1011 91,0,1,1 91,0,11 91,01,1 91,011 910,1,1 910,11 9101,1 91011 \$ ./number-sequence-test-perl 10203 1,0,2,0,3 1,0,2,03 1,0,20,3 1,0,203 1,02,0,3 1,02,03 1,020,3 1,0203 10,2,0,3 10,2,03 10,20,3 10,203 102,0,3 102,03 1020,3 10203 ```

(Note that verbose mode has been removed from this version.)

Then the actual program, also without verbose mode:

File: number-sequence-perl ```#! /usr/bin/env perl use strict; use warnings; use feature 'say'; use feature 'signatures'; no warnings qw(experimental::signatures); my \$verbose = 0; my \$N = shift(@ARGV); die "Specify a positive integer with at least two digits" unless \$N =~ /^[1-9]\d+\$/; my @result; get_val(undef, \$N); sub get_val (\$done, \$todo) { my @done = \$done ? @\$done : (); for my \$size (1 .. length(\$todo)) { my @done2 = @done; my \$val = substr(\$todo, 0, \$size); my \$todo2 = substr(\$todo, \$size); push(@done2, \$val); length(\$todo2) ? get_val(\@done2, \$todo2) : push(@result, \@done2); } } for my \$res (@result) { if (is_consecutive(@\$res)) { say join(",", @\$res); exit; } } say \$N; sub is_consecutive (@list) { my \$first = shift(@list); return 0 if substr(\$first, 0, 1) eq '0'; my \$second; while (@list) { \$second = shift(@list); return 0 if substr(\$second, 0, 1) eq '0'; return 0 unless \$second == \$first + 1; \$first = \$second; } return 1; } ```

Running it:

```\$ ./number-sequence-perl 1234 1,2,3,4 \$ ./number-sequence-perl 91011 9,10,11 \$ ./number-sequence-perl 10203 10203 ```

Looking good.

## Challenge #116.2: Sum of Squares

You are given a number `\$N >= 10`.

Write a script to find out if the given number `\$N` is such that sum of squares of all digits is a perfect square. Print 1 if it is otherwise 0.

Example: ```Input: \$N = 34 Ouput: 1 as 3^2 + 4^2 => 9 + 16 => 25 => 5^2 Input: \$N = 50 Output: 1 as 5^2 + 0^2 => 25 + 0 => 25 => 5^2 Input: \$N = 52 Output: 0 as 5^2 + 2^2 => 25 + 4 => 29 ```

File: sum-of-squares-wrong ```#! /usr/bin/env raku unit sub MAIN (Int \$N where \$N >= 10, :v(:\$verbose)); #  if \$verbose { say ": Digits: { \$N.comb }"; #  say ": Squares: { \$N.comb.map( * ** 2) }"; #  say ": Sum: { \$N.comb.map( * ** 2).sum }"; #  say ": Root: { \$N.comb.map( * ** 2).sum.sqrt }"; #  } say + (\$N.comb.map( * ** 2).sum.sqrt ~~ Int); #  ```

 Ensure a positve integer with at last two digits.

 Get the individual digits.

 Raise each digit to the power of two (with the exponentiation operator `**`).

 Get the sum of all the values.

 Get the sqare root of the sum.

 Use smart matching (`~~ Int`) to see if the result is an integer. Raku uses the Boolean values `True` and `False`, so we must coerce the result to a number. The prefix `+` operator does that for us. (It relies on the fact that the Boolean values are represented as «0» and «1» under the hood, and in numeric context. (Try `True + True` and see what you get.))

I have chosen to recalculate the intermediary values (in the verbose lines [2-5]), so that the final line  is a one liner.

See docs.raku.org/routine/** for more information about the exponentiation operator `**`.

See docs.raku.org/routine/+ for more information about the Numeric context operator `+`.

Running it:

```\$ ./sum-of-squares-wrong 34 0 \$ ./sum-of-squares-wrong -v 34 : Digits: 3 4 : Squares: 9 16 : Sum: 25 : Root: 5 0 ```

Oops!

The number «5» looks very much like an integer. But it is not:

```> say 25.sqrt; # -> 5 > say 25.sqrt.WHAT; # -> (Num) ``` ```> say 25.sqrt ~~ Int; # -> False > say 5 ~~ Int; # -> True > say 25.sqrt ~~ Num; # -> True > say 5 ~~ Num; # -> False ```

Using an explicit regex works:

```> say so 25.sqrt ~~ /^\d+\$/; # -> True > say so 24.sqrt ~~ /^\d+\$/; # -> False ```

Note that assigning the value to e.g. `\$result`, and doing something like `say so \$result == \$result.Int` is a neater solution. But that requires a variable, and that does not fit in a one liner.

File: sum-of-squares ```#! /usr/bin/env raku unit sub MAIN (Int \$N where \$N >= 10, :v(:\$verbose)); if \$verbose { say ": Digits: { \$N.comb }"; say ": Squares: { \$N.comb.map( * ** 2) }"; say ": Sum: { \$N.comb.map( * ** 2).sum }"; say ": Root: { \$N.comb.map( * ** 2).sum.sqrt }"; } say + so (\$N.comb.map( * ** 2).sum.sqrt ~~ /^\d+\$/); ```

Running it:

```\$ ./sum-of-squares 34 1 \$ ./sum-of-squares 50 1 \$ ./sum-of-squares 52 0 \$ ./sum-of-squares -v 34 : Digits: 3 4 : Squares: 9 16 : Sum: 25 : Root: 5 1 \$ ./sum-of-squares -v 50 : Digits: 5 0 : Squares: 25 0 : Sum: 25 : Root: 5 1 \$ ./sum-of-squares -v 52 : Digits: 5 2 : Squares: 25 4 : Sum: 29 : Root: 5.385164807134504 0 ```

Removing the verbosity shows how compact the program really is:

File: sum-of-squares-compact ```#! /usr/bin/env raku unit sub MAIN (Int \$N where \$N >= 10); say + so (\$N.comb.map( * ** 2).sum.sqrt ~~ /^\d+\$/); ```

### Perl

This is a straight forward(ish) translation of the Raku version.

File: sum-of-squares-perl ```#! /usr/bin/env perl use strict; use warnings; use feature 'say'; use Getopt::Long; use List::Util qw(sum); my \$verbose = 0; GetOptions("verbose" => \\$verbose); my \$N = shift(@ARGV); die "Specify a positive integer with at least two digits" unless \$N =~ /^[1-9]\d+\$/; my @N = split(//, \$N); my @squares = map { \$_ ** 2 } @N; my \$sum = sum(@squares); my \$root = sqrt(\$sum); if (\$verbose) { say ": Squares: @squares"; say ": Sum: \$sum"; say ": Root: \$root"; } say int(\$root) == \$root ? 1 : 0; ```

I have chosen to use variables for each step this time, so the program is longer.

Running it gives the same result as the Raku version:

```\$ ./sum-of-squares-perl 34 1 \$ ./sum-of-squares-perl 50 1 \$ ./sum-of-squares-perl 52 0 ```

As does verbose mode:

```\$ ./sum-of-squares-perl -v 34 : Squares: 9 16 : Sum: 25 : Root: 5 1 \$ ./sum-of-squares-perl -v 50 : Squares: 25 0 : Sum: 25 : Root: 5 1 \$ ./sum-of-squares-perl -v 52 : Squares: 25 4 : Sum: 29 : Root: 5.3851648071345 0 ```

And that's it.