Fibonacci Square
with Raku and Perl

by Arne Sommer

Fibonacci Square with Raku and Perl

[167] Published 30. January 2022.

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

Challenge #149.1: Fibonacci Digit Sum

Given an input $N, generate the first $N numbers for which the sum of their digits is a Fibonacci number.

Example:
f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]

Fibonancci Observations

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]

A Perl Version

This is straight forward translation of the Raku version, with the Fibonacci Sequence swapped with two variables (the preceding values) as Perl does not have lazy sequences.

File: fibonacci-digit-sum-perl
#! /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]

Challenge #149.2: Largest Square

Given a number base, derive the largest perfect square with no repeated digits and return it as a string. (For base>10, use ‘A’..‘Z’.)

Example:
 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.

File: largest-square
#! /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

Perl

This is a straight forward translation of the Raku version.

File: largest-square-perl
#! /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.