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

问题:此代码运行 sub permute 的次数太多。如果数组大小很大，这会大大减慢我的程序。我不想要所有排列，只要不满足我的条件，我只需要下一个排列。假设有 100 个排列是可能的，我想从第一个开始。如果条件满足，则退出，否则移动到第二、第三等。因此，我希望 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;