This is my response to the Perl Weekly Challenge #149.
$N, generate the first $N numbers for which the
sum of their digits is a Fibonacci number.
f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]
We have dabbled with the Fibonacci numbers in previous challenges; #77: Lonely Sum with Raku and #136: Friendly Fibonacci with Raku and Perl, and I had a go at them in my Centenary Sequences with Raku Part 4 - Primes and Fibonacci article.
The sequence starts with either zero or one, depending on who you ask. In Raku we can define both version succinctly like this:
my $fibonacci0 := (0, 1, * + * ... *); # 0, 1, 1, ...
my $fibonacci1 := (1, 1, * + * ... *); # 1, 1, 2, ...
The first result in the example (in the challenge) is zero, and that is only possible if we use the «Fibonacci starts with zero» definition.
We need a way of deciding a number's Fibonacciness. The number comes in a random order (because of «sum of the digits»), so we should cache them. And not look up (i.e. compute) any more than we actually need.
File: fibonacci-digit-sum
#! /usr/bin/env raku
subset PositiveInt of Int where * >= 1; # [1]
unit sub MAIN (PositiveInt $N = 20, :v(:$verbose)); # [1]
my $fibonacci := (0, 1, * + * ... *); # [2]
my $fds := (0 .. Inf).grep( *.&is-fibonacci-sum ); # [3]
say "f($N)=[", $fds[^$N].join(", "), "]"; # [4]
sub is-fibonacci-sum (Int $number) # [5]
{
state %is-fibonacci; # [6]
state $limit = 0; # [7]
state $index = 0; # [8]
my $sum = $number.comb.sum; # [9]
say ": Considering number $number with sum $sum" if $verbose;
return True if %is-fibonacci{$sum}; # [10]
while $sum >= $limit # [11]
{
$limit = $fibonacci[$index++]; # [12]
say ": Caching Fibonacci number $limit" if $verbose;
%is-fibonacci{$limit} = True; # [13]
}
return %is-fibonacci{$sum}; # [14]
}
[1] Ensure that $N is a posirtive integer.
[2] The Fibonacci sequence.
[3] The sequence of numbers where the sum of the digits is a Fibonacci number. Note the method like alternate calling syntax for the procedure (defined in [5]).
See
docs.raku.org/language/operators#methodop_.& for more information
about the special procedure invocation syntax .&.
[4] Print the requested number of values from the sequence.
[5] Is the sum of the digits of the specified number a Fibonacci number?
[6] We look the number up here. A state variable
is only initialized once, and will keep the value the next time it is is used.
See
docs.raku.org/syntax/state for
more information about the variable declarator state.
[7] The hightest Fibonacci number that we have cached (stored in the hash).
[8] The current index in the sequence (giving the highest number that we have cached).
[9] Get the sum of the digits.
[10] Is the sum a Fibonacci number that we have in our cache? If so, we are done.
[11] If not, check if the sum is higher or equal to the highest Fibonacci numer in our cache. (The «or equal» part does lead to duplicate computation, as shown below for the value «1», but if we drop it we will loose «0» as a result. This does show that the algorithm woul benefit from further optimization. Feel free to hav a go at it.
[12] As long as it is, get the next Fibonacci number, set the higest value,
[13] and cache the value.
[14] The number is now in the cache, if it is Fibonacci number. So we can look it up.
Running it:
$ ./fibonacci-digit-sum
f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]
Spot on.
With verbose mode:
$ ./fibonacci-digit-sum -v
: Considering number 0 with sum 0
: Caching Fibonacci number 0
: Caching Fibonacci number 1
: Considering number 1 with sum 1
: Considering number 2 with sum 2
: Caching Fibonacci number 1
: Caching Fibonacci number 2
: Caching Fibonacci number 3
: Considering number 3 with sum 3
: Considering number 4 with sum 4
: Caching Fibonacci number 5
: Considering number 5 with sum 5
: Considering number 6 with sum 6
: Caching Fibonacci number 8
: Considering number 7 with sum 7
: Considering number 8 with sum 8
: Considering number 9 with sum 9
: Caching Fibonacci number 13
: Considering number 10 with sum 1
: Considering number 11 with sum 2
: Considering number 12 with sum 3
: Considering number 13 with sum 4
: Considering number 14 with sum 5
: Considering number 15 with sum 6
: Considering number 16 with sum 7
: Considering number 17 with sum 8
: Considering number 18 with sum 9
: Considering number 19 with sum 10
: Considering number 20 with sum 2
: Considering number 21 with sum 3
: Considering number 22 with sum 4
: Considering number 23 with sum 5
: Considering number 24 with sum 6
: Considering number 25 with sum 7
: Considering number 26 with sum 8
: Considering number 27 with sum 9
: Considering number 28 with sum 10
: Considering number 29 with sum 11
: Considering number 30 with sum 3
: Considering number 31 with sum 4
: Considering number 32 with sum 5
: Considering number 33 with sum 6
: Considering number 34 with sum 7
: Considering number 35 with sum 8
: Considering number 36 with sum 9
: Considering number 37 with sum 10
: Considering number 38 with sum 11
: Considering number 39 with sum 12
: Considering number 40 with sum 4
: Considering number 41 with sum 5
: Considering number 42 with sum 6
: Considering number 43 with sum 7
: Considering number 44 with sum 8
f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use feature 'state';
use Getopt::Long;
use List::Util 'sum';
no warnings qw(experimental::signatures);
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $N = shift(@ARGV) // 20;
my $current = 0;
my @values;
while (1)
{
push(@values, $current) if is_fibonacci_sum($current); # [1]
last if @values == $N; # [2]
$current++; # [3]
}
say "f($N)=[" . join(", ", @values) . "]";
sub is_fibonacci_sum ($number)
{
state %is_fibonacci = ( 0 => 1, 1 => 1 ); # [4]
state $limit = 1;
state $fib_1 = 0; # [5]
state $fib_2 = 1; # [5a]
my $sum = sum split(//, $number); # [6]
say ": Considering number $number with sum $sum" if $verbose;
return 1 if $is_fibonacci{$sum};
while ($sum > $limit)
{
my $new = $fib_1 + $fib_2; # [7]
$fib_1 = $fib_2; # [7a]
$fib_2 = $new; # [7b]
$limit = $new; # [7c]
say ": Caching Fibonacci number $limit" if $verbose;
$is_fibonacci{$limit} = 1;
}
return $is_fibonacci{$sum};
}
[1] Add the number to the result list.
[2] We are done when we have enough values.
[3] Increase the counter, redy for the next iteration.
[4] Set up the ahsh with the first two Fibonacci values.
[5] The first and second [5a] Fibonacci values.
[6] Not as elegant as the raku version («.comb.sum»), but it works.
[7] Compute the next Fibonacci value, and update the two values ([7a] and [7b]) and the limit.
Running it gives the same result as the Raku version:
$ ./fibonacci-digit-sum-perl
f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]
With verbose mode, and a lower number of values:
$ ./fibonacci-digit-sum-perl -v 10
: Considering number 0 with sum 0
: Considering number 1 with sum 1
: Considering number 2 with sum 2
: Caching Fibonacci number 1
: Caching Fibonacci number 2
: Considering number 3 with sum 3
: Caching Fibonacci number 3
: Considering number 4 with sum 4
: Caching Fibonacci number 5
: Considering number 5 with sum 5
: Considering number 6 with sum 6
: Caching Fibonacci number 8
: Considering number 7 with sum 7
: Considering number 8 with sum 8
: Considering number 9 with sum 9
: Caching Fibonacci number 13
: Considering number 10 with sum 1
: Considering number 11 with sum 2
: Considering number 12 with sum 3
: Considering number 13 with sum 4
: Considering number 14 with sum 5
f(10)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14]
f(2)="1"
f(4)="3201"
f(10)="9814072356"
f(12)="B8750A649321"
Adding the letters A to Z to the digits give a maximum base value of 36.
A perfect square is a square where all the angles are 90 degrees, and the four sides have the same length.
Setting up the digits (alphanumeric digits) can be done in several ways:
my @digits1 = ( 0 .. $base -1 ).map( { $_ > 9 ?? ('A'.ord + $_ - 10).chr !! $_ } );
my @digits2 = (( 0 .. 9, 'A' .. 'Z' ).flat)[0 .. $base -1];
The first one uses map to swap numeric values of 10 and higher into letters,
using ord and chr to translate between character and codepoint
(and vice versa). The second one is much simpler, but we have to use flat
to avoid a top level array with two elements (an array with the (numeric) digits, and
another one with the letters). Then we just pick as many elements as we need, and leave
the rest.
#! /usr/bin/env raku
subset Base of UInt where 1 < * <= 36; # [1]
unit sub MAIN (Base $base, :v(:$verbose));
my @digits = (( 0 .. 9, 'A' .. 'Z' ).flat)[0 .. $base -1];
for @digits.permutations.reverse -> @permutation # [2]
{
# last if @permutation[0] eq "0";
my $candidate = @permutation.join; # [3]
my $decimal = $candidate.parse-base($base); # [4]
my $sqrt = $decimal.sqrt; # [5]
say ": Checking $candidate (decimal: $decimal root: $sqrt)" if $verbose;
if $sqrt ~~ /^\d+$/ # [7]
{
say $candidate; # [7a]
last; # [7b]
}
}
[1] The UInt type is an unsiged integer.
See
docs.raku.org/type/UInt for
more information about the Uint type.
[2] For all the possible permutations (i.e. sorting order).
Note the reverse so that we get them with the candidate with the highest
value first. Also note that this will evaluate the entire permutation in one go,
instead of keeping it as a lazy structure.
See
docs.raku.org/routine/permutations for more information about permutations.
[3] Get the value (join the array values together to form a strint).
[4] The value is in base $base. Convert it to the
internal (binary) representation with parse-base , so that we can work with
it.
[5] Get the square root.
[6] If the squre root is an integer, we have a perfect square. Report the number [7a] and exit the loop [7b].
Running it:
$ ./largest-square 2
01
$ ./largest-square 3
$ ./largest-square 4
3201
$ ./largest-square 5
$ ./largest-square 6
452013
$ ./largest-square 7
6250341
$ ./largest-square 8
47302651
$ ./largest-square 9
823146570
$ ./largest-square 10
9814072356
$ ./largest-square 11
A8701245369
$ ./largest-square 12
B8750A649321
The higher the base, the slower the program. Bases 2 to 10 are ok, but higher bases are really really slow.
Note that some bases do not give a perfect square. We got the expected result, except the leading zero on the first one. The commented out line was indeed commented out to get the «1» result (albeit as «01»).
Fixing it is easy:
File:./largest-square-ok (changes only)
if $sqrt ~~ /^\d+$/
{
say $candidate.substr(0,1) eq "0" ?? $candidate.substr(1) !! $candidate;
last;
}
Running it:
$ ./largest-square-ok 2
1
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Getopt::Long;
use Algorithm::Combinatorics 'permutations'; # [1]
use Math::Base::Convert; # [2]
no warnings qw(experimental::signatures);
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $base = shift(@ARGV);
die "Illegal base." unless $base =~ /^\d+$/;
die "Illegal base. Use 2..36 only" if $base < 2 or $base > 36;
my @digits = ( 0..9,'A'..'Z' )[0 .. $base -1];
my $converter = new Math::Base::Convert(\@digits, 10);
for my $permutation (reverse permutations(\@digits))
{
my $candidate = join("", @$permutation);
my $decimal = $converter->cnv($candidate);
my $sqrt = sqrt $decimal;
say ": Checking $candidate (decimal: $decimal root: $sqrt)" if $verbose;
if ($sqrt =~ /^\d+$/)
{
substr($candidate, 0,1) eq "0"
? say substr($candidate, 1)
: say $candidate;
last;
}
}
[1] As Perl does not have «permutations» built in.
[2] Instead of «parse-base» in Raku.
Running it gives the same result as the Raku version:
$ ./largest-square-perl 2
1
$ ./largest-square-perl 3
$ ./largest-square-perl 4
3201
$ ./largest-square-perl 5
$ ./largest-square-perl 6
452013
$ ./largest-square-perl 7
6250341
$ ./largest-square-perl 8
A47302651
$ ./largest-square-perl 9
823146570
$ ./largest-square-perl 10
9814072356
Base 2 to 9 are ok, base 10 took 5 seconds, and base 11 and onwards are really really slow. Just as the Raku version, by the way.
And that's it.