# March 2020 Archives

## Perl Weekly Challenge 53: Rotate Matrix and Vowel Strings

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

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

Write a script to rotate the following matrix by given 90/180/270 degrees clockwise.

``````[ 1, 2, 3 ]
[ 4, 5, 6 ]
[ 7, 8, 9 ]
``````

For example, if you rotate by 90 degrees then expected result should be like below:

``````[ 7, 4, 1 ]
[ 8, 5, 2 ]
[ 9, 6, 3 ]
``````

This is fairly straight forward. We will write a subroutine to rotate a matrix by 90°, and then we just need to call that subroutine twice to rotate by 180°, and once more to rotate by 270°. We’ll also write a subroutine to display the matrices in a relatively compact graphical form.

### Rotate Matrix in Perl

Nothing complicated, we just need to have a clear mind representation of the matrix structure and be a bit cautious when managing array indices. Note that, trying various syntaxes, I re-discovered that you can use `\$#{\$input}` or even, simpler, `\$#\$input` for getting the last index of the `\$input` arrayref, and even `\$#{@\$input[\$row]}` to get the last index of the `row` subarray in an array of arrays. Granted, this last example looks a bit like line noise, but it works fine.

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

sub display_matrix {
my \$matrix = shift;
for my \$row (@\$matrix) {
say "[", join(", ", @\$row), "]";
}
}

sub rotate_90 {
my \$input = shift;
my @output;
for my \$row (0 .. \$#\$input) {
for my \$col (0 .. \$#{@\$input[\$row]}) {
\$output[\$col][\$#{@\$input[\$row]} - \$row] = \$input->[\$row][\$col];
}
}
return \@output;
}
sub rotate_180 {rotate_90 rotate_90 @_}
sub rotate_270 {rotate_90 rotate_180 @_}

my \$matrix_ref = [
[1, 2 ,3],
[4, 5, 6],
[7, 8, 9],
];
say "Initial matrix:";
display_matrix(\$matrix_ref);
say "\nMatrix rotated 90°";
display_matrix rotate_90 \$matrix_ref;
say "\nMatrix rotated 180°";
display_matrix rotate_180 \$matrix_ref;
say "\nMatrix rotated 270°";
display_matrix rotate_270 \$matrix_ref;
say "\nRotate 360 (sanity check, should be the initial matrix)";
display_matrix rotate_270 rotate_90 \$matrix_ref;
``````

Running this program leads to the following output:

``````\$ perl rotate_matrix.pl
Initial matrix:
[1, 2, 3]
[4, 5, 6]
[7, 8, 9]

Matrix rotated 90°
[7, 4, 1]
[8, 5, 2]
[9, 6, 3]

Matrix rotated 180°
[9, 8, 7]
[6, 5, 4]
[3, 2, 1]

Matrix rotated 270°
[3, 6, 9]
[2, 5, 8]
[1, 4, 7]

Rotate 360 (sanity check, should be the initial matrix)
[1, 2, 3]
[4, 5, 6]
[7, 8, 9]
``````

There is probably a simpler way to do that using slices, but while this seems quite easy if you know in advance that you’re gonna get a 3 x 3 matrix, it appeared to me that this is not so simple for square matrices of unknown dimensions and even more so for non-square matrices.

### Rotate Matrix in Raku

I’m pretty sure that there must be some Raku built-in operators or routines that could make the thing easier, but nothing obvious came to my mind. So I decided to be lazy and simply port the Perl solution:

``````use v6;

sub display_matrix (@matrix) {
for @matrix -> \$row {
say "[", join(", ", \$row), "]";
}
}
sub rotate_90 (@input) {
my @output;
for 0 .. @input.end -> \$row {
for 0 .. @input[\$row].end -> \$col {
@output[\$col][@input[\$row].end - \$row] = @input[\$row][\$col];
}
}
return @output;
}
sub rotate_180 (@matrix) {rotate_90 rotate_90 @matrix}
sub rotate_270 (@matrix) {rotate_90 rotate_180 @matrix}

my \$matrix = (
[1, 2 ,3],
[4, 5, 6],
[7, 8, 9],
);
say "Initial matrix:";
display_matrix(\$matrix);
say "\nMatrix rotated 90°";
display_matrix rotate_90 \$matrix;
say "\nMatrix rotated 180°";
display_matrix rotate_180 \$matrix;
say "\nMatrix rotated 270°";
display_matrix rotate_270 \$matrix;
say "\nRotate 360 (sanity check, should be the initial matrix)";
display_matrix rotate_270 rotate_90 \$matrix;
``````

This program displays almost exactly the same as the equivalent Perl program:

``````\$ perl6 rotate_matrix.p6
Initial matrix:
[1 2 3]
[4 5 6]
[7 8 9]

Matrix rotated 90°
[7 4 1]
[8 5 2]
[9 6 3]

Matrix rotated 180°
[9 8 7]
[6 5 4]
[3 2 1]

Matrix rotated 270°
[3 6 9]
[2 5 8]
[1 4 7]

Rotate 360 (sanity check, should be the initial matrix)
[1 2 3]
[4 5 6]
[7 8 9]
``````

Write a script to accept an integer 1 <= N <= 5 that would print all possible strings of size N formed by using only vowels (a, e, i, o, u).

The string should follow the following rules:

1. ‘a’ can only be followed by ‘e’ and ‘i’.
2. ‘e’ can only be followed by ‘i’.
3. ‘i’ can only be followed by ‘a’, ‘e’, ‘o’, and ‘u’.
4. ‘o’ can only be followed by ‘a’ and ‘u’.
5. ‘u’ can only be followed by ‘o’ and ‘e’.

For example, if the given integer N = 2 then script should print the following strings:

``````ae
ai
ei
ia
io
iu
ie
oa
ou
uo
ue
``````

Although this is not explicitly stated, we will take it for granted that some letters may be repeated in the strings, provided they follow the rules. For example, since ‘u’ may be followed by ‘o’, and ‘o’ may be followed by ‘u’, strings such as “uou” or “ouo” are valid.

### Vowel Strings in Perl

One good way to implement the rules (such as ‘a’ can only be followed by ‘e’ and ‘i’) is to build a hash of arrays (`%successors`) where the keys are the vowels, and the values arrays of vowels that can follow the vowel given in the key (so, for example: `a => ['e', 'i']`). For any letter that we insert into a string, the hash will give us the list of letters that we can insert next. To cover the tree of possibilities, the easiest is to built a recursive subroutine (`make_str`) that will print all the permitted combinations.

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

my %successors = (
a => ['e', 'i'],
e => ['i'],
i => [qw /a e o u/],
o => ['a', 'u'],
u => ['e', 'o']
);
my @vowels = sort keys %successors;
my \$error_msg = "Please pass a parameter between 1 and 5.";
my \$str_size = shift or die \$error_msg;
die \$error_msg unless \$str_size =~ /^[1-5]\$/;

for my \$start (@vowels) {
make_str(\$str_size -1, \$start, \$start);
}

sub make_str {
my (\$left, \$last, \$string) = @_;
say \$string and return unless \$left; # Stop the recursion
for my \$next (@{\$successors{\$last}}) {
my \$new_str = \$string . \$next;
make_str(\$left -1, \$next, \$new_str);
}
}
``````

Here are some sample runs of this program:

``````\$ perl vowel_strings.pl
Please pass a parameter between 1 and 5. at vowel_strings.pl line 14.

\$ perl vowel_strings.pl 2
ae
ai
ei
ia
ie
io
iu
oa
ou
ue
uo

\$ perl vowel_strings.pl 3
aei
aia
aie
aio
aiu
eia
eie
eio
eiu
iae
iai
iei
ioa
iou
iue
iuo
oae
oai
oue
ouo
uei
uoa
uou
``````

Rather than building the allowed strings using the hash as above, we could build a list of all vowel combinations (e.g. using the `glob` built-in function) having the right size, and then filter out those not matching the succession rules. We won’t present here an implementation of this strategy (the code can be shorter, but this tends to be somewhat inefficient when the string size exceeds 2 or 3), but we will show one such implementation below in Raku.

### Vowel Strings in Raku

#### Porting to Raku the Perl Program

To start with, we will use hash of arrays (`%successors`) where the keys are the vowels, and the values arrays of vowels that can follow the vowel given in the key, as in our Perl implementation. For any letter that we insert into a string, the hash will give us the list of letters that we can insert next. And we will also use a recursive subroutine (`make_str`) to generate the full tree of permitted combinations.

``````use v6;

my %successors = (
'a' => ['e', 'i'],
'e' => ['i'],
'i' => [qw /a e o u/],
'o' => ['a', 'u'],
'u' => ['e', 'o']
);
my @vowels = sort %successors.keys;
sub MAIN (UInt \$str_size where 1 <= * <= 5) {
my \$error_msg = "Please pass a parameter between 1 and 5.";
die \$error_msg unless \$str_size ~~ /^<[1..5]>\$/;
for @vowels -> \$start {
make_str(\$str_size -1, \$start, \$start);
}
}
sub make_str (UInt \$left, Str \$last, Str \$string) {
say \$string and return unless \$left;
for |%successors{\$last} -> \$next {
my \$new_str = \$string ~ \$next;
make_str(\$left -1, \$next, \$new_str);
}
}
``````

These are two sample runs:

``````\$ perl6 vowel_strings.p6
Usage:
vowel_strings.p6 <str_size>

\$ perl6 vowel_strings.p6 3
aei
aia
aie
aio
aiu
eia
eie
eio
eiu
iae
iai
iei
ioa
iou
iue
iuo
oae
oai
ouo
ouo
uei
uoa
uou
``````

#### Generating all Vowels Combinations and Keeping the Valid Strings

Given that Raku has the `combinations` and `permutations` built-in methods, it would seem interesting to use them to generate all the candidate strings and then to filter out those not matching the rules.

But this turned out to be a bit more difficult than expected. First, if we want to to get strings such as “aia,” neither of the built-in methods mentioned before can do that. We need to “multiply” the original list of vowels and that leads to a lot of permutations and/or combinations, and also to duplicate strings that will need to be removed. In the program below, we first generate all combinations of `\$size` letters, then all permutations of these combinations, and use some regexes to remove strings with unwanted letter combinations. And we use a `SetHash` (`\$result`) to remove duplicates:

``````sub MAIN (UInt \$size where 1 <= * <= 5) {
my @vowels = | qw/a e i o u / xx (\$size - 1);
my SetHash \$result;
for @vowels.combinations(\$size) -> \$seq {
for | \$seq.permutations>>.join('') {
next if /(\w) \$0/;
next if  /ao|au|ea|eo|eu|oe|oi|ua|ui/;
\$result{\$_}++;
}
}
.say for \$result.keys.sort;
}
``````

This program produces the same results as before, but is quite slow (about 3.5 second for strings of 4 letters, versus 0.35 second for the original Raku program). Obviously, this program does a large amount of unnecessary work. We can reduce this by removing part of the duplicates earlier on, with two calls to the `unique` method:

``````sub MAIN (UInt \$size where 1 <= * <= 5) {
my @vowels = | qw/a e i o u / xx (\$size - 1);
my SetHash \$result;
for @vowels.combinations(\$size).unique(:with(&[eqv])) -> \$seq {
for | \$seq.permutations>>.join('').unique {
next if /(\w) \$0/;
next if  /ao|au|ea|eo|eu|oe|oi|ua|ui/;
\$result{\$_}++;
}
}
.say for \$result.keys.sort;
}
``````

For strings of 4 letters, the execution time is now a bit less that 2 seconds. We could further improve performance by fine tuning the number of times the original vowel alphabet is duplicated. For example, using only twice the original alphabet for strings of 4 letters (instead of 3 times as in the above program), the execution time is reduced to 0.8 second. Still significantly longer than the original Raku program.

## Wrapping up

The next week Perl Weekly Challenge is due to 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, April 5, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 52: Stepping Numbers and Lucky Winner

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

Write a script to accept two numbers between 100 and 999. It should then print all Stepping Numbers between them.

A number is called a stepping number if the adjacent digits have a difference of 1. For example, 456 is a stepping number but 129 is not.

Just to make things slightly clearer, I would say that all adjacent digits should have an absolute difference of 1, so that 542, 454, or 654 are also stepping numbers.

### Stepping Numbers in Perl

Given that the range is quite small, we can use a brute force approach on all numbers between the input values: check for every number in the range whether it fits the definition.

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

die "Please provide two numbers between 100 and 999" if @ARGV != 2;
my (\$start, \$end) = @ARGV;
chomp \$end;
die "Invalid parameters" if \$start !~ /^\d{3}\$/ or \$end !~ /^\d{3}\$/;
(\$start, \$end) = (\$end, \$start) if \$start > \$end;
for my \$num (\$start..\$end) {
my @digits = split //, \$num;
if (abs(\$digits[0] - \$digits[1]) == 1 &&
abs(\$digits[1] - \$digits[2]) == 1) {
say "\$num is a stepping number.";
}
}
``````

This is an example execution:

``````\$ perl stepping_numbers.pl 600 230
232 is a stepping number.
234 is a stepping number.
321 is a stepping number.
323 is a stepping number.
343 is a stepping number.
345 is a stepping number.
432 is a stepping number.
434 is a stepping number.
454 is a stepping number.
456 is a stepping number.
543 is a stepping number.
545 is a stepping number.
565 is a stepping number.
567 is a stepping number.
``````

Note that there is another possible approach: we could construct only stepping numbers and check that they are in the range. We will show this in Raku.

### Stepping Numbers in Raku

Using essentially the same brute-force algorithm as in Perl might lead to the following code:

``````use v6;

subset Three-digits of Int where 99 < * < 1000;

multi sub prefix:<dif1> (List \$val) {
abs(\$val[0] - \$val[1]) == 1 ?? True !! False;
}

sub MAIN (Three-digits \$start is copy, Three-digits \$end is copy) {
(\$start, \$end) = (\$end, \$start) if \$start > \$end;

for \$start..\$end -> \$num {
my \$flag = True;
for \$num.comb.rotor: 2 => -1 -> \$seq {
\$flag = False unless dif1 \$seq;
}
say "\$num is a stepping number." if \$flag;
}
}
``````

This is an example output:

``````\$ perl6 3-digits.p6 200 400
210 is a stepping number.
212 is a stepping number.
232 is a stepping number.
234 is a stepping number.
321 is a stepping number.
323 is a stepping number.
343 is a stepping number.
345 is a stepping number.
``````

But, as said earlier, we could use a different algorithm: we could construct only stepping numbers and check that they are in the range. This leads to the following solution:

``````subset Three-digits of Int where 99 < * < 1000;

sub func (Three-digits \$start is copy, Three-digits \$end is copy) {
(\$start, \$end) = (\$end, \$start) if \$start > \$end;
for 1..9 -> \$i {
for \$i-1, \$i+1 -> \$j {
for \$j-1, \$j+1 -> \$k {
my \$num = 100*\$i + 10*\$j + \$k;
say "\$num is a stepping number." if \$start < \$num < \$end;
}
}
}
}
``````

This program displays the same result as the previous solution when given the same inputs. Note that the outer loop (`for 1..9 -> \$i {`) could easily be improved in terms of performance by using the first digit of the input numbers for the range. However, the program is so fast that this is not required.

Suppose there are following coins arranged on a table in a line in random order.

``````£1, 50p, 1p, 10p, 5p, 20p, £2, 2p
``````

Suppose you are playing against the computer. Player can only pick one coin at a time from either ends. Find out the lucky winner, who has the larger amounts in total?

I do not fully understand the last sentence as a clear task. My interpretation will be to write a computer program that will win each time it can.

Looking at the challenge, the winner is the player that picks the 200p coin, since the sum of all other coins is less than 200p. Since, in any game, one of the player can end up picking the 200p coin, we don’t need to care about the other coins, we just need to optimize our strategy to get the 200p coin.

For this, we should try to leave an odd number of coins on either side of the 200p coin, so that the other player is forced to leave an even number of coins and eventually 0 coin on either side. With 8 coins, the first player can always win.

### Lucky Winner in Perl

Optimizing for the 200p coin leads to the following program:

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

my @coins = @ARGV > 0 ? @ARGV : (100, 50, 1, 10, 5, 20, 200, 2);

my (\$index200) = grep \$coins[\$_] == 200, 0..\$#coins;
my @before = @coins[0..\$index200-1];
my @after = @coins[\$index200+1..\$#coins];
while (my \$move = <STDIN>) {
chomp \$move;
last if \$move eq "";
my \$coin;
if (\$move eq "B") {
\$coin = shift @before // 200;
} elsif (\$move eq "E") {
\$coin = pop @after // 200;
} else {
say "Invalid choice"; next;
}
if (\$coin == 200) {
say "You win!"; last;
}
if (@before == 0) {
say "I pick the 200p coin at start and win"; last;
} elsif (@after == 0) {
say "I pick the 200p coin at end and win"; last;
}
if (@before % 2 == 0) {
\$coin = shift @before;
} elsif (@after %2 == 0) {
\$coin = pop @after;
} else {
# no winning move, let's hope for a mistake
if (@before > @after) {
\$coin = shift @before;
} else {
\$coin = pop @after;
}
}
}

say "New situation = @before 200 @after";
say "Pick a coin at beginning (B) or end (E)";
}
``````

Running it displays the following sample output:

``````\$ perl  coins.pl
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E)
B
New situation = 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E)
B
New situation = 5 20 200 2
Pick a coin at beginning (B) or end (E)
B
New situation = 20 200
Pick a coin at beginning (B) or end (E)
E
You win!
``````

Or:

``````\$ perl  coins.pl
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E)
E
I pick the 200p coin at end and win
``````

### Lucky winner in Raku

Just as in Perl, we are looking for the 200p coin:

``````my @coins = @*ARGS.elems > 0 ?? @*ARGS !! (100, 50, 1, 10, 5, 20, 200, 2);

say @coins;
my (\$index200) = grep { @coins[\$_] == 200}, 0..@coins.end;
my @before = @coins[0..\$index200-1];
my @after = @coins[\$index200+1..@coins.end];
loop  {
last if \$move eq "";
my \$coin;
if (\$move eq "B") {
\$coin = @before.elems ?? shift @before !! 200;
} elsif (\$move eq "E") {
\$coin = @after.elems ?? pop @after !! 200;
} else {
say "Invalid choice"; next;
}
if (\$coin == 200) {
say "You win!"; last;
}
if (@before.elems == 0) {
say "I pick the 200p coin at start and win"; last;
} elsif (@after.elems == 0) {
say "I pick the 200p coin at end and win"; last;
}
if (@before %% 2) {
\$coin = shift @before;
} elsif (@after %% 2) {
\$coin = pop @after;
} else {
# no winning move, let's hope for a mistake
if (@before.elems > @after.elems) {
\$coin = shift @before;
} else {
\$coin = pop @after;
}
}
}

say "New situation = @before[] 200 @after[]";
my \$choice = prompt "Pick a coin at beginning (B) or end (E) ";
}
``````

This program leads to similar results as the Perl program:

``````\$ perl6 coins.p6
[100 50 1 10 5 20 200 2]
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E) E
I pick the 200p coin at end and win
``````

Or:

``````\$ perl6 coins.p6
[100 50 1 10 5 20 200 2]
New situation = 100 50 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E) B
New situation = 1 10 5 20 200 2
Pick a coin at beginning (B) or end (E) B
New situation = 5 20 200 2
Pick a coin at beginning (B) or end (E) B
New situation = 20 200
Pick a coin at beginning (B) or end (E) E
You win!
``````

## Wrapping up

The next week Perl Weekly Challenge is due to 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, March 29, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge # 50: Merge Intervals and Noble Numbers

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

Write a script to merge the given intervals where ever possible.

``````[2,7], [3,9], [10,12], [15,19], [18,22]
``````

The script should merge [2, 7] and [3, 9] together to return [2, 9].

Similarly it should also merge [15, 19] and [18, 22] together to return [15, 22].

The final result should be something like below:

``````[2, 9], [10, 12], [15, 22]
``````

The example shows that intervals should be merged only if they overlap, but not if they are contiguous (in the example, [2,9] is not merged with [10, 12]).

### Merge Intervals in Perl

For each interval except the first one, we check whether it overlaps with the previous one (stored in the `\$current` variable); if it does overlap, we build a new interval merging it with `\$current`.

``````use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @intervals = ([2,7], [3,4], [5,9], [10,12], [15,19], [18,22], [0,1], [24,35], [25,30]);
@intervals =  sort { \$a->[0] <=> \$b->[0] } @intervals;
my @merged;
# say Dumper \@intervals;
my \$current = \$intervals[0];
for my \$i (1..\$#intervals) {
if (\$intervals[\$i][0] > \$current->[1]) {
push @merged, \$current;
\$current = \$intervals[\$i];
} else {
next unless \$intervals[\$i][1] > \$current->[1];
\$current->[1] = \$intervals[\$i][1];
}
}
push @merged, \$current;
say Dumper \@merged;
``````

Running this program displays the expected result:

``````\$ perl intervals.pl
\$VAR1 = [
[
0,
1
],
[
2,
9
],
[
10,
12
],
[
15,
22
],
[
25,
30
]
];
``````

### Merge Intervals in Raku

We use the same algorithm as in Perl:

``````my @intervals = [2,7], [3,4], [5,9], [10,12], [15,19], [18,22], [0,1], [24,35], [25,30];
@intervals =  sort { \$_[0] }, @intervals;
my @merged;
my \$current = @intervals[0];
for 1..@intervals.end -> \$i {
if (@intervals[\$i][0] > \$current[1]) {
push @merged, \$current;
\$current = @intervals[\$i];
} else {
next unless @intervals[\$i][1] > \$current[1];
\$current[1] = @intervals[\$i][1];
}
}
push @merged, \$current;
say @merged;
``````

And this prints out the expected result:

``````[[0 1] [2 9] [10 12] [15 22] [24 35]]
``````

You are given a list, @L, of three or more random integers between 1 and 50. A Noble Integer is an integer N in @L, such that there are exactly N integers greater than N in @L. Output any Noble Integer found in @L, or an empty list if none were found.

An interesting question is whether or not there can be multiple Noble Integers in a list.

For example,

Suppose we have list of 4 integers [2, 6, 1, 3].

Here we have 2 in the above list, known as Noble Integer, since there are exactly 2 integers in the list i.e.3 and 6, which are greater than 2.

Therefore the script would print 2.

Can there be multiple noble integers? Yes. For example, in the list [3, 3, 4, 5, 6], both 3 in the list are noble integers, but if we print “3 is a noble integer” twice, the information will be correct, but somewhat incomplete. However, since we have no requirement for such a case, we will deem such information to be sufficient. When all integers in the list are unique, there can be at most one noble number: if, in a given list, 4 is noble, that means there are 4 integers larger than 4; in such a case, there obviously cannot be 5 integers larger than 5.

### Noble Integers in Perl

Basically, for each integer in the list, we need to count how many integers are larger, which means that we would need two nested loops. It will be faster to first sort the list. For example, the list provided as an example in the task description would yield [1, 2, 3, 6]. Since there are four items in the list, we can compare the value of any element with the size of the list minus the index of such element minus 1. Here, we have 4 - 1 - 1 = 2, so 2 is a noble integer in that list. If we had [1, 2, 3, 6, 8, 9], we could similarly compute for item 3: 6 - 2 - 1 = 3, and find that 3 is a noble item in the list.

But we can do something much simpler: we can sort the list in descending order, and then just compare the value of each element with its index. In the case of the list provided in the task description, we obtain the following list: [6, 3, 2, 1], and can see immediately that the item with index 2 has a value of 2, therefore 2 is a noble integer for that list. It is quite easy to show that, in any zero-indexed list, the index of an item is always equal to the number of items preceding it and, in the case of a list sorted in descending order, the index of an item is always equal to the number of larger items. With this in mind, the code is quite simple:

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

my \$list_size = int(rand 10) + 3;
my @list = map {int(rand 50) + 1 } 1..\$list_size;
say \$list_size, "/", "@list";

# my @list = (2, 6, 1, 3,5, 8);

@list = sort {\$b <=> \$a} @list; #descending sort
say \$list_size, " / ", "@list";
for (0..\$#list) {
say "\$list[\$_] is noble." if \$list[\$_] == \$_;
}
``````

We have to run the program a few times before we get a list with a noble integer:

``````\$ perl noble_nr.pl
8/26 19 22 29 46 15 35 14
8 / 46 35 29 26 22 19 15 14

\$ perl noble_nr.pl
6/21 2 34 21 23 47
6 / 47 34 23 21 21 2

\$ perl noble_nr.pl
12/26 3 29 13 41 14 19 23 50 26 36 41
12 / 50 41 41 36 29 26 26 23 19 14 13 3

\$ perl noble_nr.pl
8/19 14 9 42 5 6 11 48
8 / 48 42 19 14 11 9 6 5
6 is noble.
``````

### Noble Integers in Raku

We will use the same approach as in Perl: sort the list in descending order and compare the index of each item with its value. Note that, in Raku, we use the `pick` method on the range, so that there is no need to coerce the generated random numbers to integers and we also won’t have any duplicate (thereby eliminating the edge case mentioned above).

``````use v6;

my \$list-size = (3..11).pick;
my @list = (1..50).pick(\$list-size).sort.reverse;
say @list;
for (0..@list.end) {
say "@list[\$_] is noble." if @list[\$_] == \$_;
}
``````

After running the program a few times with no noble integer found, we finally find one:

``````[47 46 18 15 4 3]
4 is noble.
``````

## Wrapping up

The next week Perl Weekly Challenge is due to 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, March 15, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.