Новые ответы

Перебор вариантов,

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, 18:05 , 20-Июл-05 (1)
а рекурсию в Перле отменили ?
или в школе не учили...

Ответить | Сообщить модератору
Перебор вариантов, ihor, 18:37 , 20-Июл-05 (2)
рекурсия - не самый удачный вариант, стека может не хватить.
вот вариант итеративный:
=====================================
#!/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, 19:38 , 20-Июл-05 (3)
  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, 19:41 , 20-Июл-05 (4)
Да, текст скрипта, что называется, поехал при Copy-Paste. :(
Но вариант работает.
Ответить | Сообщить модератору
Перебор вариантов, Maxim Kuznetsov, 12:05 , 22-Июл-05 (5)
проблем со стеком при рекурсивном переборе быть не может ;-)
скорее возникнет проблема с памятью ..
поясняю : если в переборе учатвуют 32 переменные хотя-бы по 2 варианта,
то глубина рекурсии всего 32, а кол-во вариантов уже минимум 2^32..
так что заменять рекурсию на итерации в данном случае - просто лишний геморой ;-)
Ответить | Сообщить модератору

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