This is my response to the Perl Weekly Challenge #116.
$N >= 10.
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] [191])
$ ./number-sequence-test 1918
([1 9 1 8] [1 9 18] [1 91 8] [1 918] [19 1 8] [19 18] [191 8] [1918])
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:
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N >= 10, :v(:$verbose)); # [1]
my $seq := gather # [2]
{
get-val( (), $N); # [3]
sub get-val (@done is copy, $todo is copy) # [4]
{
for 1 .. $todo.chars -> $size # [5]
{
my @done2 = @done.clone; # [6]
my $val = $todo.substr(0, $size); # [7]
my $todo2 = $todo.substr($size); # [8]
@done2.push($val); # [9]
say ": Done: @done2[] { $todo2 ?? "Todo: $todo2" !! ""}" if $verbose;
$todo2.chars # [10]
?? get-val(@done2, $todo2) # [10a]
!! take @done2; # [10b]
}
}
}
say $seq;
[1] Ensure a positive integer with at least two digits.
[2] Set it up as a Sequence.
[3] 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).
[4] Note is copy so that we have local copies that we can change without
messing up.
[5] Start with 1 digit at a time, and go on until we get them all in one go.
[6] Get a copy of this one (with clone), as the next iteration
of the loop should have the unchanged version (which we got in [4]).
[7] The digit(s) for this iteration.
[8] Remove the digits we just fetched (in [7]).
[9] Add the digit(s) to the done list.
[10] 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 # [1]
{
if is-consecutive(@list) # [2]
{
say @list.join(","); # [2a]
last; # [2b]
}
}
sub is-consecutive (*@list is copy) # [3]
{
my $first = @list.shift; # [4]
my $second; # [5]
while (@list) # [6]
{
$second = @list.shift; # [7]
return False unless $second == $first + 1; # [8]
$first = $second; # [9]
}
return True; # [10]
}
[1] The sequence (in $seq) is as described in the previous program.
Here we iterate over the values.
[2] I have factored out this decision to a helper procedure. If the numbers are conecutive, print them [2a] and exit [2b].
[3] Note the is copy as we are going to change the array (in [4] and [7]).
[4] Get the first value.
[5] The second value will go here.
[6] As long as there are more values,
[7] • get the next one.
[8] • return False if the two values are not consecutive.
[9] • discard the first value, and move the second one up to first base (ready for the next iteration).
[10] 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
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.
#! /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
#! /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.
$N >= 10.
$N is such that sum of
squares of all digits is a perfect square. Print 1 if it is otherwise 0.
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
I'll start with a program that does not work out:
File: sum-of-squares-wrong
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N >= 10, :v(:$verbose)); # [1]
if $verbose
{
say ": Digits: { $N.comb }"; # [2]
say ": Squares: { $N.comb.map( * ** 2) }"; # [3]
say ": Sum: { $N.comb.map( * ** 2).sum }"; # [4]
say ": Root: { $N.comb.map( * ** 2).sum.sqrt }"; # [5]
}
say + ($N.comb.map( * ** 2).sum.sqrt ~~ Int); # [6]
[1] Ensure a positve integer with at last two digits.
[2] Get the individual digits.
[3] Raise each digit to the power of two (with the exponentiation operator
**).
[4] Get the sum of all the values.
[5] Get the sqare root of the sum.
[6] 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 [6] 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.
#! /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+$/);
#! /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.