[Solved] Converting a list of numbers to use a range operator

[FloydATC]

When extracting configuration data from managed network gear such as Juniper or Cisco switches, consecutive vlans are combined into ranges "from-to". Given a $list of vlans such as "2-4,10-12" I needed an @array of every single vlan. An easy way to accomplish this is to make use of Perl's ".." range operator like so:

my $list = "2-4,10-12";

$list =~ s/\-/../g;
my @array = eval( $list );

# @array is now (2,3,4,10,11,12)

So far so good. What I'm looking for is an equally simple way to reverse the process. I mashed together the following code to get the job done but it's just painful to look at:

my @array = (2,3,4,10,11,12);

my @vlans = ();
my $span = undef;
my $last = undef;
foreach my $vlan (sort @array) {
  if (defined $last && $vlan == $last+1) {
    unless (defined $span) {
      $span = $last;
    }
    $vlans[$#vlans] = $span.'-'.$vlan;
  } else {
    push @vlans, $vlan;
    $span = undef;
  }
  $last = $vlan;
}
my $list = join(',', @vlans);

# $list is now "2-4,10-12" again

Surely there must be a better way?!

Edit: Single elements should appear like "2-4,7,10-12,20". Sorry for not pointing this out.

[toolic]

I've had this lying around. Is it any less painful?

use warnings;
use strict;

print ranges(2,3,4,10,11,12), "\n";

sub ranges {
    my @vals = @_;
    my $min = $vals[0];
    my $max;
    my @list;
    for my $i (0 .. (scalar(@vals)-2)) {
        if (($vals[$i+1] - $vals[$i]) != 1) {
            $max = $vals[$i];
            push @list, ($min == $max) ? $min : "$min-$max";
            $min = $vals[$i+1];
        }
    }
    $max = $vals[-1];
    push @list, ($min == $max) ? $min : "$min-$max";
    return join ', ', @list;
}

__END__

2-4, 10-12

I wonder if Set::IntSpan can do this.

[FloydATC]

Yes!! Set::IntSpan, I knew I'd seen something like that but couldn't remember what it was called!

my @array = (2,3,4,10,11,12);

my $set = new Set::IntSpan join(',', @array);
my $list = $set->run_list;

# $list is now "2-4,10-12"

Now this... this is not ugly :-)

[2teez]

I even love the way Parse::Range does it.
Putting your original $list in the function parse_range prints out beautifully like so:

use warnings;
use strict;
use Parse::Range qw(parse_range);

  my $list = "2-4,10-12";

  print join ','=> parse_range($list); # 2,3,4,10,11,12

[hdb]

Another version returning a string. Don't know how you want to deal with single elements?

use strict;

sub list_to_ranges {
  sort @_;
  my $last = shift;
  my $list = "$last";
  my $span = 1;
  foreach my $next (@_) {
    if( $next == $last + 1 ) {
      $span++;
      next;
    } else {
      $list .= ($span>1?"-$next":",$next");
      $span = 1;
      $last = $next;
    }
  }
  return $list;
}

print list_to_ranges( 2,3,4,8,10,11,12,15 ), "\n";
print list_to_ranges( 2,3,4,8,10,11,12,15 ), "\n";
print list_to_ranges( 8,10,11,12,15 ), "\n";

[LanX]

non-strict hack :)

use Data::Dump qw/pp/;

@array = (10, 11, 12, 2, 3, 4, 7);

@a = sort {$a <=> $b} @array;

$first = $last = shift @a;       # init start
push @a,"inf";                   # infinity end

for $now (@a) {
  unless ( $last+1 == $now ) {
    push @ranges,[$first,$last]; # todo: one element ranges
    $first=$now;
  }
  $last=$now;
}

pp @ranges;

not sure how you wanna handle one element ranges, so I kept it up to you:

([2, 4], [7, 7], [10, 12])

[Anonymous Monk]

OK, very short code, but why does this push @a,"inf" work? Where is this "inf" documented?

[LanX]

> but why does this push @a,"inf" work?

inf and -inf are special numeric constants

  DB<159> $a=inf
 => "inf"

  DB<160> --$a
 => "inf"

  DB<161> ++$a  
 => "inf"

in this case they are handy, because $now+1 == inf won't raise a warning

  DB<116> use warnings;5=="inf"
 => ""

  DB<117> use warnings;5=="WhatEver"
Argument "WhatEver" isn't numeric in numeric eq (==) at (eval 47)[mult
+i_perl5db.pl:644] line 2.

> Where is this "inf" documented?

no idea, I scanned the perldocs for X<inf> w/o success.

see also Infinity and Inf?

UPDATE: deleted wrong example about incrementing inf

[kcott]

G'day FloydATC,

Perhaps something like this would be more to your liking:

$ perl -Mstrict -Mwarnings -le '
    my @vlans = (2, 3, 4, 7, 10, 11, 12, 20);
    my $last = $vlans[0] - 2;
    my @ranges;
    push @{$ranges[$#ranges + ($_ - $last > 1)]}, $last = $_ for @vlan
+s;
    print join ",",
        map { $_->[0] == $_->[-1] ? $_->[0] : join "-", @{$_}[0, -1] }
+ @ranges;
'
2-4,7,10-12,20

[arnaud99]

Hi

This is my version for solving this. Probably very similar to some of the answers above.

use Modern::Perl;
use Data::Dumper;

    #some ranges, for testing purposes.
my @array = (2,3,4,10,11,12,13,20,21,22,34,35,36,37,38);
my $prev = undef;
my @ranges;
my $index = -1;

    #Build Array of array.
    #One Array ref for each contiguous range
foreach my $val ( sort {$a <=> $b } @array ) 
{

    if (!defined($prev) || $val != $prev +1 ) 
    {
        $index++;
        $ranges[$index] = [$val];
        
    }
    else
    {
        push @{ $ranges[$index] }, $val;
    }
    $prev = $val;
}
print Dumper(\@ranges);


    #loop though each range (array ref), and get the first and last el
+ement 
    #for each range
foreach my $a_range (@ranges)
{
    say "range: ", $a_range->[0], '..', $a_range->[-1];
}

Output

$VAR1 = [
          [
            2,
            3,
            4
          ],
          [
            10,
            11,
            12,
            13
          ],
          [
            20,
            21,
            22
          ],
          [
            34,
            35,
            36,
            37,
            38
          ]
        ];
range: 2..4
range: 10..13
range: 20..22
range: 34..38

Cheers.

Arnaud.

[hdb]

This probably belongs to the obfuscation section, but I was wondering whether there would be a s/// expression that one could apply to "2,3,4,8,10,11,12,13,14,15" repeatedly until it becomes "2-4,8,10-15"?

Any ideas?

To clarify, the expression would create a series of strings like this or similar:

"2,3,4,8,10,11,12,13,14,15"
"2-4,8,10,11,12,13,14,15"
"2-4,8,10-12,13,14,15"
"2-4,8,10-13,14,15"
"2-4,8,10-14,15"
"2-4,8,10-15"

I hope this will not throw this thread of track...

[AnomalousMonk]

Don't know if this solution is really preferable to any of the others, but its got a  s/// in there! Uses state feature (available with 5.10+), but could easily avoid it. Note that it does not bother to range-ize a degenerate range: '1,2' does not become '1-2'.

>perl -wMstrict -le
"use feature 'state';
 ;;
 my $s = '2,3,5,6,7,9,11,12,13,14,16,17,19';
 print qq{'$s' \n};
 ;;
 my $sep = qr{ \s* , \s* }xms;
 my $n   = qr{    \d+    }xms;
 ;;
 sub order {
   state $p = 0;
   my $t = $p;
   $p = $_[0];
   return $_[0] - $t == 1;
   }
 ;;
 use re 'eval';
 $s =~ s{
   (?<! \d)   ($n)   (?{   order($^N) })
   (?=   $sep ($n) (?(?{ ! order($^N) }) (*F))
     (?: $sep ($n) (?(?{ ! order($^N) }) (*F)))+
     )
   .+? \3 (?! \d)
   }
   {$1-$3}xmsg;
 ;;
 print qq{'$s' \n};
"
'2,3,5,6,7,9,11,12,13,14,16,17,19'

'2,3,5-7,9,11-14,16,17,19'

Update: Actually, the non-capturing look-ahead folderol is not needed. The following  s/// seems to work just as well.

$s =~ s{
  (?<! \d) ($n)   (?{   order($^N) })
  (?: $sep ($n) (?(?{ ! order($^N) }) (*F))){2,}
  }
  {$1-$2}xmsg;

Update: Even slightly simpler and no numbered capture group variables, but  \K only available with 5.10+, like state.

sub order {
  state $p = 0;
  my $t = $p;
  $p = $^N;
  return $^N - $t == 1;
  }

$s =~ s{
  (?<! \d) ($n) \K (?{   order() })
  (?: $sep ($n)  (?(?{ ! order() }) (*F))){2,}
  }
  {-$^N}xmsg;