# September 2020 Archives

## Perl Weekly Challenge 80: Smallest Positive Number Bits and Count Candies

These are some answers to the Week 80 of the Perl Weekly Challenge organized by Mohammad S. Anwar

Spoiler Alert: This weekly challenge deadline is due in several days (October 4, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

## Task 1: Smallest Positive Number Bits

You are given unsorted list of integers `@N`.

Write a script to find out the smallest positive number missing.

Example 1:

``````Input: @N = (5, 2, -2, 0)
Output: 1
``````

Example 2:

``````Input: @N = (1, 8, -1)
Output: 2
``````

Example 3:

``````Input: @N = (2, 0, -1)
Output: 1
``````

### Smallest Positive Integer Missing in Raku

Our program receives the list of numbers as a parameter (or takes a default list of integers if none is provided). It removes any negative values, sorts the remaining integers, and remove any duplicate (although removing duplicates is not strictly necessary). It then loops through the sorted array, picks the first gap (missing value) into the `\$result` variable and exits the loop. Then it prints the value of `result` if it is defined, or the last value of the sorted array + 1 if `\$result` is not defined (i.e. if no gap was found).

``````use v6;

my @nums = @*ARGS.elems > 1 ?? @*ARGS !! (5, 2, -2, 0);
my @sorted = @nums.grep(* >= 0).sort({\$^a <=> \$^b}).squish;
die "No solution with given input!" if @sorted.elems < 1;
my \$result;
for 0..@sorted.end-1 -> \$i {
\$result = (@sorted[\$i] + 1) and last
if @sorted[\$i] + 1 < @sorted[\$i+1];
}
say \$result.defined ?? \$result !! @sorted[*-1] + 1;
``````

Of course, a real life program should probably perform some input validation, but a real life program is not very likely to get its input from the command line.

These are the results displayed for a few input lists of integers:

``````\$ raku smallest-missing.raku
1

\$ raku smallest-missing.raku 1 8 -1
2

\$ raku smallest-missing.raku 2 0 -1
1

\$ raku smallest-missing.raku 1 4 3 2 5 8 7 9 4 4 3 2
6
``````

### Smallest Positive Integer Missing in Perl

This is a Perl port of the Raku program above (except that it does not remove duplicates). Please refer to the previous section for explanations on how it works.

``````use strict;
use warnings;
use feature qw /say/;

my @nums = @ARGV > 1 ? @ARGV : (5, 2, -2, 0);
my @sorted = sort { \$a <=> \$b } grep \$_ >= 0, @nums;
die "No solution with given input!" if @sorted < 1;
my \$result;
for my \$i (0..scalar @nums - 1) {
\$result = (\$sorted[\$i] + 1) and last
if \$sorted[\$i] + 1 < \$sorted[\$i+1];
}
say \$sorted[-1] + 1 and exit unless defined \$result;
say  \$result ;
``````

The program displays the expected results for a few input list of integers:

``````\$ perl smallest-missing.pl
1

\$ perl smallest-missing.pl 1 8 -1
2

\$ perl smallest-missing.pl 2 0 -1
1

\$ perl smallest-missing.pl 1 4 3 2 5 8 7 9
6
``````

You are given rankings of `@N` candidates.

Write a script to find out the total candies needed for all candidates. You are asked to follow the rules below:

a) You must given at least one candy to each candidate.

b) Candidate with higher ranking get more candies than their immediate neighbors on either side.

Example 1:

``````Input: @N = (1, 2, 2)

Explanation:

Applying rule #a, each candidate will get one candy. So total candies needed so far 3. Now applying rule #b, the first candidate do not get any more candy as its rank is lower than it's neighbours. The second candidate gets one more candy as it's ranking is higher than it's neighbour. Finally the third candidate do not get any extra candy as it's ranking is not higher than neighbour. Therefore total candies required is 4.

Output: 4
``````

Example 2:

``````Input: @N = (1, 4, 3, 2)

Explanation:

Applying rule #a, each candidate will get one candy. So total candies needed so far 4. Now applying rule #b, the first candidate do not get any more candy as its rank is lower than it's neighbours. The second candidate gets two more candies as it's ranking is higher than it's both neighbour. The third candidate gets one more candy as it's ranking is higher than it's neighbour. Finally the fourth candidate do not get any extra candy as it's ranking is not higher than neighbour. Therefore total candies required is 7.

Output: 7
``````

### Candy Count in Raku

Here, we use an array of three arrays of integers. For each sub-array, we first set `\$count` to the number of values in the sub-array (rule #a), and then loop through the sub-array and increment `\$count` for each neighbor that is smaller than the current value.

``````use v6;

my @n = [1, 2, 2], [1, 4, 3, 2], [<3 1 5 8 7 4 2>];;
for  @n -> @nums {
my \$count = @nums.elems;
for 0..@nums.end -> \$i {
\$count++ if defined @nums[\$i+\$_] and
@nums[\$i] > @nums[\$i+\$_] for -1, 1;
}
say "Total candies required for [@nums[]]: \$count.";
}
``````

This program displays the following (correct) output:

``````raku ./candy_count.raku
Total candies required for [1 2 2]: 4.
Total candies required for [1 4 3 2]: 7.
Total candies required for [3 1 5 8 7 4 2]: 13.
``````

### Candy Count in Perl

This is a port to Perl of the Raku program above. Please refer to the explanations in the previous section. As a side note, I was somewhat unhappy some six years ago when I discovered that you cannot get the last element of an array using the -1 subscript in Raku as you would do in Perl (`\$array[-1]`), but would need to use the whatever operator (`@array[*-1]`). While porting my script to Perl, I initially had a bug, because `\$num_ref->[\$i+\$j]` was defined (the last item in the array) when `\$i+\$j` took the -1 value. This is why I had to add a `next` statement when `\$i + \$j` took a negative value. So, after all, Perl seemed more expressive, but it turns out that Raku is slightly more consistent and a bit less dangerous in such cases.

``````use strict;
use warnings;
use feature qw /say/;

my @n = ([1, 2, 2], [1, 4, 3, 2], [qw<3 1 5 8 7 4 2>]);
for my \$num_ref (@n) {
my \$count = scalar @\$num_ref;
for my \$i (0..\$#\$num_ref) {
for my \$j (-1, 1) {
next if \$i + \$j < 0;  # avoid negative subscripts
\$count++ if (defined \$num_ref->[\$i+\$j]) and
\$num_ref->[\$i] > \$num_ref->[\$i+\$j];
}
}
say "Total candies required for [@\$num_ref]: \$count.";
}
``````

This program displays the same output as the Raku program:

``````\$ perl  candy_count.pl
Total candies required for [1 2 2]: 4.
Total candies required for [1 4 3 2]: 7.
Total candies required for [3 1 5 8 7 4 2]: 13.
``````

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, October 11, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 79: Count Set Bits and Trapped Rain Water

These are some answers to the Week 79 of the Perl Weekly Challenge organized by Mohammad S. Anwar

Spoiler Alert: This weekly challenge deadline is due in a couple of days (September 27, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

## Task 1: Count Set Bits

You are given a positive number `\$N`.

Write a script to count the total number of set bits of the binary representations of all numbers from 1 to `\$N` and return \$total_count_set_bit % 1000000007.

Example 1:

``````Input: \$N = 4

Explanation: First find out the set bit counts of all numbers i.e. 1, 2, 3 and 4.

Decimal: 1
Binary: 001
Set Bit Counts: 1

Decimal: 2
Binary: 010
Set Bit Counts: 1

Decimal: 3
Binary: 011
Set Bit Counts: 2

Decimal: 4
Binary: 100
Set Bit Counts: 1

Total set bit count: 1 + 1 + 2 + 1 = 5

Output: Your script should print `5` as `5 % 1000000007 = 5`.
``````

Example 2:

``````Input: \$N = 3

Explanation: First find out the set bit counts of all numbers i.e. 1, 2 and 3.

Decimal: 1
Binary: 01
Set Bit Count: 1

Decimal: 2
Binary: 10
Set Bit Count: 1

Decimal: 3
Binary: 11
Set Bit Count: 2

Total set bit count: 1 + 1 + 2 = 4

Output: Your script should print `4` as `4 % 1000000007 = 4`.
``````

### Count Set Bits in Raku

This is a problem where the data flow (or pipeline) programming model can make things fairly simple: get the numbers in the range, convert each of them to binary, sum the binary digits, sum each sum, and finally get the modulo. In Raku, there are several ways to implement such a data flow: functional programming model, chained method invocations, `==>` feed operator, etc. Here, we will use a combination of functional programming and chained method invocations. In fact, it makes it so simple that we can use a Raku one-liner:

``````\$ raku -e 'say ([+] map { .fmt("%b").comb.sum }, 1..@*ARGS[0]) % 1000000007' 4
5

\$ raku -e 'say ([+] map { .fmt("%b").comb.sum }, 1..@*ARGS[0]) % 1000000007' 5
7
``````

### Count Set Bits in Perl

Perl doesn’t have a `sum` built-in. There are core modules offering that, but, as I have explained often before, I’m not very keen on using off-the-shelf modules for programming challenges. We could easily write a `sum` subroutine, but the task is so simple that I prefer to use an accumulator in nested loops:

``````use strict;
use warnings;
use feature "say";

my \$n = shift;
my \$sum;
for my \$num (1..\$n) {
\$sum += \$_ for split '', sprintf "%b", \$num;
}
say \$sum % 1000000007;
``````

This duly prints the expected results:

``````\$ perl set_bit_count.pl 4
5

\$ perl set_bit_count.pl 5
7
``````

## Task 2: Trapped Rain Water

You are given an array of positive numbers `@N`.

Write a script to represent it as Histogram Chart and find out how much water it can trap.

Example 1:

``````Input: @N = (2, 1, 4, 1, 2, 5)
The histogram representation of the given array is as below.

5           #
4     #     #
3     #     #
2 #   #   # #
1 # # # # # #
_ _ _ _ _ _ _
2 1 4 1 2 5

Looking at the above histogram, we can see, it can trap 1 unit of rain water between 1st and 3rd column. Similarly, it can trap 5 units of rain water between 3rd and last column.

Therefore, your script should print 6.
``````

Example 2:

``````Input: @N = (3, 1, 3, 1, 1, 5)
The histogram representation of the given array is as below.

5           #
4           #
3 #   #     #
2 #   #     #
1 # # # # # #
_ _ _ _ _ _ _
3 1 3 1 1 5

Looking at the above histogram, we can see, it can trap 2 units of rain water between 1st and 3rd column. Also it can trap 4 units of rain water between 3rd and last column.

Therefore, your script should print 6.
``````

### Trapped Rain Water in Raku

For drawing the histogram, we just reuse (with some minor changes) the `draw-histo` subroutine of PWC # 75. It first searches the largest ordinate and then loops down on values between the largest ordinate and 0 and, for each line, prints “#” in the relevant column if the input value is greater than or equal to the current ordinate.

The `capacity` subroutine computes the trapped rain water. It basically looks at every column and looks for the largest values to the left and to the right. The column capacity is then the smallest of these two values minus the input array for that column. The total capacity is the sum of these column capacities.

``````use v6;

my @a = @*ARGS.elems > 1 ?? @*ARGS !! (2, 1, 4, 1, 2, 5);
draw-histo(@a);
say "Rain capacity is: ", capacity(@a);

sub draw-histo (@in) {
my \$max-val = @in.max;
say "";
for (1..\$max-val).reverse -> \$ordinate {
print \$ordinate;
for 0..@in.end -> \$i {
print @in[\$i] >= \$ordinate ?? " # " !! "   ";
}
say "";
}
say "  =" x @in.elems;
say "  ", join "  ", @in, "\n";
}

sub capacity (@in) {
my \$left-max = @in[0];
my \$total = 0;
for 1..@in.end-1 -> \$i {
\$left-max = @in[\$i] and next if @in[\$i] > \$left-max;
my \$right-max = max @in[\$i+1..@in.end];
my \$col = min(\$left-max, \$right-max) - @in[\$i];
\$total += \$col if \$col > 0;
}
return \$total
}
``````

These are displayed for the default input array and for two input list of values passed to the program:

``````\$ raku rain-water.raku

5                #
4       #        #
3       #        #
2 #     #     #  #
1 #  #  #  #  #  #
=  =  =  =  =  =
2  1  4  1  2  5

Rain capacity is: 6

\$ raku rain-water.raku 3 1 3 1 1 5

5                #
4                #
3 #     #        #
2 #     #        #
1 #  #  #  #  #  #
=  =  =  =  =  =
3  1  3  1  1  5

Rain capacity is: 6

\$ raku rain-water.raku 2  1  4  1  3  2

4       #
3       #     #
2 #     #     #  #
1 #  #  #  #  #  #
=  =  =  =  =  =
2  1  4  1  3  2

Rain capacity is: 3
``````

### Trapped Rain Water in Perl

For drawing the histogram, the `draw_histo` subroutine first searches the largest ordinate and then loops down on values between the largest ordinate and 0 and, for each line, prints “#” in the relevant column if the input value is greater than or equal to the current ordinate.

The `capacity` subroutine computes the trapped rain water. It basically looks at every column and looks for the largest values to the left and to the right. The column capacity is then the smallest of these two values minus the input array for that column.

In addition, since Perl doesn’t have built-ins to find the maximum and minimum values of a list of values, we have two helper subroutines, `max`and `min2`, whose purpose should be obvious. Such functions exist in list utility modules, but, as mentioned above, I prefer to avoid using off-the-shelf packages in a coding challenge

``````use strict;
use warnings;
use feature "say";

my @a = @ARGV > 1 ? @ARGV : ( 2, 1, 4, 5, 3, 7);
draw_histo(@a);
say "Rain capacity is: ", capacity(@a);

sub max {
my @vals = @_;
my \$max = shift @vals;
for my \$val (@vals) {
\$max = \$val if \$val > \$max;
}
return \$max;
}

sub min2 {
\$_[0] < \$_[1] ? \$_[0] : \$_[1];
}

sub draw_histo {
my @in = @_;
my \$max_val = max @in;
say "";
for my \$ordinate (reverse 1..\$max_val) {
print \$ordinate;
for my \$i (0..\$#in) {
print \$in[\$i] >= \$ordinate ? " # " : "   ";
}
say "";
}
say "  =" x scalar @in;
say "  ", join "  ", @in;
say "";
}

sub capacity {
my @in = @_;
my \$left_max = \$in[0];
my \$total = 0;
for my \$i (1..\$#in-1) {
\$left_max = \$in[\$i] and next if \$in[\$i] > \$left_max;
my \$right_max = max @in[\$i+1..\$#in];
my \$col = min2(\$left_max, \$right_max) - \$in[\$i];
next if \$col < 0;
\$total += \$col;
}
return \$total
}
``````

This is the displayed output for the default input array and for two input list of values:

``````\$ perl rain-water.pl

7                #
6                #
5          #     #
4       #  #     #
3       #  #  #  #
2 #     #  #  #  #
1 #  #  #  #  #  #
=  =  =  =  =  =
2  1  4  5  3  7

Rain capacity is: 3

\$ perl rain-water.pl 3 1 3 1 1 5

5                #
4                #
3 #     #        #
2 #     #        #
1 #  #  #  #  #  #
=  =  =  =  =  =
3  1  3  1  1  5

Rain capacity is: 6

\$ perl rain-water.pl 2  1  4  1  3  2

4       #
3       #     #
2 #     #     #  #
1 #  #  #  #  #  #
=  =  =  =  =  =
2  1  4  1  3  2

Rain capacity is: 3
``````

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, October 4, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 78: Leader Element and Left Rotation

These are some answers to the Week 78 of of the Perl Weekly Challenge organized by Mohammad S. Anwar

Spoiler Alert: This weekly challenge deadline is due in a few days (September 20, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

You are given an array `@A` containing distinct integers.

Write a script to find all leader elements in the array `@A`. Print (0) if none found.

``````An element is leader if it is greater than all the elements to its right side.
``````

Example 1:

``````Input: @A = (9, 10, 7, 5, 6, 1)
Output: (10, 7, 6, 1)
``````

Example 2:

``````Input: @A = (3, 4, 5)
Output: (5)
``````

Two small comments. First, if we set aside the (very special) case where the input array is empty, we will never have to print 0, since the last item of the array will always be a leader element. Second, I’ll interpret the leader element definition as strictly greater than all its successors.

We only need to read the input array backward and keep track of the maximum element seen so far. Any item strictly greater than all items seen previously is a leader. Here, we do it for the two arrays provided as examples.

``````use v6;

my @in = [9, 10, 7, 5, 6, 1], [3, 4, 5];
for @in -> @a {
my @result = gather {
my \$max = @a[*-1];
take \$max;
for @a.reverse -> \$item {
if \$item > \$max {
take \$item;
\$max = \$item;
}
}
}
say "Input: @a[]; Output: ", @result.reverse;
}
``````

The result is in conformity with what we expected:

``````Input: 9 10 7 5 6 1; Output: (10 7 6 1)
Input: 3 4 5; Output: (5)
``````

Just like in Raku, we read the input array backward and keep track of the maximum element seen so far. Any item strictly greater than all items seen previously is a leader.

``````use strict;
use warnings;
use feature "say";

my @in = ([9, 10, 7, 5, 6, 1], [3, 4, 5]);
for my \$aref (@in) {
my @result;
my \$max = @\$aref[-1];
push @result, \$max;
for my \$item (reverse @\$aref) {
if (\$item > \$max) {
push @result, \$item;
\$max = \$item;
}
}
say "Input: @\$aref; Output: ", join " ", reverse @result;
}
``````

Here again, the result is what we expected:

``````\$ perl leader.pl
Input: 9 10 7 5 6 1; Output: 10 7 6 1
Input: 3 4 5; Output: 5
``````

### Left Rotation

You are given array `@A` containing positive numbers and `@B` containing one or more indices from the array `@A`.

Write a script to left rotate `@A` so that the number at the first index of `@B` becomes the first element in the array. Similarly, left rotate `@A` again so that the number at the second index of `@B` becomes the first element in the array.

Example:

``````Input:
@A = (10 20 30 40 50)
@B = (3 4)

Explanation:

a) We left rotate the 3rd index element (40) in the @A to make it 0th index member in the array.
[40 50 10 20 30]

b) We left rotate the 4th index element (50) in the @A to make it 0th index member in the array.
[50 10 20 30 40]

Output:
[40 50 10 20 30]
[50 10 20 30 40]
``````

### Left Rotation in Raku

We can simply use array slices to get what we need. The only slight difficulty is that we need to flatten the two index slices into a single list.

``````use v6;

my @a = 10, 20, 30, 40, 50;
my @indices = 3, 4;

say "Input array: ", @a;
for @indices -> \$i {
my @out = @a[(\$i..@a.end, 0..\$i -1).flat];
say @out;
}
``````

Output:

``````\$ raku left_rotate.raku
Input array: [10 20 30 40 50]
[40 50 10 20 30]
[50 10 20 30 40]
``````

### Left Rotation in Perl

Again, we use array slices. Here, the only slight difficulty is the relatively heavy use of nested array references.

``````use strict;
use warnings;
use feature "say";

my @a = ( [[10, 20, 30, 40, 50],[3, 4]],
[[7, 4, 2, 6, 3], [1, 3, 4]] );
left_rotate(\$_) for @a;

sub left_rotate {
my \$inref = shift;
my (\$in, \$indices) = @\$inref;
say "\nInput array: @\$in - Indices: @\$indices";
for my \$i (@\$indices){
my @out = @\$in[\$i..\$#{\$in}, 0..\$i -1];
say "@out";
}
}
``````

Output:

``````\$ perl left_rotate.pl

Input array: 10 20 30 40 50 - Indices: 3 4
40 50 10 20 30
50 10 20 30 40

Input array: 7 4 2 6 3 - Indices: 1 3 4
4 2 6 3 7
6 3 7 4 2
3 7 4 2 6
``````

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, September 27, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge: Fibonacci Sum and Lonely X

These are some answers to the Week 77 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (September 13, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

You are given a positive integer `\$N`.

Write a script to find out the smallest combination of Fibonacci Numbers required to get `\$N` on addition.

You are NOT allowed to repeat a number. Print 0 if none found.

Example 1:

``````Input: \$N = 6
Output:
1 + 5 = 6
``````

Example 2:

``````Input: \$N = 9
Output:
1 + 8 = 9
``````

My first comment is that we will never have to print 0: any strictly positive integer can be expressed as a sum of some Fibonacci numbers with no duplicates. This can be proven rigorously, but since this a not a math challenge, I will only give a gist of a demonstration with a numeric example. Consider any input integer, say 30, and all Fibonacci numbers less than 30:

``````1 2 3 5 8 13 21
``````

We can subtract the largest Fibonacci number less than or equal to 30, i.e. 21, and get 9. We can repeat the operation with the new number, 9, subtract 8 from it and get 1. We repeat once more and get 0. Thus, 30 is the sum of the following Fibonacci numbers: `[21 8 1]`. Since the ratio between two consecutive Fibonacci numbers tends toward 1.618 (more precisely towards the golden mean, whose precise value is square root of 5 + 1 divided by 2), the iterative process will either stop early when the difference found is a Fibonacci number, or will converge very rapidly toward the smallest Fibonacci numbers. It can easily be shown that, with such a process, it is never possible to get a duplicate Fibonacci numbers. It is also not difficult to see that, since we always pick with the largest possible Fibonacci number, this process is bound to lead the smallest collection of Fibonacci numbers whose sum is equal to the input target.

Note: The task was changed after having been published and now requires “to find out all possible combination of Fibonacci Numbers required to get \$N on addition.” I discovered this change after having completed the task in both Raku and Perl. That’s too late, I will show solutions to the original task, especially in view of the fact that the modified task is in my humble opinion less interesting, as finding all combinations of a list of items matching a certain condition is very similar to a number of tasks of previous challenges.

### Fibonacci Sum in Raku (Original Task)

Rather than just finding a sum of Fibonacci numbers for a single input target integer, I’ve decided to illustrate the fact that it always possible to find a sum of Fibonacci numbers to obtain a target input integer, I’ll do it for every integer between 1 and 1,000.

So, we first generate an array of Fibonacci numbers less than 1000 in descending order. Then we simply iterate over this array and subtract the value found in the array if it is less than or equal to the current value, until we reach 0.

``````use v6;

my @fib = (1, 2, -> \$a, \$b { \$a + \$b } ...^ * > 1000).reverse;
for 1..1000 -> \$n {
my \$curr = \$n;
my @result;
for @fib -> \$i {
next if \$i > \$curr;
push @result, \$i;
last if \$i == \$curr;
\$curr -= \$i;
}
say "\$n -> ", @result;
}
``````

This is an excerpt of the output:

``````1 -> [1]
2 -> [2]
3 -> [3]
4 -> [3 1]
5 -> [5]
6 -> [5 1]
7 -> [5 2]
8 -> [8]
9 -> [8 1]
10 -> [8 2]
11 -> [8 3]
12 -> [8 3 1]
13 -> [13]
14 -> [13 1]
15 -> [13 2]
16 -> [13 3]
17 -> [13 3 1]
[ Lines omitted for brevity ]
984 -> [610 233 89 34 13 5]
985 -> [610 233 89 34 13 5 1]
986 -> [610 233 89 34 13 5 2]
987 -> [987]
988 -> [987 1]
989 -> [987 2]
990 -> [987 3]
991 -> [987 3 1]
992 -> [987 5]
993 -> [987 5 1]
994 -> [987 5 2]
995 -> [987 8]
996 -> [987 8 1]
997 -> [987 8 2]
998 -> [987 8 3]
999 -> [987 8 3 1]
1000 -> [987 13]
``````

### Fibonacci Sum in Raku (Modified Task)

I said before that I originally did not intend to provide solutions to the modified task, but it is so simple in Raku that I changed my mind and will nonetheless provide a solution:

``````# (Modified task)
my \$n = @*ARGS[0]:exists ?? @*ARGS[0] !! 30;
my @fib = 1, 2, * + *  ... ^ * >= \$n;
for @fib.combinations -> \$s {
say \$s if \$n == [+] \$s;
}
``````

Output:

``````(1 8 21)
(1 3 5 21)
(1 3 5 8 13)
``````

This can be made more concise:

``````my \$n = @*ARGS[0]:exists ?? @*ARGS[0] !! 30;
.say if \$n == \$_.sum for (1, 2, * + *  ... ^ * >= \$n).combinations;
``````

This script displays the same output.

### Fibonacci Sum in Perl (Original Task)

This program uses the same algorithm as the Raku program (see above), but handles only one input value instead of a full range. The only other significant difference is that the array of Fibonacci numbers is built in a `while` loop.

``````use strict;
use warnings;
use feature "say";

my \$target = shift // 100;
my @fib = (1, 2);
while (1) {
my \$new_fib = \$fib[-1] + \$fib[-2];
last if \$new_fib >= \$target;
push @fib, \$new_fib;
}
my \$curr = \$target;
my @result;
for my \$i (reverse @fib) {
next if \$i > \$curr;
push @result, \$i;
last if \$i == \$curr;
\$curr -= \$i;
}
say "\$target ->  @result";
``````

Running this script using the default value:

``````\$ perl fib.pl
100 ->  89 8 3
``````

And using a relatively large input value:

``````\$ perl fib.pl 100000
100000 ->  75025 17711 6765 377 89 21 8 3 1
``````

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.
``````

### Lonely X in Raku

We traverse the matrix and call the `check` subroutine when the visited item is a `'X'`. The `check` subroutine verifies whether any neighbor of the visited item is a `'X'`. The only slight difficulty is the special cases where some of the neighbors might not be defined.

``````use v6;

my @matrix = [ <O O X O> ],
[ <X O O O> ],
[ <X O O X> ],
[ <O X O O> ];

# @matrix = [ 0, 0, 'X'], [ 'X', 0, 0], [ 'X', 0, 0 ];

# @matrix = [<X X X>], [0, 0, 0];

sub check (Int \$m, Int \$k) {
for -1, 0, 1 -> \$i {
for -1, 0, 1 ->\$j {
next if \$i == 0 and \$j == 0;  # the item being verified, bound to be an 'X'
next if \$m+\$i < 0 or \$k+\$j < 0; # out of the matrix
next unless defined @matrix[\$m+\$i] and defined @matrix[\$m+\$i][\$k+\$j];
return False if @matrix[\$m+\$i][\$k+\$j] eq 'X';
}
}
return True;
}

my @result;
for 0..@matrix[0].end -> \$j {
for 0..@matrix.end -> \$i {
next unless @matrix[\$i][\$j] eq 'X';
push @result, [\$i, \$j] if check \$i, \$j;
}
}
say @result.elems > 0 ?? @result !! 0;
``````

Output:

``````\$ raku lonely.raku
[[0 2] [2 3]]
``````

### Lonely X in Perl

This is essentially a port to Perl of the above Raku program:

``````use strict;
use warnings;
use feature "say";

my @matrix = ([ 0, 0, 'X'], [ 'X', 0, 0], [ 'X', 0, 0 ]);

@matrix = ([ qw<O O X O> ],
[ qw<X O O O> ],
[ qw<X O O X> ],
[ qw<O X O O> ]);

# @matrix = ([qw <X X X>], [0, 0, 0]);

sub check {
my (\$m, \$k) = @_;
for my \$i (-1, 0, 1) {
for my \$j (-1, 0, 1) {
next if \$i == 0 and \$j == 0;
next if \$m+\$i < 0 or \$k+\$j < 0;
next unless exists \$matrix[\$m+\$i] and exists \$matrix[\$m+\$i][\$k+\$j];
return 0 if \$matrix[\$m+\$i][\$k+\$j] eq 'X';
}
}
return 1;
}

my @result;
for my \$i (0..\$#{\$matrix[0]}) {
for my \$j (0..\$#matrix) {
next unless \$matrix[\$j][\$i] eq 'X';
push @result, [\$j, \$i] if check \$j, \$i;
}
}
say "@\$_" for  @result;
say 0 unless @result;
``````

Output:

``````\$ perl lonely.pl
0 2
2 3
``````

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, September 20, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 76: Letter Grid

These are some answers to the Week 76 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on Aug. 16, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

I’ve written a Raku program to solve this task, but it is unfortunately a bit buggy: it works in most cases, but there are a few rare cases where it doesn’t find the minimum number of prime numbers whose summation gives you the target number. I certainly don’t want to publish here a program which I know to be faulty in some cases, and I no longer have time before the deadline to fix it. So, I’ll skip this task for now.

Write a script that takes two file names. The first file would contain word search grid as shown below. The second file contains list of words, one word per line. You could even use local dictionary file.

Print out a list of all words seen on the grid, looking both orthogonally and diagonally, backwards as well as forwards.

Search Grid:

``````B I D E M I A T S U C C O R S T
L D E G G I W Q H O D E E H D P
U S E I R U B U T E A S L A G U
N G N I Z I L A I C O S C N U D
T G M I D S T S A R A R E I F G
S R E N M D C H A S I V E E L I
S C S H A E U E B R O A D M T E
H W O V L P E D D L A I U L S S
R Y O N L A S F C S T A O G O T
I G U S S R R U G O V A R Y O C
N R G P A T N A N G I L A M O O
E I H A C E I V I R U S E S E D
S E T S U D T T G A R L I C N H
H V R M X L W I U M S N S O T B
A E A O F I L C H T O D C A E U
Z S C D F E C A A I I R L N R F
A R I I A N Y U T O O O U T P F
R S E C I S N A B O S C N E R A
D R S M P C U U N E L T E S I L
``````

Output:

``````Found 54 words of length 5 or more when checked against the local dictionary. You may or may not get the same result but that is fine.

aimed, align, antes, argos, arose, ashed, blunt, blunts, broad, buries, clove, cloven, constitution, constitutions, croon, depart, departed, enter, filch, garlic, goats, grieve, grieves, hazard, liens, malign, malignant, malls, margo, midst, ought, ovary, parted, patna, pudgiest, quash, quashed, raped, ruses, shrine, shrines, social, socializing, spasm, spasmodic, succor, succors, theorem, theorems, traci, tracie, virus, viruses, wigged
``````

My first reaction was to hate this task because it requires a lot of code lines (so many different cases) for a coding challenge. So, I tried to make a relatively concise solution avoiding code repetition.

### Word Search in Raku

I have in my default directory a `words.txt` file containing about 114,000 English words. They are all lower-case words, so I’ll have to change case for the input grid. The authorized words will be stored in a Set.

The grid will be read from a file ans stored in an array or arrays.

The program reads arrays from the grid in all directions (horizontal, vertical, from top left to bottom right and from top right to bottom left and calls the `find_words` subroutine. This subroutine takes an array of letters as input, and looks for words, both forward and backward, in the input array.

``````use v6;

my (\$dict, \$grid-file) = @*ARGS;
my \$min-length = @*ARGS[2]:exists ?? @*ARGS[2] !! 5;
my \$words = \$dict.IO.lines.grep({.chars >= \$min-length}).Set;
my @grid;
for  \$grid-file.IO.lines -> \$line {
my @letters = \$line.lc.split(' ');
push @grid, @letters;
}
my \$max_row = @grid.end;
my \$max_col = @grid[0].end;
my \$result = SetHash.new;

sub find_words (@row) {
for 0 .. @row.end -> \$i {
for \$i+\$min-length-1 .. @row.end -> \$j {
my \$word = join '', @row[\$i..\$j];
\$result{\$word}++ if \$words{\$word};
my \$flipped = \$word.flip;
\$result{\$flipped}++ if \$words{\$flipped};
}
}
}
# Horizontal
for @grid -> @row {
find_words @row;
}
# Vertical
for 0..\$max_col -> \$i {
my @col = map { @grid[\$_][\$i] }, 0..\$max_row;
find_words @col;
}
# Oblique, NW to SE
for 0..\$max_col - \$min-length + 1 -> \$i {
my @vals = grep {defined \$_}, map { @grid[\$_][\$_+\$i] }, 0..\$max_row;
find_words @vals;
}
for 1..\$max_row-\$min-length+1 -> \$j {
my @vals = grep {defined \$_}, map { @grid[\$_+\$j][\$_]}, 0..\$max_row;
find_words @vals;
}
# Oblique, NE to Sw
for \$min-length - 1 .. \$max_col -> \$j {
my @vals = grep {defined \$_}, map { @grid[\$j-\$_][\$_] }, 0..\$max_col;
find_words @vals;
}
for 1 ..\$max_row - \$min-length + 1 -> \$i {
my @vals = grep {defined \$_}, map { @grid[\$i+\$_][\$max_col-\$_] },  0..\$max_col;
find_words @vals;
}
say join " ", sort keys \$result;
``````

This program produces the following output with 57 words:

``````\$ raku letter-grid.raku words.txt grid.txt
aimed align antes arose ashed blunt blunts broad buries clove cloven constitution croon depart departed duddie enter filch garlic goats grieve grieves grith hazard ileac liens lunts malign malignant malls midst midsts ought ovary parted pudgiest quash quashed raias raped roser ruses shrine shrines sices social socializing soyas spasm spasmodic succor succors theorem theorems virus viruses wigged
``````

### Word Search in Perl

Compared too the Raku program, `Sets` and `SetHashes` are replaced with hashes. There are a few other things done differently, but it is essentially the same idea. Also, I was too lazy to use a separate file for the grid, which I included in a `__DATA__` section of the program. For the same reason, I also hard-coded the name of the file containing the list of authorized words.

``````use strict;
use warnings;
use feature "say";

my \$dict = "words.txt";
my \$min_length = shift // 5;
open my \$IN, "<", \$dict or die unable to open \$dict;
my %words = map { \$_ => 1 } grep { length \$_ >= \$min_length }
map { chomp; \$_ } <\$IN>;
close \$IN;

my @grid = map { s/[\r\n]+//; [split / /, lc \$_]} <DATA>;
my \$max_row = \$#grid;
my \$max_col = \$#{\$grid[0]}; # scalar @{\$grid}[0]} - 1;
my %result;

sub find_words {
my @row = @{\$_[0]};
for my \$i (0..\$#row) {
for my \$j (\$i+\$min_length-1..\$#row) {
my \$word = join '', @row[\$i..\$j];
\$result{\$word} = 1 if exists \$words{\$word};
}
}
}

# Horizontal
for my \$row (@grid) {
find_words \$_ for \$row, [reverse @\$row];
}
# Vertical
for my \$i (0..\$max_col) {
my @vals = map { \$grid[\$_][\$i] } 0..\$max_row;
find_words \$_ for [@vals], [reverse @vals];
}
# Oblique, NW to SE
for my \$i (0..\$max_col - \$min_length + 1) {
my @vals = grep defined \$_, map { \$grid[\$_][\$_+\$i] } 0..\$max_row;
find_words \$_ for [@vals], [reverse @vals];
}
for my \$j (1..\$max_row-\$min_length+1) {
my @vals = grep defined \$_, map { \$grid[\$_+\$j][\$_]} 0..\$max_row;
find_words \$_ for [@vals], [reverse @vals];
}
# Oblique, NE to Sw
for my \$j (\$min_length - 1 .. \$max_col) {
my @vals = grep defined \$_, map { \$grid[\$j-\$_][\$_] } 0..\$max_col;
find_words \$_ for [@vals], [reverse @vals];;
}
for my \$i (1 ..\$max_row - \$min_length + 1) {
my @vals = grep defined \$_, map { \$grid[\$i+\$_][\$max_col-\$_] }  0..\$max_col;
find_words \$_ for [@vals], [reverse @vals];
}
say join " ", sort keys %result;

__DATA__
B I D E M I A T S U C C O R S T
L D E G G I W Q H O D E E H D P
U S E I R U B U T E A S L A G U
N G N I Z I L A I C O S C N U D
T G M I D S T S A R A R E I F G
S R E N M D C H A S I V E E L I
S C S H A E U E B R O A D M T E
H W O V L P E D D L A I U L S S
R Y O N L A S F C S T A O G O T
I G U S S R R U G O V A R Y O C
N R G P A T N A N G I L A M O O
E I H A C E I V I R U S E S E D
S E T S U D T T G A R L I C N H
H V R M X L W I U M S N S O T B
A E A O F I L C H T O D C A E U
Z S C D F E C A A I I R L N R F
A R I I A N Y U T O O O U T P F
R S E C I S N A B O S C N E R A
D R S M P C U U N E L T E S I L
``````

This program produces the same output as the Raku program:

``````\$ perl letter-grid.pl
aimed align antes arose ashed blunt blunts broad buries clove cloven constitution croon depart departed duddie enter filch garlic goats grieve grieves grith hazard ileac liens lunts malign malignant malls midst midsts ought ovary parted pudgiest quash quashed raias raped roser ruses shrine shrines sices social socializing soyas spasm spasmodic succor succors theorem theorems virus viruses wigged
``````

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, September 13, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.