pascalabcnet/InstallerSamples/Algorithms/Recursion/Knapsack.pas
Бондарев Иван e6e67c193c initial commit
2015-05-14 21:35:07 +02:00

58 lines
1.1 KiB
ObjectPascal

// Çàäà÷à î ðàíöå.  ìàññèâå B çàäàíû âåñà ïðåäìåòîâ.
// Âûäàòü âñå âàðèàíòû ïîëíîé êîìïëåêòàöèè ðàíöà ÷àñòüþ ýòèõ ïðåäìåòîâ
const Sz=100;
type IntArr = array [1..Sz] of integer;
procedure PrintArr(const A: IntArr; n: integer);
begin
for var i:=1 to n do
write(A[i],' ');
writeln;
end;
procedure TrySolve(n: integer; const B: IntArr; nb: integer);
var
Subset: IntArr;
space: integer;
ns: integer;
procedure TrySolve0(i: integer);
begin
if space=0 then
PrintArr(Subset,ns)
else if (space<0) or (i>nb) then
exit // îòñå÷åíèå
else // ïðîäîëæåíèå ïåðåáîðà âñåõ ïîäìíîæåñòâ ìíîæåñòâà B
begin
TrySolve0(i+1); // ïîïðîáîâàòü íå âçÿòü i-òûé ýëåìåíò
ns += 1;
Subset[ns] := B[i];
space := space - B[i];
TrySolve0(i+1); // ïîïðîáîâàòü âçÿòü i-òûé ýëåìåíò
space := space + B[i];
ns -= 1;
end;
end;
begin
space:=n;
TrySolve0(1);
end;
procedure FillArr(var B: IntArr; var n: integer);
begin
n:=5; // êîëè÷åñòâî ïðåäìåòîâ
B[1]:=8; B[2]:=5; B[3]:=13; B[4]:=3; B[5]:=15; // âåñà ïðåäìåòîâ
end;
var
B: IntArr;
nb: integer;
begin
FillArr(B,nb);
TrySolve(23,B,5);
end.