# 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  #
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  #
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  #
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  #
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