Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Задачи на перестановки
Автор: Unconnected 16.01.2010 2:08
Привет всем.
Меня заинтересовала задача из соседней темы, про перестановки в числах.
Цитата
Задача 4 "Сумма двух чисел"
Имя входного файла: sum.in
Имя выходного файла: sum.out
Максимальное время работы на одном тесте: 2 секунды
Максимальный объем используемой памяти: 64 мегабайта
Заданы три числа: a, b, c. Необходимо выяснить, можно ли так переставить цифры в числах a и b, чтобы в сумме получилось c.
Формат входных данных
Входной файл содержит три целых числа: a, b, c (0 < a, b, c < 109). Числа разделены пробелом.
Формат выходных данных
Если искомая перестановка цифр возможна, необходимо вывести в выходной файл слово YES, в противном случае — выведите слово NO. При положительном ответе необходимо вывести во второй строке выходного файла число x, получаемое перестановкой цифр числа a, и число y, получаемое перестановкой цифр числа b, сумма которых равна c. Числа x и y не должны содержать ведущих нулей. Числа в строке разделены пробелом.
Примеры входных и выходных файлов
sum.in sum.out
12 31 25 ***YES***
**********12 13***
12 31 26 ***NO***
Вот что я сделал:
const m=6;
type st = string[3];
var a,b:st;
m1,m2:array[1..m] of st;
f:text;
i,j:byte;
buf1,buf2,c,code,aa,bb:integer;
Procedure generate(m:array of st;v:st);
var buf:char;
i:byte;
begin
if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);
i:=1;
m[i]:=v;
repeat
inc(i);
m[i][1]:=m[i-1][2];
m[i][2]:=m[i-1][3];
m[i][3]:=m[i-1][1];
until (i=3);
inc(i);
m[i][1]:=m[1][1];
m[i][2]:=m[1][3];
m[i][3]:=m[1][2];
repeat
inc(i);
m[i][1]:=m[i-1][2];
m[i][2]:=m[i-1][3];
m[i][3]:=m[i-1][1];;
until (i=6);
end;
begin
assign(f,'sum.in');
reset(f);
read(f,aa,bb,c);
close(f);
str(aa,a);
str(bb,b);
generate(m1,a);
generate(m2,b);
for i:=1 to m do
begin
val(m1[i],buf1,code);
for j:=1 to m do
begin
val(m2[j],buf2,code);
if (buf1+buf2=c) then begin
assign(f,'sum.out');
rewrite(f);
writeln(f,'YES');
write(buf1,' ',buf2,' ',c);
close(f);
halt;
end;
end;
end;
readln;
assign(f,'sum.out');
rewrite(f);
write(f,'NO');
close(f);
end.
Мой алгоритм перестановок (для трёхзначных чисел) основан на том, что если в числе переносить первую цифру в конец, пока не получится исходное число, а потом поменять 2 и 3 цифры местами и сделать то же самое, то получатся все перестановки..
Например:
123
231
312
меняем,
132
321
213
Получилось 6 перестановок, как раз 3!, как и должно быть. Моя программа почему-то не заполняет корректно массив (процедура Generate).
Автор: volvo 16.01.2010 2:40
Цитата
Моя программа почему-то не заполняет корректно массив (процедура Generate)
Потому что она у тебя вылетает за пределы этого массива: открытый массив индексируется с 0, а не с того индекса, который задан при описании типа. Соответственно, не до M, а до (M-1)... Включи контроль границ и убедись...
Автор: Unconnected 16.01.2010 4:43
Получается, надо константу m сделать равной 7? Всё равно не заполняет..
Автор: volvo 16.01.2010 5:54
Цитата
Всё равно не заполняет..
Во-первых, я не совсем понял вот этот твой финт:Цитата
if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);
1)
type
arrst = array [1 .. m] of st;
2)
procedure generate(VAR m:arrst;v:st);и третье - скорее всего, главное, заполнял бы массив вот таким образом:
i:=1;, понимаешь разницу между тем, что сделал я, и тем, что делал ты? В моем случае длина строки устанавливается корректно, в твоем - нет.
m[i]:=v;
repeat
inc(i);
m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
until (i=3);
Автор: Unconnected 16.01.2010 21:37
Короче, я решил... вроде бы... Добавил кое-что, код, конечно, не очень красивый, зато работает.
const m=6;
type st = string[3];
var a,b,cc:st;
m1,m2:array[1..m] of st;
ll:array[1..3] of byte;
f:text;
i,j:byte;
buf1,buf2,c,code,aa,bb:integer;
Procedure generate(m:array of st;v:st;num:byte);
var buf:char;
i:byte;
begin
if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);
i:=1;
m[i]:=v;
repeat
inc(i);
m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
until (i=3);
inc(i);
m[i]:=m[1][1]+m[1][3]+m[1][2];
repeat
inc(i);
m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
until (i=6);
if (num=1) then for i:=1 to 6 do m1[i]:=m[i]
else for i:=1 to 6 do m2[i]:=m[i]
end;
Function getlength(v:integer):byte;
var t:string[3];
begin
str(v,t);
getlength:=length(t);
end;
begin
assign(f,'sum.in');
reset(f);
read(f,aa,bb,c);
close(f);
str(aa,a);
str(bb,b);
str(c,cc);
ll[1]:=length(a);ll[2]:=length(b);ll[3]:=length(cc);
generate(m1,a,1);
generate(m2,b,2);
if c<100 then c:=c*10;
for i:=1 to m do
begin
val(m1[i],buf1,code);
for j:=1 to m do
begin
val(m2[j],buf2,code);
if (buf1+buf2=c) then begin
assign(f,'sum.out');
rewrite(f);
writeln(f,'YES');
if ll[1]<getlength(buf1) then
repeat
buf1:=buf1 div 10;
until (ll[1]=getlength(buf1));
if ll[2]<getlength(buf2) then
repeat
buf2:=buf2 div 10;
until (ll[2]=getlength(buf2));
if ll[3]<getlength© then
repeat
c:=c div 10
until (ll[3]=getlength©);
write(f,buf1,' ',buf2,' ',c);
close(f);
halt;
end;
end;
end;
readln;
assign(f,'sum.out');
rewrite(f);
write(f,'NO');
close(f);
end.
Кстати, volvo, я так и не понял, почему твой код заполнения массива работает, а мой - нет? Мой ведь вроде бы на те же позиции копирует символы, только вручную, а твой просто присоединяет, вроде как и на те же места..
Автор: volvo 16.01.2010 21:40
Цитата
а твой просто присоединяет, вроде как и на те же места..
Мало просто скопировать символы... Надо еще и длину строки установить, если ты заполняешь строку вручную. А если делать так, как я показал - то это делает компилятор, тебе об этом можно не заботиться...
Автор: Unconnected 16.01.2010 21:41
А как установить её, длину, вручную? Может, SetLength?
Автор: volvo 16.01.2010 21:51
Цитата
Может, SetLength?
Если у тебя 32-битный компилятор - то SetLength, если 16-битный - то прямой записью длины строки в ее нулевой байт...
Автор: Unconnected 16.01.2010 21:53
Ого, не знал, спасибо за помощь 
Автор: Lapp 17.01.2010 3:44
Обычно в подобных случаях генерировать перестановки проще всего с помощью рекурсии. Вот, смотри:
const
m=2; //количество слагаемых
var
c,i: integer;
a: array [1..m] of record
v,x: integer;
s: string;
d: set of byte
end;
f: text;
procedure Dig(n,k: integer);
var
i,z: integer;
begin
if k=0 then
if n=m then begin
z:=0;
for i:=1 to m do z:=z+a[i].x;
if z=c then begin
WriteLn(f,'YES');
for i:=1 to m do Write(f,a[i].x,' ');
Close(f);
Halt
end
end
else Dig(n+1,Length(a[n+1].s))
else with a[n] do for i:=1 to Length(s) do if not (i in d) then begin
x:=x*10+Ord(s[i])-48;
Include(d,i);
Dig(n,k-1);
Exclude(d,i);
x:=(x-Ord(s[i])+48) div 10
end
end;
begin
Assign(f,'sum.in');
ReSet(f);
for i:=1 to m do with a[i] do begin
Read(f,v);
Str(v,s);
d:=[];
x:=0
end;
ReadLn(f,c);
Close(f);
Assign(f,'sum.out');
ReWrite(f);
Dig(1,Length(a[1].s));
WriteLn(f,'NO');
Close(f)
end.
Эта программа работает с числами любой длины и любым количеством слагаемых (но последнее нужно задавать заранее константой m).
Конечно, время работы несколько страдает.. Но при m=2, пролетает быстро; не исключено, что в 2 сек уложишься. Разберешься? Комменты по запросу
.
Автор: Lapp 17.01.2010 7:34
Unconnected, можно я выскажу несколько замечаний?
Во-первых, при входных данных:
53 10 135
- твоя программа выдает:
YES
35 10 135
- что неверно..
Далее, у тебя путаница в передачей массива в подпрограмму. Нужно сделать специальный тип и передавать его. Конструкция, которую использовал ты (array без пределов) в данном случае не годится, она служит другой цели и используется иначе. Я сделал изменения в твоем коде (помечено //), посмотри; так программа не вылетает при включенном range check.
Отступы.. Они должны быть ВСЕГДА на одну и ту же величину. Сдвиг НЕ ДОЛЖЕН зависеть от того, за чем он идет: var, type или begin в конце строки - всегда на одно и то же число позиций (обычно 2, но можно и 4) от начала предыдущей строки. Исключений нет. Точка.
Это было непререкаемое правило. А теперь совет..
Лучше писать begin (repeat, case..) не на новой строке, а на той же. Это не только позволяет сэкономить строчку и отступ, но - самое главное - позволяет практически исключить такую ситуацию:
for i:=1 to 5 do
begin
a:=b;
b:=1
end;
c:=d; // вот эта строчка начинается не с end, это плохо
Лучше так:
for i:=1 to 5 do begin
a:=b;
b:=1
end; // блок закрывается end'ом
c:=d; // теперь это обычная строка текста
Если пишешь так, то появление в коде сдвинутой влево строки, НЕ начинающеся с end - почти всегда признак ошибки. Блок всегда начинается со строки, заканчивающейся begin (repeat, case..) и заканчивается строкой, начинающейся с end (until), и его тело сдвинуто. Всякое отступление от этого правила - признак возможной ошибки. Исключения случаются (они вносятся обычно оператором if .. then .. else), но их тоже проще отловить, если точно следуешь этому правилу. Очень рекомендую привыкнуть к такому способу написания кода.
Теперь твоя программа, немного исправленная мной.
const
m=6;
type
tSt = string[3]; //
tArSt = array[1..m]of tSt; //
var
a,b,cc: tSt;
m1,m2: tArSt; //
ll: array[1..3] of byte;
f:text;
i,j:byte;
buf1,buf2,c,code,aa,bb:integer;
Procedure generate(m:tArSt; v:tSt; num:byte); //
var
buf:char;
i:byte;
begin
if (length(v)<3) then repeat v:=v+'0' until (length(v)=3);
i:=1;
m[i]:=v;
repeat
inc(i);
m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
until (i=3);
inc(i);
m[i]:=m[1][1]+m[1][3]+m[1][2];
repeat
inc(i);
m[6]:='123';
m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
until (i=6);
if (num=1) then for i:=1 to 6 do m1[i]:=m[i]
else for i:=1 to 6 do m2[i]:=m[i]
end;
Function getlength(v:integer):byte;
var
t:string[3];
begin
str(v,t);
getlength:=length(t);
end;
begin
assign(f,'sum.in');
reset(f);
read(f,aa,bb,c);
close(f);
str(aa,a);
str(bb,b);
str(c,cc);
ll[1]:=length(a);ll[2]:=length(b);ll[3]:=length(cc);
generate(m1,a,1);
generate(m2,b,2);
if c<100 then c:=c*10;
for i:=1 to m do begin
val(m1[i],buf1,code);
for j:=1 to m do begin
val(m2[j],buf2,code);
if (buf1+buf2=c) then begin
assign(f,'sum.out');
rewrite(f);
writeln(f,'YES');
if ll[1]<getlength(buf1) then repeat
buf1:=buf1 div 10;
until (ll[1]=getlength(buf1));
if ll[2]<getlength(buf2) then repeat
buf2:=buf2 div 10;
until (ll[2]=getlength(buf2));
if ll[3]<getlength© then repeat
c:=c div 10
until (ll[3]=getlength©);
write(f,buf1,' ',buf2,' ',c);
close(f);
halt;
end;
end;
end;
readln;
assign(f,'sum.out');
rewrite(f);
write(f,'NO');
close(f);
end.
Надеюсь, ты сможешь извлечь из этого пользу )).
И жду исправления работы в описанной выше ситуации!
Автор: volvo 17.01.2010 15:10
Цитата
Далее, у тебя путаница в передачей массива в подпрограмму. Нужно сделать специальный тип и передавать его. Конструкция, которую использовал ты (array без пределов) в данном случае не годится, она служит другой цели и используется иначе.
А я уже говорил, что надо бы описывать тип (в сообщении №4 я назвал его arrst), но автор продолжает упорно использовать открытые массивы, из-за чего и огребает проблемы на ровном месте... Посмотрим, получится ли у тебя его убедить...
Автор: Unconnected 17.01.2010 15:31
Короче, переделал я вообще механизм программы, т.к. добавление нулей это, видимо, дохлый номер, из-за которого и получалась ошибка, приведённая Lapp'ом.
const
m=6;
type
tSt = string[3];
tArSt = array[1..m] of tSt;
var a,b,cc:tst;
m1,m2:tArSt;
f:text;
i,j:byte;
buf1,buf2,c,code,aa,bb:integer;
kol:array[1..2] of byte;
Procedure generate(m:tArSt;v:tst;num:byte);
var buf:char;
i:byte;
begin
i:=1;
m[i]:=v;
if length(v)=1 then kol[num]:=1;
if length(v)=2 then begin
kol[num]:=2;
m[2]:=v[2]+v[1];
end;
if length(v)=3 then begin
repeat
inc(i);
m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
until (i=3);
inc(i);
m[i]:=m[1][1]+m[1][3]+m[1][2];
repeat
inc(i);
m[i]:=m[i-1][2]+m[i-1][3]+m[i-1][1];
until (i=6);
end;
if (num=1) then for i:=1 to kol[num] do m1[i]:=m[i]
else for i:=1 to kol[num] do m2[i]:=m[i]
end;
begin
assign(f,'sum.in');
reset(f);
read(f,aa,bb,c);
close(f);
str(aa,a);
str(bb,b);
str(c,cc);
generate(m1,a,1);
generate(m2,b,2);
for i:=1 to kol[1] do
begin
val(m1[i],buf1,code);
for j:=1 to kol[2] do begin
val(m2[j],buf2,code);
if (buf1+buf2=c) then begin
assign(f,'sum.out');
rewrite(f);
writeln(f,'YES');
write(f,buf1,' ',buf2,' ',c);
close(f);
halt;
end;
end;
end;
assign(f,'sum.out');
rewrite(f);
write(f,'NO');
close(f);
end.
Про передачу в программу массива без пределов - просто я считал, что так и нужно передавать массивы в качестве входных параметров процедур\функций. Буду знать)
Lapp, за форматирование спасибо, приму к сведению (уже даже вроде бы принял, правя код)
С рекурсивным решением разберусь, мне как раз надо научиться делать такое.
Автор: volvo 17.01.2010 15:46
Цитата
Procedure generate(m:tArSt;v:tst;num:byte);
Автор: Unconnected 17.01.2010 15:53
Мм нет вроде, а что, что-то забыл? Там массивы уже с типами..
Автор: volvo 17.01.2010 16:00
Там не хватает слова Var... Не надо передавать в процедуру массив только как хранилище данных, заполнять его там, и тут же копировать в глобальную переменную. Ибо сразу возникает вопрос: а зачем ты вообще массив передаешь в процедуру?
Я в курсе, что ЗДЕСЬ (в данной программе) это работает... Но у тебя в процедуру передается лишний параметр, от которого можно избавиться (я про num). К тому же внутри процедуры моментально уберется лишний же цикл и условие... И вообще, это - неправильный путь. Правильный - работать с подпрограммами через параметры, а не через побочные эффекты...
И опять я убеждаюсь, что все, что делается мной на форуме пропускается мимо ушей... Я ж писал, "Как не надо писать программы", и там говорилось в частности о том, что надо избегать использования глобальных переменных, и о том, что переменная должна описываться как можно ниже в тексте программы - нет, опять этого никто не читает... Неинтересно? Заработало и ладно? Ну, что ж... Больше в этот процесс вмешиваться не буду, пишите, "чтоб работало, сдам и фиг с ним".
Автор: Unconnected 17.01.2010 16:25
Да, и правда, если добавить var, то переписывание в глобальный массив становится ненужным... Только num всё равно передавать придётся, ибо с помощью него записывается длина v в массив длин.
volvo, у меня не такой опыт в программировании, чтобы сразу делать так, как правильнее, а не как в голову пришло.
Автор: Lapp 17.01.2010 16:41
Цитата(volvo @ 17.01.2010 11:10) 
А я уже говорил, что надо бы описывать тип
...
Посмотрим, получится ли у тебя его убедить...
Извиняюсь, повторился. Но в данном случае каша маслом не испортилась, пациент все же скорее жив, чем мертв, в отличие от многих других )). Вдвоем убедим! ...
Посмотрим, получится ли у тебя его убедить...
Цитата(Unconnected @ 17.01.2010 11:31)
добавление нулей это, видимо, дохлый номер, из-за которого и получалась ошибка
Да, то, что лидирующие нули не нужно учитывать, довольно сильно меняет ситуацию. Я рыпнулся было делать перестановки, но быстро остыл и переключился на рекурсию. Не хочу сказать, что это невозможно или намного труднее, но все же требует внимательности в разработке алгоритма. А рекурсия - дубовый метод, много мозгов не требует )). Тут, правда, осложнение в том, что переставляемая строка разбита на участки (числа); это потребовало передачи двух параметров в рекурсивную процедуру. А тем более, начальные условия такие щадящие. [прошло полчаса] Ха, интересно! Я думал, что увеличение количества чисел резко замедлит работу программы. Но..Например, вот такие входные данные:
1372 62 552 381 6924 91 1583 4973 21 8119 30504
(при m=10, разумеется) легко выдают ответ:
YES
1372 62 552 381 6924 91 1853 9437 21 9811
- и увеличения времени на глаз не заметно! А штука в том, что.. Unconnected, сможешь ответить, почему?
Автор: volvo 17.01.2010 16:49
Цитата
Только num всё равно передавать придётся
Это тебе только кажется Цитата
ибо с помощью него записывается длина v в массив длин.
Это значит что? Ты просто "не умеешь это готовить". Вот твоя же программа, но туда кое-что добавлено, я комментариями оставил твой прежний вариант. И что, понадобилось передавать num?const
m=6;
type
tSt = string[3];
tArSt = record
arr: array[1..m] of tSt;
kol: byte;
end;
// kol:array[1..2] of byte;
Procedure generate(var m:tArSt;v:tst); // ;num:byte);
var buf:char;
i:byte;
begin
i:=1;
m.arr[i]:=v;
if length(v)=1 then m.kol:=1; // kol[num]:=1;
if length(v)=2 then begin
m.kol:=2;
// kol[num]:=2;
m.arr[2]:=v[2]+v[1];
end;
if length(v)=3 then begin
repeat
inc(i);
m.arr[i]:=m.arr[i-1][2]+m.arr[i-1][3]+m.arr[i-1][1];
until (i=3);
inc(i);
m.arr[i]:=m.arr[1][1]+m.arr[1][3]+m.arr[1][2];
repeat
inc(i);
m.arr[i]:=m.arr[i-1][2]+m.arr[i-1][3]+m.arr[i-1][1];
until (i=6);
end;
(*
if (num=1) then for i:=1 to kol[num] do m1[i]:=m[i]
else for i:=1 to kol[num] do m2[i]:=m[i]
*)
end;
var a,b,cc:tst;
m1,m2:tArSt;
f:text;
i,j:byte;
buf1,buf2,c,code,aa,bb:integer;
begin
assign(f,'sum.in');
reset(f);
read(f,aa,bb,c);
close(f);
str(aa,a);
str(bb,b);
str(c,cc);
generate(m1,a); //,1);
generate(m2,b); //,2);
for i:=1 to m1.kol do // kol[1] do
begin
val(m1.arr[i],buf1,code);
for j:=1 to m2.kol do begin // kol[2] do begin
val(m2.arr[j],buf2,code);
if (buf1+buf2=c) then begin
assign(f,'sum.out');
rewrite(f);
writeln(f,'YES');
write(f,buf1,' ',buf2,' ',c);
close(f);
halt;
end;
end;
end;
assign(f,'sum.out');
rewrite(f);
write(f,'NO');
close(f);
end.
Автор: Lapp 17.01.2010 17:08
volvo, я понимаю твое возмущение:
Цитата(volvo @ 17.01.2010 12:00)
пишите, "чтоб работало, сдам и фиг с ним".
- и я тебя поддерживаю, но Unconnected'а на этот раз это, вроде, не должно касаться, ибо эту задачу он стал делать, вроде как по собственной инициативе из чистого интереса )). На все требуется время, даже на запоминание азбучных истин . Лучше поддержать его порыв, мне кажется - впрочем, я не сомневаюсь, что ты это сделаешь ))..Автор: Unconnected 17.01.2010 19:28
Цитата
А рекурсия - дубовый метод, много мозгов не требует )).
К моим мозгам она чересчур требовательна)) Короче, я попробовал для начала понять, что она делает эта рекурсия, расставил примерные комментарии..
const
m=2; //количество слагаемых
var
c,i: integer;
a: array [1..m] of record
v,x: integer;
s: string;
d: set of byte
end;
f: text;
procedure Dig(n,k: integer);
var
i,z: integer;
begin
if k=0 then//1-е условие выхода.Длина слагаемого будет 0-ой тогда,когда будет (Dig(n,k-1); k=1)
if n=m then begin//если номер обрабатываемого эл-та равен всему числу слагаемых...
z:=0;
for i:=1 to m do z:=z+a[i].x;
if z=c then begin
WriteLn(f,'YES');
for i:=1 to m do Write(f,a[i].x,' ');
Close(f);
Halt
end
end
else Dig(n+1,Length(a[n+1].s))//если n-ый элемент был обработан, но есть ещё эл-ты, то обрабатываем следующий
else with a[n] do for i:=1 to Length(s) do if not (i in d) then begin
x:=x*10+Ord(s[i])-48;
Include(d,i);//здесь самое интересное и непонятное, видимо, собственно запись в a[i].x нужного числа.
Dig(n,k-1);//смысл этого цикла я не понял..
Exclude(d,i);
x:=(x-Ord(s[i])+48) div 10
end
end;
begin
Assign(f,'sum.in');
ReSet(f);
for i:=1 to m do with a[i] do begin //заполнение массива записей,инициализация полей.
Read(f,v);//v-численное представление слагаемого, s - строчное.
Str(v,s);
d:=[];
x:=0
end;
ReadLn(f,c); //считываем сумму
Close(f);
Assign(f,'sum.out');
ReWrite(f);
Dig(1,Length(a[1].s)); //первый запуск процедуры,передаётся единица,т.е берем 1е слагаемое, и длина первого слаг-ого
WriteLn(f,'NO'); //выводим NO,ибо если a+b=c выполнится,то сюда исполнение не дойдёт
Close(f)
end.
Мне понравилась строка Ord(s[i])-48, получается, это быстрый способ перевести строку с цифрой в цифру.
Куда мне анализировать, почему время не увеличивается - я в механизм работы въехать не могу..)) Хотя, меня преследует ощущение, что в цикле else with a[n] do for i:=1 to Length(s) do if not (i in d) then begin всегда будет обрабатываться только 1ый символ, но это мои интуитивные домыслы конечно)) К ним я пришёл, расписав на бумаге значения переменных при двух двузначных слагаемых. Наверное, ошибся где-то.
Запрос. На комментарии:)
Цитата
И что, понадобилось передавать num?
Не понадобилось, так лучше.
Автор: Unconnected 18.01.2010 4:54
//подновил время, правил пост
Автор: Lapp 18.01.2010 8:25
Цитата(Unconnected @ 17.01.2010 15:28)
К моим мозгам она чересчур требовательна))
Ошибаешься; ниже убедишься.Цитата
Короче, я попробовал для начала понять, что она делает эта рекурсия, расставил примерные комментарии..
От комментариев мало толку, если они просто выражают словами то, что написано на языке. Старайся вложить в комменты больше смысла. Я понимаю, что тут ты не мог это сделать, это на будущее для собственных прог )).Цитата
Куда мне анализировать, почему время не увеличивается - я в механизм работы въехать не могу..))
Для этого не нужно глубоко въезжать в алгоритм. С этого и начнем..Каков бы ни был олгоритм - это все равно перебор. Согласен? Этого знания достаточно.
На первый взгляд кажется, что такие совпадения (описанные в условии, когда сумма равна заданному числу) должны быть достаточно редки. И поэтому когда я подготавливал входные данные, я делал так:
- пишу несколько слагаемых (10 штук, для этого нужно заменить тип integer на LongInt в слагаемых и сумме);
- считаю их сумму и приписываю ее сзади;
- перемешиваю цифры в слагаемых.
Такой способ, конечно, гарантирует ответ YES при правильной работе программы. После этого я запускал прогу.. и она выдает ответ через мгновение. Почему?
Во-первых, я заметил, что ответ не тот, который я поготовил, а другой. Я решил: повезло, оказался еще один ответ! - и немного изменил данные (слагаемые и сумму, чтоб снова гарантировать ответ). И снова аналогичный результат. Вот тогда я, наконец, дал себе труд подумать минуту..
Собственно, минуты не потребовалось. У меня 10 слагаемых, каждое от 2 до 4 знаков. Всего примерно 30 цифр. Сколько существует перестановок 30 цифр? Ответ: бешеное количество, а именно 30!. Даже если учесть, что из этих 30 цифр всего 10 различных, их число все равно остается фантастическим. Это число гораздо больше самой суммы, и больше длины диапазона, в котором сумма может меняться. Что это означает? То, что:
1. если мы наобум напишем слагаемые и сумму, ответ с подавляющей вероятностью будет YES;
2. на каждую сумму существует не просто несколько, а очень много разных комбинаций, удовлетворяющих условию.
Это понятно? Если нет, перечитай, пока не разберешься. А когда разберешься, сразу станет само собой понятно, что программа находит первую из очень многих комбинаций, удовлетворяющих решению, и для этого ей не требуется слишком много времени. Поскольку ей нет нужды сканировать все комбинации. А раз валидных комбинаций много, значит, скорее всего есть и вблизи начала поиска..
)Когда это все промелькнуло в моей голове (как задница того комара, который налетел на лобовое стекло), я просто закомментировал две строчки в проге:
// close(f);
// Halt;
- рассудительно решив, что уж теперь-то истинное время работы программы (перебор всех возможных комбинаций) от меня не уйдет.. Хрен-та!
Я запустил прогу, увидел, что она действительно не вышла сразу, прикрыл окошко и пошел заниматься чем-то другим. Когда я минут через 20-30 снова заглянул в то окно, программа все работала. Я прервал ее по Ctrl-C и пошел в Far смотреть выходной файл. Его размер был 50 МБ, в нем было больше миллиона строк.. То есть программа уже нашла примерно миллион решений и прилежно продолжала искать остальные - видимо, полагая, что мне это жизненно важно )). Думаю, она делала бы это всю мою оставшуюся жизнь..Забавно, что при небольшом числе слагаемых и цифр результат как раз обратный: получить заранее заданную сумму двух двузначных числе посредством перестановок их слагаемых намного труднее. По-видимому, мозг улавливает этот факт и потом пропорционально его масштабирует. То есть происходит нечто подобное тому, что мешает нормальным людям понять Теорию Относительности: мозг основывается на чувственном опыте и с большим трудом поддается перестройке под давлением разумной агументации..
Про рекурсию напишу чуть-чуть позже..
Автор: Lapp 18.01.2010 11:17
Так, процесс в целом нам стал более понятен, теперь можно перейти к более техническим вопросам
Цитата(Unconnected @ 17.01.2010 15:28)
Запрос. На комментарии:)
RFC? Ok.Давай я лучше попробую описать способ. Думаю, это будет полезнее.
Для начала забудем про рекурсию. Рекурсия не должна быть самоцелью. Она должна появиться сама собой из естественного пути решения.
Итак, у нас есть набор цифр, записанных в массив (или строку, что то же самое). Нам нужно найти все возможные перестановки. Как?
Извини, но твой способ не совсем ... мм.. удобный, а точнее - неуниверсальный. Давай действовать иначе.. Всего у нас n позиций. На первую мы ставим в цикле по очереди все имеющиеся цифры (элементы массива цифр). Далее, на каждом конкретном шагу этого цикла мы ставим на вторую позицию все элементы массива цифр, кроме того, который поставили на первую. То есть вложенный цикл с проверкой. Если позиций больше двух, повтояем то же самое. Вот пример для перемешивания цифр в 4-значном числе:
a:='2601';
n:=Length(a); // 4
r:='';
for i1:=1 to n do begin
r:=r+a[i1];
for i2:=1 to n do if i2<>i1 then begin
r:=r+a[i2];
for i3:=1 to n do if (i3<>i1)and(i3<>i2) then begin
r:=r+a[i3];
for i4:=1 to n do if (i4<>i1)and(i4<>i2)and(i4<>i3) then begin // этот цикл можно заменить просто на i4:=10-i3-i2-i1
ProcessIt; // перемешивание завершено, тут проверка условия задачи и вывод результата
end
end
end
end;
Все просто и понятно, так ведь? Вложенный цикл, причем вложенность равна длине (значности) исходного числа. Но, со всеми преимуществами, налицо и один недостаток. Дело в том, что Паскаль не допускает чего-то типа "вложенности переменной длины". И что же, нам для каждой длины делать свой фрагмент кода?? Вообще-то, не такой уж и абсурдный вариант, как кажется на первый взгляд. Длин будет вряд ли больше 1 - 2 десятков - так, что же? В исходной задаче вообще можно было ограничиться двумя вариантами (двузначные и трехзначниые) - разве это много? Определяем длину числа и переводим стрелки на нужный кусок программы..
Это, конечно, некрасиво
.. И никто не гарантирует, что в другой задаче не будет большего числа вариантов, типа сто или тысяча. Как быть?Путей для разрешения этой проблемы несколько.
Первый, самый банальный..
На каждом этапе вложенности делать проверку глубины. Глубину мы можем отслеживать с помощью некоторой специальной переменной, назовем ее Depth. При входе на очередной уровень, мы инкриминируем эту переменную и сравниваем ее с максимальной глубиной (равной длине числа). Приведенный мной выше кусок можно модифицировать в соответствии со сказанным так, что он будет работать для длин от 1 до 4:
a:='2601';Здесь мы избежали дублирования больших кусков кода, но нам пришлось несколько раз (в схожей ситуации) вызывать процедуру обработки результата, что тоже несколько коробит.. Да и сам по себе вложенный цикл тоже не радует глаз: мы должны предусмотреть вложенность, равную максимально возможной длине числа. В нашем примере это всего лишь 3, но будем смотреть шире!
n:=Length(a); // 4
Depth:=0;
r:='';
for i1:=1 to n do begin
r:=r+a[i1];
Inc(Depth); // увеличиваем глубину
if Depth=n then ProcessIt else for i2:=1 to n do if i2<>i1 then begin
r:=r+a[i2];
Inc(Depth); // увеличиваем глубину
if Depth=n then ProcessIt else for i3:=1 to n do if (i3<>i1)and(i3<>i2) then begin
r:=r+a[i3];
Inc(Depth); // увеличиваем глубину
if Depth=n then ProcessIt else for i4:=1 to n do if (i4<>i1)and(i4<>i2)and(i4<>i3) then begin
ProcessIt
end;
Dec(Depth); // выныриваем
end;
Dec(Depth); // выныриваем
end;
Dec(Depth); // выныриваем
end;
Я сказал, что путей у нас не один. Что еще мы можем придумать? Строго говоря, есть еще средства.. Например, мы можем организовать схему с одним циклом, но со сложным манипулированием индексом. То есть в тотмомент, когда по индее нужно было бы войти во вложенный цикл мы будем сохранять текущий индекс в специальном массиве (длины, равной длине числа) и присваивать ему начальное значение (единицу). Тем самым цикл уже будет совсем другим, новым. Затем, когда нужно выходить из вложенного цикла, мы будем вынимать заранее сохраненное значение из массива - то есть возвращаться на предыдущий уровень. Цикл при этом будет продолжаться, как ни в чем ни бывало.. Индексом того массива для запоминания параметра цикла будет служить все та же Depth.
Схема вполне осуществимая, хотя и не самая простая. В чем ее суть? В том, что мы повторно используем код несколько раз. Сначала для одного цикла, потом для вложенного, потом для следующего вложенного.. Код один, но параметр цикла, поскольку он сохраняется и перекладывается туда-обратно, различный на разных этапах. Не надо сейчас сразу бросаться писать код для этого алгоритма, просто уясни, что такая схема вполне осуществима.
Уяснил?
Продолжаем.На чем мы остановились? На том, что максимально увеличили КПД написанного нами кода, посредством использования его с различными данными (вспомни, что программа=алгоритм+данные). Позвольте, но ведь в Паскале уже есть средство для этого! Это средство называется процедура/функция. Она делает как раз то, что мы хотим: выполняет тот же самый код с разными данными! Эти данные передаются в параметрах. При этом старые параметры никуда не деваются, не забываются, не затираются, а остаются в стэке. Таким образом, нам даже не нужно будет сохранять параметр цикла (и другие данные, если потребуется) в специально подготовленном для этого массиве! И сам массив, выходит, нам тоже не нужен.
Давай ближе к делу. Нам нужно организовать вложенный цикл? Хорошо. Мы сделаем процедуру, которая содержит цикл. А в том месте, в котором мы должны были бы перейти к вложенному циклу, мы просто поставим вызов этой же самой процедуры. При этом процедура работает с глобальными параметрами (кроме переменной цикла), так что все тип-топ, никакой пуницы. Вот она, рекурсия, и вылезла - сама собой, причем в полной красе )). Осталось добавить только еще одну маленькую деталь..
Когда вложенные циклы написаны явно, у нас практически нет опасности зациклиться: мы пройдем каждый цикл и в конце концов выйдем. Если же мы просто будем вызывать и вызывать нашу рекурсивную процедуру, входя все глубже и глубже, то как мы будем вылезать обратно?? Вот тут все-таки нужно использовать специальную переменную, которую в принципе можно организовать по-разному, но обычно удобно передавать как параметр рекурсивной процедуры. Если устроить процедуру так:
procedure Recurse(l:integer);- то никакого зацикливания не получится. По достижении максимальной вложенности мы вместо очередного вызова процедуры (то есть вместо следующего вложения цикла) произведем обработку результата и выйдем.
begin
if l<Depth then begin
... // тут цикл
Recurse(l+1); // вызываем с увеличением параметра
...
end
else ProcessIt; // максимальная глубина достигнута, производим обработку
end;
Боюсь, меня сегодня уже не хватит на написание комментов к той проге, чтобы от теории перейти наконец к практике. Если это по-прежнему требуется (?), я сделаю потом
.
Автор: Unconnected 18.01.2010 14:17
Lapp, спасибо огромное!! Это редкий случай, когда в статье (тянет на неё) я понял всё, от начала до конца)) Только прочитал первый пример с циклами, и уже понял, для чего множество там и всё остальное)) У меня, кстати, была мысль, ещё в начале, что когда слагаемых так много, то будет явно больше одной комбинации..
Большой плюс тебе:)
Добавлено через 19 мин.
Я, кажется, подловил твою программу
Например, входные данные: 1111 11 111 111 1111 111 1111 1111 122 5000
Прога задумалась.
Слагаемых столько же. Но, как я понял, нужных комбинаций намного меньше, и они заключаются в последнем слагаемом, а до него ещё дойти надо_)
Автор: Unconnected 18.01.2010 16:23
Я тут решил для закрепления решить сам задачку на рекурсию, тоже на перестановки (поэтому в этой же теме пишу), задача такая:
Цитата
Неподвижные точки
(Время: 1 сек. Память: 16 Мб Сложность: 57%)
Перестановкой P[1..n] размера n называется набор чисел от 1 до n, расположенных в определенном порядке. При этом в нем должно присутствовать ровно один раз каждое из этих чисел. Примером перестановок являются 1,3,4,5,2 (для n=5) и 3,2,1 (для n=3), а, например, 1,2,3,4,5,1 перестановкой не является, так как число 1 встречается два раза.
Число i называется неподвижной точкой для перестановки P, если P[i] = i. Например, в перестановке 1,3,4,2,5 ровно две неподвижных точки: 1 и 5, а перестановка 4,3,2,1 не имеет неподвижных точек.
Даны два числа: n и k. Найдите количество перестановок размера n с ровно k неподвижными точками.
Входные данные
Входной файл INPUT.TXT содержит два целых числа n (1 ≤ n ≤ 9) и k (0 ≤ k ≤ n).
Выходные данные
В выходной файл OUTPUT.TXT выведите ответ на задачу.
Примеры
№ INPUT.TXT OUTPUT.TXT
1 5 2 20
2 9 6 168
3 2 1 0
4 9 0 133496
Получилось это:
{$APPTYPE CONSOLE}
uses
SysUtils;
var i,len,kol:byte;
f:textfile;
s:string;
d:set of byte;
rkol:integer;
procedure rekur(lk:byte);
var i1,b:byte;
res:string;
begin
res:='';
if (lk=len) then begin
b:=0;
for i1:=1 to lk do if (res[i1]=inttostr(i1)) then inc(b);
if (b=kol) then inc(rkol);
res:='';
end
else for i1:=1 to lk do if not(i1 in d) then begin
res:=res+s[i1];
include(d,i1);
rekur(lk+1);
exclude(d,i1);
end;
end;
begin
rkol:=0;
d:=[];
assignfile(f,'input.txt');
reset(f);
read(f,len,kol);
close(f);
if (kol>0) then for i:=1 to kol do s:=s+inttostr(i);
for i:=kol+1 to len do s:=s+inttostr(i-1);
rekur(1);
assignfile(f,'output.txt');
rewrite(f);
writeln(f,rkol);
closefile(f);
end.
Вылетает с каким-то неизвестным исключением (an unhabled win32 exception)
Подскажите, в чём ошибка?
Автор: volvo 18.01.2010 17:21
Цитата
Подскажите, в чём ошибка?
Цитата
res:='';
if (lk=len) then begin
b:=0;
for i1:=1 to lk do if (res[i1]=inttostr(i1)) then inc(b); // <--- Вот в этом...
), значит обращение к любому ее элементу уже вызовет ошибку
Автор: Unconnected 18.01.2010 17:24
Ага, теперь нормально, только на входных данных 5 2 ответ 1 выдаёт, мол только одна возможная перестановка, а их 20.
Автор: volvo 18.01.2010 17:25
P.S.
Цитата
Вылетает с каким-то неизвестным исключением (an unhabled win32 exception)
Не совсем так... Это не неизвестное исключение. Оно просто необработанное (unhandled). Если бы ты обернул это все в try/except - получил бы диагностику ошибки (т.е., обработал бы выброшенное исключение)Добавлено через 48 сек.
Цитата
Ага, теперь нормально
Хм... Ну, так покажи, как оно стало нормально Что исправил?
Автор: Unconnected 18.01.2010 17:48
Нормально - в смысле ошибка не вылетает:) А результат неправильный даёт. Убрал res:=''; перед if (lk=len) then begin ..
Автор: volvo 18.01.2010 18:08
Цитата
А результат неправильный даёт.
Еще бы... У тебя переменная res описана локально, значит, хранит мусор. А ты содержимое этого мусора сравниваешь с какими-то значениями. Тебе еще повезло, что не вылетает. Окажется эта самая локальная строка короче чем lk символов - получишь опять вылет...
Автор: volvo 18.01.2010 18:38
P.S. На самом деле, твоя задача может решаться вот так:
uses sysutils;, если рекурсивно... Попробуй разобраться в алгоритме работы если надо - я прокомментирую, что здесь происходит
const
len = 5;
count = 2;
var
s: string;
res: integer;
procedure rec(s: string);
var
ts: string;
i, b: integer;
begin
if length(s) = len then begin
b := 0;
for i := 1 to length(s) do
if strtoint(s[i]) = i then inc(b);
if b = count then inc(res);
end
else
for i := 0 to length(s) do
begin
ts := s;
insert(inttostr(length(s) + 1), ts, i + 1);
rec(ts);
end
end;
begin
res := 0;
rec('');
writeln(res);
end.
Естественно, от IntToStr и StrToInt надо будет избавиться, они только замедляют выполнение, но чтобы разобраться что к чему, они подходят больше, чем непосредственное конвертирование. Да... Работу с файлами я не стал добавлять, задал значения константами. Для отладки - гораздо удобнее (по крайней мере мне).
Автор: Unconnected 18.01.2010 19:09
Ого.. решение короче намного, без множества и заполнение строки происходит прямо в функции.. Только сейчас, кстати, я понял, что мог бы и не заполнять заранее строку так, чтобы там были две "неподвижные" точки - можно было просто перебирать всё - немного, 5! - и считать неподвижные точки. Примерно я этот алгоритм понял - потрассировав немного - те же перестановки, только основанные на длине строки-параметра. И всё же, можно услышать, что было неправильно в моей функции?
Автор: volvo 18.01.2010 21:17
Цитата
И всё же, можно услышать, что было неправильно в моей функции?
Смотри. Начинаем с генерации строки S. Что у тебя в результате получается, для kol = 5, расскажи? У тебя получается строка "12234". Это что значит? Вообще по твоей задумке, что должна содержать строка S? Все символы, которые потом будут во всех вариациях переставляться, или что?
Автор: Unconnected 18.01.2010 21:26
Да, сначала я хотел заполнить строку с двумя неподвижными точками и чтобы нашлись все возможные вариации и посчиталось количество нужных мне вариантов. Только я не учёл, что там не только цифры от 1 до k-1 могут быть. Я имею в виду, на Подвижных позициях. Поздно что-то дошло..))
Автор: Lapp 19.01.2010 6:21
Цитата(Unconnected @ 18.01.2010 10:17)
редкий случай, когда в статье (тянет на неё) я понял всё, от начала до конца))
Это и была моя цель )).Цитата
Я, кажется, подловил твою программу
Например, входные данные: 1111 11 111 111 1111 111 1111 1111 122 5000
Прога задумалась.
Да подловить несложно. Можно просто написать в качестве суммы число, которое заведомо не получится (типа 2 или -5 )) и заставить ее написать NO (через пару годиков работы)). Например, входные данные: 1111 11 111 111 1111 111 1111 1111 122 5000
Прога задумалась.
Правильно я понимаю, что комменты уже не нужны?
Автор: Unconnected 19.01.2010 11:29
Цитата
Правильно я понимаю, что комменты уже не нужны?
Ага, правильно. Надеюсь, эта тема поможет ещё кому-то понять рекурсию:)
Автор: Unconnected 20.01.2010 4:18
И снова я... Уж очень хочется что-то самому полностью решить, рекурсивно)
Задача про Дед-Мороза.
Цитата
Ириска весит X грамм, мандарин – Y грамм, пряник – Z грамм.
Требуется написать программу, которая определит, сколько различных вариантов подарков весом ровно W грамм может сделать Дед Мороз.
Входные данные
В единственной строке входного файла INPUT.TXT содержится четыре целых числа X, Y, Z и W (1 ≤ X, Y, Z ≤ 100, 1 ≤ W ≤ 1000).
Выходные данные
Выходной файл OUTPUT.TXT должен содержать одно целое число – количество вариантов подарков.
Пример
№ INPUT.TXT OUTPUT.TXT
1 10 25 15 40 3
uses sysutils;
{$APPTYPE CONSOLE}
var f:textfile;
s:string;
r,w,res,rr:integer;
m:array[1..3] of byte;
procedure rek(lk:byte);
var i:byte;
begin
writeln(inttostr(res));
if (lk=4)or(res=w) then begin
if (res=w) then begin
inc(rr);
end;
end else for i:=1 to lk do begin
res:=res+m[i];
rek(lk+1);
res:=res-m[i];
end;
end;
begin
assignfile(f,'input.txt');
reset(f);
read(f,m[1],m[2],m[3],w);
closefile(f);
res:=0;
rek(1);
assignfile(f,'output.txt');
rewrite(f);
writeln(f,rr);
closefile(f);
end.
Короче идея в том, чтобы в переменную res суммировать вес сладостей, по очереди, чтобы получились все возможные комбинации, а потом проверять общий вес. Также учтено, что вес могут составлять не обязательно 3 подарка. Я долго мучил этот код, он, как я понял, не все варианты перебирает.. Подскажите пожалуйста на словах, что не так:)
Автор: Unconnected 20.01.2010 22:19
Короче я вроде бы разобрался, уже несколько задач сам решил... А про Деда Мороза решение такое:
var f:textfile;
s:string;
r,w,res,rr:integer;
m:array[1..3] of byte;
procedure rek(lk:byte);
var i:byte;
begin
if (lk=4) then begin
if (res=w) then begin
inc(rr);
end;
end else for i:=1 to 3 do begin
res:=res+m[i];
rek(lk+1);
res:=res-m[i];
end;
end;
begin
assignfile(f,'input.txt');
reset(f);
read(f,m[1],m[2],m[3],w);
closefile(f);
res:=0;
rek(1);
assignfile(f,'output.txt');
rewrite(f);
writeln(f,rr);
closefile(f);
end.
Lapp и Volvo, еще раз спасибо за помощь:)