Perl Weekly Challenge In Raku : Week 50

Challenge 1

For some reason people have been giving me money for a number of years now to solve problems with computers. Which is nice. Often these problems involve ranges and whether they intersect (it's very often date ranges).

As such I've drawn a diagram like this very often on a bit of paper to dredge up the memory of how to do it :

   |---------| b
 1 2 3 4 5 6 7 8 9   == [ [1,3] , [2,7], [6,8] ]
 |---| a   |---| c

Here we have 3 sets of pairs. There's a simple rule to determine if they intersect. Given 2 pairs (call them x and y they intersect if):

x[0] <= y[1] && y[0] <= x[1]

And that's it, it's really that simple. Lets look at our example :

a and b ? a[0] <= b[1] && b[0] <= a[1] == 1 <= 7 && 2 <= 3 == True
b and c ? b[0] <= c[1] && c[0] <= b[1] == 2 <= 6 && 7 <= 8 == True
a and c ? a[0] <= c[1] && c[0] <= a[1] == 1 <= 8 && 6 <= 3 == False 

With this knowledge the code to group unions is simple. Sort our list of lists, take the first item if it intersects with the second then expand it to cover the range of the two. Otherwise put it in the output and continue comparing the next one to the list... It's probably easer to read the code :

subset IntPair of Str where m!^ \d+ "," \d+ $!;

#| Given a list of Integer Pairs print the sorted list of pairs with intersections combined
multi sub MAIN (
    *@pairs where { $_.all ~~ IntPair } #= List of comma seperated integer pairs
) {
    my @working = @pairs.map(*.split(",")).sort( *[0] <=> *[0] );
    my @out;
    my $current = @working.shift;

    while ( @working ) {
        my $next = @working.shift;
        if ( $current[0] <= $next[1] && $current[1] >= $next[0] ) {
            $current = [ $current[0] < $next[0] ?? $current[0] !! $next[0],
                         $current[1] > $next[1] ?? $current[1] !! $next[1]  ]; 
        } else {
            @out.push( $current );
            $current = $next;
        }
    }
    @out.push( $current ).map( *.join(",") ).join(" ").say;
}

As normal I have wrapped this in a nice MAIN function to get some documentation and input checking.

A thought on my process

Personally when I do the challenge I try and complete it using just the language alone. Admittedly this is quite simple with Raku. In my day job I mostly work in Perl and will always reach for CPAN to see if someone has solved a problem before tackling it myself.

But I do the challenges because I want to explore the problem space and have a think about it. The thing is there is a Raku module (admittedly it's in a Beta state) that would help here Range::SetOps written by... oh me.

Ranges in Raku have a weird dual state, the represent a range between two points but if you look at them in the wrong way they will transform into a list of discrete entities.

For instance 5.5 ~~ 1..10 will return True because 5.5 is in the range 1..10 but 5.5 (elem) 1..10 will return False because the Range is coerced into a Set but making it a list of discrete items.

What Range::SetOps does is (again still in Beta, there's some flaws I really should finish it) overload the Set Operators when they handle Ranges or Sets that contain Ranges to return either Ranges or Sets of Ranges based on the operation.

For example without Range::SetOps loaded :

(2..7) ∪ (3..9) == set(2,3,4,5,6,7,8,9)

With Range::SetOps loaded :

(2..7) ∪ (3..9) == set(2..9)

With Range::SetOps our job is easier. Make our input lists into ranges. Find the Union Set of them then make them back into lists :

use Range::SetOps;
subset IntPair of Str where m!^ \d+ "," \d+ $!;

#| Given a list of Integer Pairs print the sorted list of pairs with intersections combined
multi sub MAIN (
    *@pairs where { $_.all ~~ IntPair } #= List of comma seperated integer pairs
) {
    ([∪] @pairs.map( { ($_[0]..$_[1]) } )).keys.map( { [$_.min,$_.max] } ).sort.map( *.join(",") ).join(" ").say;
}

Here we use the reduction meta operator [] to chain the ∪ intersection operations and end up with a Set of Ranges which we then turn back into a list of lists, prettify and print.

And yes I really should get round to finishing it, mostly it's handling Ranges with exceptions (^1..^10) for example.

Challenge 2

There's one thing about the description for this challenge I wasn't sure of which is whether you can have duplicate numbers. I checked and you can't. In which case my first intuitive thought for how to check if a number is Noble is simple enough.

Sort the list. Take the first number if it equals the length of the remaining list it's Noble. Repeat while you have a list.

#| Generate and display a random list of n integers (default 10) between 1 and max (default 30)
#| Then print the Noble Integers in the list
multi sub MAIN (
    UInt :n(:$number) = 10, #= Number of values to generate
    UInt :m(:$max) where { $max > $number } = 50  #= Maximum value (must be greater then $n)
) {
    my @list = (1..$max).pick($number);
    say "Generated List : {@list.join(",")}";
    MAIN( @list );
}

#| Given a list of Integers print the noble integers in the list
multi sub MAIN (
    *@values is copy where { $_.all ~~ UInt } #= Space seperated list of Intgers to check
) {
    @values.=sort;
    while ( @values ) {
        my $val = @values.shift;
        say $val if $val == @values.elems;
    }
}

Last night though my brain decided to have a think about the problem a bit more. The challenge asks can there be multiple noble numbers in a list?

So lets look at our options.

Can we have a list with 0 Noble numbers?

This is trivial to prove by example [3,4,5] is a simple example. But we also can glean a rule.

Given a sorted list of length L if the first number is greater than L-1 then the list has no Noble numbers.

Can we have a list with 1 Noble number?

Here we can work from the rule given before. If we have a sorted list of length L and it's first value is L-1 then it's a noble number.

As you can remove all the numbers before the first Noble number then many lists can have a noble number in.

[1,2,3,4,5,6,7,8,11,15] = 5 is Noble
[5,6,7,8,11,15] = 5 is Noble

Any amount of numbers (between 1 and 4) can go before the 5 and it will still be Noble.

There's a whole bunch of other stuff about for a given length of list what the range of possible Noble numbers are but I'm not interested in that right now.

Can we have a list with 2 Noble Numbers?

Assume we have a list with a Noble number in N this means there are N numbers following it in the list and 0 to N-1 numbers before it in the list.

Could N-1 be Noble? No.

There are N+1 (N and the N numbers following) after it. The same hold true for any number less than N.

Could N+1 be Noble? No.

There are N-1 number following it (as it has to come after N in the list and we know that there are N numbers in the following list). Again this holds true for all values greater than N.

So No. A given list will have either 0 or 1 Noble number.

Neat.