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