laurent_r

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

Task 1: Merge Intervals

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]]

Task 2: Noble Integers

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.