3

[perl 5.8.8]

我有一系列名称，例如：

names='foobar1304,foobar1305,foobar1306,foobar1307'

其中名称的不同之处仅在于名称中某处的连续数字字符串。任何序列中的数字串都具有相同的长度，并且数字串形成一个连续的数字序列，没有跳过，例如003,004,005。

我想要一个紧凑的表示，如： 

compact_name='foobar1304-7'

（紧凑的形式只是一个名称，所以它的确切形式是可以协商的。）通常只有 <10 个东西，尽管有些集合可能跨越十年，例如

'foobaz2205-11'

在 perl 中有一些简洁的方法可以做到这一点吗？我不是一个大的 perl 黑客，所以要温柔一点......

处理嵌入式序列的奖励积分，例如：

names='foobar33-pqq,foobar34-pqq,foobar35-pqq'

理想的脚本会巧妙地退回'firstname2301-lastname9922'以防它无法识别名称中的序列。

4

2 回答 2

2

我不确定我是否得到了您的规范，但它以某种方式起作用：

#!/usr/bin/perl
use warnings;
use strict;

use Test::More;

sub compact {
    my $string = shift;
    my ($name, $value) = split /=/, $string;

    $name =~ s/s$// or die "Cannot create compact name for $name.\n";  #/ SO hilite bug
    $name = 'compact_' . $name;

    $value =~ s/^'|'$//g;                                              #/ SO hilite bug
    my @values = split /,/, $value;                                    #/ SO hilite bug
    my ($prefix, $first, $suffix) = $values[0] =~ /^(.+?)([0-9]+)(.*)$/;

    my $last = $first + $#values;
    my $same = 0;
    $same++ while substr($first, 0, $same) eq substr($last, 0, $same);
    $last = substr $last, $same - 1;

    for my $i ($first .. $first + $#values) {
        $values[$i - $first] eq ($prefix . $i . $suffix) 
            or die "Invalid sequence at $values[$i-$first].\n";
    }
    return "$name='$prefix$first-$last$suffix'";
}


is( compact("names='foobar1304,foobar1305,foobar1306,foobar1307'"),
    "compact_name='foobar1304-7'");

is( compact("names='foobaz2205,foobaz2206,foobaz2207,foobaz2208,foobaz2209,foobaz2210,foobaz2211'"),
    "compact_name='foobaz2205-11'");

is( compact("names='foobar33-pqq,foobar34-pqq,foobar35-pqq'"),
    "compact_name='foobar33-5-pqq'");

done_testing();
于 2013-05-28T20:59:52.967 回答
1

有人肯定会发布更优雅的解决方案，但以下

use strict;
use warnings;

my $names='foobar1308-xy,foobar1309-xy,foobar1310-xy,foobar1311-xy';
my @names = split /,/,$names;

my $pfx = lcp(@names);

my @nums = map { m/$pfx(\d*)/; $1 } @names;
my $first=shift @nums;
my $last = pop @nums;
my $suf=$names[0];
$suf =~ s/$pfx\d*//;

print "$pfx\{$first-$last}$suf\n";

#https://gist.github.com/3309172
sub lcp {
    my $match = shift;
    substr($match, (($match ^ $_) =~ /^\0*/, $+[0])) = '' for @_;
    $match;
}

印刷：

foobar13{08-11}-xy
于 2013-05-28T21:15:32.283 回答