The weekly challenge 246 - Task 2: Linear Recurrence of Second Order

  1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-246/#TASK2
  3 #
  4 # Task 2: Linear Recurrence of Second Order
  5 # =========================================
  6 #
  7 # You are given an array @a of five integers.
  8 #
  9 # Write a script to decide whether the given integers form a linear recurrence
 10 # of second order with integer factors.
 11 #
 12 # A linear recurrence of second order has the form
 13 #
 14 #  a[n] = p * a[n-2] + q * a[n-1] with n > 1
 15 #
 16 # where p and q must be integers.
 17 #
 18 #
 19 ## Example 1
 20 ##
 21 ## Input: @a = (1, 1, 2, 3, 5)
 22 ## Output: true
 23 ##
 24 ## @a is the initial part of the Fibonacci sequence a[n] = a[n-2] + a[n-1]
 25 ## with a[0] = 1 and a[1] = 1.
 26 #
 27 ## Example 2
 28 ##
 29 ## Input: @a = (4, 2, 4, 5, 7)
 30 ## Output: false
 31 ##
 32 ## a[1] and a[2] are even. Any linear combination of two even numbers with
 33 ## integer factors is even, too.
 34 ## Because a[3] is odd, the given numbers cannot form a linear recurrence of
 35 ## second order with integer factors.
 36 #
 37 ## Example 3
 38 ##
 39 ## Input: @a = (4, 1, 2, -3, 8)
 40 ## Output: true
 41 ##
 42 ## a[n] = a[n-2] - 2 * a[n-1]
 43 #
 44 ############################################################
 45 ##
 46 ## discussion
 47 ##
 48 ############################################################
 49 #
 50 # We need a solution that allows for
 51 # p * a[0] + q * a[1] = a[2]
 52 # p * a[1] + q * a[2] = a[3]
 53 # p * a[2] + q * a[3] = a[4]
 54 #
 55 # A linear combination of a number a in term of two other numbers b and c
 56 # is possible if gcd(b,c) divides a; however there might be multiple
 57 # such combinations possible so it is not possible from one triplet of
 58 # numbers to determine which (if any) linear recurrence works for all
 59 # 5 numbers. For example (4,2,4): 1*4+0*2=4, 0*4+2*2=4, 2*4-2*2=4,
 60 # 3*4-4*2=4, -1*4+8*2=4, ...
 61 # The gcd method however allows to check whether there is any potential
 62 # solution at all, so let's start with that. Since the gcd of two numbers
 63 # can slso be combined linearly out of the two numbers I can only assume
 64 # the task was meant to use that, however in the general case we might have
 65 # to check any of the (potentially infinitely many) linear combinations for
 66 # whether or not their factors are suitable for the whole chain of numbers,
 67 # and it doesn't even hold true for the first example.
 68 # So we can try to find a few linear combinations from the first triplet,
 69 # and if any of those works for all numbers we're good.
 70 # As a heuristic for the range of p and q we use +/- |a|+|b| and try more or
 71 # less all combinations of these; since we have multiple numbers we just
 72 # take the maximum of those numbers * 2 instead.
 73 #
 74 use strict;
 75 use warnings;
 76 
 77 linear_recurrence_of_second_order(1, 1, 2, 3, 5);
 78 linear_recurrence_of_second_order(4, 2, 4, 5, 7);
 79 linear_recurrence_of_second_order(4, 1, 2, -3, 8);
 80 
 81 sub linear_recurrence_of_second_order {
 82    my @a = @_;
 83    my ($i, $j, $k,$l, $m) = @a;
 84 
 85    if($k % gcd($i, $j)) {
 86       return false();
 87    }
 88    if($l % gcd($j, $k)) {
 89       return false();
 90    }
 91    if($m % gcd($k, $l)) {
 92       return false();
 93    }
 94 
 95    my $limit = 2 * absmax(@a);
 96    foreach my $p ( -$limit..$limit ) {
 97       foreach my $q ( -$limit..$limit ) {
 98          if($p * $i + $q * $j == $k) {
 99             if($p * $j + $q * $k == $l) {
100                if($p * $k + $q * $l == $m) {
101                   return true();
102                }
103             }
104          }
105       }
106    }
107    return false();
108 
109 }
110 
111 sub absmax {
112    my @list = @_;
113    my $max = abs($list[0]);
114    foreach my $elem (@list) {
115       $max = abs($elem) if abs($elem) > $max;
116    }
117    return $max;
118 }
119 
120 sub true {
121    print "Output: true\n";
122    return 1;
123 }
124 
125 sub false {
126    print "Output: false\n";
127    return 0;
128 }
129 
130 sub gcd {
131    my ($x, $y) = @_;
132    if($x < 0) {
133       return gcd(-$x, $y);
134    }
135    if($y < 0) {
136       return gcd($x, -$y);
137    }
138    if($x < $y) {
139       return gcd($y, $x);
140    }
141    my $z = $x % $y;
142    if($z) {
143       return gcd($y, $z);
144    } else {
145       return $y;
146    }
147 }