laurent_r

These are some answers to the Week 149 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 30, 2022 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 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]

Fibonacci Digit Sum in Raku

We first populate a Set (for fast look-up) with the Fibonacci numbers up to 1000. Note that we could choose a much smaller maximum value, but it doesn’t cost much and it will work with very large sequences.

To generate the Fibonacci numbers, we use the sequence operator, in which we provide the first two numbers of the Fibonacci sequence and a formula (* + *) to compute a Fibonacci number from the two previous ones. The last part of the code line is the stopping condition. This idiomatic construction makes the code very concise and fast. This is an example in a Raku one-liner:

$ raku -e 'say 0, 1, * + * ...^  * > 100'
(0 1 1 2 3 5 8 13 21 34 55 89)

Then, we use the gather / take construct to loop over successive integers and store those satisfying the criteria, and we stop when we reach the limit.

sub MAIN (Int $max = 20) {       # 20: default input value
    my $fibo = set(0, 1, * + * ...^  * > 1000);
    my $count = 0;
    my @numbers = gather {
        for 0 .. Inf -> $num {
            if $num.comb.sum (elem) $fibo {
                take $num;
                $count++;
                last if $count >= $max;
            }
        }
    }
    say @numbers;
}

This script displays the following output:

$ raku ./fib_digit_sum.raku
[0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44]

$ raku ./fib_digit_sum.raku 25
[0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44 49 50 53 58 62]

Fibonacci Digit Sum in Perl

The Perl solution follows essentially the same ideas as the Raku implementation, except that we use a plain while loop (instead of a sequence) to generate the Fibonacci numbers and we store them in a hash instead of a set for fast look-up.

use strict;
use warnings;
use feature "say";

sub fib_digit_sum {
    my $max = shift;
    my @fib = (0, 1);
    my $count = 1;
    while ($count < 100) {
        push @fib, $fib[-1] + $fib[-2];
        $count ++;
    }
    my %fibo = map { $_ => 1 } @fib;
    my @numbers;
    my $count_result = 0;
    my $i = 0;
    while ($count_result < $max) {
        my $sum = 0;
        $sum += $_ for split //, $i;
        if (exists $fibo{$sum}) {
            push @numbers, $i;
            $count_result++;
        }
        $i++
    }           
     say "@numbers";
}

fib_digit_sum(shift);

This program displays the following output:

$ perl ./fib_digit_sum.pl 20
0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44

$ perl ./fib_digit_sum.pl 50
0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44 49 50 53 58 62 67 71 76 80 85 94 100 101 102 104 107 110 111 113 116 120 122 125 131 134 139 140 143 148 152

Task 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"

Note that any program that I can think of for solving this task is bound to become very slow for large bases (especially some of them such as 13 in the case of the programs below).

Largest Square in Raku

We start with the largest number that can be expressed in $base digits in the given $base. We compute largest_root, the integer part of the root of that number. Then we iterate down one by one from largest_root and check whether the square of each such number has no duplicate digit when expressed in the input base.

sub largest ($base) {
    my $largest_num = $base ** $base - 1;
    my $largest_root = $largest_num.sqrt.Int;
    for (1..$largest_root).reverse -> $i {
        my $sq = $i².base($base);
        next if $sq.chars != $sq.comb.Set;
        say "f($base) = $sq" and last;
    }
}
for 1..14 -> $test { largest $test }

This program displays the following output:

$ raku ./largest_sq.raku
f(2) = 1
f(3) = 1
f(4) = 3201
f(5) = 4301
f(6) = 452013
f(7) = 6250341
f(8) = 47302651
f(9) = 823146570
f(10) = 9814072356
f(11) = A8701245369
f(12) = B8750A649321
f(13) = CBA504216873
f(14) = DC71B30685A924

Largest Square in Perl

This is essentially the same idea in Perl. We use two helper subroutines: has_unique_digits to discard squares having duplicate digits (using a hash), and base_to_b to convert a number into a string representing that number in the given base.

use strict;
use warnings;
use feature "say";

sub base_to_b {
    my ($n, $b) = @_;
    my $s = "";
    while ($n) {
        $s .= ('0'..'9','A'..'Z')[$n % $b];
        $n = int($n / $b);
    }
    scalar(reverse($s));
}

sub has_unique_digits {
    my $in = shift; 
    my %seen = map { $_ => 1 } split //,  $in;
    return length $in == scalar keys %seen;
}

sub largest {
    my $base = shift;
    my $largest_num = $base ** $base - 1;
    my $largest_root = int sqrt $largest_num;
    for my $i ( reverse 1..$largest_root) {
        my $sq = base_to_b ($i*$i, $base);
        next unless has_unique_digits $sq;
        say "f($base) = $sq" and last;
    }
}

largest $_ for 1..14;

This script displays the following output:

$ perl ./largest_sq.pl
f(2) = 1
f(3) = 1
f(4) = 3201
f(5) = 4301
f(6) = 452013
f(7) = 6250341
f(8) = 47302651
f(9) = 823146570
f(10) = 9814072356
f(11) = A8701245369
f(12) = B8750A649321
f(13) = CBA504216873
f(14) = DC71B30685A924

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on February 6, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.