Perl一个一个地排列数组的所有排列

Question

我有一个阵列,比方说

@array = qw(11 12 13 14 15);

我想执行一些操作并检查一个条件.如果条件满足,我将退出我的程序,但如果不满足,我想以字典顺序更新我的数组到下一个排列,即尝试使用@ array = qw(11 12 13 15 14);

目前我正在使用此代码:

sub permute {

    return ([]) unless (@_);
    return map {
                 my @cdr = @_;
                 my $car = splice @cdr, $_, 1;
                 map { [$car, @$_]; } &permute(@cdr);
               } 0 .. $#_;
}

my @array = qw(11 12 13 14 15);

foreach ( &permute(@array) ) {

    if ( condition met ) {
        print "@$_";
        exit;
    }
}

问题:此代码运行子置换次数太多次.如果数组大小很大,这会大大减慢我的程序.我不想要所有的排列,只要我的条件不满足,我只需要下一个排列.假设100个排列是可能的,我想从1st开始.如果条件满足,退出else移动到2nd,3rd等等.所以,我希望方法permute只运行以找到下一个排列而不是全部.

请帮忙.

Answer 1

改编自perl FAQ以恢复某些点/阵列的排列.

# Fischer-Krause ordered permutation generator
sub permute (&\@\@) {
    my $code = shift;
    my ($starting, $current) = @_;

    my %h;
    @h{@$starting} = 0 .. $#$starting;
    my @idx = @h{@$current};

    while ( $code->(@$starting[@idx]) ) {
        my $p = $#idx;
        --$p while $idx[$p-1] > $idx[$p];
        my $q = $p or return;
        push @idx, reverse splice @idx, $p;
        ++$q while $idx[$p-1] > $idx[$q];
        @idx[$p-1,$q]=@idx[$q,$p-1];
    }
}

# starting array
my @start   = qw(11 12 13 14 15);
# begin with permutations from @current array position
my @current = qw(11 12 13 15 14);
my $i = 3;
permute { print "@_\n"; return --$i } @start, @current;