Perl Weekly Challenge # 6: Compact Number Ranges

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

Spoiler alert: this post reveals breaking details about the plot of forthcoming episodes of Game of Thrones. Oops, no, that's not what I meant to say. As of this writing, the Perl Weekly Challenge # 6 is still going until Sunday May 10, 2019, please don't read on if you intend to solve the challenge by yourself.

The Wikipedia link provided in the question concerning the second challenge (Ramanujan's Constant) was apparently changed some time after the challenge was initially posted. I worked on the original link (and the Landau-Ramanujan Constant), only to find out a couple of days later that the question is now different. Because of that, I'll hopefully cover the second challenge in a later post (and will try to provide at least partial answers for both constants associated with the name of Srinivasa Ramanujan).

Anyway, given the situation, this blog post will cover only the first proposed challenge, which relates to compact numeric ranges.

Create a script which takes a list of numbers from command line and print the same in the compact form. For example, if you pass “1,2,3,4,9,10,14,15,16” then it should print the compact form like “1-4,9,10,14-16”.

In the input example provided with the question, the numbers are sorted in ascending order, but there is no reason to limit ourselves to such a case. The question is then the following: if the input is not in ascending order, are we supposed to keep the order provided and compact the sub-ranges, or are we supposed to reorder the numbers and compact the ranges over the sorted data? In other words, if the input data is "1,2,3,4,9,10,14,15,16,5,6,7", are we supposed to display:

1-4,9,10,14-16,5-7

or:

1-7,9,10,14-16?

I chose the first interpretation, but, as we will see, there wouldn't be much code to change to follow the second interpretation.

I will suppose that the input data is correct (i.e. a list of space-separated numbers) and not try to validate the input.

Perl 5 Compact Ranges

So this is my initial attempt:

use strict;
use warnings;
use feature 'say';

my @input = @ARGV > 0 ? @ARGV : (1,2,3,4,9,10,14,15,16,3,4,5,6,4,5,6,7,9,9);
my $prev = my $start = shift @input;
for my $num (@input) {
    if ( $prev == $num - 1 ) {
            $prev = $num;
    } else {
        print $prev == $start ? "$prev," : "$start-$prev,";
        $start = $prev = $num;
    }
}
say $prev == $start ? $prev : "$start-$prev";

Nothing complicated. Just note that if the user doesn't pass any parameter to the script, I have provided a default list of numbers. This is only to make my tests easier.

This works as follows:

$  perl num_ranges.pl 1 2 3 4 9 10 14 15 16 3 4 5 6 9
1-4,9-10,14-16,3-6,9

So, this seems to work properly. If I wanted to use the second interpretation, I would only need to change the for loop statement and the next line as follows:

for my $num (sort { $a <=> $b } @input) {
    next if $num == $prev;
    if ( $prev == $num - 1 ) {
            $prev = $num;
    } else {
        print $prev == $start ? "$prev," : "$start-$prev,";
        $start = $prev = $num;
    }
}

This modified version displays the following output:

$  perl num_ranges.pl 1 2 3 4 9 10 14 15 16 3 4 5 6 9
1-6,9-10,14-16

But there is a slight problem with what we've done so far. When there are only two consecutive numbers (such as 9,10 in the examples above), the required output is "9,10" and not "9-10". Thus, the above solution is not completely correct.

Fixing the Initial Perl 5 solution

Let's try to fully satisfy the requirement.

This means that the conditional in both print statements becomes more complicated, as we now need three-way comparisons. In addition, I wasn't entirely satisfied that this comparison is repeated at two different places: I don't like repeating code when I can avoid it. So I changed the code to move these comparisons out of the main code into a compare subroutine.

use strict;
use warnings;
use feature 'say';

sub compare {
    my ($prev, $start) = @_;
    if ($prev > $start + 1) {
        return "$start-$prev";
    } elsif  ($prev > $start) {
        return "$start,$prev";
    } else {
        return "$prev";
    }
}

my @input = @ARGV > 0 ? @ARGV : (1,2,3,4,9,10,14,15,16,3,4,5,6,4,5,6,7,9,9);
my $prev_val = my $start_val = shift @input;
my $output = "";   
for my $num (@input) {
    if ($num != $prev_val + 1) {
        $output .= compare ($prev_val, $start_val) . ",";
        $start_val = $num;
    }
    $prev_val = $num;
}
$output .= compare ($prev_val, $start_val);
say $output;

Note that I also decided to build progressively an $output variable, rather than printing the result piece by piece.

The result is similar to what we had before, but this time with commas between the 9 and 10:

$  perl num_ranges.pl 1 2 3 4 9 10 14 15 16 3 4 5 6 9
1-4,9,10,14-16,3-6,9

Now that it has become more complicated, I have the feeling that the code gets a bit large and clumsy for such a simple requirement.

We can make the compare subroutine a bit more concise:

sub compare {
    my ($prev, $start) = @_;
    return $prev > $start + 1 ? "$start-$prev" 
        : $prev > $start     ? "$start,$prev"
        : "$prev";
}

This is slightly better, but still feels somewhat clumsy.

A Recursive Perl 5 Approach

Let's see if a recursive approach is better. This could look like this:

use strict;
use warnings;
use feature 'say';

my @input = @ARGV > 0 ? @ARGV : (1,2,3,4,9,10,14,15,16,3,4,5,6,4,5,6,7,9,9);

sub process_input {
    my ($range, $input, $output) = @_;
    my $curr_val = shift @$input;
    if ($curr_val == $range->[1] + 1) {
        $range->[1] = $curr_val;
    } else {
        my $sep = $range->[1] > $range->[0] + 1 ? "-" : ",";
        $output .= (join $sep, @$range) . ",";
        $range = [$curr_val, $curr_val];
    }
    return $output if @$input == 0;
    process_input ($range, $input, $output);
}

my $first = shift @input;
my $output = process_input([($first) x 2], \@input, ""); 
chop $output;
say $output;

The process_input subroutine takes three parameters: * The $range is an array ref containing the first element of a consecutive sequence and the last seen element; * $input is a ref to the unprocessed input; and * output is the string where we build up the result.

This is slightly more concise, but only by a thin margin (and it is probably a bit less easy to understand).

I have also been thinking about trying a functional programming approach, some form of a "lispy" data flow or data pipeline solution using chained map and grep routines, but wasn't able to come up with something that would truly look better. Well, I can't really think of some more elegant way to solve the problem in Perl 5. I look forward to seeing what other participants to the challenge have done.

Perl 6 Compact Ranges

Initially, I did not see any way of doing this that would be very different from the P5 version.

This is a Perl 6 adaptation of the corrected P5 version:

use v6;
sub compare ($prev, $start) {
    return $prev > $start + 1 ?? "$start-$prev" 
        !! $prev > $start     ?? "$start,$prev"
        !! "$prev";
}

my @input = @*ARGS.elems > 0 ?? |@*ARGS !! (1,2,3,4,9,10,14,15,16,3,4,5,6,4,5,6,7,9,9);
my $prev_val = my $start_val = shift @input;

my $output = "";
for @input -> $num {
    if ($num != $prev_val + 1) {
        $output ~= compare($prev_val, $start_val) ~ ",";
        $start_val = $num;
    }
    $prev_val = $num;
}
$output ~= compare $prev_val, $start_val;
say $output;

With no argument passed to the script, it uses the default array and prints out:

$ perl6 num_range.p6
1-4,9,10,14-16,3-6,4-7,9,9

Apart from the slight syntax adjustment between P5 and P6, there is not much difference.

Note that I also thought about using given ... when statements in the compare subroutine, but I ended up feeling that it made the code longer and less expressive for this kind of case. The given ... when "switch" statement is nice when implicitly using the smart match operator, for example to check the topic against a value, a regex or a type, but using it in a purely procedural fashion at it would be the case here gave me the unpleasant impression of going back in time by several decades and writing Pascal or Ada code in Perl 6. It's probably just a personal bias.

The recursive approach in P6 would essentially look like the P5 recursive version, except for the fact that using dynamic scope variables might simplify the passing of arguments between successive recursive calls. Not very interesting.

Compact Ranges in Perl 6: a Functional Approach

Then I thought again about one of my pet subjects: why not try a functional programming approach? Perl 6 provides the gather ... take control flow statement, which can be thought as a generalized version of map, grep, and return: it is sort of a map in which you can also filter items (as in a grep), or of a grep in which you can also map various elements to something else. And you can return the data to the gather statement at the point you choose.

Please note that there were two bugs in the original version that I presented here. Many thanks to Alexander who pointed out to them.

Here we go:

use v6;
sub get($start, $prev) {
    take $prev > $start + 1 ?? "$start-$prev" 
        !! $prev > $start     ?? "$start,$prev"
        !! "$prev";
}
my @input = @*ARGS.elems > 0 ?? |@*ARGS !! (1,2,3,4,9,10,14,15,16,3,4,5,6,4,5,6,7,9,10,11);
my $prev = my $start = shift @input;
my @result = gather {
    for @input -> $num {
        if $num != $prev + 1 {
            get $start, $prev;
            $start = $num;
        }
    $prev = $num;
    }
    get $start, $prev;
}
say @result.join(",");

That may not be perfect, but I'm much more satisfied with this than with all previous versions, be it P5 or P6.

The Perl Weekly Challenge # 6 is still going on, you're welcome to participate before May 5, 2019, 6 p.m., UK time.

4 Comments

Dear Laurent,

Could it be that the statement "my @input = @*ARGS.elems > 0 ?? @*ARGS !! 1,2,3,4,9,10,14,15,16,3,4,5,6,4,5,6,7,9,9;" does not have the desired effect?

When I run it, and the condition of the ternary operator is true, only the "1" of the List (for the false condition) is replaced with "@*ARGS", and the values "2,3,4,9,10,..." etc. are added to @input.

In addition, it seems that "@*ARGS" forms an itemized array inside @input, which in turn causes an issue with the following shift statement.

At any rate, I can't get your solution to successfully accept commandline parameters, and I'm also unsure how to fix the perceived issue with the itemized array.

Alexander

PS1 It seems the assignment issue can be resolved simply by enclosing the list items in parentheses, e.g. like so (1,2,3,4,...9,9).

PS2 I meanwhile realized that the remark above about the itemized array was due to the fact that I provided numbers on the commandline in the form of a comma separated list; providing space-separated numbers overcomes this issue.

PS3 I stumbled on another possible issue: when I provide a single series of consecutive numbers, only the last number of the series is output. E.g. when I run the script with the arguments 222 223 224, it outputs 224 rather than 222-224. It takes a closing non-consecutive number to have the compact series output.

Leave a comment

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about Perl (5 and 6).