Нахождение двух минимальных сумм чисел Опции

[S_lip]

Здравствуйте!
Вот такая задачка:

Дана упорядоченная последовательность N чисел. (2<=N<=200). Каждое число больше 0, но меньше 30000. Нужно из этого ряда найти два набора чисел, величины которых должны быть равны и минимальны. Гарантируется, что эта величина будет меньше 100000. Эту величину нужно выписать.

Примеры:
Дано: 1 2 3 4 5. Группы чисел: 1 2 и 3. Ответ: 3.
Дано: 1 2 5 5 8 10 102. Группы чисел: 5 и 5. Ответ: 5.
Дано: 2 3 4 5. Группы чисел: 2 3 и 5. Ответ: 5.
Дано: 1 3 5 7 13 21. Группы чисел: 1 7 и 3 5. Ответ: 8.
Дано: 1 2 5 8 14. Группы чисел: 1 2 5 и 8. Ответ: 8.


Вот я придумал вот такое решение:
http://img401.imageshack.us/img401/500/20308125la9.png

const
  MaxCount=200;
  MaxSum=100000;
type
  pair=record
    l,r:longint;
  end;
var
  a:array [1..MaxCount] of integer;
  b:array [0..50000] of pair; //чтоб хватило
  f:text;
  n,i,j,k,d:integer;
begin
  assign(f,'file.in');
  reset(f);
  readln(f,n);
  for i:= 1 to n do readln(f,a[i]);
  close(f);

  d:=0;
  repeat
    inc(d);
    b[0].l:=a[d];
    b[0].r:=0;
    i:=1;
    k:=d;

    repeat
      inc(k);
      for j:= 0 to (i-1) do begin
        b[j+i].l:=b[j].l;
        b[j+i].r:=b[j].r+a[k];
        inc(b[j].l , a[k]);
      end;
      j:=1;
      inc(i,i);
      while (j<=i) and (b[j-1].l<>b[j-1].r) do inc(j);
    until(j<=i) or (b[0].l>MaxSum)

  until j<=i;
  
  writeln(b[j-1].l);
end.

Программа перебирает все возможне пары сначало с участием первого числа. Если сумма этих пар больше 100000, а равные величины так и не найдены, то перебирает все возможные пары с участием второго числа и т.д.

Это решение кушает очень много памяти и при большом N вылетает. Возможно, есть более элегантное и правильное решение? =)

[S_lip]

Спасибо всем большое за ответы!
klem4, спасибо за код.
Я "вроде бы" нашел решение.

Чтобы было более понятнее вот текст задачки:

Код

Давным-давно в высоких горах жил хмельной садовод Чек. У него было два сына Ричибук и Чибирук. Благодаря выращиванию хмеля Чек заработал достаточно большую стопку национальных денег -  фугриков. Особенность фугриков в том, что они могут иметь различные номиналы от 1 до 30000. Прошло время, дети стали взрослыми и хотели отправиться искать новые рассады хмеля. Однако, перед отправкой они зашли к отцу и попросить у него денег. Отец жалобно вздохнул и понял, что этого ему не избежать. Но лучше отдать по возможности меньше. Он также понял, что у детей должно быть по равной сумме денег, чтобы никто не обиделся.

В первой строке входного файла дано количество фугриков N (2<=N<=200). В каждой следующей строчке содержится число Ai, которое является i-той денежной единицей (1<=Ai<=30000).  Числа идут в возрастающем порядке.
Нужно найти и выписать сумму денег, которую Чеку придется отдать каждому из сыновей.
Гарантируется что всего Чек отдаст не более 100000 фугриков.

Автор: Ģirts Folkmanis (www.lio.lv/olimps)  - эт, чтоб меня не засудили =P

Цифры там немного другие, но это нисколько не меняет суть.
Чтобы не нагружать прогу сортировкой, данные уже отсортированы.

Вот мое решение:

const
  MaxCount=200;
  MaxSum=100000;
var
  a:array [1..MaxCount] of integer;
  u,d:array [1..(MaxSum div 2)*3+1] of longint; //"*3+1" для крайности, т.к. мы сначала заполняем, а потом отсеиваем ненужное
  udn:longint;
  b:array [0..(MaxSum div 2)] of longint; //если будет болше 50000, то общая сумма будет больше 100000
  f:text;
  n:byte;
  i,j,k:longint;

begin
  assign(f,'file.in');
  reset(f);
  readln(f,n);
  for i:= 1 to n do
    readln(f,a[i]);
  close(f);

  for i:= 0 to (MaxSum div 2) do b[i]:=0;
  udn:=1;
  i:=1;
  u[1]:=0;
  d[1]:=a[1];
  b[a[1]]:=a[1];

  repeat
    inc(i);

    inc(udn);
    u[udn]:=0;
    d[udn]:=a[i];

    for j:= 1 to udn-1 do begin
      inc(udn);
      u[udn]:=u[j];
      d[udn]:=d[j]+a[i];
      inc(udn);
      if u[j]+a[i]<d[j] then begin
        u[udn]:=u[j]+a[i];
        d[udn]:=d[j];
      end else begin
        u[udn]:=d[j];
        d[udn]:=u[j]+a[i];
      end;
    end;

    inc(j);
    repeat
      k:=d[j]-u[j];
      if (d[j]>(MaxSum div 2)) or (u[j]>(MaxSum div 2)) then begin
        u[j]:=u[udn];
        d[j]:=d[udn];
        dec(udn);
      end else if b[k]>0 then begin
        if u[j]<u[b[k]] then begin
          u[b[k]]:=u[j];
          d[b[k]]:=d[j];
        end;
        u[j]:=u[udn];
        d[j]:=d[udn];
        dec(udn);
      end else begin
        b[k]:=j;
        inc(j);
      end;
    until j>udn;
  until b[0]>0;

  writeln(u[b[0]]); //ответ
end.

По моим подсчетам, максимальное количество чисел, которые нужно будет перебирать, будет 16, а не 10, как говори andriano. Это числа 1 2 4 8 16 32 64 128 256 512 1024 2048 4096 8192 16384 и еще одно до 30000. Почему эти числа? Потому, что из 1 2 можно максимум составить 3; из 1 2 4 - 7; 1 2 4 8 - 15 и т.д.

"Вроде бы" решил потому, что в тестере (на сайте с условием), этот код не прошел все тесты и в одном дал неправильный ответ. К тестам доступа нет. Может кто-нибудь может найти такие входные данный (основываясь на условие), чтобы эта программа дала неправильный ответ?

Сообщение отредактировано: S_lip - 29.12.2007 3:30