Merge pull request #9210 from jo-37/contrib

Solutions to challenge 246

4 files changed, 296 insertions, 0 deletions

diff --git a/challenge-246/jo-37/blog.txt b/challenge-246/jo-37/blog.txt
new file mode 100644
index 0000000000..dddbeb8879
--- /dev/null
+++ b/challenge-246/jo-37/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-246/jo-37/blog/Blog.md
diff --git a/challenge-246/jo-37/blog/Blog.md b/challenge-246/jo-37/blog/Blog.md
new file mode 100644
index 0000000000..649afc8ede
--- /dev/null
+++ b/challenge-246/jo-37/blog/Blog.md
@@ -0,0 +1,174 @@
+# Recurring Lotteries
+
+## 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
+```
+---
+### Solution
+There is a trivial solution to this task using `List::MoreUtils::sample`:
+```
+sample 6, 1 .. 49;
+```
+Emulating a "lottery device" instead.
+There is a pool of initially 49 numbered balls.
+In every turn, one ball is selected randomly and removed from the pool.
+
+The task description suggests the numbers being sorted in ascending order.
+```
+sub sixoutoffortynine {
+	my @pool = (1..49);
+    my @winning;
+    push @winning, splice @pool, rand @pool, 1 for 1 .. 6;
+    sort {$a <=> $b} @winning;
+}
+```
+## Task 2: Linear Recurrence of Second Order
+**Submitted by: Jörg 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]
+```
+---
+### Solution
+In the following an asterisk `*` denotes matrix multiplication as well as vector or scalar multiplication depending on the type of its operands.
+
+From the formula
+```
+a[n] = p[0] * a[n-2] + p[1] * a[n-1]
+```
+and an initial sequence `a[0],...,a[3]` we need to derive the 'hidden' parameters `p[0]` and `p[1]`:
+```
+a[2] = a[0] * p[0] + a[1] * p[1]
+a[3] = a[1] * p[0] + a[2] * p[1]
+```
+Using vectors and a matrix
+```
+a23 = (a[2])
+      (a[3])
+p = (p[0])
+    (p[1])
+M = (a[0], a[1])
+    (a[1], a[2])
+```
+we may write:
+```
+a23 = M * p
+```
+#### Regular case
+Suppose `M` is regular, i.e. `det(M) = a[0] * a[2] - a[1]^2 != 0`
+
+Then `M` has an inverse matrix and we find:
+```
+p = inv(M) * a23
+```
+We need to check if:
+
+  * all elements of `p` are integer and
+  * the fifth element `a[4]` fits into the sequence.
+
+The latter is the case if
+```
+a[4] = pT * a23
+```
+#### Degenerated case
+Next we need to consider the degenerated case where `det(M) = 0`, i.e.
+```
+a[0] * a[2] = a[1]^2
+```
+Here the middle element `a[1]` is the geometric mean of its neighbors.
+This is the characteristic property of a geometric sequence, which may be regarded as a linear recurrence of order 1:
+```
+a[n] = p[1] * a[n-1]
+```
+Suppose `a[1] != 0`.
+Then we have `p[1] = a[2] / a[1]`.
+The initial element `a[0]` becomes irrelevant and we need to check if
+
+  * `p[1]` is integer and
+  * the fourth and fifth elements `a[3]` and `a[4]` fit into the found geometric sequence.
+
+#### Doubly degenerated case
+Finally we have the case where the determinant of `M` is zero and `a[1] = 0`.  
+From `a[0] * a[2] = a[1]^2` it follows, that `a[0]` or `a[2]` must be zero, too.
+This means there are two neighboring zeroes in the sequence and thus we need to check if:
+
+  * `a[2]`, `a[3]` and `a[4]` are all zero.
+### Implementation
+Using `PDL` it is not too complicated to implement the above steps. Furthermore they may
+be extended to more than five numbers with little effort.
+Some attention must be payed to comparing floating point numbers, though.
+Therefore using `PDL`'s relaxed `approx` instead of `==`.
+```
+  1 use PDL;
+  2 use PDL::NiceSlice;
+  3 sub is_lin_recur_2 {
+  4     my $a = pdl @_;
+  5     my $m = cat $a(0:1), $a(1:2);
+  6     if ($m->determinant) {
+  7         my $p = $m->inv x $a(2:3)->transpose;
+  8         return all(approx $p, $p->rint) &&
+  9            all approx $a(4:), $p->transpose x cat $a(2:-3), $a(3:-2);
+ 10     }
+ 11     if ($a(1)) {
+ 12         my $p1 = $a(2) / $a(1);
+ 13         return approx($p1, $p1->rint) && all approx $a(3:), $p1 * $a(2:-2);
+ 14     }
+ 15     return all $a(2:) == 0;
+ 16 }
+```
+line 4: Create a `double` ndarray from the given numbers.  
+line 5: Create the matrix `M` as the concatenation of two ndarray slices.  
+line 6: The determinant of a matrix must be nonzero to be invertible.   
+line 7: Multiply the inverse of `M` with the column vector `(a[2],  a[3])T` to find the parameters `p`.  
+line 8: Check if `p` is integer.  
+line 9: Check if the fifth to last element follow the recurrence defined by the initial four elements. For this purpose build a (L-4)x2 ndarray holding successive pairs from the given numbers starting with `(a[2], a[3])`, transform these with the recurrence relation and compare the result with the numbers themselves starting with `a[4]`.  
+line 11: Here we have `a[0] * a[2] = a[1]^2`. We may divide by `a[1]` if it is not zero.  
+line 12: `p1` is the factor in the geometric sequence.  
+line 13: Check if `p1` is integer and if the fourth to last element follow the recurrence defined by the first three elements.  
+line 15: Here the determinant is zero and `a[1]` is zero, too. Check if the third to last elements are all zero.  
\ No newline at end of file
diff --git a/challenge-246/jo-37/perl/ch-1.pl b/challenge-246/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..ba06467be3
--- /dev/null
+++ b/challenge-246/jo-37/perl/ch-1.pl
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+
+use v5.11;
+use warnings;
+
+
+### Input and Output
+
+srand time;
+say for sixoutoffortynine();
+
+
+### Implementation
+
+sub sixoutoffortynine {
+	my @pool = (1..49);
+    my @winning;
+    push @winning, splice @pool, rand @pool, 1 for 1 .. 6;
+    sort {$a <=> $b} @winning;
+}
diff --git a/challenge-246/jo-37/perl/ch-2.pl b/challenge-246/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..bdb35e6014
--- /dev/null
+++ b/challenge-246/jo-37/perl/ch-2.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/perl -s
+
+use v5.10;
+use Test2::V0 '!float';
+use PDL;
+use PDL::NiceSlice;
+
+our ($tests, $examples, $verbose);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV > 4;
+usage: $0 [-examples] [-tests] [-verbose] [--] [N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-verbose
+    print intermediate results and the detected recurrence from the
+    first elements
+
+N...
+    five or more integers
+
+EOS
+
+
+### Input and Output
+
+say is_lin_recur_2(@ARGV) ? 'true' : 'false';
+
+
+### Implementation
+
+sub logv {
+    printf @_ if $verbose;
+}
+
+sub is_lin_recur_2 {
+    my $a = pdl @_;
+    logv "a: %s\n", $a;
+    my $m = cat $a(0:1), $a(1:2);
+    logv "M: %s\n", $m;
+    if ($m->determinant) {
+        my $p = $m->inv x $a(2:3)->transpose;
+        logv "p: %s\n", $p;
+        logv "recur: a[n] = %g * a[n-2] + (%g * a[n-1])\n", $p->list;
+        return all(approx $p, $p->rint) &&
+            all approx $a(4:), $p->transpose x cat $a(2:-3), $a(3:-2);
+    }
+    if ($a(1)) {
+        my $p1 = $a(2) / $a(1);
+        logv "recur: a[n] = %g * a[n-1]\n", $p1->sclr;
+        return approx($p1, $p1->rint) && all approx $a(3:), $p1 * $a(2:-2);
+    }
+
+    logv "recur: a[n] = 0\n";
+    return all $a(2:) == 0;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        ok  is_lin_recur_2(1, 1, 2, 3, 5),  'example 1';
+        ok !is_lin_recur_2(4, 2, 4, 5, 7),  'example 2';
+        ok  is_lin_recur_2(4, 1, 2, -3, 8), 'example 3';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        ok  is_lin_recur_2(1, 0, 0, 0, 0),     'order 0';
+        ok !is_lin_recur_2(1, 0, 0, 1, 0),     'failed order 0, @ 3';
+        ok !is_lin_recur_2(1, 0, 0, 0, 1),     'failed order 0, @ 4';
+        ok !is_lin_recur_2(0, 0, 1, 0, 0),     'failed order 0, @ 2';
+        ok  is_lin_recur_2(1, 2, 4, 8, 16),    'order 1';
+        ok !is_lin_recur_2(1, 2, 4, 9, 16),    'failed order 1, @ 3';
+        ok !is_lin_recur_2(1, 2, 4, 8, 15),    'failed order 1, @ 4';
+        ok !is_lin_recur_2(81, 27, 9, 3, 1),   'failed order 1, non-integer';
+        ok  is_lin_recur_2(1, 0, 2, 0, 4),     'order 2: a[n] = 2 * a[n-2]';
+        ok  is_lin_recur_2(1, 1, 0, 0, 0),     'order 2: zeroes';
+        ok !is_lin_recur_2(1, 1, 0, 0, 1),     'failed order 2, @ 4';
+        ok  is_lin_recur_2(1, 0, 0, 0, 0, 0),  'order 0: six numbers';
+        ok !is_lin_recur_2(1, 0, 0, 0, 0, 1),  'failed order 0: six numbers';
+        ok  is_lin_recur_2(1, 1, 1, 1, 1, 1),  'order 1: six numbers';
+        ok !is_lin_recur_2(1, 1, 1, 1, 1, 2),  'failed order 1: six numbers';
+        ok  is_lin_recur_2(1, 1, 2, 3, 5, 8),  'order 2: six numbers';
+        ok !is_lin_recur_2(1, 1, 2, 3, 5, 7),  'failed order 2: six numbers';
+        ok  is_lin_recur_2(1, 1, 11, 21, 131), 'approximation required';
+	}
+
+    done_testing;
+    exit;
+}