Perl Weekly Challenge: Week 246
Challenge 1:
6 out of 49
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
This maybe our shortest Raku one-liner yet.
(1 .. 49).pick(6).sort.join("\n").say
The list (1 .. 49) is the possible integers we can select. The appropriately named
.pick() method will pick one of those integers at random. Successive calls to .pick() are guaranteed to be unique (atleast until the 50th time it is called.) Six random
numbers are picked and sorted with .sort() and printed one per line with .join() and
.say().
Perl doesn't have .pick() so I had to code my own and this is what I came up with:
sub pick {
It takes two arguments, a reference to a range of numbers to pick from and the count of numbers to pick.
my ($arr, $count) = @_;
This variable stores the results.
my @results;
Then for $count times...
for (0 .. $count - 1) {
... We pick a random element from $arr with rand() and then remove it from the list with
splice(). The range of integers to select from will be 0 to the length of $arr minus 1; this will be treated as the offset parameter to splice(). rand() returns a floating point number so it has to be wrapped in int() to get an actual integer. The number selected is then added to @results with push().
push @results, splice @{$arr}, int(rand(scalar @{$arr})), 1;
}
Once we have our results, we return them either as an array or an array reference depending
on if pick() was called in list or scalar context.
return wantarray ? @results : \@results;
}
Now the main part of the script is one line.
say join "\n", pick([1 .. 49], 6);
The problem with pick() is that it is destructive. Each time a random element is selected, it is removed from the list so if you were to call it 50 times on our sample range, it would fail on the 50th time because the array would be empty. However it can
be made non-destructive with just a small adjustment.
In the revised version of pick()...
sub pick {
my ($arr, $count) = @_;
@results is a hash now. Its' keys will be the random elements we have picked.
my %results;
This variable will keep track of how many random elements we have picked.
my $picked = 0;
Now until we have picked $count number of random elements...
while ($picked < $count) {
We pick a random element from $arr.
my $random = $arr->[int(rand(scalar @{$arr}))];
If it is already in %results, it means it was already picked so we ignore
it and try again but if it doesn't exist in %results...
unless (exists $results{$random}) {
...we add it as a key (the value assigned doesn't really matter.) and increment
the value of $picked.
$results{$random} = 1;
$picked++;
}
}
Finally, we return the keys of the %results hash as a list or list reference as
needed.
return wantarray ? keys %results : [ keys %results ];
}
Challenge 2:
Linear Recurrence of Second Order
You are given an array
@aof 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]
Urgh maths! This is probably not at all the proper way to solve this challenge but given the formula in the spec I was
able to work out the examples in my head so I thought such a "brute-force" approach where my solution just tried different values of p and q to see if they fit would be good enough.
And here it is.
I go through different combinations of numbers from -10 to 10 for p and q.
for -10 .. 10 -> $p {
for -10 .. 10 -> $q {
if they work for @a[3] (and for good measure @[4]) I print True and end processing.
if @a[3] == $p * @a[1] + $q * @a[2] && @a[4] == $p * @a[2] + $q * @a[3] {
say 'true';
exit;
}
}
}
If none of the values fit, I assume the sequence is not a second order linear recurrence and print False.
say 'false';
Of course it could be that it is and p or q are merely outside the range -10 .. 10 in which case this is the wrong answer, but it works for the examples.
This is the Perl version.
for my $p (-10 .. 10) {
for my $q (-10 .. 10) {
if ($a[3] == $p * $a[1] + $q * $a[2] && $a[4] == $p * $a[2] + $q * $a[3]) {
say 'true';
exit;
}
}
}
say 'false';
Not my finest hour I'm afraid.