Actions from laurent_r Movable Type Pro 4.38 2021-09-21T23:30:42Z http://blogs.perl.org/mt/mt-cp.cgi?__mode=feed&_type=actions&blog_id=0&id=4694 Commented on Perl Weekly Challenge 130: Odd Number and Binary Search Tree in laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10422#1810931 2021-09-21T22:30:42Z laurent_r Yeah, right, it's another way of doing it. Not very significantly different, though. It may slightly improve performance for some data shapes.

]]>
Posted Perl Weekly Challenge 130: Odd Number and Binary Search Tree to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10422 2021-09-16T16:58:12Z 2021-09-16T17:01:25Z These are some answers to the Week 130 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 September 19, 2021 at 24:00). This blog... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 130 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 September 19, 2021 at 24:00). 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 of positive integers, such that all the numbers appear even number of times except one number.

Write a script to find that integer.

Example 1:

``````Input: @N = (2, 5, 4, 4, 5, 5, 2)
Output: 5 as it appears 3 times in the array where as all other numbers 2 and 4 appears exactly twice.
``````

Example 2:

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

Even though I have duly noted that the task specification states that only one number appears an odd number of time, I’ll expand slightly the task to find all the integers appearing an odd number of times, in the event that there is more than one.

### Odd Number in Raku

In Raku, a Bag is a built-in immutable collection of distinct elements in no particular order that each have an integer weight assigned to them signifying how many copies of that element are considered “in the bag”. This is the perfect data structure to implement an histogram from a list of input values: just converting the input list into a bag, i.e. a list of unique key-values with the value being the frequency of the key. We then just need to filter out keys whose values are even to obtain the desired result.

``````my \$bag = (2, 5, 4, 4, 5, 5, 2).Bag;
say grep { \$bag{\$_} % 2 }, \$bag.keys;
``````

This script displays the following output:

``````raku ./odd_number.raku
(5)
``````

Adding a 2 to the input list will make the 2-count odd:

``````\$ raku ./odd_number.raku
(5 2)
``````

### Odd Number in Perl

Perl doesn’t have a built-in `Bag` type, but it is almost as easy to implement an histogram using a hash. The algorithm is otherwise essentially the same:

``````#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

my %histo;
\$histo{\$_}++ for (2, 5, 4, 4, 5, 5, 2);
say join " ", grep { \$histo{\$_} % 2 } keys %histo;
``````

This script displays the following output:

``````\$ perl odd_number.pl
5
``````

Adding a 2 to the input list will make the 2-count odd:

``````\$ perl odd_number.pl
2 5
``````

## Task 2: Binary Search Tree

You are given a tree.

Write a script to find out if the given tree is Binary Search Tree (BST).

According to Wikipedia, the definition of BST:

A binary search tree is a rooted binary tree, whose internal nodes each store a key (and optionally, an associated value), and each has two distinguished sub-trees, commonly denoted left and right. The tree additionally satisfies the binary search property: the key in each node is greater than or equal to any key stored in the left sub-tree, and less than or equal to any key stored in the right sub-tree. The leaves (final nodes) of the tree contain no key and have no structure to distinguish them from one another.

Example 1:

``````Input:
8
/ \
5   9
/ \
4   6

Output: 1 as the given tree is a BST.
``````

Example 2:

``````Input:
5
/ \
4   7
/ \
3   6

Output: 0 as the given tree is a not BST.
``````

We’ll implement the binary tree as a nested hash of hashes, in which the keys are `val` (the current node value), `lc` (left child node), and `rc` (right child node).

### Binary Search Tree in Raku

we implement a recursive `dft` (depth-first traversal) subroutine to explore the tree. We return 0 when any value is larger than any previous value, except that a right child is larger than its immediate parent node.

``````use v6;

sub dft (%t, \$min) {
my \$value = %t<val>;
my \$new-min = \$value < \$min ?? \$value !! \$min ;
# say "\$max \$min \$value \$new-max \$new-min";
if %t<lc>:exists {
# say "%t<lc><val> \$min";
return 0 if %t<lc><val> > \$value;
return 0 if %t<lc><val> > \$min;
return 0 unless dft %t<lc>, \$new-min;
}
if %t<rc>:exists {
# say "%t<rc><val> \$min";
return 0 if %t<rc><val> < \$value;
return 0 if %t<rc><val> > \$min;
return 0 unless dft %t<rc>, \$new-min;
}
return 1;
}
my %tree1 = (
val => 8,
lc => { val => 5,
lc => {val => 4},
rc => {val => 6}
},
rc => {val => 9}
);
#       8
#      / \
#     5   9
#    / \
#   4   6
say (dft %tree1, Inf), "\n";

my %tree2 = (val => 5,
lc => { val => 4,
lc => {val => 3},
rc => {val => 6}
},
rc => {val => 7});
#       5
#      / \
#     4   7
#    / \
#   3   6
say dft %tree2, Inf;
``````

This displays the following output:

``````\$ raku ./bst.raku
1

0
``````

### Binary Search Tree in Perl

We also use a recursive `dft` (depth-first traversal) subroutine, with the same rules as above.

``````#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

sub dft {
my (\$t, \$min) = @_;
my \$value = \$t->{val};
my \$new_min = \$value < \$min ? \$value : \$min ;
# say " \$min \$value \$new_min";
if (exists \$t->{lc}) {
# say "%t<lc><val> \$min";
return 0 if \$t->{lc}{val} > \$value;
return 0 if \$t->{lc}{val} > \$min;
return 0 unless dft(\$t->{lc}, \$new_min);
}
if (exists \$t->{rc}) {
# say "%t<rc><val> \$max \$min";
return 0 if \$t->{rc}{val} < \$value;
return 0 if \$t->{rc}{val} > \$min;
return 0 unless dft(\$t->{rc}, \$new_min);
}
return 1;
}
my %tree1 = (
val => 8,
lc => { val => 5,
lc => {val => 4},
rc => {val => 6}
},
rc => {val => 9}
);
#       8
#      / \
#     5   9
#    / \
#   4   6
say "tree1: ", dft(\%tree1, 1e9), "\n";

my %tree2 = (val => 5,
lc => { val => 4,
lc => {val => 3},
rc => {val => 6}
},
rc => {val => 7});
#       5
#      / \
#     4   7
#    / \
#   3   6
say "tree2: ", dft \%tree2, 1e9;
``````

This displays the following output:

``````\$ perl  bst.pl
tree1: 1

tree2: 0
``````

## 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 September 26, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 128: Minimum Platforms to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10412 2021-09-07T21:41:27Z 2021-09-07T21:44:54Z These are some answers to the Week 128 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Note: very little time this week, so I only completed task 2. You are given two arrays of arrival and departure times... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 128 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Note: very little time this week, so I only completed task 2.

You are given two arrays of arrival and departure times of trains at a railway station.

Write a script to find out the minimum number of platforms needed so that no train needs to wait.

Example 1:

``````Input: @arrivals   = (11:20, 14:30)
@departures = (11:50, 15:00)
Output: 1

The 1st arrival of train is at 11:20 and this is the only train at the station, so you need 1 platform.
Before the second arrival at 14:30, the first train left the station at 11:50, so you still need only 1 platform.

Example 2:

Input: @arrivals   = (10:20, 11:00, 11:10, 12:20, 16:20, 19:00)
@departures = (10:30, 13:20, 12:40, 12:50, 20:20, 21:20)
Output: 3

Between 12:20 and 12:40, there would be at least 3 trains at the station, so we need minimum 3 platforms.

UPDATED [2021-08-30 23:30 UK TIME]: Corrected the between time description of the example 2. Thanks Peter Campbell Smith.
``````

We need to perform a number of comparisons between arrival and departure times. We could write a dedicated compare subroutine (which would be quite simple). I decided however that I prefer to convert all the times into time stamps, namely the number of seconds elapsed since 00:00 a.m. that day, for which we can simply perform a numerical comparison. Our program then reads both arrays in parallel, always picking the smallest value. A `size` counter keeps track of the number of trains in the station at any given time, and `\$max-size` keeps track of the maximum value reached by `\$size`.

## Minimum Platforms in Raku

Our program reads both arrays in parallel, always picking the smallest value. A `size` counter keeps track of the number of trains in the station at any given time, and `\$max-size` keeps track of the largest size reached. When reading to sets of values in parallel, there are usually two edge cases when we reach the end of any of the datasets. If we reach the end of the arrival times, we can just exit the loop, since we will not increase the `\$size` value beyond the maximum value so far. If we reach the end of the departure time array, then we need to increment the `\$max-size` by one for any value left in the arrival time array.

``````my @arrivals   = <10:20 11:00 11:10 12:20 16:20 19:00>;
my @departures = <10:30 13:20 12:40 12:50 20:20 21:20>;
my @ts-arr = map { my (\$m, \$s) = split /\:/, \$_; \$m * 60 + \$s;}, @arrivals;
my @ts-dep = map { my (\$m, \$s) = split /\:/, \$_; \$m * 60 + \$s;}, @departures;
my \$size = 0;
my \$max-size = 0;
while @ts-arr.end != 0 {
if @ts-dep.end == 0 {
\$max-size++;
} elsif @ts-arr <= @ts-dep {
shift @ts-arr;
\$size++;
\$max-size = \$size if \$size > \$max-size;
# say "\$size \$max-size";
} else {
shift @ts-dep;
\$size--;
}
}
say \$max-size;
``````

With the built-in sample input data, the program displays the following output:

``````\$ raku ./min-platforms.raku
3
``````

## Minimum Platforms in Perl

We’re basically porting the Raku program to Perl. Please refer to the above if you need explanations.

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

my @arrivals   = qw<10:20 11:00 11:10 12:20 16:20 19:00>;
my @departures = qw<10:30 13:20 12:40 12:50 20:20 21:20>;
my @ts_arr = map { my (\$m, \$s) = split /:/, \$_; \$m * 60 + \$s;} @arrivals;
my @ts_dep = map { my (\$m, \$s) = split /:/, \$_; \$m * 60 + \$s;} @departures;
my \$size = 0;
my \$max_size = 0;
while (@ts_arr) {
if (\$#ts_dep == 0) {
\$max_size++;
} elsif (\$ts_arr <= \$ts_dep) {
shift @ts_arr;
\$size++;
\$max_size = \$size if \$size > \$max_size;
# say "\$size \$max-size";
} else {
shift @ts_dep;
\$size--;
}
}
say \$max_size;
``````

Output:

``````\$ perl min-platforms.pl
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 September 12, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Commented on Perl Weekly Challenge 127: Disjoint Sets and Conflict Intervals in laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10391#1810916 2021-09-05T19:35:11Z laurent_r Hi Philip,

I love both Perl and Raku and do not wish to get into an argument about which language is better. Sure, when you start with a new programming language, you have to spend time to learn it. If you don't want to spend that time on Raku, fair enough, that's a perfectly reasonable argument. I personally very much enjoyed learning Raku and certainly do not regret the time I spent learning it.

]]>
Posted Perl Weekly Challenge 127: Disjoint Sets and Conflict Intervals to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10391 2021-08-29T21:41:56Z 2021-09-05T19:21:34Z These are some answers to the Week 127 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Task 1: Disjoint Sets You are given two sets with unique integers. Write a script to figure out if they are disjoint.... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 127 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

You are given two sets with unique integers.

Write a script to figure out if they are disjoint.

``````The two sets are disjoint if they don’t have any common members.
``````

Example:

``````Input: @S1 = (1, 2, 5, 3, 4)
@S2 = (4, 6, 7, 8, 9)
Output: 0 as the given two sets have common member 4.

Input: @S1 = (1, 3, 5, 7, 9)
@S2 = (0, 2, 4, 6, 8)
Output: 1 as the given two sets do not have common member.
``````

### Disjoint Sets in Raku

Raku has built-in `Set` type and operators, which are perfect match for the task at hand, so that the code doing the work holds in just one code line. The `is-disjoint` subroutine receives two lists as parameters. The `(&)` set intersection operator coerces the two lists into `Sets` and generate a new `Set` with the common items. The `is-disjoint` subroutine the returns 1 if the new set is empty and 0 otherwise.

``````use v6;

sub is-disjoint (\$s1, \$s2) {
return (\$s1 (&) \$s2).elems == 0 ?? 1 !! 0;
}
say is-disjoint (1, 2, 5, 3, 4), (4, 6, 7, 8, 9);
say is-disjoint (1, 3, 5, 7, 9), (0, 2, 4, 6, 8);
``````

This script generates the following output:

``````raku ./disjoint.raku
0
1
``````

### Disjoint Sets in Perl

Perl doesn’t have `Set` operators, but we can use a hash to more or less the same effect. The `is_disjoint` subroutine in the program below populates a hash with the data from one of the input lists and then loops over the data of the other list to find common items, if any.

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

sub is_disjoint {
my (\$s1, \$s2) = @_;
my %h1 = map { \$_ => 1 } @\$s1;
for my \$d (@\$s2) {
return 0 if exists \$h1{\$d};
}
return 1;
}
say is_disjoint [1, 2, 5, 3, 4], [4, 6, 7, 8, 9];
say is_disjoint [1, 3, 5, 7, 9], [0, 2, 4, 6, 8];
``````

This script generates the following output:

``````\$ perl  ./disjoint.pl
0
1
``````

You are given a list of intervals.

Write a script to find out if the current interval conflicts with any of the previous intervals.

Example:

``````Input: @Intervals = [ (1,4), (3,5), (6,8), (12, 13), (3,20) ]
Output: [ (3,5), (3,20) ]

- The 1st interval (1,4) do not have any previous intervals to compare with, so skip it.
- The 2nd interval (3,5) does conflict with previous interval (1,4).
- The 3rd interval (6,8) do not conflicts with any of the previous intervals (1,4) and (3,5), so skip it.
- The 4th interval (12,13) again do not conflicts with any of the previous intervals (1,4), (3,5) and (6,8), so skip it.
- The 5th interval (3,20) conflicts with the first interval (1,4).

Input: @Intervals = [ (3,4), (5,7), (6,9), (10, 12), (13,15) ]
Output: [ (6,9) ]

- The 1st interval (3,4) do not have any previous intervals to compare with, so skip it.
- The 2nd interval (5,7) do not conflicts with the previous interval (3,4), so skip it.
- The 3rd interval (6,9) does conflict with one of the previous intervals (5,7).
- The 4th interval (10,12) do not conflicts with any of the previous intervals (3,4), (5,7) and (6,9), so skip it.
- The 5th interval (13,15) do not conflicts with any of the previous intervals (3,4), (5,7), (6,9) and (10,12), so skip it.
``````

One thing is not clear to me in the task description and associated examples: are `(1,4)` and `(4, 6)` conflicting intervals? They have one common item, but it may be considered that they don’t really overlap. I will consider that they are conflicting intervals, although it may also be argued that they are not.

### Conflict Intervals in Raku

If you have a relatively large number of intervals, checking sequentially each interval with every preceding interval may turn out to be costly. So I preferred to implement a hash containing each value of the interval preceding ranges, since hash lookup is very efficient. Of course, this might be a problem for extremely large numbers of intervals (or extremely large intervals), as we may run out of memory. However, in real life situations, we can usually have an idea of the size of the input, and design our algorithm accordingly.

``````use v6;

my @intervals = (1,4), (3,5), (6,8), (12, 13), (3,20);
my %vals;
my @conflicts;
for @intervals -> \$interv {
my \$overlap = False;
my (\$st, \$end) = \$interv[0,1];
for \$st..\$end -> \$i {
\$overlap = True and next if %vals{\$i}:exists;
%vals{\$i} = 1;
}
push @conflicts, \$interv if \$overlap;
}
say @conflicts;
``````

This script displays the following output:

``````\$ raku ./conflict_intervals.raku
[(3 5) (3 20)]
``````

### Conflict Intervals in Perl

This Perl solution is a port to Perl of the Raku solution above and is based on the same assumptions regarding the size of the input data.

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

my @intervals = ([1,4], [3,5], [6,8], [12, 13], [3,20]);
my %vals;
my @conflicts;
for my \$interv (@intervals) {
my \$overlap = 0;
my (\$st, \$end) =  @\$interv[0..1];
for my \$i (\$st..\$end) {
\$overlap = 1, next if exists \$vals{\$i};
\$vals{\$i} = 1;
}
push @conflicts, \$interv if \$overlap;
}
say join ", ", @\$_ for @conflicts;
``````

This script displays the following output:

\$ perl ./conflict_intervals.pl 3, 5 3, 20

## 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 September 5, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 126: Count Numbers and Minesweeper Game to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10375 2021-08-19T22:16:34Z 2021-08-19T22:18:17Z These are some answers to the Week 126 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 August 22, 2021 at 24:00). This blog... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 126 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 August 22, 2021 at 24:00). 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 print count of numbers from 1 to `\$N` that don’t contain digit 1.

Example

``````Input: \$N = 15
Output: 8

There are 8 numbers between 1 and 15 that don't contain digit 1.
2, 3, 4, 5, 6, 7, 8, 9.

Input: \$N = 25
Output: 13

There are 13 numbers between 1 and 25 that don't contain digit 1.
2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25.
``````

### Count Numbers in Raku

This is quite simple. Our program simply loops over the integers in the `2..\$N` range and increments a counter for each integer not containing any 1.

``````sub check ( \$n where { \$n ~~ /^\d+\$/} ) {
my \$count = 0;
for 2..\$n -> \$i {
\$count++ unless \$i ~~ /1/;
}
say "There are \$count integers without a 1 in the 1..\$n range.";
}
check @*ARGS // 24;
``````

This script displays the following output:

``````\$ raku ./count_numbers.raku
There are 12 integers without a 1 in the 1..24 range.

\$ raku ./count_numbers.raku 32
There are 19 integers without a 1 in the 1..32 range.
``````

### Count Numbers in Perl

To have a bit more fun, I decided to write a different, more functional, implementation, with a `grep` on the range of integers. All the real work is done in a single code line:

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

my \$n = shift // 24;
my \$count = scalar grep {not /1/} 2..\$n;
say "There are \$count integers with no 1 in the 1..\$n range";
``````

This script displays the following output:

``````\$ perl ./count_numbers.pl
There are 12 integers with no 1 in the 1..24 range

\$ perl ./count_numbers.pl 32
There are 19 integers with no 1 in the 1..32 range
``````

### Count Numbers in Julia

Essentially a port of the Raku program to Julia:

``````function check(n)
count = 0;
for i in 2:n
if ! contains("\$i", "1")
count += 1
end
end
println("There are \$count integers without a 1 in the 1..\$n range.")
end
check(24);
``````

Output:

``````\$ julia ./count_numbers.jl
There are 12 integers without a 1 in the 1..24 range.
``````

You are given a rectangle with points marked with either x or `*`. Please consider the x as a land mine.

Write a script to print a rectangle with numbers and x as in the Minesweeper game.

``````A number in a square of the minesweeper game indicates the number of mines within the neighbouring squares (usually 8), also implies that there are no bombs on that square.
``````

Example:

``````Input:
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x

Output:
x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x
``````

In principle, this is quite easy, except that there are a number of edge cases (in the literal sense of the word edge), namely the edges and corners of the minesweeper grid.

Solving the edge cases might be as easy as dis-activating the “uninitialized” warnings, but I eschew doing that. Another way might be to add fictitious lines and columns (with no mine) around the grid and removing them at the end after the computations. I doubt though that it leads to a really simpler solution. Anyway, I decided to implement it “the hard way”, i.e. to check whether the position being examined is on a border or a corner.

### Minesweeper Game in Raku

The `get-count` subroutine does the hard work: for an input position in the grid, it checks which adjacent positions are defined and then computes the number of such adjacent position where there is a mine. The rest of the program is populating the grid (an array of arrays) and looping on every position of the grid to get the number of neighboring mines. Note that we’re using some dynamic scope variables to avoid passing them around.

``````use v6;

sub get-count (\i, \j) {
my \$count = 0;
my @positions;
for -1, 0, +1 -> \$k {
for -1, 0, +1 -> \$m {
push @positions, (i + \$k, j + \$m) unless \$k == \$m == 0;
}
}
my \$count-mines = 0;
for @positions -> \$pos {
next if \$pos | \$pos < 0;
next if \$pos > \$*max-i or \$pos > \$*max-j;
\$count-mines++ if @*mine-field[\$pos][\$pos] eq 'x';
}
return \$count-mines;
}

my @in-str =
"x * * * x * x x x x",
"* * * * * * * * * x",
"* * * * x * x * x *",
"* * * x x * * * * *",
"x * * * x * * * * x";

my @*mine-field;
# Populating an AoA from the array of strings
for @in-str -> \$line {
push @*mine-field, [split /\s+/, \$line];
}
say join "\n", @*mine-field, "\n";
my \$*max-i = @*mine-field.end;
my \$*max-j = @*mine-field.end;
for 0..\$*max-i -> \$i {
for 0..\$*max-j -> \$j {
next if @*mine-field[\$i][\$j] eq 'x';
@*mine-field[\$i][\$j] = get-count \$i, \$j;
}
}
say join "\n", @*mine-field;
``````

This program displays the following output:

``````\$ raku ./mine-sweeper.raku
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x
-
-
x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x
``````

### Minesweeper Game in Perl

This is essentially a port to Perl of the above Raku program. The `get_count` subroutine does the hard work: for an input position in the grid, it checks which adjacent positions are defined and then computes the number of such adjacent position where there is a mine. The rest of the program is populating the grid (an array of arrays) and looping on every position of the grid to get the number of neighboring mines.

``````use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my (@mine_field, \$max_i, \$max_j);

sub get_count {
my (\$i, \$j) = @_;
my \$count = 0;
my @positions;
for my \$k (-1, 0, +1) {
for my \$m (-1, 0, +1) {
push @positions, [\$i + \$k, \$j + \$m] unless \$k == 0 and \$m == 0;
}
}
my \$count_mines = 0;
for my \$pos (@positions) {
next if \$pos-> <0 or \$pos-> < 0;
next if \$pos-> > \$max_i or \$pos-> > \$max_j;
\$count_mines++ if \$mine_field[\$pos->][\$pos->] eq 'x';
}
return \$count_mines;
}

sub print_grid {
say "@\$_" for @_; say "";
}

my @in_str =
( "x * * * x * x x x x",
"* * * * * * * * * x",
"* * * * x * x * x *",
"* * * x x * * * * *",
"x * * * x * * * * x" );

# Populating an AoA from the array of strings
for my \$line (@in_str) {
push @mine_field, [split /\s+/, \$line];
}

\$max_i = \$#mine_field;
\$max_j = \$#{\$mine_field};
print_grid @mine_field;

for my \$i (0..\$max_i) {
for my \$j (0..\$max_j) {
next if \$mine_field[\$i][\$j] eq 'x';
\$mine_field[\$i][\$j] = get_count \$i, \$j;
}
}
print_grid @mine_field;
``````

This program displays the following output:

``````\$ perl ./mine-sweeper.pl
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x

x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x
``````

## 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 August 29, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 125: Pythagorean Triples to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10366 2021-08-15T22:36:20Z 2021-08-15T22:37:49Z These are some answers to the Week 125 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Task 1: Pythagorean Triples You are given a positive integer \$N. Write a script to print all Pythagorean Triples containing \$N as... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 125 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

You are given a positive integer \$N.

Write a script to print all Pythagorean Triples containing \$N as a member. Print -1 if it can’t be a member of any.

Triples with the same set of elements are considered the same, i.e. if your script has already printed (3, 4, 5), (4, 3, 5) should not be printed.

``````The famous Pythagorean theorem states that in a right angle triangle, the length of the two shorter sides and the length of the longest side are related by a²+b² = c².
``````

A Pythagorean triple refers to the triple of three integers whose lengths can compose a right-angled triangle.

Example:

``````Input: \$N = 5
Output:
(3, 4, 5)
(5, 12, 13)

Input: \$N = 13
Output:
(5, 12, 13)
(13, 84, 85)

Input: \$N = 1
Output:
-1
``````

It has been known since Euclid and is quite easy to prove that any integer larger than 2 can be part of a Pythagorean triple. We’ll use that knowledge in our implementation.

On the other hand, I don’t really know how to be sure that you really produce an exhaustive list of triples for a given input value.

### Pythagorean Triples in Raku

There are several possible ways to go for this task, but I decided to build a data structure with all Pythagorean triples within a certain range. This is probably efficient if we’re going to test many input values (as done in the script below), but probably not for one single value.

``````use v6;

my @squares = map { \$_² }, 1..Inf;
my \$max = 200;
my \$square-set = @squares[0..\$max];
my @square-triples = gather {
for (@squares[0..\$max]).combinations(2) -> \$comb {
my \$sum = [+] \$comb;
take (|\$comb, \$sum) if \$sum (elem) \$square-set;
}
}
# say @square-triples;
my %look-up = 0 => -1, 1 => -1, 2 => -1;
for @square-triples -> \$triple {
push %look-up, \$triple[\$_].sqrt => (map { \$_.sqrt}, \$triple[0..2]) for 0..2;
}
# say %look-up{13};
for 1..20 -> \$test {
say "\$test:\t", %look-up{\$test};
}
``````

This program displays the following output:

``````\$ raku ./pythagorean-triples.raku
1:      -1
2:      -1
3:      (3 4 5)
4:      (3 4 5)
5:      [(3 4 5) (5 12 13)]
6:      (6 8 10)
7:      (7 24 25)
8:      [(6 8 10) (8 15 17)]
9:      [(9 12 15) (9 40 41)]
10:     [(6 8 10) (10 24 26)]
11:     (11 60 61)
12:     [(5 12 13) (9 12 15) (12 16 20) (12 35 37)]
13:     [(5 12 13) (13 84 85)]
14:     (14 48 50)
15:     [(8 15 17) (9 12 15) (15 20 25) (15 36 39) (15 112 113)]
16:     [(12 16 20) (16 30 34) (16 63 65)]
17:     [(8 15 17) (17 144 145)]
18:     [(18 24 30) (18 80 82)]
19:     (19 180 181)
20:     [(12 16 20) (15 20 25) (20 21 29) (20 48 52) (20 99 101)]
``````

### Pythagorean Triples in Raku

Again, we produce a data structure with all Pythagorean triples within a certain range. This is probably efficient if we’re going to test many input values (as done in the script below), but probably not for one single value.

Perl don’t have a built-in `combinations` function. So, we could use again the recursive `combine` subroutine of last week’s challenge:

``````sub combine {
my \$count = shift;
my @out = @{\$_};
my @in  = @{\$_};
if (\$count == 0) {
push @combinations, [@out];
return;
}
for my \$i (0..\$#in) {
combine (\$count - 1, [@out, \$in[\$i]], [@in[0..\$i -1], @in[\$i+1..\$#in]]);
}
}
``````

and call it thus:

``````combine 2, [], [2..20]; # populates @combinations
``````

But, here, we only need to produce combinations of two items, and it is therefore simpler to generate them directly like this:

``````my @combinations;
for my \$i (2..200) {
push @combinations, [\$i, \$_] for \$i+1 .. \$max;
}
``````

So, this is my Perl implementation of the task:

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

my \$max = 300;
my @squares = map  \$_ * \$_ , 1..\$max;
my %square_hash = map { \$_ => 1 } @squares;
my @combinations;
for my \$i (2..200) {
push @combinations, [\$i, \$_] for \$i+1 .. \$max;
}
my @triples;
for my \$comb (@combinations) {
my \$sum_sq = \$comb-> ** 2 + \$comb-> ** 2;
push @triples, [ @\$comb, 0 + \$sum_sq ** 0.5 ] if exists \$square_hash{\$sum_sq};
}
my %look_up = (0 => " [ -1 ] ", 1 => " [ -1 ] ", 2 => " [ -1 ] " );
for my \$triple (@triples) {
for my \$val (@\$triple) {
\$look_up{\$val} .= " [ @\$triple ] " ;
}
}
for my \$test (1..30) {
my \$result = \$look_up{\$test};
say "\$test:\t \$result";
}
``````

This program displays the following output:

``````\$ perl pythagorean-triples.pl
1:        [ -1 ]
2:        [ -1 ]
3:        [ 3 4 5 ]
4:        [ 3 4 5 ]
5:        [ 3 4 5 ]  [ 5 12 13 ]
6:        [ 6 8 10 ]
7:        [ 7 24 25 ]
8:        [ 6 8 10 ]  [ 8 15 17 ]
9:        [ 9 12 15 ]  [ 9 40 41 ]
10:       [ 6 8 10 ]  [ 10 24 26 ]
11:       [ 11 60 61 ]
12:       [ 5 12 13 ]  [ 9 12 15 ]  [ 12 16 20 ]  [ 12 35 37 ]
13:       [ 5 12 13 ]  [ 13 84 85 ]
14:       [ 14 48 50 ]
15:       [ 8 15 17 ]  [ 9 12 15 ]  [ 15 20 25 ]  [ 15 36 39 ]  [ 15 112 113 ]
16:       [ 12 16 20 ]  [ 16 30 34 ]  [ 16 63 65 ]
17:       [ 8 15 17 ]  [ 17 144 145 ]
18:       [ 18 24 30 ]  [ 18 80 82 ]
19:       [ 19 180 181 ]
20:       [ 12 16 20 ]  [ 15 20 25 ]  [ 20 21 29 ]  [ 20 48 52 ]  [ 20 99 101 ]
21:       [ 20 21 29 ]  [ 21 28 35 ]  [ 21 72 75 ]  [ 21 220 221 ]
22:       [ 22 120 122 ]
23:       [ 23 264 265 ]
24:       [ 7 24 25 ]  [ 10 24 26 ]  [ 18 24 30 ]  [ 24 32 40 ]  [ 24 45 51 ]  [ 24 70 74 ]  [ 24 143 145 ]
25:       [ 7 24 25 ]  [ 15 20 25 ]  [ 25 60 65 ]
26:       [ 10 24 26 ]  [ 26 168 170 ]
27:       [ 27 36 45 ]  [ 27 120 123 ]
28:       [ 21 28 35 ]  [ 28 45 53 ]  [ 28 96 100 ]  [ 28 195 197 ]
29:       [ 20 21 29 ]
30:       [ 16 30 34 ]  [ 18 24 30 ]  [ 30 40 50 ]  [ 30 72 78 ]  [ 30 224 226 ]
``````

I’m very late and have no time this week for the second task.

## 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 August 22, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 124: Happy Women Day and Tug of War to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10334 2021-08-03T18:54:06Z 2021-08-07T21:40:58Z These are some answers to the Week 124 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 August 8, 2021 at 24:00). This blog... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 124 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 August 8, 2021 at 24:00). 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: Happy Women Day

Write a script to print the Venus Symbol, international gender symbol for women. Please feel free to use any character.

Example:

``````    ^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in Raku

The task specification provides little information, so we could just use a variable containing the ASCII art for the Venus symbol and print it out:

``````my \$venus = q:to/END/;
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
END
say \$venus;
``````

Predictably, this script displays the Venus symbol:

``````\$ raku ./venus.raku
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

But, of course, that doesn’t really look like a programming challenge. So, we’ll try to do a little bit more coding, with loops, array slices and so on. There are basically five line types. We’ll store those lines in variables and print the variables as appropriate to obtain the right figure. This might look like this:

``````use v6;

my \$bar = "   ^^^^^";
my @pairs = "  ^     ^", " ^       ^", "^         ^";
my \$single = "     ^";

say \$bar;
say join "\n", @pairs[0, 1, 2, 2, 2, 2, 2, 1, 0];
say \$bar;
say \$single for 1..3;
say \$bar;
say \$single for 1..2;
``````

This program displays the following output:

``````\$ raku ./venus2.raku
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

It would probably be simpler to put all five line types in an array, as we did in the Python implementation below, but it works as it is, and, as they say, if it ain’t broke, don’t fix it.

### Venus Symbol in Perl

This is essentially the same as the second Raku solution above:

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

my \$bar = "   ^^^^^";
my @pairs = ("  ^     ^", " ^       ^", "^         ^");
my \$single = "     ^";

say \$bar;
say join "\n", @pairs[0, 1, 2, 2, 2, 2, 2, 1, 0];
say \$bar;
say \$single for 1..3;
say \$bar;
say \$single for 1..2;
``````

Output:

``````\$ perl ./venus.pl
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

As for the Raku implementation, it would probably be simpler to put all five line types in an array, as we did in the Python implementation below.

### Venus Symbol in Sed

Here we use a sed stream editor one-liner to reformat data passed to it by the shell:

``````\$ echo '
llll11111llll
lll1lllll1lll
ll1lllllll1ll
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
ll1lllllll1ll
lll1lllll1lll
llll11111llll
llllll1llllll
llllll1llllll
llllll1llllll
llll11111llll
llllll1llllll
llllll1llllll
' | sed 's/l/ /g; s/1/x/g'

xxxxx
x     x
x       x
x         x
x         x
x         x
x         x
x         x
x       x
x     x
xxxxx
x
x
x
xxxxx
x
x
``````

Oh, yes, I know I probably shouldn’t be doing that, but I couldn’t resist the temptation of introducing a little bit of obfuscation. I guess the trick should be pretty obvious.

### Venus Symbol in Awk

This essentially a port to awk of the sed script just above, with the same obfuscation trick:

``````\$ echo '
llll11111llll
lll1lllll1lll
ll1lllllll1ll
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
ll1lllllll1ll
lll1lllll1lll
llll11111llll
llllll1llllll
llllll1llllll
llllll1llllll
llll11111llll
llllll1llllll
llllll1llllll
' | awk 'gsub("l", " ") gsub("1", "*")'

*****
*     *
*       *
*         *
*         *
*         *
*         *
*         *
*       *
*     *
*****
*
*
*
*****
*
*
``````

### Venus Symbol in Python

Here we use a solution similar to the Raku and Perl solutions above, except that we store all the line types in a single array, making the code significantly shorter:

``````lines = ("   ^^^^^", "  ^     ^", " ^       ^", "^         ^", "     ^")
for x in 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4:
print(lines[x])
``````

Output:

``````   ^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in Scala

``````object root extends App {
var venus = """
OOOO00000OOOO
OOO0OOOOO0OOO
OO0OOOOOOO0OO
O0OOOOOOOOO0O
O0OOOOOOOOO0O
O0OOOOOOOOO0O
O0OOOOOOOOO0O
O0OOOOOOOOO0O
OO0OOOOOOO0OO
OOO0OOOOO0OOO
OOOO00000OOOO
OOOOOO0OOOOOO
OOOOOO0OOOOOO
OOOOOO0OOOOOO
OOOO00000OOOO
OOOOOO0OOOOOO
OOOOOO0OOOOOO"""
val pattern = "O".r
venus = pattern replaceAllIn (venus, " ")
val pattern2 = "0".r
println(pattern2 replaceAllIn (venus, "+"))
}
``````

Output:

``````   +++++
+     +
+       +
+         +
+         +
+         +
+         +
+         +
+       +
+     +
+++++
+
+
+
+++++
+
+
``````

### Venus Symbol in Bash

We use a heredoc and pipe the input through a sed command to get a more interesting output:

``````#!/usr/bin/bash

if true; then
cat <<- END |  sed 's/v/♀/g'

vvvvv
v     v
v       v
v         v
v         v
v         v
v         v
v         v
v       v
v     v
vvvvv
v
v
v
vvvvv
v
v

END
fi
``````

Output:

``````\$ bash venus.bash

♀♀♀♀♀
♀     ♀
♀       ♀
♀         ♀
♀         ♀
♀         ♀
♀         ♀
♀         ♀
♀       ♀
♀     ♀
♀♀♀♀♀
♀
♀
♀
♀♀♀♀♀
♀
♀
``````

### Venus Symbol in Plain Bourne shell

Cheating a little bit, we can display the Venus symbol with a very simple shell one-liner:

``````\$ echo "♀"
♀
``````

### Venus Symbol in TCL

A very simple TCL script:

``````/usr/bin/tclsh

puts "♀"
``````

Output:

``````\$tclsh venus.tcl
♀
``````

### Venus Symbol in Java

Starting with Java 15, you can use so-called test blocks (i.e. multiline strings) by declaring the string with `"""` (three double-quote marks).

``````public class Main {
private static String venus = """
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
""";

public static void main(String args[]) {
System.out.printf(venus);
}
}
``````

Output:

``````   ^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in Lua

In Lua, you can use double square brackets `[[` and `]]` to define multiline strings.

``````venus =   [[
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
]]
print(venus)
``````

Output:

``````\$ lua venus.lua
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in C

Essentially a port to C of the Python program above:

``````#include <stdio.h>

const char * lines[] = { "   ^^^^^", "  ^     ^",
" ^       ^", "^         ^",
"     ^"};
const int indexes[] = { 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 };

int main() {
int size = sizeof (indexes) / sizeof (int);
for (int i = 0; i < size; i++) {
printf("%s\n", lines[indexes[i]]);
}
}
``````

Output:

``````\$ ./a.out
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in D

The D programming language syntax is quite similar to C, so this is a port to D of the C program just above:

``````import std.stdio;

string lines[] = [ "   ^^^^^", "  ^     ^",
" ^       ^", "^         ^",
"     ^"];
int indexes[] = [ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ];

int main() {
for (int i = 0; i < 18; i++) {
writeln(lines[indexes[i]]);
}
return 0;
}
``````

Output:

``````\$ ./venus.amx
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in Ruby

Same algorithm as in Python (and some other languages):

``````lines = ["   ooooo", "  o     o", " o       o", "o         o", "     o"]

for i in [0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4] do
puts lines[i]
end
``````

Output:

``````\$ ruby venus.rb
ooooo
o     o
o       o
o         o
o         o
o         o
o         o
o         o
o       o
o     o
ooooo
o
o
o
ooooo
o
o
``````

### Venus Symbol in Dart

``````var lines = [ "   ^^^^^", "  ^     ^",
" ^       ^", "^         ^",
"     ^"];
var indexes = [ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ];

void main() {
for (int i = 0; i < 18; i++ ) {
print(lines[indexes[i]]);
}
}
``````

Output:

``````\$ dart venus.dart
^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in Kotlin

``````fun main() {
val lines = arrayOf("   ^^^^^", "  ^     ^",
" ^       ^", "^         ^",  "     ^");

for (i in arrayOf(0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4)) {
println(lines[i]);
}
}
``````

Output (Kotlin program compiled to a Java Jar):

``````\$ java -jar venus.jar

^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in Go

``````package main
import "fmt"

func main() {
lines := string{"   ^^^^^", "  ^     ^",
" ^       ^", "^         ^",  "     ^"}
indexes := int{0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4}

for i := 0; i < 18; i++ {
fmt.Printf("%s\n", lines[indexes[i]])
}
}
``````

Same output as usual:

``````   ^^^^^
^     ^
^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
^       ^
^     ^
^^^^^
^
^
^
^^^^^
^
^
``````

### Venus Symbol in Nim

Nim uses Python-like code indentation.

``````let lines = ["   #####", "  #     #", " #       #", "#         #", "     #"]

for i in [ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ]:
echo lines[i]
``````

Output:

``````   #####
#     #
#       #
#         #
#         #
#         #
#         #
#         #
#         #
#       #
#     #
#####
#
#
#
#####
#
#
``````

### Venus Symbol in Julia

Julia arrays are 1-based, i.e. they start at 1, not 0.

``````lines = ["   ♀♀♀♀♀", "  ♀     ♀", " ♀       ♀", "♀         ♀", "     ♀"]
for i = [1, 2, 3, 4, 4, 4, 4, 4, 3, 2, 1, 5, 5, 5, 1, 5, 5]
println( lines[i] )
end
``````

Output:

``````\$ julia ./venus.jl
♀♀♀♀♀
♀     ♀
♀       ♀
♀         ♀
♀         ♀
♀         ♀
♀         ♀
♀         ♀
♀       ♀
♀     ♀
♀♀♀♀♀
♀
♀
♀
♀♀♀♀♀
♀
♀
``````

### Venus Symbol in Rust

``````fn main() {
let line = ["   #####", "  #     #", " #       #", "#         #", "     #"];
for i in [ 0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ] {
println!("{}", line[i]);
}
}
``````

Output:

``````   #####
#     #
#       #
#         #
#         #
#         #
#         #
#         #
#       #
#     #
#####
#
#
#
#####
#
#
``````

### Venus Symbol in Pascal

``````program venus;
var
lines: array[0..4] of string = ('   OOOOO', '  O     O', ' O       O', 'O         O', '     O');
indexes: array[0..16] of integer = (0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4);
i: integer;
begin
for i:= 0 to 16 do
writeln(lines[indexes[i]]);
end.
``````

Output:

``````   OOOOO
O     O
O       O
O         O
O         O
O         O
O         O
O         O
O       O
O     O
OOOOO
O
O
O
OOOOO
O
O
``````

### Venus Symbol in Zig

``````const std = @import("std");
const lines: []const u8 = [_][]const u8{"   QQQQQ", "  Q     Q", " Q       Q", "Q         Q", "     Q"};
const indexes = [_]usize{ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 };
pub fn main() !void {
const stdout = std.io.getStdOut().writer();
for (indexes) | idx | {
try stdout.print("{s}\n", .{lines[idx]});
}
}
``````

Output:

``````./venus
QQQQQ
Q     Q
Q       Q
Q         Q
Q         Q
Q         Q
Q         Q
Q         Q
Q         Q
Q       Q
Q     Q
QQQQQ
Q
Q
Q
QQQQQ
Q
Q
``````

### Venus Symbol in Io

Io is a class-less object-oriented language. The object system is based on prototypes. To build an object, you basically clone another object. Io also has strong support to cocurrent programming. To give a gist of its syntax, let me just give an “Hello world” example:

``````"Hello world" print
``````

What’s going on here is that the code sends the `print` message to the string `"Hello world"`. Receivers go on the left, and messages go on the right. You just send messages to objects. Another thing to know is that that to read an item of an array, the Io syntax is `array at(ind)`, where `ind` is the item subscript or index. With this in mind, it is quite easy to understand the `venus.io` script below:

``````lines := list("   *****", "  *     *", " *       *", "*         *", "     *", "")
indexes := list(0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4, 5)
for (i, 0, 17, lines at(indexes at(i)) println)
``````

Output:

``````\$ io venus.io
*****
*     *
*       *
*         *
*         *
*         *
*         *
*         *
*       *
*     *
*****
*
*
*
*****
*
*
``````

## Task 2: Tug of War

You are given a set of `\$n` integers (n1, n2, n3, ….).

Write a script to divide the set in two subsets of `n/2` sizes each so that the difference of the sum of two subsets is the least. If `\$n` is even then each subset must be of size `\$n/2` each. In case `\$n` is odd then one subset must be `(\$n-1)/2` and other must be `(\$n+1)/2`.

Example:

``````Input:        Set = (10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
Output:  Subset 1 = (30, 40, 60, 70, 80)
Subset 2 = (10, 20, 50, 90, 100)

Input:        Set = (10, -15, 20, 30, -25, 0, 5, 40, -5)
Subset 1 = (30, 0, 5, -5)
Subset 2 = (10, -15, 20, -25, 40)
``````

### Tug of War in Raku

We implement a `find_smallest_diff` subroutine that uses the combinations built-in method to generate all combinations of `int \$n/2` elements; for each such combination, it uses the `(-)` set difference operator to find the complementary combination and proceeds to compute the difference between the item sums; finally, it returns the partition having the smallest difference and the value of this difference.

``````use v6;

sub find_smallest_diff(@in) {
my \$inbag = @in.Bag;
my \$min_val = Inf;
my \$min_seq;
my \$count = @in.elems div 2;
for @in.combinations: \$count -> @c1 {
my @c2 = (\$inbag (-) @c1.Bag).keys;
if abs(@c2.sum - @c1.sum) < \$min_val {
\$min_val = abs(@c2.sum - @c1.sum);
\$min_seq = (@c1, " -- ", @c2);
}
}
return "\$min_seq => \$min_val";
}

my @tests = [10, 20, 30, 40, 50, 60, 70, 80, 90, 100],
[10, -15, 20, 30, -25, 0, 5, 40, -5];
say find_smallest_diff(\$_) for @tests;
``````

This programs displays the following output:

``````\$ raku ./tug.raku
10 20 50 90 100  --  40 30 80 70 60 => 10
10 -15 30 5  --  20 40 0 -25 -5 => 0
``````

### Tug of War in Perl

In Perl, we implement a `combine` recursive subroutine to find all combinations of a given size, and a `sum` subroutine to find the sum of all items of an array or list. Except for that, the algorithm to find the smallest difference (in the `find_smallest_diff` subroutine) is essentially the same as in Raku.

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

my @comb;

sub combine {
my \$count = shift;
my @out = @{\$_};
my @in  = @{\$_};
if (\$count == 0) {
push @comb, [@out];
return;
}
for my \$i (0..\$#in) {
combine (\$count - 1, [@out, \$in[\$i]], [@in[0..\$i -1], @in[\$i+1..\$#in]]);
}
}

sub sum {
my \$sum = 0;
\$sum += \$_ for @_;
return \$sum;
}

sub find_smallest_diff {
my @in = @{\$_};
my \$min_val;
my \$min_seq;
for my \$c (@comb) {
my @c1 = @\$c;
my %seen = map { \$_ => 1 } @c1;
my @c2 = grep  { not exists \$seen{\$_}} @in;
my \$diff = abs(sum(@c2) - sum(@c1));
\$min_val = \$diff unless defined \$min_val;
if (\$diff < \$min_val) {
\$min_val = \$diff;
\$min_seq = ("@c1 -- @c2 ");
}
}
return "\$min_seq => \$min_val";
}

for my \$test ( [10, 20, 30, 40, 50, 60, 70, 80, 90, 100],
[10, -15, 20, 30, -25, 0, 5, 40, -5] ) {
my \$count = int (@\$test / 2);
combine \$count, [], \$test;
say find_smallest_diff \$test;
}
``````

This program displays the following output:

``````\$ perl tug_of_war.pl
10 20 50 90 100 -- 30 40 60 70 80  => 10
10 -15 30 5 -- 20 -25 0 40 -5  => 0
``````

## 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 August 15, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 123: Ugly Numbers and Square Points to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10329 2021-07-31T22:31:57Z 2021-08-02T09:29:03Z These are some answers to the Week 123 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Spoiler Alert: This weekly challenge deadline is due on August 1, 2021 at 24:00. This blog post offers some solutions to this... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 123 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due on August 1, 2021 at 24:00. 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 integer `\$n` >= 1.

Write a script to find the \$nth element of Ugly Numbers.

``````Ugly numbers are those number whose prime factors are 2, 3 or 5. For example, the first 10 Ugly Numbers are 1, 2, 3, 4, 5, 6, 8, 9, 10, 12.
``````

Example

``````Input: \$n = 7
Output: 8

Input: \$n = 10
Output: 12
``````

### Ugly Numbers in Raku

The `is-ugly` subroutine finds whether its input value is ugly by dividing it by 2, 3 and 5 as long as it can do it evenly. At the end, the number is ugly if the end result is 1.

The program then simply builds an infinite lazy list of ugly numbers. The nth ` ugly number is just the nth number of that list.

``````use v6;

sub is-ugly (UInt \$in is copy where * > 0) {
for 2, 3, 5 -> \$div {
\$in div= \$div while \$in %% \$div;
}
return \$in == 1;
}
my \$ugly-nrs = grep {is-ugly \$_}, (1...Inf);
my \$n = @*ARGS // 7;
say \$ugly-nrs[\$n-1];
``````

Some sample executions:

``````\$ raku ./ugly-nrs.raku
8
-
\$ raku ./ugly-nrs.raku 10
12
-
\$ raku ./ugly-nrs.raku 100
1536
``````

### Ugly Numbers in Perl

The `is-ugly` subroutine is essentially similar to its counterpart in Raku: it finds whether its input value is ugly by dividing it by 2, 3 and 5 as long as it can do it evenly. At the end, the number is ugly if the end result is 1.

The rest or the program is quite different because there is no lazy list in Perl. So we basically use an infinite loop and test the successive integers for ugliness. The program counts the ugly numbers, and it prints out the number and exits the loop when the target range is reached.

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

sub is_ugly {
my \$in = shift;
for my \$div (2, 3, 5) {
\$in /= \$div while \$in % \$div == 0;
}
return \$in == 1;
}

my \$n = shift // 7;
my \$i = 0;
my \$count = 0;
while (1) {
\$count ++;
\$i++ if is_ugly \$count;
say \$count and last if \$i == \$n
}
``````

Some sample executions:

``````\$ perl ./ugly-nrs.pl
8

\$ perl ./ugly-nrs.pl 10
12

\$ perl ./ugly-nrs.pl 100
1536
``````

## Ugly Numbers in Scala

In Scala, we also use a `while` loop.

``````object root extends App {
def isUgly(in: Int): Boolean = {
var cpy = in
val div = List(2, 3, 5);
for (i <- div) {
while (cpy % i == 0) {
cpy = cpy / i
}
}
if (cpy == 1) { return true }
return false
}
val n = 7
var j = 0
var k = 0
while (k <= n) {
j = j + 1
if (isUgly(j)) {
k = k + 1
// println(k)
if (k == n) { println(k) }
}
}
}
``````

With the hard-coded input value of 7, the program duly prints 8, the 7th ugly number.

## Ugly Numbers in Python

``````import sys
def isUgly(n):
for div in [2, 3, 5]:
while (n % div == 0):
n = n / div;
if n == 1:
return True
return False;

count = 0
i = 0
target = int(sys.argv)
while count <= target:
i += 1;
if isUgly(i):
count += 1;
if count == target:
print(i)
break
``````

Sample output:

``````\$ python3 ugly-nums.py 7
8

\$ python3 ugly-nums.py 10
12

\$ python3 ugly-nums.py 100
1536
``````

You are given coordinates of four points i.e. (x1, y1), (x2, y2), (x3, y3) and (x4, y4).

Write a script to find out if the given four points form a square.

Example:

``````Input: x1 = 10, y1 = 20
x2 = 20, y2 = 20
x3 = 20, y3 = 10
x4 = 10, y4 = 10
Output: 1 as the given coordinates form a square.

Input: x1 = 12, y1 = 24
x2 = 16, y2 = 10
x3 = 20, y3 = 12
x4 = 18, y4 = 16
Output: 0 as the given coordinates doesn't form a square.
``````

How do we determine whether four points form a square? There is undoubtedly a number of ways to do that, but it seems to me that the easiest is to check whether the four edges of the quadrilateral are equal. The problem, though, is that we can compute 6 distances between four points, 4 or which are the edges, and two the diagonals. But we don’t know in advance which distance will be the edges and which will be the diagonals. So, essentially, for the six possible distances in a square, we expect four to be equal (the edges) and 2 others with a distance equal to the edge length multiplied by the square root of 2.

This is what we find with the distances computed in the first test case provided with the task:

``````([x => 10 y => 20] [x => 20 y => 20]) 10
([x => 10 y => 20] [x => 20 y => 10]) 14.142135623730951
([x => 10 y => 20] [x => 10 y => 10]) 10
([x => 20 y => 20] [x => 20 y => 10]) 10
([x => 20 y => 20] [x => 10 y => 10]) 14.142135623730951
([x => 20 y => 10] [x => 10 y => 10]) 10
``````

It seems likely that having two values for the six distances might be sufficient. But I would rather test that one of the distance values appears four times.

### Square Points in Raku

People who know me know that I am not really a great fan of object-oriented programming, but, in this case, I found that implementing a very simple `Point` class made some sense. The `dist` subroutine takes two `Point` objects as input parameters. Otherwise, the `build4point` subroutine creates four points from a list of numeric parameters.

The program computes the six possible distances between the four points, and confirm that the four points form a square if there are four distances that are equal. Note that, for “oblique” squares, it might be necessary to round the distances before comparing them, but that might lead to false squares. So there is a trade-off, and I’m not sure how to handle it. The program below doesn’t try to handle such specific cases.

``````use v6;

class Point {
has \$.x;    # abscissa
has \$.y;    # ordinate

method gist { return "[x => \$!x y => \$!y]"}
}

sub dist (Point \$a, Point \$b) {
return sqrt( (\$b.x - \$a.x)² + (\$b.y - \$a.y)² );
}

sub build4points (@in) {
my @points;
for @in -> \$x, \$y {
push @points, Point.new(x => \$x, y => \$y)
}
return @points;
}

my @tests = <10 20 20 20 20 10 10 10>,
<12 24 16 10 20 12 18 18>;
for @tests -> @test {
my @p = build4points @test;
my %dist;
for (@p).combinations: 2 -> \$c {
%dist{dist(\$c, \$c)}++;
}
# say %dist;
print @test, " => ";
if any(values %dist) == 4 {say 1;} else {say 0}
}
``````

This program displays the follwing output:

``````\$ raku .:square-points.raku
10 20 20 20 20 10 10 10 => 1
12 24 16 10 20 12 18 18 => 0
``````

### Square Points in Perl

We are not using OO-programming in Perl, but the algorithm is essentially the same.

``````use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

sub dist {
my (\$p1, \$p2) = @_;
sqrt((\$p2->{x} - \$p1->{x}) ** 2 + (\$p2->{y} - \$p1->{y}) ** 2);
}

sub build4points {
my @i = @_;
my @p;
for (1..4) {
push @p, { x => shift, y => shift };
}
return @p;
}
my @tests = ( [ qw/10 20 20 20 20 10 10 10/ ],
[ qw/12 24 16 10 20 12 18 18/ ] );
for my \$test (@tests) {
my @points = build4points(@\$test);
my %dist;
for my \$p ( [0, 1], [0, 2], [0, 3], [1, 2], [1, 3], [2, 3] ) {
my \$distance =  dist(\$points[\$p->], \$points[\$p->]);
\$dist{\$distance}++
}
# say Dumper \%dist;
print "@\$test => ";
if ( grep { \$_ == 4 } values %dist) {
say 1;
} else {
say 0;
}
}
``````

This program displays the following output:

``````\$ perl ./square-points.pl
10 20 20 20 20 10 10 10 => 1
12 24 16 10 20 12 18 18 => 0
``````

## 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 August 8, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 122: Average of Stream and Basketball Points to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10314 2021-07-20T21:19:53Z 2021-07-25T22:38:35Z These are some answers to the Week 122 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Spoiler Alert: This weekly challenge deadline is due in a few days, on July 25, 2021 at 24:00. This blog post offers... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 122 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days, on July 25, 2021 at 24:00. 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: Average of Stream

You are given a stream of numbers, `@N`.

Write a script to print the average of the stream at every point.

Example:

``````Input: @N = (10, 20, 30, 40, 50, 60, 70, 80, 90, ...)
Output:      10, 15, 20, 25, 30, 35, 40, 45, 50, ...

Average of first number is 10.
Average of first 2 numbers (10+20)/2 = 15
Average of first 3 numbers (10+20+30)/3 = 20
Average of first 4 numbers (10+20+30+40)/4 = 25 and so on.
``````

This is often called a moving average or a running average, or, more precisely in this case, a cumulative moving average, since we want to compute the mean of all data received so far.

It is of course possible to keep track of all data seen so far and, each time, to recompute the average from the whole dataset using standard formulas. However, if we have the current average and the number of values from which it was computed, it is quite easy to compute the new average with a new value. Suppose that the average of the first five values of a series is 8. This means that the sum s of the first five values was s = 5 x 8 = 40. As a new value, say 2, is taken into account, then the new sum is 42, and the new average is 42 / 6 = 7. So the rule it to multiply the current average by the current number of values, to add the new value and to divide this new sum by the new number of values, i.e. the current number of values plus 1.

### Average of Stream in Raku

Implementing the rule described above is fairly straight forward. For our test, we use an infinite (lazy) arithmetic sequence with a common difference of 10 between two consecutive terms.

``````use v6;

my @n = 10, 20 ... Inf;
my @cum_moving_avg = @n;
for 1..^10 -> \$i {
@cum_moving_avg[\$i] = (@cum_moving_avg[\$i-1] * \$i + @n[\$i]) / (\$i + 1);
}
say ~@cum_moving_avg;
``````

This program displays the following output:

``````raku ./mvg_avg.raku
10 15 20 25 30 35 40 45 50 55
``````

Note that, with an arithmetic sequence as input, the output sequence of moving average values is also an arithmetic sequence.

### Average of Stream in Perl

This is an implementation of the same rule in Perl. We cannot use an infinite sequence in Perl, so we simply use an arithmetic sequence of 10 terms.

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

my @n = (10, 20, 30, 40, 50, 60, 70, 80, 90, 100);
my @mvg_avg = (\$n);
for my \$i (1..9) {
\$mvg_avg[\$i] = (\$mvg_avg[\$i-1] * \$i + \$n[\$i]) / (\$i + 1);
}
say "@mvg_avg";
``````

This program displays the following output:

``````\$ perl ./mvg_mean.pl
10 15 20 25 30 35 40 45 50 55
``````

### Average of Stream in Scala

This is a port to Scala of the Raku and PPerl implementations above:

``````object root extends App {
val n = Array.range(10, 101, 10) // (10, 20, ... 100)
val mvg_avg = new Array[Int](10)
mvg_avg(0) = n(0)
for (i <- 1 to 9) {
mvg_avg(i) = (mvg_avg(i - 1) * i + n(i)) / (i + 1)
}
println(mvg_avg.mkString(" "))
}
``````

This program yields the following result:

``````10 15 20 25 30 35 40 45 50 55
``````

### Average of Stream in Python

A port to Python of the Raku and Perl versions above:

``````n = list(range(10, 100, 10)) # [10, 20 ... 90]
mvg = [n]
for i in range(1, 9):
mvg.append((mvg[i-1] * i + n[i])  / (i + 1))
print(mvg)
``````

Output:

``````\$ python3 mvg_mean.py
[10, 15.0, 20.0, 25.0, 30.0, 35.0, 40.0, 45.0, 50.0]
``````

### Average of Stream in C

Implementation of essentially the same algorithm in the C programming language. There is a slight change in the management of indices because the arguments passed to a C program start with `argv[1}` (since `argv` contains the program name). Another slight change is that this program doesn’t populate an array of mean values, but prints out the average value as soon as it is found. This should lead to a smaller memory footprint (which may be useful if the stream is very large).

``````#include <stdio.h>
#include <stdlib.h>

int main(int argc, char *argv[]) {
int avg = atoi(argv);
printf("%5i  ", avg);
for (int i = 1; i < argc - 1; i++) {
avg = (avg * i + atoi(argv[i+1])) / (i + 1);
printf("%3i ", avg);
};
printf("\n");
}
``````

Output:

``````\$ ./a.out 10 20 30 40 50 60 70 80 90 100
10   15  20  25  30  35  40  45  50  55
``````

### Average of Stream in Awk

Again some tweaks on the management of indices because of the specific properties and behavior of arrays in awk, but essentially the same algorithm.

``````{
avg = \$1;
print \$1;
for (i = 1; i < NF; i++) {
avg[i] = (avg[i-1] * i + \$(i+1)) / (i+1)
print avg[i]
}
}
``````

Output:

``````\$ echo '10 20 30 40 50 60 70 80 90 100
' | awk -f mvg_mean.awk
10
15
20
25
30
35
40
45
50
55
``````

### Average of Stream in D

The D programming language is similar to C or C°°, except that it is supposed to be more secure.

``````import std.stdio;
import std.math;
import std.conv;

void main(string[] args) {
int avg = std.conv.to!int(args);
printf ("%d ", avg);
for (int i = 1; i < args.length - 1; i++) {
avg = (avg * i + std.conv.to!int(args[i+1])) / (i + 1);
printf("%3d ", avg);
}
printf("\n");
}
``````

Output:

``````\$ mvg-mean.amx 10 20 30 40 50 60 70 80 90 100
10  15  20  25  30  35  40  45  5
``````

You are given a score `\$S`.

You can win basketball points e.g. 1 point, 2 points and 3 points.

Write a script to find out the different ways you can score `\$S`.

Example:

``````Input: \$S = 4
Output: 1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1

Input: \$S = 5
Output: 1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2
``````

I initially tried to use the `|` and `X` operators and the `combinations`, `unique` and some other method invocations to try to generate the values with a single expression, but turned out to be more difficult than I expected. So, I gave up and decided to use a good old recursive subroutine (`find-dist`) to generate all possible solutions leading to the target value:

``````use v6;

my \$target = @*ARGS // 5;
my @vals = 1, 2, 3;

sub find-dist (\$sum, @seq) {
for @vals -> \$i {
my \$new-sum = \$sum + \$i;
# if \$new-sum > \$target, then we don't
# need to test other values of @vals and
# can use return directly instead of next
# since these values are in ascending order
return if \$new-sum > \$target;
my @new-seq = |@seq, \$i;
if \$new-sum == \$target {
say ~@new-seq;
return;
} else {
find-dist(\$new-sum, @new-seq);
}
}
}
find-dist 0, ();
``````

This displays the following output:

``````\$ raku ./score-dist.raku
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

\$ raku ./score-dist.raku 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1
``````

This a port to Perl of the Raku solution using a recursive subroutine:

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

my \$target = shift // 5;
my @vals = (1, 2, 3);

sub find_dist  {
my (\$sum, @seq) = @_;
for my \$i (@vals) {
my \$new_sum = \$sum + \$i;
# if \$new_sum > \$target, then we don't
# need to test other values of @vals and
# can use return instead of next
# since these values are in ascending order
return if \$new_sum > \$target;
my @new_seq = (@seq, \$i);
if (\$new_sum == \$target) {
say ""@new_seq";
return;
} else {
find_dist(\$new_sum, @new_seq);
}
}
}
find_dist 0, ();
``````

This program generates the following output:

``````\$ perl score-dist.pl
1 1 1 1 1
1 1 1 2
1 1 2 1
1 1 3
1 2 1 1
1 2 2
1 3 1
2 1 1 1
2 1 2
2 2 1
2 3
3 1 1
3 2

\$ perl score-dist.pl 4
1 1 1 1
1 1 2
1 2 1
1 3
2 1 1
2 2
3 1
``````

## 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 August 1, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 121: Invert Bit to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10313 2021-07-17T22:05:19Z 2021-07-17T22:06:33Z These are some answers to the Week 121 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Spoiler Alert: This weekly challenge deadline is due on July 18, 2021 at 24:00. This blog post offers some solutions to this... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 121 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due on July 18, 2021 at 24:00. 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 integers `0 <= \$m <= 255` and `1 <= \$n <= 8`.

Write a script to invert `\$n` bit from the end of the binary representation of `\$m` and print the decimal representation of the new binary number.

Example:

``````Input: \$m = 12, \$n = 3
Output: 8

Binary representation of \$m = 00001100
Invert 3rd bit from the end = 00001000
Decimal equivalent of 00001000 = 8

Input \$m = 18, \$n = 4
Output: 26

Binary representation of \$m = 00010010
Invert 4th bit from the end = 00011010
Decimal equivalent of 00011010 = 26
``````

## Invert Bit in Raku

We use the fmt method to convert the input numeral into a binary string. We could also use the `base` method, but the `fmt` method makes it possible to also specify an output format on 8 digits in one step (with leading 0’s when needed). Then we use the substr to obtain the value of the `\$nth` bit from the right (using the `*-\$n` subscript for that), and we use the substr-rw to modify the relevant bit. Finally, we use the parse-base to convert back the result into its numeric equivalent.

``````use v6;

sub invert-bit (UInt \$m where * <=255, UInt \$n where 1 <= * <= 8) {
my \$bin = \$m.fmt("%08b");
# say \$bin;
my \$bit = \$bin.substr(*-\$n, 1);
\$bin.substr-rw(*-\$n, 1) = \$bit == 0 ?? 1 !! 0;
# say \$bin;
return \$bin.parse-base(2);
}
for 12, 3,
18, 4,
249, 1 {
say "\$^a \$^b => ", invert-bit \$^a, \$^b;
}
``````

This program displays the following output:

``````\$ raku ./invert-bit.raku
12 3 => 8
18 4 => 26
249 1 => 248
``````

## Invert Bit in Perl

The Perl program is essentially a port to Perl of the Raku program above. Since Perl doesn’t have a binary string to numeral conversion, we re-use the `bin2dec` subroutine implemented in a previous challenge. And we use `sprintf` to perform decimal to binary representation conversion.

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

sub bin2dec {
my \$bin = shift;
my \$sum = 0;
for my \$i (split //, \$bin) {
\$sum = \$sum * 2 + \$i;
}
return \$sum;
}

sub invert_bit {
my (\$m, \$n) = @_;
my \$bin = sprintf "%08b", \$m;
# say \$bin;
my \$bit = substr \$bin, -\$n, 1;
substr \$bin, -\$n, 1, \$bit == 0 ? 1 : 0;
# say \$bin;
return bin2dec \$bin;
}
for my \$pair ( [12, 3], [18, 4], [249, 1] ) {
say "@\$pair => ", invert_bit @\$pair;
}
``````

This program displays the following output:

``````\$ perl ./invert-bit.pl
12 3 => 8
18 4 => 26
249 1 => 248
``````

## Wrapping up

Because of my volunteer activity involvement in a Covid-19 vaccination center this weekend, I won’t have time this week to work on task 2. The traveling salesman problem has been studied in detail over decades and is not particularly difficult to understand and implement, but it does require quite a bit of coding effort for which I don’t have any free time this week.

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 July 25, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 120: Swap Odd/Even Bits and Clock Angle to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10291 2021-07-09T22:10:58Z 2021-07-09T22:12:13Z These are some answers to the Week 120 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Spoiler Alert: This weekly challenge deadline is due in a couple of days, on July 11, 2021). This blog post offers some... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 120 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days, on July 11, 2021). 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: Swap Odd/Even Bits

You are given a positive integer `\$N` less than or equal to 255.

Write a script to swap the odd positioned bit with even positioned bit and print the decimal equivalent of the new binary representation.

Example:

``````Input: \$N = 101
Output: 154

Binary representation of the given number is 01 10 01 01.
The new binary representation after the odd/even swap is 10 01 10 10.
The decimal equivalent of 10011010 is 154.

Input: \$N = 18
Output: 33

Binary representation of the given number is 00 01 00 10.
The new binary representation after the odd/even swap is 00 10 00 01.
The decimal equivalent of 100001 is 33.
``````

### Swap Odd/Even Bits in Raku

We use the fmt method to convert the input numeral into a binary string. We could also use the `base` method, but the `fmt` method makes it possible to also specify an output format on 8 digits in one step (with leading 0’s when needed). Then, we split the binary string into groups of two digits and swap them. Finally, we use the parse-base to convert back the result into its numeric equivalent.

``````use v6;

sub swap-bits (UInt \$n where * <=255) {
my \$bin = \$n.fmt("%08b");
\$bin ~~ s:g/(\d)(\d)/\$1\$0/;
return \$bin.parse-base: 2;
}
say "\$_ : ", swap-bits \$_ for 101, 154, 33, 18;
``````

This program displays the following output:

``````\$ raku ./swap_bits.raku
101 : 154
154 : 101
33 : 18
18 : 33
``````

### Swap Odd/Even Bits in Perl

The Perl program is essentially a port to Perl of the Raku program above. Since Perl doesn’t have a binary string to numeral conversion, we re-use the `bin2dec` subroutine implemented last week.

``````#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

sub bin2dec {
my \$bin = shift;
my \$sum = 0;
for my \$i (split //, \$bin) {
\$sum = \$sum * 2 + \$i;
}
return \$sum;
}

for my \$test (101, 154, 33, 18) {
my \$b2 = sprintf "%08b", \$test;
\$b2 =~ s/(\d)(\d)/\$2\$1/g;
say "\$test: ", bin2dec \$b2;;
}
``````

This program displays the following output:

``````\$ perl ./swap_bits.pl
101: 154
154: 101
33: 18
18: 33
``````

You are given time `\$T` in the format hh:mm.

Write a script to find the smaller angle formed by the hands of an analog clock at a given time.

HINT: A analog clock is divided up into 12 sectors. One sector represents 30 degree (360/12 = 30).

Example:

``````Input: \$T = '03:10'
Output: 35 degree

The distance between the 2 and the 3 on the clock is 30 degree.
For the 10 minutes i.e. 1/6 of an hour that have passed.
The hour hand has also moved 1/6 of the distance between the 3 and the 4, which adds 5 degree (1/6 of 30).
The total measure of the angle is 35 degree.

Input: \$T = '04:00'
Output: 120 degree
``````

### Clock Angle in Raku

The general problem is not very difficult, but, as with anything having to do with time, there is a number of edge cases making the solution more complicated than we might initially expect.

Here, we compute the angle of each hand with the origin (00h00) measured clockwise. Then we compute the absolute value of the difference. At he end, if we find an angle larger than 180, we replace it by its complement to 360.

``````use v6;

sub find-angle (Str \$t) {
my (\$h, \$m) = split /\:/, \$t;
# We compute angles in degrees from 0h00 and clockwise
my \$m-angle = \$m * 6;  # or: \$m * 360/60
my \$h-angle = (\$h * 360/12 + \$m-angle / 12) % 360;
my \$angle = abs (\$m-angle - \$h-angle);
return \$angle <= 180 ?? \$angle !!  360 - \$angle;
}
for <03:10 04:00 07:00 15:10 20:44> -> \$test {
say "\$test: ", find-angle \$test;
}
``````

This is the output displayed for the built-in test cases:

``````\$ raku ./find-angle.raku
03:10: 35
04:00: 120
07:00: 150
15:10: 35
20:44: 2
``````

### Clock Angle in Perl

This is essentially a port to Perl of the Raku program above (although I must admit that there is one edge case that I originally missed in my Raku implementation and that I corrected after having found out about it in the Perl program).

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

sub find_angle {
my \$time = shift;
my (\$h, \$m) = split /:/, \$time;
# angles counted in deg clockwise from the 0/12 position
my \$m_angle = \$m * 6; # or: \$m * 360/60
# for the short hand:
#     1 hr = 360 / 12 = 30 degrees
#     1 min = #m_angle / (360 / 30) = #m_angle /12
my \$h_angle = (\$h * 30 + \$m_angle / 12) % 360;
my \$hands_angle = abs(\$h_angle - \$m_angle);
return  \$hands_angle <= 180 ? \$hands_angle : 360 - \$hands_angle;
}

for my \$t (qw / 03:10 04:00 07:00 15:10 18:00 /) {
say "\$t: ", find_angle \$t;
}
``````

This is the output displayed for the built-in test cases:

``````\$ perl ./find-angle.pl
03:10: 35
04:00: 120
07:00: 150
15:10: 35
18:00: 180
``````

## 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 July 18, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 119: Swap Nibbles and Sequence without 1-on-1 to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10282 2021-07-01T22:08:55Z 2021-07-01T22:10:27Z These are some answers to the Week 119 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Spoiler Alert: This weekly challenge deadline is due in a couple of days, on Independence Day (July 4, 2021). This blog post... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 119 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days, on Independence Day (July 4, 2021). 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 swap the two nibbles of the binary representation of the given number and print the decimal number of the new binary representation.

``````A nibble is a four-bit aggregation, or half an octet.
``````

To keep the task simple, we only allow integer less than or equal to 255.

Example:

``````Input: \$N = 101
Output: 86

Binary representation of decimal 101 is 1100101 or as 2 nibbles (0110)(0101).
The swapped nibbles would be (0101)(0110) same as decimal 86.

Input: \$N = 18
Output: 33

Binary representation of decimal 18 is 10010 or as 2 nibbles (0001)(0010).
The swapped nibbles would be (0010)(0001) same as decimal 33.
``````

### Swap Nibbles in Raku

Raku has a built-in base method to convert a number to a string representation in a given base, and a parse-base method to perform the reverse operation. I thought it might be clever to use base 4 rather than base 2 to get directly two nibbles, but it turns out that it doesn’t make things any simpler than using a binary representation (as done in the Perl representation below). Note that we use the `fmt("%04s")` method invocation to pad the base-4 string representation with leading 0’s making the swap of the two nibbles very easy with a regex.

``````use v6;

for 254, 101, 18 -> \$n {
my \$b4 = \$n.base(4).fmt("%04s");
# say \$n.base(2).fmt("%08s");
\$b4 ~~ s/(\d**2)(\d**2)/\$1\$0/;
# say \$b4.parse-base(4).base(2).fmt("%08s");
say "\$n -> ", \$b4.parse-base(4);
}
``````

With the built-in test cases, this script displays the following output:

``````\$ raku ./swap-nibbles.raku
254 -> 239
101 -> 86
18 -> 33
``````

### Swap Nibbles in Perl

In Perl, we use the built-in `sprintf` function to convert a number to a binary string representation. And since there is no built-in function to perform the reverse operation, we roll out our own `bin2dec` subroutine. Otherwise, the Perl implementation is essentially similar to the Raku implementation.

``````#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

sub bin2dec {
my \$bin = shift;
my \$sum = 0;
for my \$i (split //, \$bin) {
\$sum = \$sum * 2 + \$i;
}
return \$sum;
}

for my \$test (254, 101, 18) {
my \$b2 = sprintf "%08b", \$test;
\$b2 =~ s/(\d{4})(\d{4})/\$2\$1/;
say bin2dec \$b2;;
}
``````

This program displays the following output:

``````\$ perl  swap-nibbles.pl
239
86
33
``````

## Task 2: Sequence without 1-on-1

Write a script to generate sequence starting at 1. Consider the increasing sequence of integers which contain only 1’s, 2’s and 3’s, and do not have any doublets of 1’s like below. Please accept a positive integer `\$N` and print the `\$N`th term in the generated sequence.

``````1, 2, 3, 12, 13, 21, 22, 23, 31, 32, 33, 121, 122, 123, 131, …
``````

Example:

``````Input: \$N = 5
Output: 13

Input: \$N = 10
Output: 32

Input: \$N = 60
Output: 2223
``````

### Sequence without 1-on-1 in Raku

In Raku, we just build an infinite lazy list representing this sequence. Since it’s a lazy list, Raku will generate only the sequence numbers needed by the program. We convert a list of consecutive integers into base-4 representations and filter out numbers containing 0’s or consecutive 1’s. Note that when we need the nth term of the series, we have to use index `n - 1`.

``````use v6;

my \$seq-no_1 = grep { not /11 | 0 / }, map { \$_.base(4) },
1..Inf;
say \$seq-no_1[\$_ - 1] for 5, 10, 60;
``````

This program displays the following output:

``````raku ./seq_123.raku
13
32
2223
``````

### Sequence without 1-on-1 in Perl

If we wanted to use the same principle in Perl, since we don’t have lazy lists, we would have to select a large enough maximum value. For example:

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

my @seq = grep { not /11/ } grep /^[1-3]+\$/, 1..5000;
say \$seq[\$_ + 1] for (5, 10, 60);
``````

This would display the following correct output:

``````\$ perl seq_123.pl
22
121
2232
``````

But this approach is not very satisfactory because we don’t know how to select a large enough value. If the selected value is too small, the program will fail, and it it is very large we might be doing a lot of useless computation.

The alternative is to build the successive terms of the sequence. We use the `incr` subroutine to implement the unusual counting rules. And call it as many times as needed to get the proper result:

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

sub incr {
my @num = @{\$_};
my \$i = \$#num;
while (\$i >= 0) {
if (\$num[\$i] < 3) {
\$num[\$i] ++;
return \@num;
} else {
\$num[\$i] = 1;
\$i --;
}
}
return [ 1, @num ];
}

for my \$i (5, 10, 60) {
my \$res =  ;
for (1..\$i) {
\$res = incr \$res;
\$res = incr \$res while (join "", @\$res) =~ /11/;
}
say @\$res;
}
``````

This yields the same output as before:

``````\$ perl seq_123_2.pl
13
32
2223
``````

## 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 July 11, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 118: Binary Palindrome to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10273 2021-06-23T22:11:16Z 2021-06-23T22:13:26Z These are some answers to the Week 118 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Spoiler Alert: This weekly challenge deadline is due in a couple of days (June 27, 2021). This blog post offers some solutions... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 118 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (June 27, 2021). 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 if the binary representation of the given integer is Palindrome. Print 1 if it is otherwise 0.

Example:

``````Input: \$N = 5
Output: 1 as binary representation of 5 is 101 which is Palindrome.

Input: \$N = 4
Output: 0 as binary representation of 4 is 100 which is NOT Palindrome.
``````

### Binary Palindrome in Raku

In Raku, the base method converts the invocant number to a string representation of the number in the given base. So we need to compare compare the binary representation of the number to its reverse string (using the flip routine). The code for doing that is a simple Raku one-liner. The `+` sign is used to numify Boolean values returned by the comparison (i.e. convert `True`and `False` values to 1 and 0, respectively).

``````use v6;

for 1..12 -> \$test {
say "\$test -> ", + (\$test.base(2) eq \$test.base(2).flip);
}
``````

This is the output with the 12 test cases:

``````\$ raku ./bin-palindrome.raku
1 -> 1
2 -> 0
3 -> 1
4 -> 0
5 -> 1
6 -> 0
7 -> 1
8 -> 0
9 -> 1
10 -> 0
11 -> 0
12 -> 0
``````

### Binary Palindrome in Perl

The Perl implementation is quite similar to the Raku implementation, except that we use the `sprintf` built-in function to convert the number to a binary representation of the input number.

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

for my \$test (1..12) {
my \$bin_num = sprintf "%b", \$test;
say "\$test -> ", \$bin_num eq reverse (\$bin_num) ? 1 : 0;
}
``````

This is the output with the 12 test cases:

``````\$ perl ./bin-palindrome.pl
1 -> 1
2 -> 0
3 -> 1
4 -> 0
5 -> 1
6 -> 0
7 -> 1
8 -> 0
9 -> 1
10 -> 0
11 -> 0
12 -> 0
``````

A knight is restricted to move on an 8×8 chessboard. The knight is denoted by N and its way of movement is the same as what it is defined in Chess.

`*` represents an empty square. `x` represents a square with treasure.

``````The Knight’s movement is unique. It may move two squares vertically and one square horizontally, or two squares horizontally and one square vertically (with both forming the shape of an L).
``````

There are 6 squares with treasures.

Write a script to find the path such that Knight can capture all treasures. The Knight can start from the top-left square.

``````  a b c d e f g h
8 N * * * * * * * 8
7 * * * * * * * * 7
6 * * * * x * * * 6
5 * * * * * * * * 5
4 * * x * * * * * 4
3 * x * * * * * * 3
2 x x * * * * * * 2
1 * x * * * * * * 1
a b c d e f g h
``````

BONUS: If you believe that your algorithm can output one of the shortest possible path.

I have secured a Raku program solving the knight’s tour problem, using Warnsdorff’s rule. Since this program guarantees that the knight visits every square exactly once, we’re guaranteed to find all treasures in a relatively limited number of moves. But it is rather unlikely to find the shortest possible path. I’ll try to look for an optimal path, but this appears to require an entirely different algorithm. I’m very busy this week: I have meetings late on Thursday and Friday evenings and I have a fully booked weekend, with at best a couple of hours free on Saturday night. In short, I’m really not sure that I’ll be able to complete task 2 in time. This is the reason I decided to publish this blog post with solutions to only task 1. I’ll update this post if I succeed to complete task 2 in due time.

## 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 Independence Day, i.e. July 4, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>
Posted Perl Weekly Challenge 117: Missing Row and Possible Paths to laurent_r tag:blogs.perl.org,2021:/users/laurent_r//3226.10270 2021-06-19T17:33:40Z 2021-06-19T17:35:14Z These are some answers to the Week 117 of the Perl Weekly Challenge organized by Mohammad S. Anwar. Spoiler Alert: This weekly challenge deadline is due in a couple of days (June 20, 2021). This blog post offers some solutions... laurent_r http://blogs.perl.org/mt/mt-cp.cgi?__mode=view&blog_id=3226&id=4694 These are some answers to the Week 117 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (June 20, 2021). 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 text file with rows numbered 1-15 in random order but there is a catch one row in missing in the file.

``````11, Line Eleven
1, Line one
9, Line Nine
13, Line Thirteen
2, Line two
6, Line Six
8, Line Eight
10, Line Ten
7, Line Seven
4, Line Four
14, Line Fourteen
3, Line three
15, Line Fifteen
5, Line Five
``````

Write a script to find the missing row number.

If the numbers are really 1 to 15 and if only one number is missing, then we could sum the numbers that we have and subtract the result from the sum of all integers between 1 and 15 (120), which would give us the missing number.

However, I’ll work on a task that is a bit more general: rather than only 1 to 15, I’ll use a range from 1 to any larger integer, and I’ll also suppose that there can be more than 1 number missing.

### Missing Row in Raku

I will simulate the input file as a string variable. We read the input data and store in the `%seen` hash the row numbers. At the end, we go through the range and print out numbers that are not in the hash.

``````use v6;

my \$file = "11, Line Eleven
1, Line one
9, Line Nine
13, Line Thirteen
2, Line two
6, Line Six
8, Line Eight
10, Line Ten
7, Line Seven
4, Line Four
14, Line Fourteen
3, Line three
15, Line Fifteen
5, Line Five";

my %seen;
my \$max = 0;

for \$file.lines -> \$line {
my \$num = \$line ~~ /^(\d+)/;
%seen{\$num} = 1;
\$max = \$num if \$num > \$max;
}
for 1..\$max -> \$i {
say "Missing number = ", \$i unless %seen{\$i}:exists;
}
``````

This program displays the following output:

``````raku ./missing_row.raku
Missing number = 12
``````

### Missing Row in Perl

This is essentially a port to Perl of the Raku program above, except that we store the input in a `__DATA__` section:

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

my %seen;
my \$max = 0;

while (my \$line = <DATA>) {
my \$num = \$1 if \$line =~ /^(\d+)/;
\$seen{\$num} = 1;
\$max = \$num if \$num > \$max;
}
for my \$i (1..\$max) {
say "Missing number = ", \$i unless exists \$seen{\$i};
}

__DATA__
11, Line Eleven
1, Line one
9, Line Nine
13, Line Thirteen
2, Line two
6, Line Six
8, Line Eight
10, Line Ten
7, Line Seven
4, Line Four
14, Line Fourteen
3, Line three
15, Line Fifteen
5, Line Five
``````

This program displays the same output as the Raku program:

``````\$ perl missing_row.pl
Missing number = 12
``````

## Task 2 - Find Possible Paths

You are given size of a triangle.

Write a script to find all possible paths from top to the bottom right corner.

In each step, we can either move horizontally to the right (H), or move downwards to the left (L) or right (R).

BONUS: Try if it can handle triangle of size 10 or 20.

Example 1:

``````Input: \$N = 2

S
/ \
/ _ \
/\   /\
/__\ /__\ E

Output: RR, LHR, LHLH, LLHH, RLH, LRH
``````

Example 2:

``````Input: \$N = 1

S
/ \
/ _ \ E

Output: R, LH
``````

First, I will not try the bonus, because the result would just be insanely large: a triangle of size 10 has more than one million possible paths and a triangle of size 20 has billions or possibly trillions of paths.

### Possible Paths in Raku

We use the recursive `visit` subroutine to build all possible paths.

``````use v6;

sub visit (\$row, \$col, \$path) {
print "\$path " and return if \$row == \$col == \$*end;
visit(\$row + 1, \$col + 1, "{\$path}R") if \$row < \$*end and \$col < \$*end;
visit(\$row, \$col + 1, "{\$path}H") if \$col < \$row;
visit(\$row + 1, \$col, "{\$path}L") if \$row < \$*end;
}

sub MAIN(UInt \$size = 3) {
my \$*end = \$size;
visit(0, 0, '');
}
``````

This program displays the following output:

``````raku ./possible_path.raku 3
RRR RRLH RLRH RLHR RLHLH RLLHH LRRH LRHR LRHLH LRLHH LHRR LHRLH LHLRH LHLHR LHLHLH LHLLHH LLRHH LLHRH LLHHR LLHHLH LLHLHH LLLHHH
``````

We can also find the number of paths with an input value of 10:

``````raku ./possible_path.raku 10 | wc
0 1037718 18474633
``````

### Possible Paths in Perl

This a port to Perl of the above Raku program:

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

my \$end = shift // 3;

sub visit  {
my (\$row, \$col, \$path) = @_;
print "\$path " and return if \$row == \$end and \$col == \$end;
visit(\$row + 1, \$col + 1, "\${path}R") if \$row < \$end and \$col < \$end;
visit(\$row, \$col + 1, "\${path}H") if \$col < \$row;
visit(\$row + 1, \$col, "\${path}L") if \$row < \$end;
}

visit(0, 0, '');
``````

This program displays the following output:

``````\$ perl possible_path.pl 3
RRR RRLH RLRH RLHR RLHLH RLLHH LRRH LRHR LRHLH LRLHH LHRR LHRLH LHLRH LHLHR LHLHLH LHLLHH LLRHH LLHRH LLHHR LLHHLH LLHLHH LLLHHH

\$ perl possible_path.pl 2
RR RLH LRH LHR LHLH LLHH
``````

## 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, June 27, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

]]>