В приложении представлено два варианта реализации точного алгоритма решения задачи о рюкзаке на языке Turbo Pascal. Алгоритм основан на полном переборе траекторий задачи, т.е. переборе всех подмножеств предметов. В первом варианте для организации перебора траекторий взят алгоритм порождения подмножеств в порядке двоичного счета , во втором – алгоритм порождения подмножеств в порядке минимального изменения . Второй вариант реализации более предпочтителен, т.к. при подсчете функционала, т.е. при нахождении суммарной массы и стоимости предметов, составляющих текущее подмножество, удалось избавиться от циклических действий (см. реализацию функции Func в первом и втором варианте).
Вариант 1.
uses CRT;
const maxN=20; {Максимальное число предметов}
type t_el_MS=record
M:real;{Масса предмета}
S:real {Стоимость предмета}
end;
t_MS=array[0..maxN-1] of t_el_MS;
t_b =array[0..maxN] of byte;
var n:byte; {Число предметов}
MS:t_MS; {Масса и стоимость предметов}
b:t_b; {Текущее подмножество предметов}
b1:t_b; {Подмножество выбранных предметов}
SM,SS:real; {Суммарная масса и стоимость предметов,
составляющих текущее подмножество}
maxSM,maxSS:real; {Суммарная масса и стоимость выбранных предметов}
i:byte;
procedure Init(var n:byte; var MS:t_MS;
var maxSM:real);
var i:byte;
begin
write('Число предметов (не более ',maxN:2,') =');
readln(n);
writeln('Введите массу каждого предмета:');
for i:=0 to n-1 do
begin
write(i+1:2,': '); readln(MS[i].M)
end;
writeln('Введите стоимость каждого предмета:');
for i:=0 to n-1 do
begin
write(i+1:2,': '); readln(MS[i].S)
end;
write('Максимальная суммарная масса выбранных предметов =');
readln(maxSM);
end;
procedure Print(n:byte; b1:t_b;
maxSM,maxSS:real);
var i:byte;
begin
if maxSS>0 then
begin
writeln('Суммарная масса предметов со следующими номерами:');
for i:=0 to n-1 do
if b1[i]=1 then write(i+1:3);
writeln;
writeln('не превышает установленного предела равного', maxSM:9:3,',');
writeln('а суммарная стоимость этих предметов максимальна и равна ', maxSS:9:3);
end;
end;
procedure Repl(b:t_b; var b1:t_b);
var i:byte;
begin
for i:=0 to n-1 do b1[i]:=b[i]
end;
procedure Func(n:byte; MS:t_MS; b:t_b;
var SM,SS:real);
var i:byte;
begin
SM:=0; SS:=0;
for i:=0 to n-1 do
if b[i]=1 then
begin SM:=SM+MS[i].M; SS:=SS+MS[i].S end;
end;
begin
ClrScr;
writeln('ЗАДАЧА О РЮКЗАКЕ');
Init(n,MS,maxSM);
maxSS:=0;
for i:=0 to n do b[i]:=0;
while b[n]<>1 do
begin
Func(n,MS,b,SM,SS);
if (SM<=maxSM) and (SS>maxSS) then
begin maxSS:=SS; Repl(b,b1) end;
i:=0;
while B[i]=1 do
begin B[i]:=0; i:=i+1 end;
B[i]:=1
end;
Print(n,b1,maxSM,maxSS);
end.
Вариант 2.
uses CRT;
const maxN=20; {Максимальное число предметов}
maxStack=20; {Максимальный размер стека}
type t_el_MS=record
M:real;{Масса предмета}
S:real {Стоимость предмета}
end;
t_MS=array[1..maxN] of t_el_MS;
t_q =array[1..maxN] of byte;
t_S =record
St:array[1..maxStack] of byte;
t: byte
end;
var n:byte; {Число предметов}
MS:t_MS; {Масса и стоимость предметов}
q:t_q; {Текущее подмножество предметов}
q1:t_q; {Подмножество выбранных предметов}
SM,SS:real; {Суммарная масса и стоимость предметов,
составляющих текущее подмножество}
S:t_S; {Стек}
maxSM,maxSS:real; {Суммарная масса и стоимость
выбранных предметов}
i,j:byte;
procedure Init(var n:byte; var MS:t_MS;
var maxSM:real);
var i:byte;
begin
write('Число предметов (не более ',maxN:2,') =');
readln(n);
writeln('Введите массу каждого предмета:');
for i:=1 to n do
begin write(i:2,': '); readln(MS[i].M) end;
writeln('Введите стоимость каждого предмета:');
for i:=1 to n do
begin write(i:2,': '); readln(MS[i].S) end;
write('Максимальная суммарная масса выбранных предметов =');
readln(maxSM);
end;
procedure Print(n:byte; q1:t_q;
maxSM,maxSS:real);
var i:byte;
begin
if maxSS>0 then
begin
writeln('Суммарная масса предметов со следующими номерами:');
for i:=1 to n do
if q1[i]=1 then write(i:3);
writeln;
writeln('не превышает установленного предела равного', maxSM:9:3,',');
writeln('а суммарная стоимость этих предметов максимальна и равна ', maxSS:9:3);