Сумма квадратов Опции

[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]

Пардон, я напутал с генерацией последовательностей, поэтому из рассмотрения выпадали некоторые четвёрки чисел. Теперь так:

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))), но, в свете того, что решение без данной оптимизации прекрасно справляется с поставленной задачей (в т. ч., укладывается в разумные временные рамки), будем считать такой подход избыточным усложнением алгоритма и его реализации.

Сообщение отредактировано: xds - 16.01.2006 8:09