Набор суммы минимальным числом слагаемых , динамическое программирование

Ув. коллеги
Решила (кое-как) задачу с помощью ДП, но как-то тупо, тройным циклом, полностью заполняя всю трёхмерную таблицу.
Можно ли не всю таблицу заполнять, или вообще двумерной таблицей обойтись?

Задача NP-полная, псевдополиномиальная.
Условие.
Дано N целых положительных слагаемых, целое положительное число B.
Вопрос.
Набрать сумму, минимально отклоняющуюся от B (с недостатком). Если таких наборов несколько, выбрать решение с минимальным числом слагаемых.
Или так: набрать заданный вес как можно ближе по недостатку, используя минимальное число камней.

Решение.
Функция T[i,j,k] равна 1, если вес j можно набрать первыми i слагаемыми, используя не более k слагаемых.
Иначе - нулю. Три параметра у функции, вот уже и трёхмерная таблица.
Реккурентные соотношения.
Если вес i-го слагаемого M[i] не превосходит набираемой суммы j, то
T[i, j, k]:= max{T[i - 1, j, k], T[i - 1, j - M[i], k-1]}
иначе T[i, j, k]:= T[i - 1, j, k]

Консольное приложение в Делфи7. Не могу вернуть комментариям читаемый вид, увы.
Вроде работает. Выдает ближайший к заданной сумме минимальный набор.

const
    N=5; //êîëè÷åñòâî ñëàãàåìûõ
    Ves=16; //íàáèðàåìûé âåñ
    Ks=4;   //îãðàíè÷åíèå íà ÷èñëî ñëàãàåìûõ
    var
    M: array[1..N] of integer;//âåñà ñëàãàåìûõ
    //T= 1 åñëè âåñ íàáðàí, T= 0 - â ïðîòèâíîì ñëó÷àå
    //0..N - èç ñêîëüêè ïåðâûõ ñëàãàåìûõ ìîæíî íàáèðàòü ñóììó
    //0..Ves - êàêîé âåñ íóæíî íàáðàòü
    //0..Ks - ñêîëüêî ñëàãàåìûõ ìîæíî âçÿòü
    T:array[0..N,0..Ves,0..Ks] of byte;
    sum,i,j,v,k,kmin:integer;
begin
    M[1]:= 4; M[2]:= 4; M[3]:= 3; M[4]:= 7; M[5]:= 3;
 
    //íåíóëåâîé âåñ èç 0 ñëàãàåìûõ íå íàáåðåøü
    for j := 1 to Ves do
      for k := 1 to Ks do
        T[0, j, k] := 0;
 
    for i := 1 to  N do
      for j:=1 to Ves do
        T[i, j, 0] := 0;
 
    for j := 1 to Ves do
        T[0, j, 0] := 0;
 
    //íóëåâîé âåñ âñåãäà ìîæíî íàáðàòü
    for i:= 0 to  N do
      for k:=0 to Ks do
        T[i, 0, k] := 1;
 
    for i := 1 to N do begin
      for j := 1 to Ves do begin
        for k:=1 to Ks do
        //i-å ñëàãàåìîå íå ïðåâîñõîäèò íàáèðàåìóþ ñóììó
        if j >= M[i] then begin
          //i-å ñëàãàåìîå â ðàçáèåíèå íå âõîäèò
          if  T[i - 1, j, k]> T[i - 1, j - M[i], k-1] then
             T[i, j, k]:= T[i - 1, j, k]
          //äîáàâëÿåì i-å ñëàãàåìîå ê ðåøåíèþ
          else T[i, j, k]:= T[i - 1, j - M[i], k-1]; end
        //i-å ñëàãàåìîå áîëüøå íàáèðàåìîé ñóììû
        else T[i, j, k]:= T[i - 1, j, k];
      end;
    end;
 
    for j:= Ves downto 1 do
      //ìîæåì íàáðàòü ñóììó j ñ îãðàíè÷åíèåì íà Ks ñëàãàåìûõ
      if T[N, j, Ks] = 1 then
        begin
          //èùåì ðàçáèåíèå j íà ìèíèìàëüíîå ÷èñëî ñëàãàåìûõ
          for i:= Ks downto 1 do
            if T[N, j, i]=1 then k:=i;
          kmin:=k;
 
          //âîññòàíàâëèâàåì ðàçáèåíèå j íà ìèíèìàëüíîå ÷èñëî ñëàãàåìûõ
          sum:= j;  v:=0;
          for i:= N downto 1 do
            begin
            //i-å ñëàãàåìîå íå âîøëî â ðàçáèåíèå
            if (T[i, sum, k] = T[i - 1, sum, k]) or (sum=0)then
              writeln (i,'---No')
            //i-å ñëàãàåìîå âîøëî â ðàçáèåíèå
            else if sum>0 then
              begin
                writeln (i,'   ',M[i]);
                //óìåíüøèëè ñóììó
                sum := sum - M[i];
                v:=v+M[i];
                //óìåíüøèëè êîëè÷åñòâî èñïîëüçóåìûõ ñëàãàåìûõ
                k:=k-1;
              end;
             end;
          break;
        end;
    writeln('summa=',v, ' count=', kmin);
    readln;
end.

Набор сумм минимальным количеством монет при условии неограниченного числа монет каждого номинала.
Если условие не соблюдено, возможна модификация.

function NaborSummMinColMonet(const Data: array of Integer; Sum: Integer; List: TStrings): Integer;
var
  X, i, j, MinData: Integer;
  A: array of Integer;
  AList: array of string;
begin
  List.Clear;
  SetLength(A, Sum + 1);
  SetLength(AList, Sum + 1);
  MinData := MinIntValue(Data);
  for i := 0 to High(Data) do begin
    X := Data[i];
    if X > Sum then
      Break;
    A[X] := 1;
    AList[X] := IntToStr(X);
    for j := MinData to Sum - X do
      if A[j] <> 0 then
        if (A[j + X] = 0) or (A[j + X] > A[j]) then begin
          A[j + X] := A[j] + 1;
          AList[j + X] := AList[j] + ' ' + IntToStr(X);
        end;
  end;
  Result := A[Sum];//минимальное количество монет, которым набрана Sum
 
  //номиналы монет, которыми набраны возможные суммы до Sum включительно
  for i := 1 to Sum do
    if A[i] <> 0 then
       List.Add(Format('Sum %d Cnt: %d Vals: %s',[i, A[i], AList[i]]));
end;
 
procedure TForm1.Button18Click(Sender: TObject);
begin
  NaborSummMinColMonet([3, 6, 13], 20, Memo1.Lines);
end;
 
 
Sum 3 Cnt: 1 Vals: 3
Sum 6 Cnt: 1 Vals: 6
Sum 9 Cnt: 2 Vals: 3 6
Sum 12 Cnt: 2 Vals: 6 6
Sum 13 Cnt: 1 Vals: 13
Sum 15 Cnt: 3 Vals: 3 6 6
Sum 16 Cnt: 2 Vals: 3 13
Sum 18 Cnt: 3 Vals: 6 6 6
Sum 19 Cnt: 2 Vals: 6 13

const
N=5; //количество слагаемых
   Ves=16; //набираемый вес
   Ks=4;   //ограничение на число слагаемых
   var
   M: array[1..N] of integer;//веса слагаемых
   //T= 1 если вес набран, T= 0 - в противном случае
   //0..N - из скольки первых слагаемых можно набирать сумму
   //0..Ves - какой вес нужно набрать
   //0..Ks - сколько слагаемых можно взять
   T:array[0..N,0..Ves,0..Ks] of byte;
   sum,i,j,v,k,kmin:integer;
begin
   M[1]:= 4; M[2]:= 4; M[3]:= 3; M[4]:= 7; M[5]:= 3;
 
   //ненулевой вес из 0 слагаемых не наберешь
   for j := 1 to Ves do
     for k := 1 to Ks do
       T[0, j, k] := 0;
 
   for i := 1 to  N do
     for j:=1 to Ves do
       T[i, j, 0] := 0;
 
   for j := 1 to Ves do
       T[0, j, 0] := 0;
 
   //нулевой вес всегда можно набрать
   for i:= 0 to  N do
     for k:=0 to Ks do
       T[i, 0, k] := 1;
 
   for i := 1 to N do begin
     for j := 1 to Ves do begin
       for k:=1 to Ks do
       //i-е слагаемое не превосходит набираемую сумму
       if j >= M[i] then begin
         //i-е слагаемое в разбиение не входит
         if  T[i - 1, j, k]> T[i - 1, j - M[i], k-1] then
            T[i, j, k]:= T[i - 1, j, k]
         //добавляем i-е слагаемое к решению
         else T[i, j, k]:= T[i - 1, j - M[i], k-1]; end
       //i-е слагаемое больше набираемой суммы
       else T[i, j, k]:= T[i - 1, j, k];
     end;
   end;
 
   for j:= Ves downto 1 do
     //можем набрать сумму j с ограничением на Ks слагаемых
     if T[N, j, Ks] = 1 then
       begin
         //ищем разбиение j на минимальное число слагаемых
         for i:= Ks downto 1 do
           if T[N, j, i]=1 then k:=i;
         kmin:=k;
 
         //восстанавливаем разбиение j на минимальное число слагаемых
         sum:= j;  v:=0;
         for i:= N downto 1 do
           begin
           //i-е слагаемое не вошло в разбиение
           if (T[i, sum, k] = T[i - 1, sum, k]) or (sum=0)then
             writeln (i,'---No')
           //i-е слагаемое вошло в разбиение
           else if sum>0 then
             begin
               writeln (i,'   ',M[i]);
               //уменьшили сумму
               sum := sum - M[i];
               v:=v+M[i];
               //уменьшили количество используемых слагаемых
               k:=k-1;
             end;
            end;
         break;
       end;
   writeln('summa=',v, ' count=', kmin);
   readln;
end

Пасибки! Пока обедала , сообразила, как сократить число параметров до двух.
Щас новую прожку напишу, а потом нагло полезу на готовое.

Теперь функция T[i,j] возвращает минимальное число слагаемых в наборе веса j первыми i слагаемыми;
T[i,j]= +бесконечность, если вес набрать нельзя.

Реккурентные соотношения
T[i,0]= 0 при i>=0
T[0,j]= +бесконечность при j>=1
Если вес i-го слагаемого M[i] не превосходит набираемой суммы j, то
T[i, j]:= min{T[i - 1, j], T[i - 1, j - M[i]]+1}
иначе T[i, j]:= T[i - 1, j]

const
    N=5; //количество слагаемых
    Ves=16; //набираемый вес
    inf=100;//+бесконечность)))
    var
    M: array[1..N] of integer;//веса слагаемых
    //T= мин. число слагаемых в наборе веса;
    //если вес набрать нельзя T= +бесконечность
    //0..N - из скольки первых слагаемых можно набирать сумму
    //0..Ves - какой вес нужно набрать
    T:array[0..N,0..Ves] of byte;
    sum,i,j,v,k,kmin:integer;
begin
    M[1]:= 4; M[2]:= 4; M[3]:= 3; M[4]:= 7; M[5]:= 3;
 
    //ненулевой вес из 0 слагаемых не наберешь
    for j:= 1 to Ves do
      T[0, j]:= inf;
 
    //нулевой вес можно набрать 0 слагаемых
    for i:= 0 to  N do
      T[i, 0] := 0;
 
    for i := 1 to N do begin
      for j := 1 to Ves do begin
        //i-е слагаемое не превосходит набираемую сумму
        if j > M[i] then begin
          //i-е слагаемое в разбиение не входит
          if  T[i - 1, j]< T[i - 1, j - M[i]]+1 then
             T[i, j]:= T[i - 1, j]
          //добавляем i-е слагаемое к решению
          else T[i, j]:= T[i - 1, j - M[i]]+1; end
        //i-е слагаемое больше набираемой суммы
        else if j < M[i] then T[i, j]:= T[i - 1, j]
        //набор суммы одним слагаемым
        else T[i, j]:=1;
      end;
    end;
 
    for j:= Ves downto 1 do
      //можем набрать сумму j
      if T[N, j]< inf then
        begin
          kmin:=T[N,j];
          //восстанавливаем разбиение j на минимальное число слагаемых
          sum:= j;  v:=0;
          for i:= N downto 1 do
            begin
            //i-е слагаемое не вошло в разбиение
            if (T[i, sum] = T[i - 1, sum]) or (sum=0)then
              writeln (i,'---No')
            //i-е слагаемое вошло в разбиение
            else if sum>0 then
              begin
                writeln (i,'   ',M[i]);
                //уменьшили сумму
                sum := sum - M[i];
                v:=v+M[i];
              end;
             end;
          break;
        end;
    writeln('summa=',v, ' count=', kmin);
    readln;
 
end.

Сообщение отредактировано: Swetlana - 30.08.11, 11:46

MBo, посмотрела.
То, что для суммы, набираемой одной монетой, не надо вычислять, исправила.

Скрытый текст

Вообще-то, я додумалась, но чёто поленилась сразу код исправлять

Правильно я поняла, что двумерная табличка нужна только для восстановления решения?
То есть у тебя массив A одномерный, т.к. сразу запоминаем разбиение?

>массив A одномерный, т.к. сразу запоминаем разбиение?
Да. Переделывал из другой задачи, имена существенных переменных сразу не сделал нормальными
A - BestCounts
AList - BestValuesList

И возвращаемые значения - не совсем то, что по условию.

Нужный результат - в последнем ненулевом элементе A (и соотв. AList). Его индекс - максимальная сумма, не превосходящая заданную, которую можно набрать из данного комплекта.

В А - количество слагаемых (минимально требуемое)
В AList - строка с самим разбиением, набором слагаемых (одним из, если их несколько)

По сути - восходящее ДП.

>X := Data[i];
Очередной номинал

>A[X] := 1;
Это суммы, выражаемые одной монетой, что, безусловно, выгодно всегда.

> if A[j] <> 0 then
учитываем только ненулевые предсуммы

> if (A[j + X] = 0) or (A[j + X] > A[j]) then begin
Если сумма j + X еще не встречалась, либо в лучшем до сих пор случае набрана не меньшим количеством монет, чем это возможно с использованием монеты X

Вообще-то восстановить решение тоже можно по одномерной.

Вроде недавно уже была такая задача.

Вот вариант с восстановлением пути

function NaborSummMinColMonet2(const Data: array of Integer; Sum: Integer):string;
var
  X, i, j, MinData: Integer;
  BestCounts: array of Integer;
  BackLook: array of Integer;
begin
  SetLength(BestCounts, Sum + 1);
  SetLength(BackLook, Sum + 1);
  MinData := MinIntValue(Data);
  for i := 0 to High(Data) do begin
    X := Data[i];
    if X > Sum then
      Break;
    BestCounts[X] := 1;
    BackLook[X] := 0;
    for j := MinData to Sum - X do
      if BestCounts[j] <> 0 then
        if (BestCounts[j + X] = 0) or (BestCounts[j + X] > BestCounts[j]) then begin
          BestCounts[j + X] := BestCounts[j] + 1;
          BackLook[j + X] := j;
        end;
  end;
 
  i := Sum;
  while (i >= 0) and (BestCounts[i] = 0) do
    Dec(i);
 
  while i <> 0 do begin
    Result := Result + IntToStr(i - BackLook[i]) + ' ';
    i := BackLook[i];
  end;
end;

Пасибки, щас буду сравнивать твой второй и мой третий.
Думала, как отказаться от двумерных массвов, и завела дополнительную функцию L.
Теперь у меня функция T одномерная, аргумент - набираемая сумма, T[j] - min число слагаемых.
L[j] - номер последнего слагаемого, использованного для набора суммы j.
Задача с неограниченным числом слагаемых решилась сразу, а вот с ограниченным что-то не получается...

Размен суммы (или ближайшей к ней с недостатком) минимальным количеством монет, в неограниченном количестве

const
    N=3; //количество слагаемых
    Ves=19; //набираемый вес
    inf=100;//+бесконечность)))
    var
    //веса слагаемых в порядке возрастания, количество экземпляров не ограничено
    M: array[1..N] of integer;
    //T= мин. число слагаемых в наборе веса;
    //если вес набрать нельзя T= +бесконечность
    //0..Ves - какой вес нужно набрать
    T:array[0..Ves] of byte;
    //номер последнего слагаемого, использованного для набора веса
    L: array[0..Ves] of byte;
    sum,i,j,v,k,kmin:integer;
begin
    M[1]:= 2; M[2]:= 4; M[3]:= 6;
 
    //инициализация
    T[0]:= 0; L[0]:=0;
    for j:= 1 to Ves do
      T[j]:= inf;
 
    for j := 1 to Ves do
      for i := 1 to N do
        begin
          //i-е слагаемое не превосходит набираемую сумму
          if (j > M[i])and(T[j - M[i]]<inf) then
            begin
              //добавляем i-е слагаемое к решению
              //и запоминаем его номер
              if  T[j]> T[j - M[i]]+1 then
                begin
                  T[j]:= T[j - M[i]]+1; L[j]:= i;
                end
            end
          //i-е и все последующие слагаемые больше набираемой суммы
          else if (j < M[i]) then break
          //минимальный набор суммы одним слагаемым
          else if (j= M[i]) then
            begin
              T[j]:= 1; L[j]:= i; break;
            end;
        end;
    //восстановление разбиения
    for j:= Ves downto 1 do
      //можем набрать сумму j
      if T[j]< inf then
        begin
          kmin:=T[j];
          //восстанавливаем разбиение j на минимальное число слагаемых
          sum:= j;  v:=0;
          while sum<>0 do
            begin
              i:= L[sum];//i-е слагаемое вошло в разбиение
              writeln (M[i],' ');
              //уменьшили сумму
              sum := sum - M[i];
              v:=v+M[i];
            end;
          break;
        end;
    writeln('summa=',v, ' count=', kmin);
    readln;
 
end.

Добавлено 30.08.11, 20:54

Цитата amk @ 30.08.11, 12:53

Вообще-то восстановить решение тоже можно по одномерной.

Вроде недавно уже была такая задача.

Я уезжала, видимо, чего-то упустила...

Сообщение отредактировано: Swetlana - 30.08.11, 20:57

>Теперь у меня функция T одномерная, аргумент - набираемая сумма, T[j] - min число слагаемых.
L[j] - номер последнего слагаемого, использованного для набора суммы j.

Угу, теперь по сути наши алгоритмы близки.


>а вот с ограниченным что-то не получается
Тут надо подумать, как будет время - для неограниченного сильно облегчает жизнь то, что сумма с бОльшим числом слагаемых заменяется лучшим вариантом безусловно, т.к. она ни в коем случае не понадобится, а для ограниченного в этом я сомневаюсь.

Цитата MBo @ 31.08.11, 03:18

Угу, теперь по сути наши алгоритмы близки.


>а вот с ограниченным что-то не получается
Тут надо подумать, как будет время - для неограниченного сильно облегчает жизнь то, что сумма с бОльшим числом слагаемых заменяется лучшим вариантом безусловно, т.к. она ни в коем случае не понадобится, а для ограниченного в этом я сомневаюсь.

Ага, только мне ещё подправить нужно - суммы набирать, начиная с веса минимального слагаемого.
Написала, наконец, с подказками

В неограниченных весах вначале цикл по набираемым суммам. Фиксируем сумму, для неё прогоняем все подходящие по весу слагаемые. То есть не фиксируем, было взято это слагаемое раньше или нет.
А в варианте с двумерной табличкой удалённый параметр (из скольки первых i слагаемых делаем набор) как раз выполнял эту функцию...

MBo, ценный алгоритм, задача о рюкзаке с неограниченным количеством предметов влёт решается.
Для тех, кто в гугле, приведу формулировку.

РЮКЗАК С КРАТНЫМ ВЫБОРОМ ЭЛЕМЕНТОВ
Условие. Задано конечное множество предметов, положительные целые стоимости и веса каждого предмета, полож.целое ограничение на вес рюкзака.
Вопрос. Можно ли сопоставить каждому предмету целую положительную кратность так, чтобы суммарный вес всех предметов с учётом кратностей не превосходил общее ограничение на вес рюкзака, а суммарная ценность была максимальной.

const
    N=3; //количество предметов
    Ves=8; //ограничение на вес рюкзака
    var
    //веса предметов в порядке возрастания, количество экземпляров не ограничено
    M: array[1..N] of integer;
    //стоимости предметов
    C: array[1..N] of integer;
    //T= максимальная ценность рюкзака данного веса
    //если вес набрать нельзя, T=0
    T:array[0..Ves] of integer;
    //номер последнего слагаемого, вошедшего в рюкзак данного веса
    L: array[0..Ves] of byte;
    sum,i,j,v,k,Cmax:integer;
begin
    M[1]:= 2; M[2]:= 4; M[3]:= 6;
    C[1]:= 2; C[2]:= 5; C[3]:= 6;
    //инициализация
    for j:= 0 to Ves do
      begin T[j]:= 0; L[j]:=0; end;
 
    for j := M[1] to Ves do
      for i := 1 to N do
        begin
          if (T[j]<C[i]) and (j=M[i]) then
            //набираем вес одним предметом
            begin
              T[j]:= C[i]; L[j]:=i;
            end
          //i-е слагаемое не превосходит набираемую сумму
          //и набор веса j - M[i] уже существует
          else if (j >= M[i])and (T[j - M[i]]>0) then
            begin
              //добавляем i-е слагаемое к решению
              //и запоминаем его номер
              if  T[j]< T[j - M[i]]+ C[i] then
                begin
                  T[j]:= T[j - M[i]]+C[i]; L[j]:= i;
                end
            end
          //i-е и все последующие слагаемые больше набираемой суммы
          else if (j < M[i]) then break;
        end;
 
    Cmax:=0; sum:=0;
    //ищем максимум стоимости
    for j:= Ves downto 1 do
      if T[j]> Cmax then
        begin Cmax:=T[j]; sum:=j; end;
    
    //восстанавливаем содержимое максимально ценного рюкзака
    v:=0; k:=0;
    while sum<>0 do
      begin
        i:= L[sum];//i-е слагаемое вошло в рюкзак
        writeln (M[i],' ');
        //уменьшили сумму
        sum := sum - M[i];
        v:=v+M[i]; k:= k+C[i];
      end;
    writeln('Cmax=', k,' ves=',v);
    readln;
end.

Добавлено 31.08.11, 07:43
Залезла в лекции Котова по ДП)
Для задачи о наборе веса (пример1 в цитате) любым, не минимальным, количеством заданных слагаемых, приводится способ, как избавится от двумерного массива.

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

T[0] := 1;
for i:=1 to 5 do
T[i] := 0;
for i:=1 to 5 do
for j:=16 downto M[i] do
T[j] := max(T[j], T[j - M[i]]);

Однако при этом уже невозможно прямо восстановить структуру решения. Чтобы устранить этот недостаток, обычно используется подход, при котором для каждой позиции запоминается позиция-предшественник, из которой мы в нее попали в текущую позицию. Эта позиция определяется аргументом, на котором достигаемся оптимум (максимум, минимум) рассматриваемой функции. В данном случае для каждой позиции i можно определить номер первого предмета, для которого значение Т(i, j) стало максимальным (в данном случае равным единице).
{Вычисление значений и запоминание предшественника (Father)}
T[0] := 1;
Father[0]:=0
for j:=1 to 16 do
begin
T[j] := 0;
Father[j]:=0
end;
for i:=1 to 5 do
for j:=16 to M[i] do
if T[j] < T[j - M[i]] then
begin
T[j] := T[j - M[i]] ;
Father[j]:=i;
end;



{Восстановление решения}
sum:=16;
i:= Father[sum];
While (i>0) do
Begin
Writeln(i);
sum:=sum-M[i];
i:= Father[sum];
End;
--------------------

Сообщение отредактировано: Swetlana - 31.08.11, 11:29

Подправила в цитате из Котова опечатку, в первом фрагменте кода. Вообще, в этой задаче, про набор суммы, сплошные опечатки. Ладно.

Набор суммы минимальным числом заданных слагаемых.
Вариант с одномерными массивами.
Вначале код

const
    N=5; //количество слагаемых
    Ves=6; //набираемый вес
    inf=100;//+бесконечность)
    var
    //веса слагаемых, отсортированных по возрастанию
    M: array[1..N] of integer;//веса слагаемых
    //T= мин. число слагаемых в наборе веса;
    //если вес набрать нельзя T= +бесконечность
    T:array[0..Ves] of byte;
    //номер последнего слагаемого, вошедшего в набор веса
    L:array[0..Ves] of byte;
    sum,i,j,v,k,kmin:integer;
begin
    M[1]:= 3; M[2]:= 4; M[3]:= 4; M[4]:= 4; M[5]:= 7;
 
    //нулевой вес набирается нулём слагаемых
    T[0]:=0; L[0]:=0;
    //ненулевой вес пока не набран
    for j:= 1 to Ves do
      T[j]:= inf;
 
    for i := 1 to N do
      for j := Ves downto M[1] do
        begin
          //i-е слагаемое не превосходит набираемую сумму
          if M[i] < j then
            begin
              //добавляем i-е слагаемое к решению
              if  T[j] > T[j - M[i]]+1 then
                begin
                  T[j]:= T[j - M[i]]+1; L[j]:=i;
                end
            end
          //i-е слагаемое больше набираемой суммы и всех последующих
          else if M[i] > j then break
          //набор суммы одним слагаемым
          else
            begin T[j]:=1; L[j]:= i; end;
        end;
 
    for j:= Ves downto 1 do
      //можем набрать сумму j
      if T[j]< inf then
        begin
          kmin:=T[j];
          //восстанавливаем разбиение j на минимальное число слагаемых
          sum:= j;  v:=0;
          while sum<>0 do
            begin
              i:= L[sum];
              writeln (M[i]);
              //уменьшили сумму
              sum := sum - M[i];
              v:=v+M[i];
            end;
          break; //сумма набрана ну и слава тебе, Господи
        end;
    writeln('summa=',v, ' count=', kmin);
    readln;
end.

-------------------------------------------------------------------
Разберём способ заполнения массива T
следующими циклами

Цитата

for i := 1 to N do
for j := Ves downto M[1] do

и реккурентными соотношениями

Цитата

T[0]:=0; L[0]:=0;
//ненулевой вес пока не набран
for j:= 1 to Ves do
T[j]:= inf;

Цитата

//i-е слагаемое не превосходит набираемую сумму
if M[i] < j then
begin
//добавляем i-е слагаемое к решению
if T[j] > T[j - M[i]]+1 then
begin
T[j]:= T[j - M[i]]+1; L[j]:=i;
end
end
//i-е слагаемое больше набираемой суммы и всех последующих
else if M[i] > j then break
//набор суммы одним слагаемым
else
begin T[j]:=1; L[j]:= i; end;

Добавлено 31.08.11, 11:48
Слагаемые отсортированы по возрастанию. Фиксируем минимальное слагаемое, в программе это 3.
Цикл весов прокручивается впустую, от больших к меньшим, пока не достигает минимального веса 3.
Записываем T[3]=1.
Первое слагаемое вышло, в дальнейшем слагаемое 3 для набора суммы уже не доступно. В разложение больших весов оно может попасть только как решение подзадачи "набрать вес 3 минимальным числом слагаемых".
Аналогично фиксируем второе слагаемое 4, прокручиваем цикл с весами и записываем T[4]=1.
Веса 5 и 6 набрать нельзя, для них значение T равно +бесконечности.
Если поменять циклы таким образом

Цитата

for j := M[1] to Ves do
for i := 1 to N do

то при наборе веса 6 слагаемое 3 можно было бы использовать второй раз, и 6 было бы набрано как 3+3.
Итак, набираем весь 7, текущее слагаемое - 4 (их в наборе несколько). 7-4=3. Смотрим решение подзадачи T[3].
Она уже решена, поэтому T[7]=1+T[3]=2.

Добавлено 31.08.11, 12:08
Если поменять циклы таким образом

Цитата

for i := 1 to N do
for j := M[1] to Ves do

то 3 будет использоваться многократно, т.к. при фиксированном значении слагаемого 3 в одном проходе
суммы набираются от меньшего к большему. Т.е. вначале набираем сумму 3 с помощью тройки. Потом при наборе 6 опять используем 3 (текущее слагаемое) + решение подзадачи T[3].

Одним словом, чтобы разобраться, надо поэкспериментировать с циклами, попереставлять их то так, то эдак

Сообщение отредактировано: Swetlana - 31.08.11, 12:08

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

>Нужно набрать сумму, но с заданным числом слагаемых(с повторениями).
Это всё условие, ничего не упущено?