laurent_r

These are some answers to the Week 136 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 October 31, 2021 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: Two Friendly

You are given 2 positive numbers, $m and $n.

Write a script to find out if the given two numbers are Two Friendly.

Two positive numbers, m and n are two friendly when gcd(m, n) = 2 ^ p where p > 0. The greatest common divisor (gcd) of a set of numbers is the largest positive number that divides all the numbers in the set without remainder.

Example 1:

Input: $m = 8, $n = 24
Output: 1

Reason: gcd(8,24) = 8 => 2 ^ 3

Example 2:

Input: $m = 26, $n = 39
Output: 0

Reason: gcd(26,39) = 13

Example 3:

Input: $m = 4, $n = 10
Output: 1

Reason: gcd(4,10) = 2 => 2 ^ 1

In other words, the greatest common divisor of two friendly numbers needs to be a power of two. Or, there must be a power of two for which, when both integers are divided by this power of two, the results are co-primes.

Two Friendly Numbers in Raku

Raku has a built-in gcd infix operator. So we just need to compute the GCD if the two input integers. If the GCD is 1 (numbers are co-primes) or less (one of the input integers was 0), then we return 0, as the integers are not two friendly numbers. (Note that it may be argued that 1 is a power of 2, i.e. 2 ^ 0, but I considered this to be a degenerate case, and that co-primes are not two-friendly; anyway, the task description is clear on the subject and specifies that “gcd(m, n) = 2 ^ p where p > 0”). Otherwise, we divide the GCD by two as long as the result is even. When we can no longer divide by two, the two input integers were two friendly numbers if the result of the final division is 1 (as the GCD was a power of two).

use v6;

sub is-friendly (Int $i, Int $j) {
    my $gcd = $i gcd $j;
    return 0 if $gcd <= 1;
    $gcd /= 2 while $gcd %% 2;
    return $gcd == 1 ?? 1 !! 0;
}
for 8, 24, 26, 39, 4, 10, 7, 5, 18, 0 {
    say "$^a, $^b => ", is-friendly $^a, $^b;
}

Note that Raku can take two numbers at a time from the input list in the for loop at the bottom, because the loop uses two parameters, which is quite convenient. In this case, we used placeholder variables aka self-declared positional parameters ($^a and $^b), but it would also work just as well with formal declared loop parameters, such as:

for 8, 24, 26, 39, 4, 10, 7, 5, 18, 0 -> $a, $b {
    say "$a, $b => ", is-friendly $a, $b;
}

This program yields the following results for the built-in input test integers:

$ raku ./friendly.raku
8, 24 => 1
26, 39 => 0
4, 10 => 1
7, 5 => 0
18, 0 => 0

Two Friendly Numbers in Perl

Just like in Raku, we divide the GCD by two as long as the result is even. When we can no longer divide by two, the two input integers were two friendly numbers is the result of the final division is 1. The main difference with Raku, though, is that Perl doesn’t have a built-in GCD function or operator. So we implement the gcd subroutine for that purpose, implementing a well-known method derived from the famous Euclidean algorithm.

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

sub gcd {
    my ($i, $j) = @_;
    return 0 if $i < 1 or $j < 1;
    while ($j) {
        ($i, $j) = ($j, $i % $j);
    }
    return $i;
}
sub is_friendly {
    my $gcd = gcd $_[0], $_[1];
    return 0 if $gcd <= 1;
    $gcd /= 2 while $gcd % 2 == 0;
    return $gcd == 1 ? 1 : 0;
}
for my $pair ([8, 24], [26, 39], [4, 10], [7, 5], [18, 0]) {
    say "@$pair => ", is_friendly @$pair;
}

This program displays the following output:

$ perl ./friendly.pl
8 24 => 1
26 39 => 0
4 10 => 1
7 5 => 0
18 0 => 0

Task 2: Fibonacci Sequence

You are given a positive number $n.

Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number.

Fibonacci Numbers: 1,2,3,5,8,13,21,34,55,89, …

Example 1:

Input:  $n = 16
Output: 4

Reason: There are 4 possible sequences that can be created using Fibonacci numbers
i.e. (3 + 13), (1 + 2 + 13), (3 + 5 + 8) and (1 + 2 + 5 + 8).

Example 2:

Input:  $n = 9
Output: 2

Reason: There are 2 possible sequences that can be created using Fibonacci numbers
i.e. (1 + 3 + 5) and (1 + 8).

Example 3:

Input:  $n = 15
Output: 2

Reason: There are 2 possible sequences that can be created using Fibonacci numbers
i.e. (2 + 5 + 8) and (2 + 13).

Fibonacci Sequence in Raku

I do not see any way to solve this problem other than listing all possible sequences of Fibonacci numbers less than or equal to the target number and counting those sequence whose sum is equal to the target number. We first initialize a list (a global variable) of the first 16 Fibonacci numbers using the sequence ... operator. The reason for doing this is that we don’t want to recompute the Fibonacci numbers for every input test integer. Of course, we would have to change this for input integers larger than 1597, but that’s good enough for our testing purpose.

Then, the fib-seq subroutine uses the built-in combinations method to generate all sequences of Fibonacci numbers and uses the builin grep and sum functions to keep the sequences whose sum is equal to the target input integer. And it returns the number of sequences matching this criterion.

Note that, although the task specification did not request that, I’ve decided to print out the matching sequences as this makes it much easier to check the result.

use v6;

my @fib = 1, 2, * + * ... * > 1000; # 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597

sub fib-seq (UInt $n) {
    my $count = 0;
    ++$count and .say for grep { $_.sum == $n }, @fib.grep({$_ <= $n }).combinations;
    return $count;
}
for 16, 9, 15, 89, 100 {
    say "Number of sequences for $_: ", fib-seq($_), "\n";
}

This programs prints out the following output:

$ raku ./main.raku
(3 13)
(1 2 13)
(3 5 8)
(1 2 5 8)
Number of sequences for 16: 4

(1 8)
(1 3 5)
Number of sequences for 9: 2

(2 13)
(2 5 8)
Number of sequences for 15: 2

(89)
(34 55)
(13 21 55)
(5 8 21 55)
(2 3 8 21 55)
Number of sequences for 89: 5

(3 8 89)
(1 2 8 89)
(3 8 34 55)
(1 2 3 5 89)
(1 2 8 34 55)
(3 8 13 21 55)
(1 2 3 5 34 55)
(1 2 8 13 21 55)
(1 2 3 5 13 21 55)
Number of sequences for 100: 9

Fibonacci Sequence in Perl

The Perl implementation is very similar to the Raku implementation, except that we need to code our own sum and combine subroutines to replace the equivalent Raku built-in methods.

Note that, as in Raku and although the task specification did not request that, I’ve decided to print out the matching sequences as this makes it much easier to check the result. Just comment out the penultimate code line of the fib_seq subroutine to avoid printing the sequences.

use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @comb;
my @fib = qw /1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597/;

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub combine {
    my $target = shift;
    my $count = shift;
    my @out = @{$_[0]};
    my @in  = @{$_[1]};
    return if sum @out > $target;
    push @comb, [@out] and return if sum(@out) == $target;
    return if $count == 0;
    for my $i (0..$#in) {
        combine ($target, $count - 1, [@out, $in[$i]], [@in[$i+1..$#in]]);
    }
}


sub fib_seq {
    my $n = shift;
    my @short_fib = grep { $_ <= $n } @fib;
    my $count =  scalar @short_fib;
    @comb = ();
    combine $n, $count, [], [@short_fib];
    say "@$_" for @comb;
    return scalar @comb;
}

say "Number of sequences for $_: ", fib_seq $_ for 16, 9, 15, 89, 100;

This program displays the following output:

$ perl ./fib-seq.pl
1 2 5 8
1 2 13
3 5 8
3 13
Number of sequences for 16: 4
1 3 5
1 8
Number of sequences for 9: 2
2 5 8
2 13
Number of sequences for 15: 2
2 3 8 21 55
5 8 21 55
13 21 55
34 55
89
Number of sequences for 89: 5
1 2 3 5 13 21 55
1 2 3 5 34 55
1 2 3 5 89
1 2 8 13 21 55
1 2 8 34 55
1 2 8 89
3 8 13 21 55
3 8 34 55
3 8 89
Number of sequences for 100: 9

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 November 7, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.