URL: https://www.opennet.me/cgi-bin/openforum/vsluhboard.cgi
Форум: vsluhforumID9
Нить номер: 4494
[ Назад ]

Исходное сообщение
"Перебор вариантов"

Отправлено Cforest , 20-Июл-05 17:03 
  Привет. Нужен совет - как создать прогу.
Есть файл с таким содержимым:
a1 a2 a3 a4 a5
b1 b2 b3
c1 c2 c3 c4
Количество строк и элементов в строке может быть разным. Элементы разделены пробелами). Нужна прога, которая выполняет перебор вариантов. Каждый вариант - это множество, в которое входит по одному элементу из каждой строки. То есть прога должна выводить следующее:
a1 b1 c1
a1 b1 c2
a1 b1 c3
a1 b1 c4
a1 b2 c1
a1 b2 c2
...
a5 b3 c4

Самое простое в этой задаче - считать строки из файла и загнать в массив массивов.
open (List, "list.txt") or die "Can't read list $!";
while (<List>) {
    push @rows, [ split ];
}
А дальше должны идти вложенные циклы for:
  перебор элементов 1-го массива
    перебор элементов 2-го массива
        ...
          перебор элементов N-го массива (N - количество строк)
             вывод элемента

Сложность в том, что заранее количество строк неизвестно. Соответственно, заранее неизвестно количество массивов в @rows (значение N) и количество вложенных циклов for. Из-за этого вложенную структуру циклов for нельзя жестко задать в скрипте. Видимо, это можно реализовать с помощью рекурсии - количество строк (массивов) известно через $#rows. Но, увы, в рекурсии не силен. Сможет кто-нить помочь ?


Содержание

Сообщения в этом обсуждении
"Перебор вариантов"
Отправлено Maxim Kuznetsov , 20-Июл-05 18:05 
а рекурсию в Перле отменили ?
или в школе не учили...



"Перебор вариантов"
Отправлено ihor , 20-Июл-05 18:37 
рекурсия - не самый удачный вариант, стека может не хватить.
вот вариант итеративный:
=====================================
#!/usr/local/bin/perl

use strict;
# ====================================
sub load {
    my($fname) = @_;
    my(@vals, @res, $str);
    
    open(FILE, $fname) || die "Can't open $fname!";
    while (defined ($str = <FILE>)) {
        @vals = split(/\s+/, $str);
        push(@res, [0, $#vals, [@vals]]);
    } # while
    close(FILE);
    return \@res;
} # sub

# ====================================
sub make_next {
    my($input) = @_;
    my($i, $m, $carry);
    $carry = 1;
    
    for ($i = $#{$input}; $i >= 0; $i--) {
        $m = ${${$input}[$i]}[0] + $carry;
        if ($m > ${${$input}[$i]}[1]) {
            ${${$input}[$i]}[0] = 0;
        } else {
            $carry = 0;
            ${${$input}[$i]}[0] = $m;
            last;
        } # else
    } # for
    
    return 1 if $carry == 0;
    return 0;
} # sub
# ====================================
sub show {
    my($input) = @_;
    my($elem, @idxs, @vals, $src);
    
    foreach $elem (@{$input}) {
        push(@idxs, ${$elem}[0]);
        push(@vals, ${${$elem} [2]}[${$elem}[0]]);
    } # foreach
    
    print '(' . join(', ', @idxs) . ') ';
    print '(' . join(', ', @vals) . ")\n";
} # sub
# ====================================
sub produce {
    my($input) = @_;
    my($dims, @res, $subres, $elem, $subelem);
    
    do {
        show($input);
    } while (make_next($input));
} # sub
# ====================================
my($fname, $input);
$fname = "/tmp/input.txt";
    
$input = load($fname);
produce($input);


"Перебор вариантов"
Отправлено Cforest , 20-Июл-05 19:38 
  Ihor, спасибо!

Вот какой вариант получился с рекурсией (наверное, не очень изящный - давно не программировал). Вы абсолютно правы - при рекурсии возможны проблемы со стеком. Еще раз спасибо!

#!/usr/bin/perl

sub get_element {
    my ($array, $variant) = @_;
    if ($array == $#rows) {
    for $element (0 .. $#{ $rows[$array] }) {        
        print Result join (" ", @{ $variant });
        print Result " ", $rows[$array][$element], "\n";
    }
    } else {
    for $element (0 .. $#{ $rows[$array] }) {        
        my @incomplete_variant = @{ $variant };
        push @incomplete_variant, $rows[$array][$element];
        my $inner_array = $array + 1;
        get_element($inner_array, \@incomplete_variant);
    }
    }
}      

open (List, "list.txt") or die "Can't read list $!";
while (<List>) {
    push @rows, [ split ];
}
close(List);

open (Result, "> result.txt") or die "Can't write results $!";

for $i (0..$#{ $rows[0] }) {
    my @variant;
    push (@variant, $rows[0][$i]);
    get_element(1, \@variant);
    undef @variant;
}
close (Result);


"Перебор вариантов"
Отправлено Cforest , 20-Июл-05 19:41 
Да, текст скрипта, что называется, поехал при Copy-Paste. :(
Но вариант работает.

"Перебор вариантов"
Отправлено Maxim Kuznetsov , 22-Июл-05 12:05 
проблем со стеком при рекурсивном переборе быть не может ;-)
скорее возникнет проблема с памятью ..
поясняю : если в переборе учатвуют 32 переменные хотя-бы по 2 варианта,
то глубина рекурсии всего 32, а кол-во вариантов уже минимум 2^32..

так что заменять рекурсию на итерации в данном случае - просто лишний геморой ;-)


"Перебор вариантов"
Отправлено kotz80 , 06-Апр-10 18:39 
>[оверквотинг удален]
> do {
>  show($input);
> } while (make_next($input));
>} # sub
># ====================================
>my($fname, $input);
>$fname = "/tmp/input.txt";
>
>$input = load($fname);
>produce($input);

А на Паскале можно то же самое?? А то эти иероглифи не понимаю, перл -  это не мой конек