%
Алгоритм Рюкзака

Меню сайта

Статистика
Рейтинг@Mail.ru Яндекс.Метрика

Варианты алгоритма рюкзака на Turbo Pascal

В приложении представлено два варианта реализации точного алгоритма решения задачи о рюкзаке на языке 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);

end;

end;

 

procedure Repl(q:t_q; var q1:t_q);

var i:byte;

begin

for i:=1 to n do q1[i]:=q[i]

end;

 

procedure Func(n:byte; MS:t_MS; q:t_q;

num:byte; var SM,SS:real);

begin

if q[num]=0 then

begin SM:=SM-MS[i].M; SS:=SS-MS[i].S end

else

begin SM:=SM+MS[i].M; SS:=SS+MS[i].S end;

end;

 

{Помещение в стек}

procedure PutStack(var S:t_S; el:byte);

begin

S.t:=S.t+1;

if S.t>maxStack then

begin writeln('Стек переполнен'); Halt end;

S.St[S.t]:=el

end;

 

{Извлечение из стека}

procedure GetStack(var S:t_S; var el:byte);

begin

if S.t=0 then

begin writeln('Стек пуст'); Halt end;

el:=S.St[S.t];

S.t:=S.t-1

end;

 

{Проверка стека на пустоту}

function EmptyStack(S:t_S):boolean;

begin EmptyStack:=S.t=0 end;

 

{Инициализация стека}

procedure InitStack(var S:t_S);

begin S.t:=0 end;

 

begin

ClrScr;

writeln('ЗАДАЧА О РЮКЗАКЕ');

Init(n,MS,maxSM);

maxSS:=0;

SM:=0;

SS:=0;

InitStack(S);

for i:=n downto 1 do

begin q[i]:=0; PutStack(S,i) end;

while not EmptyStack(S) do

begin

GetStack(S,i);

q[i]:=1-q[i];

Func(n,MS,q,i,SM,SS);

if (SM<=maxSM) and (SS>maxSS) then

begin maxSS:=SS; Repl(q,q1); end;

for j:=i-1 downto 1 do PutStack(S,j)

end;

Print(n,q1,maxSM,maxSS);

end.

 


Источник: http://studopedia.org/

Учебное издание

Муромцев Виктор Владимирович


Назад Домой Вперед

 

Друзья сайта
  • Группа AR в ВК.
  • Группа AR в FB.
  • Группа AR в OK.
  • Алгебра Логики.
  • Альтернатива Групп.

  • Алгоритм Рюкзака © 2017 created AD.