Привет. Нужен совет - как создать прогу.
Есть файл с таким содержимым:
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. Но, увы, в рекурсии не силен. Сможет кто-нить помочь ?
а рекурсию в Перле отменили ?
или в школе не учили...
рекурсия - не самый удачный вариант, стека может не хватить.
вот вариант итеративный:
=====================================
#!/usr/local/bin/perluse 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);
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);
Да, текст скрипта, что называется, поехал при Copy-Paste. :(
Но вариант работает.
проблем со стеком при рекурсивном переборе быть не может ;-)
скорее возникнет проблема с памятью ..
поясняю : если в переборе учатвуют 32 переменные хотя-бы по 2 варианта,
то глубина рекурсии всего 32, а кол-во вариантов уже минимум 2^32..так что заменять рекурсию на итерации в данном случае - просто лишний геморой ;-)
>[оверквотинг удален]
> do {
> show($input);
> } while (make_next($input));
>} # sub
># ====================================
>my($fname, $input);
>$fname = "/tmp/input.txt";
>
>$input = load($fname);
>produce($input);А на Паскале можно то же самое?? А то эти иероглифи не понимаю, перл - это не мой конек