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

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

Сообщение отредактировано: Pola - 15.01.2006 14:11

[klem4]

Нажать кнопку удалить, кстати, я поменял результат не поменялся ... а итераций то явно меньше будет, ну ладно пусть это останется в секрете

[Pola]

Да, итераций будет меньше
и из
1112
1121
1211
2111
останется только первая комбинация

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

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

[klem4]

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

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

[Pola]

Ладно, уже не нужно

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

Код

                       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]

угу ..

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

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.

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

[Pola]

что такое flag?
почему его нет в третьем while?

Сообщение отредактировано: Pola - 15.01.2006 14:36

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

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