在Perl中,如何生成列表的所有可能组合?

时间:2012-04-24 14:24:30

标签: arrays perl combinations combinatorics

我有一个带有列表的文件,需要创建一个文件,将每行与另一行进行比较。例如,我的文件有:

AAA  
BBB  
CCC  
DDD  
EEE

我希望最终列表看起来像这样:

AAA  BBB  
AAA  CCC  
AAA  DDD  
AAA  EEE  
BBB  CCC  
BBB  DDD  
BBB  EEE  
CCC  DDD  
CCC  EEE  
DDD  EEE

我试图在Perl中这样做,这是第一次,我遇到了一些麻烦。我知道你需要制作一个数组,然后拆分它,但之后我遇到了一些麻烦。

7 个答案:

答案 0 :(得分:29)

使用Algorithm::Combinatorics。基于迭代器的方法比一次生成所有内容更可取。

#!/usr/bin/env perl

use strict; use warnings;
use Algorithm::Combinatorics qw(combinations);

my $strings = [qw(AAA BBB CCC DDD EEE)];

my $iter = combinations($strings, 2);

while (my $c = $iter->next) {
    print "@$c\n";
}

输出:

AAA BBB
AAA CCC
AAA DDD
AAA EEE
BBB CCC
BBB DDD
BBB EEE
CCC DDD
CCC EEE
DDD EEE

答案 1 :(得分:8)

使用递归来编写它是很简单的。

此代码示例演示。

use strict;
use warnings;

my $strings = [qw(AAA BBB CCC DDD EEE)];

sub combine;

print "@$_\n" for combine $strings, 5;

sub combine {

  my ($list, $n) = @_;
  die "Insufficient list members" if $n > @$list;

  return map [$_], @$list if $n <= 1;

  my @comb;

  for my $i (0 .. $#$list) {
    my @rest = @$list;
    my $val  = splice @rest, $i, 1;
    push @comb, [$val, @$_] for combine \@rest, $n-1;
  }

  return @comb;
}

修改

我道歉 - 我正在生成排列而不是组合

此代码是正确的。

use strict;
use warnings;

my $strings = [qw(AAA BBB CCC DDD EEE)];

sub combine;

print "@$_\n" for combine $strings, 2;

sub combine {

  my ($list, $n) = @_;
  die "Insufficient list members" if $n > @$list;

  return map [$_], @$list if $n <= 1;

  my @comb;

  for (my $i = 0; $i+$n <= @$list; ++$i) {
    my $val  = $list->[$i];
    my @rest = @$list[$i+1..$#$list];
    push @comb, [$val, @$_] for combine \@rest, $n-1;
  }

  return @comb;
}

<强>输出

AAA BBB
AAA CCC
AAA DDD
AAA EEE
BBB CCC
BBB DDD
BBB EEE
CCC DDD
CCC EEE
DDD EEE

答案 2 :(得分:7)

查看Math::Combinatorics - 在列表上执行组合和排列

从CPAN复制示例:

use Math::Combinatorics;

  my @n = qw(a b c);
  my $combinat = Math::Combinatorics->new(count => 2,
                                          data => [@n],
                                         );

  print "combinations of 2 from: ".join(" ",@n)."\n";
  print "------------------------".("--" x scalar(@n))."\n";
  while(my @combo = $combinat->next_combination){
    print join(' ', @combo)."\n";
  }

  print "\n";

  print "permutations of 3 from: ".join(" ",@n)."\n";
  print "------------------------".("--" x scalar(@n))."\n";
  while(my @permu = $combinat->next_permutation){
    print join(' ', @permu)."\n";
  }

  output:
combinations of 2 from: a b c
  ------------------------------
  a b
  a c
  b c

  permutations of 3 from: a b c
  ------------------------------
  a b c
  a c b
  b a c
  b c a
  c a b
  c b a

答案 3 :(得分:0)

  1. 取第一个字符串
  2. 从下一个位置到结束遍历数组
    1. 将下一个字符串附加到原始字符串
  3. 接下一个字符串并返回第2步

答案 4 :(得分:0)

怎么样:

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump qw(dump);

my @in = qw(AAA BBB CCC DDD EEE);
my @list;
while(my $first = shift @in) {
    last unless @in;
    my $rest = join',',@in;
    push @list, glob("{$first}{$rest}");
}
dump @list;

<强>输出:

(
  "AAABBB",
  "AAACCC",
  "AAADDD",
  "AAAEEE",
  "BBBCCC",
  "BBBDDD",
  "BBBEEE",
  "CCCDDD",
  "CCCEEE",
  "DDDEEE",
)

答案 5 :(得分:0)

这是使用glob的黑客攻击:

my @list = qw(AAA BBB CCC DDD EEE);

for my $i (0..$#list-1) {
    print join "\n", glob sprintf "{'$list[$i] '}{%s}",
          join ",", @list[$i+1..$#list];
    print "\n";
}

输出:

AAA BBB
AAA CCC
AAA DDD
AAA EEE
BBB CCC
BBB DDD
BBB EEE
CCC DDD
CCC EEE
DDD EEE

P.S。您可能希望使用Text::Glob::ExpandString::Glob::Permute模块而不是普通glob()来避免在当前工作目录中匹配文件的警告。

答案 6 :(得分:0)

我对以下Perl模块进行了基准测试:

  1. Math::Combinatorics
  2. Algorithm::Combinatorics
  3. Cmb

基准测试包括执行OP所要求的,两个项目的组合,但将词组增加到10,000个,而不仅仅是最初请求的5个(AAA BBB CCC DDD EEE)。

Math :: Combinatorics的测试脚本

#!/usr/bin/env perl
use strict; use warnings;
use Math::Combinatorics;
my $strings = [qw(AAA BBB CCC DDD EEE) x 2000];
my $iter = new Math::Combinatorics (count => 2, data => $strings);
while (my @c = $iter->next_combination) {
    print "@c\n";
}

这每秒产生约53,479个组合。

Algorithm :: Combinatorics的测试脚本

#!/usr/bin/env perl
use strict; use warnings;
use Algorithm::Combinatorics qw(combinations);
my $strings = [qw(AAA BBB CCC DDD EEE) x 2000];
my $iter = combinations($strings, 2);
while (my $c = $iter->next) {
    print "@$c\n";
}

这每秒产生约861,982个组合。

Cmb的测试脚本

#!/usr/bin/env perl
use strict; use warnings;
use Cmb;
my $strings = [qw(AAA BBB CCC DDD EEE) x 2000];
my $cmb = new Cmb { size_min => 2, size_max => 2 };
$cmb->cmb_callback($#$strings + 1, $strings, sub {
    print "@_\n";
    return 0;
});

这每秒产生约2,940,882个组合。

但是,如果您只需要打印组合,Cmb实际上可以比上述方法更快地完成操作。

#!/usr/bin/env perl
use strict; use warnings;
use Cmb;
my $strings = [qw(AAA BBB CCC DDD EEE) x 2000];
my $cmb = new Cmb { size_min => 2, size_max => 2 };
$cmb->cmb($#$strings + 1, $strings);

这每秒产生约3,333,000个组合。

基准测试是在Intel(R)Xeon(R)上使用Perl 5.16.3在内核3.10.0-1062.1.1.el7.x86_64 x86_64上的CentOS Linux版本7.7.1908(Core)上使用dpv执行的。 )CPU E5-2699 v4 @ 2.20GHz