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

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

Давайте, может у кого-то будут координально другие идеи !

[klem4]

угу ..

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

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.

я рад что еще кто-то заинтересовался задаче этой