Perl Weekly Challenge: Week 77
Challenge 1:
Fibonacci Sum
You are given a positive integer
$N.Write a script to find out all possible combination of Fibonacci Numbers required to get
$Non addition.You are NOT allowed to repeat a number. Print 0 if none found.
Example 1
Input: $N = 6
Output:
1 + 2 + 3 = 6
1 + 5 = 6
Example 2
Input: $N = 9
Output:
1 + 8 = 9
1 + 3 + 5 = 9
The first part of the solution to this problem involves finding numbers in
the Fibonacci Sequence. We can do this in Raku in a very cool and efficient
way with lazy lists as shown in the line of code below. The only thing that
tripped me up a little is my code started the sequence from 0 but in order
to get the same results as in the spec, we have to stsrt from 1. The last
part of the line, [^$N] ensures that the lazy list only stops producing
Fibonacci numbers when the count reaches $N.
my @fibs = (1, 2, -> $a, $b { $a + $b} ... ∞)[^$N];
All the actual work of solving this challenge is done in the find() function
which will be described below. The spec says that if we fail to find any
Fibonacci sums, we should print 0 and that's what is being done here but actually
I don't think it is needed because if I recall correctly, all positive integers
can be represented as atleast one sum of fibonacci numbers.
unless find($N, @fibs, [], 0) {
say 0;
};
That's it for MAIN() now onto find().
find() systematically explores all possible combinations of Fibonacci numbers that
sum to the target, using recursion and backtracking. It takes four parameters:
$n— the remaining sum.@fibs— an array of Fibonacci numbers.@current— the current combination being built.$start— the starting index for the search.
sub find($n, @fibs, @current, $start) {
All recursive functions need a base case so they don't continue running for ever
(or until the stack overflows and the program crashes.) So first we check if
$n has reached zero and if @current is not empty. If so, we print the current
combination (joined by plus signs) and its sum, then return 1 to indicate a valid combination has been found.
if $n == 0 && @current {
say @current.join(q{ + }), " = ", @current.sum;
return 1;
}
The say() statement here is out of place and violates the seperation of concerns software engineering principle. This is a mistake on my part. I somehow interpreted the spec to mean the result should the number of Fibonacci sums found
not the sums themselves. When I realized my error, I wedged this in here but
what I should have done is kept a running list of combinations found, added
@current to the list and returned it. The returned list could have been and
should have been captured in MAIN() and used to print the sums there. And if
I had still wanted to print the number of sums, I could have done so by calling .elems() on the result.
It is with this misunderstanding in mind that a variable $found is initialized to 0 to keep track of the number of valid combinations found in this call.
my $found = 0;
The function then iterates over the indices of the Fibonacci array, starting from $start up to the end.
for $start .. @fibs.end -> $i {
For each index $i, it checks if the Fibonacci number at that position is greater than the remaining sum $n. If it is, the loop skips to the next index, as adding this number would exceed the target.
if @fibs[$i] > $n {
next;
}
If the Fibonacci number is less than or equal to $n, the function recursively calls itself with the updated sum ($n - @fibs[$i]), the same Fibonacci array, a new combination array with the current Fibonacci number appended, and the next index ($i + 1). This ensures that each combination uses each Fibonacci number at most once and avoids duplicate combinations in different orders.
$found += find($n - @fibs[$i], @fibs,
@current.clone.push(@fibs[$i]), $i + 1);
}
Finally, the function returns the total number of valid combinations found which, as I said before, is not actually what we want.
return $found;
}
For Perl, we need a replacement sum() function and a way to calculate
Fibonacci numbers.
The answer to the second need is the function shown below. fibonacci()
takes one argument, $n, which is the number of Fibonacci numbers wanted.
sub fibonacci($n) {
A list is created to hold the generated numbers. The first two Fibonacci numbers ared added to it.
my @fibs = (1, 2);
Then we keep adding Fibonacci numbers to the list by adding together the previous two elements...
while (true) {
my $fib = $fibs[-1] + $fibs[-2];
...stopping only when the generated number is greater than $n.
if ($fib > $n) {
last;
}
But if it is not greater than $n the generated number is added to the list.
push @fibs, $fib;
}
Finally, we return the list of Fibonacci numbers we have found.
return @fibs;
}
The Perl version of find() works the same as Raku (and has the same design flaws.)
sub find($n, $fibs, $current, $start) {
if ($n == 0 && @{$current}) {
say q{}, (join q{ + }, @{$current}), " = ", sum(@{$current});
return 1;
}
my $found = 0;
for my $i ($start .. scalar @{$fibs} - 1) {
if ($fibs->[$i] > $n) {
next;
}
my @next = @{$current};
push @next, $fibs->[$i];
$found += find($n - @{$fibs}[$i], $fibs, \@next, $i + 1);
}
return $found;
}
The main code looks like this:
my @fibs = fibonacci($N);
unless (find($N, \@fibs, [], 0)) {
say 0;
};
Challenge 2:
Lonely X
You are given m x n character matrix consists of O and X only.
Write a script to count the total number of X surrounded by O only. Print 0 if none found.
Example 1
Input: [ O O X ]
[ X O O ]
[ X O O ]
Output: 1 as there is only one X at the first row last column surrounded by only O.
Example 2
Input: [ O O X O ]
[ X O O O ]
[ X O O X ]
[ O X O O ]
Output: 2
a) First X found at Row 1 Col 3.
b) Second X found at Row 3 Col 4.
This is another one where the MAIN() function is very simple.
The @args are command-line arguments. Each argument represents a row of the
character matrix or grid. So for example 2, they would be OOXO XOOO XOOX OXOO. They are made into a grid by the appropriately named makeGrid() function.
This grid is then used as input to the findLonely() function whose return
value is printed out with say().
say findLonely(makeGrid(@args));
makeGrid() takes @args and converts them into a 2D array.
sub makeGrid(@args) {
my @grid;
for @args -> $row {
@grid.push($row.comb.Array);
}
Then a one-element thick padding consisting of Os is added on all sides.
This will make finding lonely Xs much simpler.
@grid.unshift(('O' xx @grid[0].elems).Array);
@grid.push(('O' xx @grid[0].elems).Array);
for @grid -> $row {
$row.unshift('O');
$row.push('O');
}
return @grid;
}
findLonely() uses the grid created by makeGrid().
sub findLonely(@grid) {
First a variable is created to store the number of lonely Xs found; it is initialized to 0.
my $lonely = 0;
Then in a double loop we examine every cell of the grid except those in the layer of padding.
for 0 ^..^ @grid.end -> $i {
for 0 ^..^ @grid[$i].end -> $j {
If the cell contains an X...
if @grid[$i][$j] eq 'X' {
...a variable is created to count how many Os around it.
my $neighbors = 0;
This is done by examinging every cell adjacent to the current one in another
double loop and incrementing $neighbors if it contains a O. For simplicity
the current cell is also included in the loops even though by definition it
will not contain O.
for -1 .. 1 -> $ii {
for -1 .. 1 -> $jj {
if @grid[$i + $ii][$j + $jj] ne 'X' {
$neighbors++;
}
}
}
If all 8 neighbors are Os, we have a lonely X so we increment our count;
if $neighbors == 8 {
$lonely++;
}
}
Once again I see in hindsight that I've made a conceptual error. It would make
more sense if I counted adjacent Xs and the test was if $neighbors == 1.
}
}
return $lonely;
}
This is the Perl version. For once, no other code was needed.
sub makeGrid(@args) {
my @grid;
for my $row (@args) {
push @grid, [split //, $row];
}
push @grid, [('O') x scalar @{$grid[0]}];
unshift @grid, [('O') x scalar @{$grid[0]}];
for my $row (@grid) {
unshift @$row, 'O';
push @$row, 'O';
}
return @grid;
}
sub findLonely(@grid) {
my $lonely = 0;
for my $i (1 .. scalar @grid - 2) {
for my $j (1 .. scalar @{$grid[$i]} - 2) {
if ($grid[$i][$j] eq 'X') {
my $neighbors = 0;
for my $ii (-1 .. 1) {
for my $jj (-1 .. 1) {
if ($grid[$i + $ii]->[$j + $jj] ne 'X') {
$neighbors++;
}
}
}
if ($neighbors == 8) {
$lonely++;
}
}
}
}
return $lonely;
}
say findLonely(makeGrid(@ARGV));