laurent_r

These are some answers to the Week 246, Task 2, 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 December 10, 2023 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Linear Recurrence of Second Order

You are given an array @a of five integers.

Write a script to decide whether the given integers form a linear recurrence of second order with integer factors.

A linear recurrence of second order has the form

a[n] = p * a[n-2] + q * a[n-1] with n > 1

where p and q must be integers.

Example 1

Input: @a = (1, 1, 2, 3, 5)
Output: true

@a is the initial part of the Fibonacci sequence a[n] = a[n-2] + a[n-1]
with a[0] = 1 and a[1] = 1.

Example 2

Input: @a = (4, 2, 4, 5, 7)
Output: false

a[1] and a[2] are even. Any linear combination of two even numbers with integer factors is even, too.
Because a[3] is odd, the given numbers cannot form a linear recurrence of second order with integer factors.

Example 3

Input: @a = (4, 1, 2, -3, 8)
Output: true

a[n] = a[n-2] - 2 * a[n-1]

Finding whether:

a[n] = p * a[n-2] + q * a[n-1]

isn't very difficult, except that p and q can both take an infinite number of values. We need to limit the range of these two integers. I initially wrote a Raku program in which p and q iterated over hard-coded integers from -5 to +5. It was OK for testing (and it worked for the test cases outlined in the task specification), but I did not find that satisfactory. So, I changed the range for p and q to be the minimum and maximum of the input array. This seems to work in all cases, but I can't prove it. Also, there may be a better solution to use a narrower range. But I do not have the energy to investigate the math aspect of it.

Linear Recurrence of Second Order in Raku

We have three nested loops iterating over the values of p and q as described above and over the input array. Note that, in most cases, the most inner loop short-circuits almost immediately when the values of p and q are found to be not suitable for the input array.

sub linear-rec (@in) {
    my @range = @in.minmax;
    for @range -> $p {
        for @range -> $q {
            for 2..@in.end -> $i {
                last if @in[$i] != 
                    $p * @in[$i-2] + $q * @in[$i-1];
                # say "$p $q $i";
                return ("True:  p = $p, q = $q") 
                    if $i == @in.end;
            }
        }
    }
    return (False);
}

my @tests = <1 1 2 3 5>, <4 2 4 5 7>, <4 1 2 -3 8>;
for @tests -> @test {
    printf "%-12s => ", "@test[]";
    say linear-rec @test;
}

This program displays the following output:

$ raku ./linear-recurrence.raku
1 1 2 3 5    => True:  p = 1, q = 1
4 2 4 5 7    => False
4 1 2 -3 8   => True:  p = 1, q = -2

Linear Recurrence of Second Order in Perl

This is a port to Perl of the above Raku program (see the previous sections for explanations).

use strict;
use warnings;
use feature 'say';

sub linear_rec {
    my @in = @_;
    my ($min, $max) = (sort {$a <=> $b} @in)[0, -1];
    for my $p ($min .. $max) {
        for my $q ($min .. $max) {
            for my $i (2..$#in) {
                last if $in[$i] != 
                    $p * $in[$i-2] + $q * $in[$i-1];
                # say "$p $q $i";
                return ("True:  p = $p, q = $q") 
                    if $i == $#in;
            }
        }
    }
    return "False";
}

my @tests = ([<1 1 2 3 5>], [<4 2 4 5 7>], [<4 1 2 -3 8>]);
for my $test (@tests) {
    printf "%-12s => ", "@$test";
    say linear_rec @$test;
}

This program displays the following output:

$ perl linear-recurrence.pl
1 1 2 3 5    => True:  p = 1, q = 1
4 2 4 5 7    => False
4 1 2 -3 8   => True:  p = 1, q = -2

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