## Advent Calendar - December 25, 2023

Monday, Dec 25, 2023| Tags: Perl

### |   Day 24   |   Day 25   |

The gift is presented by `Cheok-Yin Fung`. Today he is talking about his solution to The Weekly Challenge - 246. This is re-produced for `Advent Calendar 2023` from the original post.

## CY’s Take on The Weekly Challenge #246 ‐ Uniqueness

### Task 1: 6 out of 49

Instead of picking out the balls from a box, we can imagine we line up a set of balls labelled `1, 2, 3 ..., 49`, and pick out a ball one by one via randomly selecting the `k-th` ball on the line to be removed.

``````use v5.30.0;
use warnings;

my @ans;
my @arr = (1..49);
for my \$i (0..5) {
my \$k = int(rand(49-\$i));
push @ans, splice(@arr, \$k, 1);
}

say join "\n", sort {\$a<=>\$b} @ans;
``````

### Task 2: Linear Recurrence of Second Order

Let’s have a brief analysis for the task first. It is given 5 integers, and they form some linear recurrence; we have `three linear (Diophantine)` equations to play with.

Because of the requirement of `integral parameter` solution(s), I started with extended Euclidean algorithm and Bézout coefficients. Some theory can be found on Wikipedia or here (Linear Diophantine Equations).

The pros of the approach are `(1)` it identifies `non-integral linear equations` early on; `(2)` instead of `two degeneracies` which may be found in solving the `two coefficients` through the first `two linear equations`, it reduces to `one degeneracy (a[2]*a[0]-a[1]*a[1]` may be `zero`). And by number theoretic arguments, we know `a[2] = k a[1] = k^2 a[0]` in case of the `degeneracy` occurs, then we have `p + qk = k^2. a[3] = p a[1] + q a[2] = p k a[0] + q k^2 a[0] = k^3 a[0]`. Similarly we can deduce `a[4] = k^4 a[0]`.

The code is full of printing of equations which may not be so relevant to the `"solution"` but for verifying `number theoretic algorithms`.

``````# The Weekly Challenge 246
# Task 2 Linear Recurrence of Second Order
# a[n] = p * a[n-2] + q * a[n-1] with n > 1
# where p and q must be integers.
use v5.30.0;
use warnings;

sub ex_euc_alg {
my @r = (\$_[0], \$_[1]);
my @s = (1, 0);
my @t = (0, 1);
my \$i = 0;
while (\$r[-1] != 0) {
my \$q = int(\$r[\$i-1]/\$r[\$i]);
\$r[\$i+1] = \$r[\$i-1] - \$q * \$r[\$i];
while (\$r[\$i+1] > abs(\$r[\$i])) {
\$r[\$i+1] = \$r[\$i+1] - abs(\$r[\$i]);
\$q = \$q + abs(\$r[\$i])/\$r[\$i]
}
while (\$r[\$i+1] < 0) {
\$r[\$i+1] = \$r[\$i+1] + abs(\$r[\$i]);
\$q = \$q - abs(\$r[\$i])/\$r[\$i]
}
\$s[\$i+1] = \$s[\$i-1] - \$q*\$s[\$i];
\$t[\$i+1] = \$t[\$i-1] - \$q*\$t[\$i];
\$i++;
}
my \$a0 = \$_[0];
my \$b0 = \$_[1];
say "\$r[\$i-1] = \$a0*\$s[\$i-1]+\$b0*\$t[\$i-1]";
my (\$d,\$x,\$y) = (\$r[\$i-1], \$s[\$i-1], \$t[\$i-1]);
# for my \$k (-10..10) {
#     my \$x1 = \$x - \$k*\$b0/\$d;
#     my \$y1 = \$y + \$k*\$a0/\$d;
#     say "\$d = \$a0*\$x1+\$b0*\$y1";
# }

return [\$r[\$i-1], \$s[\$i-1], \$t[\$i-1]];
}

sub check {
my @a = @_;

# consective zeros check
if (\$a[0] == 0 && \$a[1] == 0) {
return (\$a[2] == 0 && \$a[3] == 0 && \$a[4] == 0) ? 1 : 0;
}
if (\$a[2] == 0) {
if (\$a[1] == 0) {
return (\$a[3] == 0 && \$a[4] == 0) ? 1 : 0;
}
if (\$a[3] == 0) {
return (\$a[4] == 0) ? 1 : 0;
}
}

my (\$d0, \$d1, \$x0, \$y0, \$u0, \$v0);
my (\$a0, \$b0);
my (\$a1, \$b1);

(\$d0, \$x0, \$y0) = ex_euc_alg(\$a[0], \$a[1])->@*;
(\$a0, \$b0) = (\$a[0], \$a[1]);
return 0 if \$a[2] % \$d0 != 0;
\$x0 = \$x0 *(\$a[2]/\$d0);
\$y0 = \$y0 *(\$a[2]/\$d0);
say "\$a[2] = \$a0*\$x0+\$b0*\$y0";
# for my \$k (-10..10) {
#     my \$x1 = \$x0 + \$b0/\$d0*\$k ;
#     my \$y1 = \$y0 - \$a0/\$d0*\$k;
#     say "\$a[2] = \$a0*\$x1+\$b0*\$y1";
# }

(\$d1, \$u0, \$v0) = ex_euc_alg(\$a[1], \$a[2])->@*;
(\$a1, \$b1) = (\$a[1], \$a[2]);
return 0 if \$a[3] % \$d1 != 0;
\$u0 = \$u0 *(\$a[3]/\$d1);
\$v0 = \$v0 *(\$a[3]/\$d1);
say "\$a[3] = \$a1*\$u0+\$b1*\$v0";
# for my \$j (-10..10) {
#     my \$x1 = \$u0 + \$b1/\$d1*\$j ;
#     my \$y1 = \$v0 - \$a1/\$d1*\$j;
#     say "\$a[3] = \$a1*\$x1+\$b1*\$y1";
# }

# \$x0 + \$b0/\$d0*\$k == \$u0 + \$b1/\$d1*\$j
# \$y0 - \$a0/\$d0*\$k == \$v0 - \$a1/\$d1*\$j

# \$a0\$x0 + \$a0\$b0/\$d0*\$k == \$a0\$u0 + \$a0\$b1/\$d1*\$j
# \$b0\$y0 - \$b0\$a0/\$d0*\$k == \$b0\$v0 - \$b0\$a1/\$d1*\$j

if (\$a[2]*\$a[0] != \$a[1]*\$a[1]) {
my \$j = (\$a0*\$x0 + \$b0*\$y0 - \$a0*\$u0 - \$b0*\$v0)*\$d1/(\$a0*\$b1 - \$b0*\$a1);
my \$x1 = \$u0 + \$b1/\$d1*\$j;
my \$y1 = \$v0 - \$a1/\$d1*\$j;
say "(\$x1, \$y1)";
return 0 if int(\$x1) != \$x1 || int(\$y1) != \$y1;
return (\$a[4] == \$a[2]*\$x1+\$a[3]*\$y1) ? 1 : 0;
}
else {
return ( \$a[1]*\$a[2] == \$a[3]*\$a[0]
&&
\$a[1]*\$a[3] == \$a[4]*\$a[0]) ? 1 : 0;
# Explanation:
# if a[2] = a[1]*a[1]/\$a[0],
# z d0 = x^2/y d0
# since d0 = gcd(x d0, y d0), x, y coprime
# then y must be 1, i.e. x a[0] = a[1]
# and a[2] = x^2 d0 = x a[1]
# i.e. x a[1] = a[2]
}
}
``````

## Test Cases

``````use Test::More tests=>11;
ok check(1, 1, 2, 3, 5);
ok !check(4, 2, 4, 5, 7);
ok check(4, 1, 2, -3, 8);

ok check(3, 9, 27, 81, 243);
ok check(3, 5, 27, 45, 243);
ok check(1, 1, 0, 0, 0);

ok check(0, 0, 0, 0, 0);
ok check(1, 0, 0, 0, 0);
ok check(0, 3, 0, 0, 0);

ok !check(0, 0, 3, 0, 0);
ok check(2, 4, 8, 16, 32);
``````

Hope for Peace!

#### Acknowledgement: Thanks to discussion of the `PA&A Discord Channel` (maintained by `Adam Crussell`).

If you have any suggestion then please do share with us perlweeklychallenge@yahoo.com.

## SO WHAT DO YOU THINK ?

If you have any suggestions or ideas then please do share with us.