Помощь - Поиск - Пользователи - Календарь
Полная версия: Сумма квадратов
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
klem4
Продолжаю выкладывать понравившиеся мне олимпиадные задачи

Пара четверок. Найти минимальное число, которое представляется суммой четырех квадратов натуральных чисел не единственным образом

т.е 1112 и 1121 - одно и тоже.


Вот мое первое решение, если доделаю сейчас, выложу втрое, более короткое

uses crt;
var
i,j,k,l,t : byte;
n : word;
a : array[1..4] of byte;
flag : boolean;
begin
clrscr;
n := 0;
repeat
inc(n);
flag := true;
fillchar(a, sizeof(a), 0);
i := 1;
while (sqr(i) < n) and flag do begin
j := 1;
while(sqr(i) + sqr(j) < n) and flag do begin
k := 1;
while(sqr(i) + sqr(j) + sqr(k) < n) do begin
l := 1;
while(sqr(i) + sqr(j) + sqr(k) + sqr(l) <= n) and flag do begin
if sqr(i) + sqr(j) + sqr(k) + sqr(l) < n then inc(l)
else begin
if a[1] = 0 then begin
a[1] := i; a[2] := j; a[3] := k; a[4] := l;
inc(l);
end{A[1] = 0}
else begin
t := 1;
while (t <= 4) and flag do begin
flag := not((a[t] <> i) and (a[t] <> j) and (a[t] <> k) and (a[t] <> l));
inc(t);
end;{WHILE}
if not(flag) then begin
writeln(n);
writeln(i,' ',j,' ',k,' ',l);
writeln(a[1],' ',a[2],' ',a[3],' ',a[4]);
end;{END}
end;{A[1] <> 0}
end;{S = N}
inc(l);
end;{L}
inc(k);
end;{K}
inc(j);
end;{J}
inc(i);
end;{I}
until not(flag);
readln
end.



Давайте, может у кого-то будут координально другие идеи !
xds
Неопределённость в условии - поэтому два решения. Первое - для случая, когда в сумме могут присутствовать одинаковые слагаемые, второе - для случая, когда все слагаемые различны. Естественно, результаты отличаются.

1) С повторениями:
program Sqr4;

type
T4 = array[0..4] of LongInt;

procedure AdvanceT4(var a: T4);
begin
if a[3] < a[4] then
Inc(a[3])
else
if a[2] < a[3] then
Inc(a[2])
else
if a[1] < a[2] then
Inc(a[1])
else
begin
a[1] := 1;
a[2] := 1;
a[3] := 1;
Inc(a[4]);
end;
Inc(a[0]);
end;

procedure WriteT4(const a: T4);
begin
Writeln(
'= Sqr(', a[1],
') + Sqr(', a[2],
') + Sqr(', a[3],
') + Sqr(', a[4], ')'
);
end;

var
a, b: T4;
na, nb: LongInt;
i: Integer;

begin
for i := 0 to 4 do
begin
a[i] := 1;
b[i] := 1;
end;
repeat
na := Sqr(a[1]) + Sqr(a[2]) + Sqr(a[3]) + Sqr(a[4]);
nb := Sqr(b[1]) + Sqr(b[2]) + Sqr(b[3]) + Sqr(b[4]);
if na < nb then
AdvanceT4(a)
else
if (na > nb) or (a[0] = b[0]) then
AdvanceT4(b)
else
Break;
until False;
Writeln(na);
WriteT4(a);
WriteT4(b);
end.


2) Без повторений:
program Sqr4;

type
T4 = array[0..4] of LongInt;

procedure AdvanceT4(var a: T4);
begin
if a[3] < a[4] - 1 then
Inc(a[3])
else
if a[2] < a[3] - 1 then
Inc(a[2])
else
if a[1] < a[2] - 1 then
Inc(a[1])
else
begin
a[1] := 1;
a[2] := 2;
a[3] := 3;
Inc(a[4]);
end;
Inc(a[0]);
end;

procedure WriteT4(const a: T4);
begin
Writeln(
'= Sqr(', a[1],
') + Sqr(', a[2],
') + Sqr(', a[3],
') + Sqr(', a[4], ')'
);
end;

var
a, b: T4;
na, nb: LongInt;
i: Integer;

begin
for i := 0 to 4 do
begin
a[i] := i;
b[i] := i;
end;
repeat
na := Sqr(a[1]) + Sqr(a[2]) + Sqr(a[3]) + Sqr(a[4]);
nb := Sqr(b[1]) + Sqr(b[2]) + Sqr(b[3]) + Sqr(b[4]);
if na < nb then
AdvanceT4(a)
else
if (na > nb) or (a[0] = b[0]) then
AdvanceT4(b)
else
Break;
until False;
Writeln(na);
WriteT4(a);
WriteT4(b);
end.
klem4
Особо пока не вникал в твое решение, но в задании надо найти минимальное число, твоя вторая програма выдает 336, а моя как минимальное 28 ...
Pola
начальные значения
j:=i;
k:=j;
l:=k;
klem4
Нажать кнопку удалить, кстати, я поменял результат не поменялся ... а итераций то явно меньше будет, ну ладно пусть это останется в секрете secret.gif
Pola
Да, итераций будет меньше
и из
1112
1121
1211
2111
останется только первая комбинация

Цитата(klem4 @ 15.01.2006 14:04) *

Нажать кнопку удалить,

Где она? около сообщения не вижу...
klem4
Цитата
Где она? около сообщения не вижу...


Хмм.. возможно сейчас это доступно только модераторам и администраторам, надо узнать ...
Pola
Ладно, уже не нужно smile.gif

А вот сокращение перебора для олимпиадной задачи дело не последнее...
теперь можно наверное и проверку убрать
Код

                       begin
                         t := 1;
                         while (t <= 4) and flag do begin
                            flag := not((a[t] <> i) and (a[t] <> j) and (a[t] <> k) and (a[t] <> l));
                            inc(t);
                         end;{WHILE}
klem4
угу .. good.gif

Занчится пока выходит вот так :

uses crt;
var
i,j,k,l,t : byte;
n : word;
a : array[1..4] of byte;
flag : boolean;
begin
clrscr;
n := 0;
repeat
inc(n);
flag := true;
fillchar(a, sizeof(a), 0);
i := 1;
while (sqr(i) < n) and flag do begin
j := i;
while(sqr(i) + sqr(j) < n) and flag do begin
k := j;
while(sqr(i) + sqr(j) + sqr(k) < n) do begin
l := k;
while(sqr(i) + sqr(j) + sqr(k) + sqr(l) <= n) and flag do begin
if sqr(i) + sqr(j) + sqr(k) + sqr(l) < n then inc(l)
else begin
if a[1] = 0 then begin
a[1] := i; a[2] := j; a[3] := k; a[4] := l;
inc(l);
end{A[1] = 0}
else begin
flag := false;
writeln(n);
writeln(i,' ',j,' ',k,' ',l);
writeln(a[1],' ',a[2],' ',a[3],' ',a[4]);
end;{A[1] <> 0}
end;{S = N}
inc(l);
end;{L}
inc(k);
end;{K}
inc(j);
end;{J}
inc(i);
end;{I}
until not(flag);
readln
end.


я рад что еще кто-то заинтересовался задаче этой smile.gif
Pola
что такое flag?
почему его нет в третьем while?
klem4
flag принимает false если результат достигнут и тогда больше ничего делать не надо, в 3-м while-е пропустил ...
xds
Пардон, я напутал с генерацией последовательностей, поэтому из рассмотрения выпадали некоторые четвёрки чисел. Теперь так:
program Sqr4_3;

procedure Next4(var a: array of LongInt);
begin
if a[1] < a[2] then Inc(a[1])
else if a[2] < a[3] then Inc(a[2])
else if a[3] < a[4] then Inc(a[3])
else
begin
a[1] := 1;
a[2] := 1;
a[3] := 1;
Inc(a[4]);
end;
Inc(a[0]);
end;

var
a, b: array[0..4] of LongInt;
na: LongInt;
i: Integer;

begin
for i := 0 to 4 do a[i] := 1;
repeat
na := Sqr(a[1]) + Sqr(a[2]) + Sqr(a[3]) + Sqr(a[4]);
for i := 0 to 4 do b[i] := 1;
while a[0] <> b[0] do
if Sqr(b[1]) + Sqr(b[2]) + Sqr(b[3]) + Sqr(b[4]) <> na then
Next4(b)
else
begin
Writeln(na);
Exit;
end;
Next4(a);
until False;
end.

Конечно, подбор воторой четвёрки можно ограничить и снизу, начиная с (1, 1, 1, Trunc(Sqrt(na / 4))), но, в свете того, что решение без данной оптимизации прекрасно справляется с поставленной задачей (в т. ч., укладывается в разумные временные рамки), будем считать такой подход избыточным усложнением алгоритма и его реализации.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.