Perl: как объединить последовательные номера страниц?

Question

• ОС: Windows Server 2012, поэтому у меня нет доступа к утилитам Unix
• Activestate Perl 5.16. Извините, я не могу обновить ОС или Perl, я застрял с ним.
• Я выполнил поиск в Google и прочитал около 10 страниц, я нашел похожие проблемы, но не то, что искал.
• Затем я сделал 3 поиска здесь и обнаружил похожие проблемы с SQL, R, XSLT, но не то, что я ищу.
• На самом деле я не уверен, с чего начать, поэтому у меня даже нет кода.

Я бынравится объединять последовательные номера страниц в диапазон страниц. На входе будет ряд чисел в массиве.

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

Спасибо за вашу помощь!

Это единственный код, который у меня есть.

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;
}

Answer 1

Это называется интервал . Используйте 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

Answer 2

Это похоже на то, что вы хотите.

#!/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

Функция rangify() создает массив массивов. Он пересекает ваш входной список и, если число на единицу больше предыдущего, то добавляет новый номер в массив второго уровня, который в данный момент находится в конце массива первого уровня. Если новое число не является последовательным, оно добавляет новый массив второго уровня в конец массива первого уровня.

Построив эту структуру данных, мы проходим массив первого уровня, просматривая каждый измассивы второго уровня. Если массив второго уровня содержит только один элемент, мы знаем, что это не диапазон, поэтому мы перезаписываем значение одним числом из массива. Если он содержит более одного элемента, то это диапазон, и мы перезаписываем значение первым и последним элементами, разделенными дефисом.

Answer 3

Возможно, у вас уже есть лучшее решение с модулем Set::IntSpan::Fast::XS, но, если вы хотите воспользоваться возможностью изучить perl, вот еще один perl -иш-способ сделать это.

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";

Это не супер элегантный или короткий, но очень простой для понимания и отладки.

Answer 4

Так что мне удалось настроить этот код, чтобы он работал на меня. Передайте ваш массив чисел в procpages(), который затем вызовет 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;
}