0
  • OS: Windows server 2012, so I don't have access to Unix utils
  • Activestate Perl 5.16. Sorry I cannot upgrade the OS or Perl, I'm stuck with it.
  • I did a google search and read about 10 pages from that, I find similar problems but not what I'm looking for.
  • I then did 3 searches here and found similar issues with SQL, R, XSLT, but not what I'm looking for.
  • I actually am not sure where to start so I don't even have code yet.

I'd like to combine consecutive page numbers into a page range. Input will be a series of numbers in an array.

Input as an array of numbers: my @a=(1,2,5)
Output as a string: 1-2, 5

Input ex: (1,2,3,5,7)
Output ex: 1-3, 5, 7

Input ex: (100,101,102,103,115,120,121)
Output ex: 100-103,115,120-121

Thank you for your help!

This is the only code I have so far.

sub procpages_old
# $aref = array ref to list of page numbers.
# $model = used for debugging.
# $zpos = used for debugging only.
{my($aref,$model,$zpos)=@_;
my $procname=(caller(0))[3];

my @arr=@$aref; # Array of page numbers.
my @newarr=();
my $i=0;
my $np1=0; # Page 1 of possible range.
my $np2=0; # Page 2 of possible range.
my $p1=0; # Page number to test.
my $p2=0;
my $newpos=0;
while ($i<$#arr)
    {
    $np1=$arr[$i];
    $np2=getdata($arr[$i+1],'');
    $p1=$np1;
    $p2=$np2;
    while ($p2==($p1+1)) # Consecutive page numbers?
        {
        $i++;
        $p1=$a[$i];
        $p2=getdata($a[$i+1],'');
        }
    $newarr[$newpos]=$np1.'-'.$p2;
    $newpos++;
    # End of loop
    $i++;
    }

my $pages=join(', ',@arr);

return $pages;
}
Bulrush
  • 548
  • 2
  • 4
  • 19

4 Answers4

2

That's called an intspan. Use Set::IntSpan::Fast::XS.

use Set::IntSpan::Fast::XS qw();
my $s = Set::IntSpan::Fast::XS->new;
$s->add(100,101,102,103,115,120,121);
$s->as_string; # 100-103,115,120-121
daxim
  • 39,270
  • 4
  • 65
  • 132
1

This seems to do what you want.

#!/usr/bin/perl

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

while (<DATA>) {
  chomp;
  say rangify(split /,/);
}

sub rangify {
  my @nums = @_;

  my @range;

  for (0 .. $#nums) {
    if ($_ == 0 or $nums[$_] != $nums[$_ - 1] + 1) {
      push @range, [ $nums[$_] ];
    } else {
      push @{$range[-1]}, $nums[$_];
   }
  }

  for (@range) {
    if (@$_ == 1) {
      $_ = $_->[0];
    } else {
      $_ = "$_->[0]-$_->[-1]";
    }
  }

  return join ',', @range;
}

__DATA__
1,2,5
1,2,3,5,7
100,101,102,103,115,120,121

The rangify() function builds an array of arrays. It traverses your input list and if a number is just one more than the previous number then it adds the new number to the second-level array that's currently at the end of the first-level array. If the new number is not sequential, it adds a new second-level array at the end of the first level array.

Having built this data structure, we walk the first-level array, looking at each of the second-level arrays. If the second level array contains only one element then we know it's not a range, so we overwrite the value with the single number from the array. If it contains more than one element, then it's a range and we overwrite the value with the first and last elements separated with a hyphen.

Dave Cross
  • 68,119
  • 3
  • 51
  • 97
0

So I managed to adjust this code to work for me. Pass your array of numbers into procpages() which will then call num2range().

######################################################################
# In: 
# Out: 
sub num2range 
{

  local $_ = join ',' => @_;
  s/(?<!\d)(\d+)(?:,((??{$++1}))(?!\d))+/$1-$+/g;
  tr/-,/, /;
  return $_;
}
######################################################################
# Concatenate consecutive page numbers in array.
# In: array like (1,2,5,7,99,100,101)
# Out: string like "1-2, 6, 7, 99-101"
sub procpages
{my($aref,$model,$zpos)=@_;
my $procname=(caller(0))[3];

my @arr=@$aref;
my $pages=num2range(@arr);
$pages=~s/\,/\-/g; # Change comma to dash.
$pages=~s/ /\, /g; # Change space to comma and space.
#$pages=~s/\,/\, /g;

return $pages;
}
Bulrush
  • 548
  • 2
  • 4
  • 19
0

You probably have the best solution already with the Set::IntSpan::Fast::XS module, but assuming you want to take the opportunity to learn perl here's another perl-ish way to do it.

use strict;
use warnings;

my @nums = (1,2,5);

my $prev = -999;    # assuming you only use positive values, this will work
my @out = ();

for my $num (@nums) {
    # if we are continuing a sequence, add a hyphen unless we did last time
    if ($num == $prev + 1) {
        push (@out, '-') unless (@out and $out[-1] eq '-');
    }
    else {
        # if we are breaking a sequence (@out ends in '-'), add the previous number first
        if (@out and $out[-1] eq '-') {
            push(@out, $prev);
        }
        # then add the current number
        push (@out, $num);
    }
    # track the previous number
    $prev = $num;
}

# add the final number if necessary to close the sequence
push(@out, $prev) if (@out and $out[-1] eq '-');

# join all values with comma
my $pages = join(',', @out);
# flatten the ',-,' sequence to a single '-'
$pages =~ s/,-,/-/g;

print "$pages\n";

This is not super elegant or short, but is very simple to understand and debug.

Nick P
  • 759
  • 5
  • 20