Perl 如何创建多个列表的组合而不使用硬编码循环？

我有如下数据：

    my @homopol = (
                   ["T","C","CC","G"],  # part1
                   ["T","TT","C","G","A"], #part2
                   ["C","CCC","G"], #part3 ...upto part K=~50
                  );


    my @prob = ([1.00,0.63,0.002,1.00,0.83],
                [0.72,0.03,1.00, 0.85,1.00],
                [1.00,0.97,0.02]);


   # Note also that the dimension of @homopol is always exactly the same with @prob.
   # Although number of elements can differ from 'part' to 'part'.

我想做的是

生成从

part1

到

partK

在

@prob

中找到相应元素的乘积

因此，最终我们希望得到以下结果：

T-T-C  1 x 0.72 x 1 = 0.720
T-T-CCC     1 x 0.72 x 0.97 = 0.698
T-T-G  1 x 0.72 x 0.02 = 0.014
...
G-G-G  1 x 0.85 x 0.02 = 0.017
G-A-C  1 x 1 x 1 = 1.000
G-A-CCC     1 x 1 x 0.97 = 0.970
G-A-G  1 x 1 x 0.02 = 0.020

问题是我下面的代码是通过硬编码实现的 循环。由于

@homopol

的部件数量可以变化且较大 （例如~K=50），我们需要一种灵活紧凑的方法来获得相同的结果。有吗？ 我在考虑使用，但不确定如何实现

use strict;
use Data::Dumper;
use Carp;


my @homopol = (["T","C","CC","G"],
               ["T","TT","C","G","A"],
               ["C","CCC","G"]);


my @prob = ([1.00,0.63,0.002,1.00,0.83],
            [0.72,0.03,1.00, 0.85,1.00],
            [1.00,0.97,0.02]);



my $i_of_part1 = -1;
foreach my $base_part1 ( @{ $homopol[0] } ) {
    $i_of_part1++;
    my $probpart1 = $prob[0]->[$i_of_part1];

    my $i_of_part2 =-1;
    foreach my $base_part2 ( @{ $homopol[1] } ) {
        $i_of_part2++;
        my $probpart2 = $prob[1]->[$i_of_part2];

        my $i_of_part3 = -1;
        foreach my $base_part3 ( @{ $homopol[2] } ) {
            $i_of_part3++;
            my $probpart3 = $prob[2]->[$i_of_part3];

            my $nstr = $base_part1."".$base_part2."".$base_part3;
            my $prob_prod = sprintf("%.3f",$probpart1 * $probpart2 *$probpart3);

            print "$base_part1-$base_part2-$base_part3 \t";
            print "$probpart1 x $probpart2 x $probpart3 = $prob_prod\n";

        }
    }
}

---

为什么不使用递归呢？将深度作为一个参数传递，让函数在循环内以深度+1调用自身。

您可以通过创建一个与@homopol数组长度相同的标记数组（N say）来实现，以跟踪您正在查看的组合。实际上，这个数组就像一个

---

以N为基数的数字，元素为数字。迭代的方式与以N为基数写下连续数字的方式相同，例如（0 0…0），（0 0…1），…，（0 0…N-1），（0 0…1 0），…

方法1：从指数计算

计算homopol中长度的乘积（长度1*长度2*…*长度n）。然后，将i从零迭代到乘积。现在，您需要的索引是i%length1，（i/length1）%length2，（i/length1/length2）%length3

方法2：递归

我被打败了，看尼基的回答。：-）

在不更改输入数据的情况下使用的解决方案如下所示：

use Algorithm::Loops;

# Turns ([a, b, c], [d, e], ...) into ([0, 1, 2], [0, 1], ...)
my @lists_of_indices = map { [ 0 .. @$_ ] } @homopol;

NestedLoops( [ @lists_of_indices ], sub {
  my @indices = @_;
  my $prob_prod = 1; # Multiplicative identity
  my @base_string;
  my @prob_string;
  for my $n (0 .. $#indices) {
    push @base_string, $hompol[$n][ $indices[$n] ];
    push @prob_string, sprintf("%.3f", $prob[$n][ $indices[$n] ]);
    $prob_prod *= $prob[$n][ $indices[$n] ];
  }
  print join "-", @base_string; print "\t";
  print join "x", @prob_string; print " = ";
  printf "%.3f\n", $prob_prod;
});

但我认为，通过将结构更改为类似的结构，实际上可以使代码更清晰

[ 
  { T => 1.00, C => 0.63, CC => 0.002, G => 0.83 },
  { T => 0.72, TT => 0.03, ... },
  ...
]

因为没有并行数据结构，您可以简单地迭代可用的基序列，而不是迭代索引，然后在两个不同的位置查找这些索引。

我建议，这将创建一个迭代器来生成所有集合的叉积。因为它使用迭代器，所以不需要预先生成每个组合；相反，它会根据需要生成每一个

use strict;
use warnings;
use Set::CrossProduct;

my @homopol = (
    [qw(T C CC G)],
    [qw(T TT C G A)],
    [qw(C CCC G)], 
);

my @prob = (
    [1.00,0.63,0.002,1.00],
    [0.72,0.03,1.00, 0.85,1.00],
    [1.00,0.97,0.02],
);

# Prepare by storing the data in a list of lists of pairs.
my @combined;
for my $i (0 .. $#homopol){
    push @combined, [];
    push @{$combined[-1]}, [$homopol[$i][$_], $prob[$i][$_]]
        for 0 .. @{$homopol[$i]} - 1;
};

my $iterator = Set::CrossProduct->new([ @combined ]);
while( my $tuple = $iterator->get ){
    my @h = map { $_->[0] } @$tuple;
    my @p = map { $_->[1] } @$tuple;
    my $product = 1;
    $product *= $_ for @p;
    print join('-', @h), ' ', join(' x ', @p), ' = ', $product, "\n";
}

---

@霍布斯：你的方法也创造了不必要的成对和单一组合（例如T-T，T-TT，T-）。我们有什么方法可以修改它吗？

NestedLoops

接受一个可选的过滤器子项，它允许您控制代码将被调用的组合。但是默认情况下，它应该做与问题中的原始代码相同的事情，所以我不确定它应该做什么。您可以使用

while（my$tuple=$iterator->next）

来避免将所有这些内容都放在内存中。@FM&Brian:您的新修复程序给出了错误的结果。我得到了无限循环，每行都有“T-T-c1x0.72x1=0.720”。@傻瓜小子，对不起，又修好了。应该在编辑之前运行代码。我们需要的方法是

get

而不是

next

。哦，那是我的错。很抱歉next（）向前看，但没有得到下一个元组。不需要时为什么要使用递归？Perl没有尾部递归，因此它在其他语言中工作的主要原因通常会扼杀Perl。递归到50的深度在任何语言中都是完全可以接受的。不要为了避免递归而不必要地使代码复杂化。使代码复杂化？使用递归更为复杂。：）而且，你不知道它只有50深。当人们在新的情况下使用程序时，程序往往会扩展其限制。既然很容易避免风险，为什么要冒险呢？：）嗯，没有什么能比得上早晨DNA编码的气味了。：）