Perl Weekly Challenge: Week 136
Challenge 1:
Two Friendly
You are given 2 positive numbers,
$mand$n.Write a script to find out if the given two numbers are
Two Friendly.Two positive numbers, m and n are two friendly when gcd(m, n) = 2 ^ p where p > 0. The greatest common divisor (gcd) of a set of >numbers is the largest positive number that divides all the numbers in the set without remainder.
Example 1
Input: $m = 8, $n = 24
Output: 1
Reason: gcd(8,24) = 8 => 2 ^ 3
Example 2
Input: $m = 26, $n = 39
Output: 0
Reason: gcd(26,39) = 13
Example 3
Input: $m = 4, $n = 10
Output: 1
Reason: gcd(4,10) = 2 => 2 ^ 1
Raku has a lot of the mathematical operations we need builtin so we can do this as a one-liner:
say log2(@*ARGS[0] gcd @*ARGS[1]) % 1 == 0 ?? 1 !! 0
This dense line of code does a lot.
First the values of $m and $n are taken from the command line as @*ARGS[0] and @*ARGS[1]. Their greatest common divisor
is taken via the gcd operator. The base 2 logarithm of that value is taken with the log2() function. If the result modulo 1 is
0, that means the gcd was a perfect power of 2 so we can output 1. If it was not, we output 0.
The Perl version is a bit more involved. For a start, Perl doesn't have a log2 function but it does have logε so we can emulate it with a bit of maths.
sub log2 {
my ($n) = @_;
return log($n) / log(2);
}
Perl also doesn't have a gcd() function. Luckily, this has come up before so I was able to find code I wrote for PWC 89 and use that.
sub gcd {
my ($a, $b) = @_;
return 0 == $b ? $a : gcd($b, $a % $b);
}
The values of $m and $n are taken from the command line:
my ($m, $n) = @ARGV;
... and the log2 of their gcd is calculated as in Raku.
my $x = log2(gcd($m, $n));
Modulus works differently in Perl so a different method of determing whether the gcd was an integer power of 2 had to be used.
In lieu of using a module, I compared the number with int() of that number and printed 1 or 0 accordingly.
say $x == int($x) ? 1 : 0;
Challenge 2:
Fibonacci Sequence
You are given a positive number $n.
Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number.
Fibonacci Numbers: 1,2,3,5,8,13,21,34,55,89, …
Example 1
Input: $n = 16
Output: 4
Reason: There are 4 possible sequences that can be created using Fibonacci numbers
i.e. (3 + 13), (1 + 2 + 13), (3 + 5 + 8) and (1 + 2 + 5 + 8).
Example 2
Input: $n = 9
Output: 2
Reason: There are 2 possible sequences that can be created using Fibonacci numbers
i.e. (1 + 3 + 5) and (1 + 8).
Example 3
Input: $n = 15
Output: 2
Reason: There are 2 possible sequences that can be created using Fibonacci numbers
i.e. (2 + 5 + 8) and (2 + 13).
The first step in tackling this problem is to find fibonacci numbers. Intuitively, they must be less than the
value of $n.
Raku has a wonderful concept called the lazy list. It means we can efficiently generate Fibonacci numbers as needed like this:
(1, 1, -> $a, $b { $a + $b } ... *)
My initial idea was to use .grep() to extract numbers less than or equal $n from the lazy list but apparently you
can't do that or atleast I wasn't able to in the short time I had available. So instead I used a for loop and checked each
successive value from the list until I reach one which was greater than $n. I used gather and take which also operate
in a lazy fashion for maximum efficiency. The resulting function looks like this:
sub fib(Int $n) {
return (gather {
for (1, 1, -> $a, $b { $a + $b } ... *) -> $i {
if ($i <= $n) {
take $i;
} else {
last;
}
}
})[1 .. *]
}
One more thing to note is the [1 .. *] at the end. The problem is that the Fibonacci sequence starts with two 1s
but for this problem, we only want one. So an array slice returns all but the first element.
Now we must find which sequences of numbers returned by fib() can be summed to equal #n. (Good old [+] provides the sum.) Getting all the sequences can be done with the .combinations() method but this really gets all the combinations. Due to the way it works there are many duplicates. So what I did was to stringify valid sequences and add them to a hash. After all the combinations have been gone through, ounting the keys of that hash gives the number of unique sequences whose sum is $n
my %sequences;
for fib($n).combinations -> @fib {
if ([+] @fib) == $n {
%sequences{@fib.join(q{, })}++;
}
}
say %sequences.elems;
As is often the case, the main task in translating from Raku to Perl is making up for functionality missing in the latters standard library. Perl doesn't have .combinations() for instance. Fortunately, this kind of thing has happened before and I already had code I could reuse. (Once again from PWC 89.) It is shown below.
sub combinations {
my @list = @{$_[0]};
my $length = $_[1];
if ($length <= 1) {
return map [$_], @list;
}
my @combos;
for (my $i = 0; $i + $length <= scalar @list; $i++) {
my $val = $list[$i];
my @rest = @list[$i + 1 .. $#list];
for my $c (combinations(\@rest, $length - 1)) {
push @combos, [$val, @{$c}] ;
}
}
return @combos;
}
It worked well enough but it is not ideally suited for this problem. If I had more time, I would rewrite it to make it more like my nextPrime() function which I haved used in PWC 133 and many other times. And it only returns combinations of a particular length which meant I needed an extra loop in order to get all the combinations.
This is fib(). In the absence of lazy lists, gather and take, It simply calculates Fibonacci in a non-recursive way
and adds ones which are less than or equal to $n into an array.
sub fib {
my ($n) = @_;
my $a = 1;
my $b = 1;
my @fib = ($b);
while (my $c = $a + $b) {
if ($c <= $n) {
push @fib, $c;
} else {
last;
}
$a = $b;
$b = $c;
}
return @fib;
}
sum() is another little piece of code I've used before most recently in PWC 124.
sub sum {
my ($arr) = @_;
my $total = 0;
for my $elem (@{$arr}) {
$total += $elem;
}
return $total;
}
Armed with all this, we can solve the problem. An unexpected feature of my combinations() function is that it doesn't
return duplicates. So I didn't need to do the hash thing and just maintained a simple count of valid sequences.
my $count = 0;
my @fibs = fib($n);
As mentioned previously, the second parameter taken by combinations() is the length of the combinations that are returned. So to get all combinations, I needed this extra outer loop.
for my $len (1 .. scalar @fibs) {
for my $combo (combinations(\@fibs, $len)) {
if (sum($combo) == $n) {
$count++;
}
}
}
say $count;