Решение. Это классическая задача на метод динамического программирования

Это классическая задача на метод динамического программирования. Состояния открытости двери можно представить “треугольной решеткой”, изображенной на рисунке. Каждая вершина определяет степень открытости q в момент времени t. Некоторым вершинам решетки приписаны веса, равные сумме денег у посетителя, приходящего в момент времени t и имеющего степень полноты, равную q. Требуется найти путь по решетке, проходящий через вершины, сумма весов которых имеет максимальное значение. Следует отметить, что нет необходимости хранить оценки всех вершин. Нам необходимо подсчитать оценки для момента времени t. Это возможно, если известны их значения для всех предыдущих моментов времени, однако для подсчета достаточно помнить только оценки для момента времени t–1. Приведем более простой пример входных данных:

3 5 6

3 4 1

5 10 1

1 4 1

Соответствующая решетка приведена на рисунке. Справа на рисунке указаны моменты времени. Слева от некоторых вершин решетки приведены суммы денег у посетителей, приходящих в этот момент времени и имеющих степень полноты, совпадающей со степенью открытости двери, записанной в вершине решетки. Ответ для данного примера очевиден: 11.

Основная процедура, остальные очевидны:

Procedure Solve;

Var i,j:Integer; {массивы для формирования оценок вершин решетки}

SOld,SNew:Array[0..MaxK] Of LongInt;

Begin

SOld[0]:=0;

For i:=1 To K Do SOld[i]:=-MaxLongInt;

SNew:=SOld;

For i:=1 To Tend Do Begin{цикл по моментам времени}

SNew[0]:=SOld[0];

For j:=1 To i Do{цикл по достижимым состояниям}

SNew[j]:=Max(SOld[j-1],SOld[j]);

{формирование оценок вершин}

For j:=1 To N Do {цикл по посетителям}

If (T[j]=i) And (SNew[S[j]]<>-MaxLongInt)

{если время прихода посетителя совпадает

с рассматриваемым моментом времени

и состояние достижимо, то изменяем

оценку вершины, соответствующей полноте

посетителя}

Then Inc(SNew[S[j]],P[j]);

SOld:=SNew;{запоминаем массив оценок}

End;

Res:=-MaxLongInt;

For i:=1 To K Do Res:=Max(Res,SNew[i]);

{находим максимальное значение

в окончательном массиве оценок}

End;

Приложение 2

Реализация метода ДП - программирования для задачи о рюкзаке:

program DP2;

{$APPTYPE CONSOLE}

uses SysUtils;

Const MaxW = 200; MaxN = 100;

var Value:array [0..MaxW,0..MaxN] of integer; {массив значений(сколько можно набрать для 1..W весов в 1..N предметов)}

Take:array [0..MaxW,0..MaxN] of boolean; {массив значений брали предмет или нет}

W,P:array [0..MaxN] of integer; {Массив весов, массив цен}

i, N, Weight, MaxWeight:integer;

procedure Init;

begin

assign(input,'input.txt');

reset(input);

readln(N, MaxWeight);

for i:=1 to N do readln(W[i], P[i]);

close(input);

end;

procedure Solve;

begin

fillchar(Take, sizeof(Take), false); {обнуляем}

fillchar(Value, sizeof(Value), 0);

for Weight:=1 to MaxWeight do begin {выбираем оптимум для веса Weight}

for i:=1 to N do {берем предметы с 1 по N}

{если вес предмета больше чем текущий вес рюкзака}

{или предыдущий набор дороже выбираемого}

if (W[i]> Weight) or (Value[Weight, i-1] >= Value[Weight-W[i], i-1]+P[i]) then begin

Value[Weight, i]:= Value[Weight, i - 1];

{тогдеа берем предыдущий набор}

Take[Weight, i]:= false; {говорим что вещь i не взята}

end

else begin {иначе добавляем к предыдущему набору текущий предмет}

Value[Weight, i]:= Value[Weight - W[i], i-1] +P[i];

Take[Weight, i]:= true; {говорим что вещь i взята}

end;

end;

end;

procedure Done;

begin

assign(output,'output.txt');

rewrite(output);

Writeln('Наилучший набор ', Value[MaxWeight, N]);

Weight:= MaxWeight;

for i:= N downto 1 do if Take[Weight, i] then begin

Write(i,' ');

Weight:= Weight-W[i];

end;

close(output);

end;

begin

Init;

Solve;

Done;

end.

Приложение 3

Реализация полного перебора для задачи о рюкзаке:

program FS;

{$APPTYPE CONSOLE}

uses SysUtils;

type mas = array[1..50] of integer;

Var N, MaxW:integer;{количество предметов, максимальный вес}

W,P,BestP,NowP:mas;

Max:Integer;

procedure Init;

var i:integer;

begin

assign(input,'input.txt');

reset(input);

readln(N, MaxW);

for i:=1 to N do readln(W[i], P[i]);

close(input);

end;

{передаем Nab - номер набранной группы, OstW-вместимость, stoim-цена набранного (еще не набрали нисколько)}

Procedure Search(Nab, OstW:integer; Stoim:integer);

var i:integer;

begin

{здесь OstW-вес который следует набрать из оставшихся. Stoim-стоимость текущего решения}

{Nab - набор предметов. если наполнили рюкзак

и набрали стоимость больше чем имеется, то считаем это новым решением}

if (Nab > N) and (Stoim > Max) then begin {найдено решение}

BestP:=NowP;

Max:=Stoim;

end

{иначе если количество взятых <= обьема. забиваем рюкзак дальше}

else if Nab<=N then {иначе если набрано меньше чем влазит}

for i:=0 to OstW div W[Nab] do begin {идем от 0 до ост. места}

NowP[Nab]:=i; {берем предмет Nab 0..OstW div W[Nab] раз}

Search(Nab+1,OstW-i*W[Nab],Stoim+i*P[Nab]);

{после каждого взятия предмета увеличиваем стоимость набора

и уменьшаем место в рюкзаке на вес предмета, так же увеличиваем

количество раз взятия предмета}

end;

end;

procedure print(name:string; out_:mas; num:integer);

var i:integer;

begin

if num=0 then begin

Writeln('Наилучший набор ', Max);

Writeln;

Write(' Номер предмета:');

for i:=1 to n do write(i: 3);

Writeln;

end else begin

Write(name);

for i:=1 to n do write(out_[i]: 3);

Writeln;

end;

end;

procedure Done;

begin

assign(output,'output.txt');

rewrite(output);

print('Наилучший набор ',bestP,0);

print(' Количество взятых:',BestP,1);

print(' Вес предмета:',W,1);

print('Стоимость предмета:',P,1);

close(output);

end;

begin

init;

Search(1, MaxW, 0);

done;

end.

Приложение 4

Реализация Жадного алгоритма для задачи о рюкзаке:

program Greedy;

{$APPTYPE CONSOLE}

uses SysUtils;

var W, P:array [1..15000] of integer; {веса, цены}

Price:array [1..15000] of real; {относительная ценность}

Take:array [1..15000] of boolean; {использование предметов}

i, N, BestPrice, NowWeight, MaxWeight:integer;

{Количество предметов, Лучшая стоимость, Текущий вес, Макс. вес}

{Считаем что предметы уже отсортированы}

procedure Init;

begin

assign(input,'input.txt');

reset(input);

readln(N, MaxWeight);

for i:=1 to N do readln(W[i], P[i]);

close(input);

end;

procedure Solve;

begin

fillchar(Take, sizeof(Take), False);

i:=0;

while NowWeight+W[i+1]<MaxWeight do begin

inc(i);

BestPrice:= BestPrice + P[i];

NowWeight:= NowWeight + W[i];

Take[i]:= true;

end;

end;

procedure Done;

begin

assign(output,'output.txt');

rewrite(output);

i:=1;

writeln('Максимальная стоимость ',BestPrice);

writeln('Вес предметов максимальной стоимости ',NowWeight);

writeln('Используемые предметы');

writeln('Вес Цена');

while Take[i] do begin

writeln(W[i],' ',P[i]);

inc(i);

end;

close(output);

end;

begin

init;

solve;

done;

end.

Дата добавления: 2014-10-17