Как я могу создать комбинации из нескольких списков без циклов жесткого кодирования?

У меня есть данные, которые выглядят так:

    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'.

Что я хочу сделать, так это

  1. Сгенерировать все комбинации элементов от part1 до partK
  2. Найдите произведение соответствующих элементов в @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), нам нужен гибкий и компактный способ получить тот же результат. Есть ли? Я думал использовать Algorithm::Loops, но не уверен, как этого добиться.

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";

        }
    }
}

nested-loops algorithm perl
person neversaint    schedule 18.09.2009    source источник
comment
Ммм нет ничего лучше запаха кодирования ДНК по утрам. :)   -  person Ether    schedule 18.09.2009

Ответы (5)


arrow_upward
4
arrow_downward

Я бы рекомендовал Set::CrossProduct, который создаст итератор для получения перекрестного произведения всех из ваших наборов. Поскольку он использует итератор, ему не нужно заранее генерировать каждую комбинацию; скорее, он дает каждый по требованию.

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";
}
person FMc    schedule 18.09.2009
comment
Использование комбинации() означает, что вы создаете все кортежи. Вы можете использовать while( my $tuple = $iterator->next ), чтобы не помещать все это в память. - person brian d foy; 18.09.2009
comment
@FM и Брайан: Ваше новое исправление дало неправильный результат. Я получил бесконечный цикл с T-T-C 1 x 0,72 x 1 = 0,720 для каждой строки. - person neversaint; 19.09.2009
comment
@foolishbrat Извините, исправлено снова. Надо было запустить код перед редактированием. Нам нужен метод get, а не next. - person FMc; 19.09.2009
comment
О, это моя вина. Прости. next() заглядывает вперед, но не получает следующий кортеж. - person brian d foy; 20.09.2009

arrow_upward
2
arrow_downward

Решение с использованием Algorithm::Loops без изменения входных данных будет выглядеть примерно так:

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, ... },
  ...
]

потому что без параллельных структур данных вы можете просто перебирать доступные базовые последовательности вместо того, чтобы перебирать индексы и затем искать эти индексы в двух разных местах.

person hobbs    schedule 18.09.2009
comment
@hobbs: Ваш подход также создает ненужную парную и одиночную комбинацию (например, TT,T-TT, T--) . Есть ли способ изменить это? - person neversaint; 18.09.2009
comment
NestedLoops принимает необязательный фильтр, который позволяет вам контролировать, какие комбинации будут вызываться вашим кодом. Но по умолчанию он должен делать то же самое, что и исходный код в вопросе, поэтому я не уверен, что он должен делать. - person hobbs; 18.09.2009

arrow_upward
0
arrow_downward

Почему вы не используете рекурсию? Передайте глубину в качестве параметра и позвольте функции вызвать себя с глубиной + 1 внутри цикла.

person Niki    schedule 18.09.2009
comment
Зачем использовать рекурсию, если она вам не нужна? В Perl нет хвостовой рекурсии, поэтому основная причина, по которой она работает в других языках, часто убивает вас в Perl. - person brian d foy; 18.09.2009
comment
Рекурсия на глубину 50 вполне приемлема для любого языка. Не усложняйте код без необходимости, чтобы избежать рекурсии. - person Jonathan Graehl; 18.09.2009
comment
Усложнить код? Сложнее использовать рекурсию. :) И вы не знаете, что это будет только глубина 50. Программы, как правило, расширяют свои возможности по мере того, как люди используют их в новых ситуациях. Если так легко избежать риска, зачем рисковать? :) - person brian d foy; 20.09.2009

arrow_upward
-1
arrow_downward

вы можете сделать это, создав массив индексов той же длины, что и массив @homopol (скажем, N), чтобы отслеживать, на какую комбинацию вы смотрите. На самом деле этот массив подобен числу по основанию N, элементами которого являются цифры. Повторяйте так же, как вы записываете последовательные числа по основанию N, например (0 0 0 ... 0), (0 0 0 ... 1), ..., (0 0 0 ... N- 1), (0 0 0 ... 1 0), ....

person Chris Card    schedule 18.09.2009

arrow_upward
-2
arrow_downward

Подход 1: расчет по индексам

Вычислите произведение длин в гомополе (длина1 * длина2 * ... * длинаN). Затем повторите i от нуля до продукта. Теперь вам нужны следующие индексы: i% length1, (i/length1)%length2, (i/length1/length2)% length3,...

Подход 2: рекурсия

Меня опередили, см. ответ Ники. :-)

person Igor ostrovsky    schedule 18.09.2009