Perl Weekly Challenge 246.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 246.

Task 1: 6 out of 49

Submitted by: Andreas Voegele
6 out of 49 is a German lottery.

Write a script that outputs six unique random integers from the range 1 to 49.

Output
3
10
11
22
38
49

I fill an array with the possible values, generate a random index to the array and use splice to remove that element and output it.

perl -MPOSIX=floor -E '@n=1..49; say splice @n,floor(rand @n), 1 for(1..6);'

Results:

37
30
16
24
38
39

An even shorter alternative is to use the fact that hashes return their keys in a random order (not sure if random enough).

perl -E '%n=map{$_=>1} 1..49; @n=keys %n; say join " ", @n[0..5];'

Results:

7 43 48 28 23 33

The full code is identical.

1  # Perl weekly challenge 246
2  # Task 1:  6 out of 49
3  #
4  # See https://wlmb.github.io/2023/12/03/PWC246/#task-1-6-out-of-49
5  use v5.36;
6  my %n=map{$_=>1} 1..49;
7  my @n=keys %n;
8  say join " ", @n[0..5];

Example:

./ch-1.pl

Results:

23 33 19 9 14 4

Task 2: Linear Recurrence of Second Order

Submitted by: Jorg Sommrey
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]

Assuming there is a linear second order recursion, I may interpret the equations for a[2] and a[3] as a system of two equations in two unknowns p and q:

a[2]=a[0] p + a[1] q
a[3]=a[1] p + a[2] q

The solution is

p=P/R
q=Q/R

where

P=a[2]^2-a[3] a[1]
Q=a[0] a[3]-a[1] a[2]
R=a[0] a[2]-a[1]^2

p and q are integer if D divides P and Q. After obtaining the integer coefficients, I must check that all the remaining terms are consistent. The results fits a 2-liner:

Example 1:

perl -E '
($z,$u,$d,$t)=@a=@ARGV;$P=$d**2-$t*$u;$Q=$z*$t-$u*$d;$R=$z*$d-$u**2;$r=$P%$R==0&&$Q%$R==0;$p=$P/$R;
$q=$Q/$R;$r&&=$a[$_]==$p*$a[$_-2]+$q*$a[$_-1] for (4..@a-1);$r=$r?"True":"False";say "@a => $r"
' 1 1 2 3 5

Results:

1 1 2 3 5 => True

Example 2:

perl -E '
($z,$u,$d,$t)=@a=@ARGV;$P=$d**2-$t*$u;$Q=$z*$t-$u*$d;$R=$z*$d-$u**2;$r=$P%$R==0&&$Q%$R==0;$p=$P/$R;
$q=$Q/$R;$r&&=$a[$_]==$p*$a[$_-2]+$q*$a[$_-1] for (4..@a-1);$r=$r?"True":"False";say "@a => $r"
' 4 2 4 5 7

Results:

4 2 4 5 7 => False

Example 3:

perl -E '
($z,$u,$d,$t)=@a=@ARGV;$P=$d**2-$t*$u;$Q=$z*$t-$u*$d;$R=$z*$d-$u**2;$r=$P%$R==0&&$Q%$R==0;$p=$P/$R;
$q=$Q/$R;$r&&=$a[$_]==$p*$a[$_-2]+$q*$a[$_-1] for (4..@a-1);$r=$r?"True":"False";say "@a => $r"
' 4 1 2 -3 8

Results:

4 1 2 -3 8 => True

(Note: This code is wrong as it fails for singular sequences. See below 2.1, 2.2)

The full code follows.

 1  # Perl weekly challenge 246
 2  # Task 2:  Linear Recurrence of Second Order
 3  #
 4  # See https://wlmb.github.io/2023/12/03/PWC246/#task-2-linear-recurrence-of-second-order
 5  use v5.36;
 6  use List::Util qw(all);
 7  die <<~"FIN" unless @ARGV>=4;
 8      Usage: $0 N0 N1 N2 N3 [N4...]
 9      to check if the sequence of integers Ni obeys a linear second order recurrence with
10      integer coefficients
11      FIN
12  die "Arguments must be integer" unless all {/^[+-]?\d+$/} @ARGV;
13  my @x =@ARGV;
14  my $num_p = $x[2]**2-$x[3]*$x[1];
15  my $num_q = $x[0]*$x[3]-$x[1]*$x[2];
16  my $den = $x[0]*$x[2]-$x[1]**2;
17  my $result = $num_p%$den==0 && $num_q%$den==0; # coefficients are integer
18  my $p=$num_p/$den;
19  my $q=$num_q/$den;
20  $result &&= $x[$_]==$p*$x[$_-2]+$q*$x[$_-1] for (4..@x-1);
21  $result = $result?"True":"False";
22  say "@x => $result"

Examples:

./ch-2.pl 1 1 2 3 5
./ch-2.pl 4 2 4 5 7
./ch-2.pl 4 1 2 -3 8

Results:

1 1 2 3 5 => True
4 2 4 5 7 => False
4 1 2 -3 8 => True

Alternative solution

The solution above fails if the denominator $den is null, i.e., for a singular matrix. For example

./ch-2.pl 1 2 4 8 16

Results:

Illegal modulus zero at ./ch-2.pl line 18.

Singular systems have no solution or infinite solutions. They can be found using singular value decomposition (SVD). To that end, I use svd from PDL. According to theory, any real matrix may be written as M=U D VT, where U and V are unitary, and D is diagonal. The matrix M is as above. If I define x=(p,q)T as the vector I’m looking for, where a[n]=p a[n-1] + q a[n-2], then I have to solve the equation M x = y, where y=(a[2], a[3])T. Using SVD, the solution is x=V D-1 UT y if all the singular values (the diagonal of the matrix D) are positive. If the two singular values are 0, then there is no solution, unless y=(0,0)T, in which case, the solution is x=(0,0)T. If only one singular value is 0, say D[1,1], then there is no solution unless the inner product U1 . y=0, where U1 is column 1 of the matrix U, in which case there are infinite solutions of the form x=(U0 . y)V0 + z V1, where V0 is the zeroeth column of V and z is an arbitrary real number. We still have to check that there is an integer solution. I don’t know how to do that, so I test a few values that yield an integer value of q, and stop if the corresponding p is also an integer. (CY Fung noticed that this kind of singular matrices can only correspond to sequences of the form a[0], k a[0], k2 a[0]… and that my first attempt at a solution had an error).

The code is the following:

 1  # Perl weekly challenge 246
 2  # Task 2:  Linear Recurrence of Second Order
 3  # Second alternative: using SVD
 4  #
 5  # See https://wlmb.github.io/2023/12/03/PWC246/#task-2-linear-recurrence-of-second-order
 6  use v5.36;
 7  use PDL;
 8  use List::Util;
 9  die <<~"FIN" unless @ARGV>=4;
10      Usage: $0 N0 N1 N2 N3 [N4...]
11      to check if the sequence of integers Ni obeys a linear second order recurrence with
12      integer coefficients
13      FIN
14  die "Arguments must be integer" unless List::Util::all {/^[+-]?\d+$/} @ARGV;
15  my ($pq, $uncertain)=is_linear_2(@ARGV);
16  my $result=defined $pq && test_pq($pq, @ARGV);
17  my $certain=$uncertain? "Probably ": "";
18  $result=$certain . $result?"True":"False";
19  say "@ARGV -> $result";
20  
21  sub is_linear_2(@x){
22      my $m=pdl[[$x[0], $x[1]],[$x[1], $x[2]]];
23      my ($U, $D, $V)=svd($m); # singular value decomposition
24      my $result;
25      my $sol;
26      my $rhs=pdl[$x[2], $x[3]];
27      if($D->slice([0,0,0])->approx(0)){ # null matrix
28  	return pdl(0,0) if(($rhs==0)->all);
29  	return;
30      }
31      if($D->slice([1,0,0])->approx(0)){ # singular matrix
32  	return unless $V->slice([1,0,0])->inner($rhs)->approx(0);
33          return pdl(0, $x[1]/$x[0]);
34      }
35      my $d_inv=zeroes(2,2); # not singular
36      $d_inv->diagonal(0,1).=1/$D;
37      $sol=($V x $d_inv x $U->transpose x $rhs->dummy(0))->squeeze;
38      return $sol if $sol->approx($sol->rint)->all; # check integer
39  }
40  
41  sub test_pq($pq, @x){
42      my $x=pdl(@ARGV);
43      my $previous_two=pdl($x->slice([0,-3]),$x->slice([1,-2]))->transpose;
44      return $x->slice([2,-1])->approx($pq->inner($previous_two))->all;
45  }

Examples:

./ch-2b.pl 1 1 2 3 5
./ch-2b.pl 4 2 4 5 7
./ch-2b.pl 4 1 2 -3 8
./ch-2b.pl 1 2 4 8 16
./ch-2b.pl 0 0 0 0 0
./ch-2b.pl 1 1 1 1 1
./ch-2b.pl 1 1 2 2 4 4
./ch-2b.pl 1 3 9 27 81
./ch-2b.pl -1 2 -4 8 -16
./ch-2b.pl -1 2 -4 8 -16
./ch-2b.pl -1 1 -1 1 -1

Results:

1 1 2 3 5 -> True
4 2 4 5 7 -> False
4 1 2 -3 8 -> True
1 2 4 8 16 -> True
0 0 0 0 0 -> True
1 1 1 1 1 -> True
1 1 2 2 4 4 -> True
1 3 9 27 81 -> True
-1 2 -4 8 -16 -> True
-1 2 -4 8 -16 -> True
-1 1 -1 1 -1 -> True

The program works, but after some thought, I guess it is too complex.

A third alternative

After developing the second alternative I realized that using SVD was overkill. There is a very simple variation of my first alternative that covers all cases. I just have to check for singluar inputs.

The code is:

 1  # Perl weekly challenge 246
 2  # Task 2:  Linear Recurrence of Second Order
 3  # Third alternative: going back to integer math
 4  #
 5  # See https://wlmb.github.io/2023/12/03/PWC246/#task-2-linear-recurrence-of-second-order
 6  use v5.36;
 7  use List::Util qw(all);
 8  die <<~"FIN" unless @ARGV>=4;
 9      Usage: $0 N0 N1 N2 N3 [N4...]
10      to check if the sequence of integers Ni obeys a linear second order recurrence with
11      integer coefficients
12      FIN
13  die "Arguments must be integer" unless all {/^[+-]?\d+$/} @ARGV;
14  my @x =@ARGV;
15  my ($p, $q);
16  my $result;
17  if($x[0]==$x[1]==0){
18      ($p,$q)=(0,0);
19      $result=1;
20  }elsif($x[0]*$x[2]==$x[1]**2){
21      # other singular matrix
22      ($p,$q)=(0,$x[1]/$x[0]);
23      $result = $x[1]%$x[0]==0;
24  }else{
25      my $num_p = $x[2]**2-$x[3]*$x[1];
26      my $num_q = $x[0]*$x[3]-$x[1]*$x[2];
27      my $den = $x[0]*$x[2]-$x[1]**2;
28      $result = $num_p%$den==0 && $num_q%$den==0; # coefficients are integer
29      $p=$num_p/$den;
30      $q=$num_q/$den;
31  }
32  $result &&= $x[$_]==$p*$x[$_-2]+$q*$x[$_-1] for (2..@x-1);
33  $result = $result?"True":"False";
34  say "@x => $result"

./ch-2c.pl 1 1 2 3 5
./ch-2c.pl 4 2 4 5 7
./ch-2c.pl 4 1 2 -3 8
./ch-2c.pl 1 2 4 8 16
./ch-2c.pl 0 0 0 0 0
./ch-2c.pl 1 1 1 1 1
./ch-2c.pl 1 1 2 2 4 4
./ch-2c.pl 1 3 9 27 81
./ch-2c.pl -1 2 -4 8 -16
./ch-2c.pl -1 2 -4 8 -16
./ch-2c.pl -1 1 -1 1 -1

Results:

1 1 2 3 5 => True
4 2 4 5 7 => False
4 1 2 -3 8 => True
1 2 4 8 16 => True
0 0 0 0 0 => True
1 1 1 1 1 => True
1 1 2 2 4 4 => True
1 3 9 27 81 => True
-1 2 -4 8 -16 => True
-1 2 -4 8 -16 => True
-1 1 -1 1 -1 => True
Written on December 3, 2023