This is my 20th week participating into the weekly challenge.

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

I made a few assumptions about this.

1) We’re merging left to right

2) We can recursively merge.

I didn’t want to brute for the problem so I just modelled the array using the min and max values. I then checked these values with the next list and if they over lapped that the smallest and largest values to form a new list.

#### Perl 5 solution

```
#!/usr/bin/perl
# Test: ./ch-1.pl "[2,7], [3,9], [10,12], [15,19], [18,22]"
use strict;
use warnings;
use feature qw /say/;
use List::Util qw /min max /;
my $arg_string = join '', @ARGV;
$arg_string =~ s/[\s\[\]]//g;
my @values = split (',', $arg_string);
my @lists;
# Create the lists
while (@values) {
my $min = shift @values;
my $max = shift @values;
push @lists, [$min, $max];
}
my $i = 0;
while ($i < scalar(@lists) - 1) {
if ( $lists[$i]->[1] >= $lists[$i+1]->[0] &&
$lists[$i]->[0] <= $lists[$i+1]->[1]) {
my $new_min = min($lists[$i]->[0], $lists[$i+1]->[0]);
my $new_max = max($lists[$i]->[1], $lists[$i+1]->[1]);
splice ( @lists, $i, 2, [$new_min, $new_max] );
} else {
$i++;
}
}
say join ', ',
map { '[' . $_->[0] . ', ' . $_->[1] . ']'}
@lists;
```

**Output**

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

#### Raku solution

```
# Test: perl6 ch-1.p6 "[2,7], [3,9], [10,12], [15,19], [18,22]"
sub MAIN(Str $lists) {
my @values =
$lists.subst(/<[\s\[\]]>/, '', :g).split(',')>>.Int;
my $i = 0;
# Loop through the list items
while ($i < @values.elems - 3) {
# Compare the last element of the list to the
# first element of the next list
if ( @values[$i+1] >= @values[$i+2] &&
@values[$i] <= @values[$i+3] ) {
# Create new list indexes
my @new_list = (
min(@values[$i], @values[$i+2]),
max(@values[$i+1], @values[$i+3])
);
@values.splice($i, 4, @new_list);
} else {
$i = $i + 2;
}
}
# Print the values
$i = 0;
my @v_string;
while ($i < @values) {
@v_string.push(
'[' ~ @values[$i++] ~ ', ' ~
@values[$i++] ~ "]"
);
}
say join ', ', @v_string;
}
```

**Output**

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

## Task 2

### Noble Integer

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

First, there will never be multiple Noble integers (Assuming we don’t check duplicate integers). This becomes apparent when you sort the list. If noble numbers were described as `exactly N integers less than N`

then we can have multiple Noble numbers

So I tackled this problem by creating a sorted list and and just counting the number of items remaining in the list. Then comparing it with the noble number candidate.

It’s interesting to note that duplications can exist. For example:

[1 , 2, 2, 3 , 4].

I solved the duplication problem by just checking the last 2 vs the remaining total of the list.

#### Perl 5 solution

```
#!/usr/bin/perl
# Test: ./ch-2.pl
use strict;
use warnings;
use feature qw /say/;
# Create @L
my @L = sort { $a <=> $b } map { int(rand(50) + 1) } ( 1 .. 50 );
my $i = 0;
my $total = scalar(@L);
# Output the list
say "List: " . join ', ', @L;
# Loop through each number
while ($i < $total) {
# Skip duplicates
if ($i + 1 < $total && $L[$i] != $L[$i + 1]) {
say "Noble number found: " . $L[$i]
if ($L[$i] == $total - $i - 1);
}
$i++;
}
```

**Output**

```
List: 2, 7, 7, 7, 8, 8, 9, 11, 13, 16, 18, 20, 20, 21, 22, 22, 24, 24, 26, 27, 27, 27, 27, 31, 31, 32, 32, 32, 32, 33, 34, 35, 35, 37, 37, 38, 38, 40, 41, 41, 41, 42, 43, 44, 44, 44, 46, 47, 49, 50
Noble number found: 27
```

#### Raku solution

```
# Test: perl6 ch-2.p6
use v6.d;
sub MAIN() {
my $list_size = 50;
# Create @L
my @L = ((1 .. 50).roll: $list_size) ;
# Output the list
say 'List: ' ~ @L.perl;
# Find Noble number
my $noble =
@L.sort.pairs.grep(
{.key == $list_size - .value}
)>>.value;
# Output it if found
say "Noble found: " ~ $noble
if ($noble);
}
```

**Output**

```
List: [8, 23, 17, 35, 25, 43, 41, 20, 34, 29, 12, 22, 36, 15, 20, 47, 24, 35, 10, 43, 2, 42, 17, 40, 8, 19, 1, 13, 48, 38, 5, 50, 19, 33, 7, 1, 45, 40, 30, 25, 22, 7, 22, 4, 29, 12, 18, 47, 9, 42]
Noble found: 24
```

## One thought on “PERL WEEKLY CHALLENGE – 050”