diff options
| -rw-r--r-- | challenge-246/jo-37/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-246/jo-37/blog/Blog.md | 174 | ||||
| -rwxr-xr-x | challenge-246/jo-37/perl/ch-1.pl | 20 | ||||
| -rwxr-xr-x | challenge-246/jo-37/perl/ch-2.pl | 101 |
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; +} |