Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Методичні вказівки з курсової роботи AтаПЗОВПвТ....doc
Скачиваний:
7
Добавлен:
05.12.2018
Размер:
7.49 Mб
Скачать

Текст процедури побудови опорного плану перевезень

вантажу методом випадкового заповнення (рандомизації)

// A[m, n] – матриця транспортних комунікацій (суміжності), де у A[i, j]-ї

клітинці знаходяться вартість транспортування одиниці вантажу із і-того транспортного вузла в j

// TT[m+1, n+1] – транспортна таблиця, де у (n+1)-ї колонці знаходяться обсяги

запасів, а у (m+1)-ї строки – обсяги заявок вантажу

// m – кількість постачальників вантажу

// n – кількість споживачів вантажу

sum_vid := 1; // Сумарний обсяг відправлення вантажу

sum_pryz := 1; // Сумарний обсяг призначення вантажу

while ((sum_vid <> 0) and (sum_pryz <> 0)) do

begin

randomize;

111:i := random(m+1);

if (i = 0) then

goto 111;

112:j := random(n+1);

if (j = 0) then

goto 112;

if (TT[i,j] = 0) then

begin

if (A[m+1,j] <= A[i,n+1]) then

TT[i,j] := A[m+1,j]

else

TT[i,j] := A[i,n+1];

A[m+1,j] := A[m+1,j] - TT[i,j];

A[i,n+1] := A[i,n+1] - TT[i,j];

end;

sum_vid := 0;

for i:=1 to m do

sum_vid := sum_vid + A[i,n+1];

sum_pryz := 0;

for j:=1 to n do

sum_pryz := sum_pryz + A[m+1,j];

end;

Додаток 15

Текст процедури побудови опорного плану перевезень

вантажу методом апроксимації Фогеля

// A[m, n] – матриця транспортних комунікацій (суміжності), де у A[i, j]-ї

клітинці знаходяться вартість транспортування одиниці вантажу із і-того транспортного вузла в j

// TT[m+1, n+1] – транспортна таблиця, де у (n+1)-ї колонці знаходяться обсяги

запасів, а у (m+1)-ї строки – обсяги заявок вантажу

// m – кількість постачальників вантажу

// n – кількість споживачів вантажу

sum_vid := 1; // Сумарний обсяг відправлення вантажу

sum_pryz := 1; // Сумарний обсяг призначення вантажу

while ((sum_vid <> 0) and (sum_pryz <> 0)) do

begin

for i:=1 to 20 do

for j:=1 to 20 do

rizn[i,j] := 0;

// Знаходження різниці по строкам

for i:=1 to m do

begin

min := A[i,1];

ind := 1;

for j:=2 to n do

if (A[i,j] <= min) then

begin

min := A[i,j];

ind := j;

end;

rizn[1,i] := min;

min := 999;

for j:=1 to n do

if (A[i,j] <= min) and (ind <> j) then

min := A[i,j];

rizn[1,i] := min - rizn[1,i];

end;

// Знаходження різниці по стовпцям

for j:=1 to n do

begin

min:= A[1,j];

ind := 1;

for i:=2 to m do

if (A[i,j] <= min) then

begin

min := A[i,j];

ind := i;

end;

rizn[1,m+j] := min;

min := 999;

for i:=1 to m do

if (A[i,j] <= min) and (ind <> i) then

min := A[i,j];

rizn[1,m+j] := min - rizn[1,m+j];

end;

// Знаходження максимальної різниці по строкам і стовпцям

max := rizn[1,1];

ind := 1;

for k:=2 to (m+n) do

if (rizn[1,k] > max) then

begin

max := rizn[1,k];

ind := k;

end;

rizn[2,ind] := 1;

flag := false;

for k:=1 to (m+n) do

if (rizn[1,k] = max) and (k<>ind) then

begin

rizn[2,k] := 1;

flag := true;

end;

if (ind <= m) then

begin

rizn[1,m+n+1] := ind;

min_j := A[ind,1];

ind := 1;

for j:=2 to n do

if (A[rizn[1,m+n+1],j] < min_j) then

begin

min_j:=A[rizn[1,m+n+1],j];

ind := j;

end;

rizn[2,m+n+1] := ind;

end

else

begin

rizn[1,m+n+1] := ind-m;

min_i := A[1,ind-m];

ind := 1;

for i:=2 to m do

if (A[i,rizn[1,m+n+1]] < min_i) then

begin

min_i:=A[i,rizn[1,m+n+1]];

ind := i;

end;

rizn[2,m+n+1] := ind;

end;

// Заповнення чергової клітинки ТТ

if flag then

// Декілька максимальних різниць по строкам і стовпцям

begin

l:=0;

for k:=1 to (m+n) do

if (rizn[2,k] = 1)then

if (k <= m) Then

begin

min_j := A[k,1];

ind := 1;

for j:=2 to n do

if (A[k,j] < min_j) then

begin

min_j:=A[k,j];

ind := j;

end;

min_i := A[1,ind];

for i:=2 to m do

if (A[i,ind] < min_i) then

min_i := A[i,ind];

if (min_j = min_i) then

begin

l := l+1;

rizn[1,m+n+l] := k;

rizn[2,m+n+l] := ind;

end;

end

else

begin

min_i := A[1,k-m];

ind := 1;

for i:=2 to m do

if (A[i,k-m] < min_i) then

begin

min_i:=A[i,k-m];

ind := i;

end;

min_j := A[ind,1];

for j:=2 to n do

if (A[ind,j] < min_j) then

min_j := A[ind,j];

if (min_i = min_j) then

begin

l := l+1;

rizn[1,m+n+l] := k;

rizn[2,m+n+l] := ind;

end;

end;

if (l > 1) Then

// Декілька різниць задовольняють умові рівняння мінімального

// елементу у строчці мінімальному у стовпці

begin

ind := 1;

if (rizn[1,m+n+1] <= m) then

min := A[rizn[1,m+n+1],rizn[2,m+n+1]]

else

min := A[rizn[2,m+n+1],rizn[1,m+n+1]-m];

for i:=2 to l do

if (rizn[1,m+n+i] <= m) then

if (A[rizn[1,m+n+i],rizn[2,m+n+i]] < min) then

begin

min := A[rizn[1,m+n+i],rizn[2,m+n+i]];

ind := i;

end

else

if (A[rizn[2,m+n+i],rizn[1,m+n+i]-m] < min) then

begin

min := A[rizn[2,m+n+i],rizn[1,m+n+i]-m];

ind := i;

end;

if (rizn[1,m+n+ind] <= m) then

if (TT[rizn[1,m+n+ind],n+1] < TT[m+1,rizn[2,m+n+ind]]) then

begin

TT[rizn[1,m+n+ind],rizn[2,m+n+ind]] := TT[rizn[1,m+n+ind],n+1];

TT[rizn[1,m+n+ind],n+1] := 0;

TT[m+1,rizn[2,m+n+ind]] := TT[m+1,rizn[2,m+n+ind]] - TT[rizn[1,m+n+ind],rizn[2,m+n+ind]];

end

else

begin

TT[rizn[1,m+n+ind],rizn[2,m+n+ind]] := TT[m+1,rizn[2,m+n+ind]];

TT[m+1,rizn[2,m+n+ind]] := 0;

TT[rizn[1,m+n+ind],n+1] := TT[rizn[1,m+n+ind],n+1] - TT[rizn[1,m+n+ind],rizn[2,m+n+ind]];

end

else

if (TT[rizn[2,m+n+ind],n+1] < TT[m+1,rizn[1,m+n+ind]-m]) then

begin

TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m] := TT[rizn[2,m+n+ind],n+1];

TT[rizn[2,m+n+ind],n+1] := 0;

TT[m+1,rizn[1,m+n+ind]-m] := TT[m+1,rizn[1,m+n+ind]-m] - TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m];

end

else

begin

TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m] := TT[m+1,rizn[1,m+n+ind]-m];

TT[m+1,rizn[1,m+n+ind]-m] := 0;

TT[rizn[2,m+n+ind],n+1] := TT[rizn[2,m+n+ind],n+1] - TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m];

end

end

else

// Одна різниця задовольняє умові рівняння мінімального

// елементу у строчці мінімальному у стовпці

begin

ind := 1;

if (rizn[1,m+n+ind] <= m) then

if (TT[rizn[1,m+n+ind],n+1] < TT[m+1,rizn[2,m+n+ind]]) then

begin

TT[rizn[1,m+n+ind],rizn[2,m+n+ind]] := TT[rizn[1,m+n+ind],n+1];

TT[rizn[1,m+n+ind],n+1] := 0;

TT[m+1,rizn[2,m+n+ind]] := TT[m+1,rizn[2,m+n+ind]] - TT[rizn[1,m+n+ind],rizn[2,m+n+ind]];

end

else

begin

TT[rizn[1,m+n+ind],rizn[2,m+n+ind]] := TT[m+1,rizn[2,m+n+ind]];

TT[m+1,rizn[2,m+n+ind]] := 0;

TT[rizn[1,m+n+ind],n+1] := TT[rizn[1,m+n+ind],n+1] - TT[rizn[1,m+n+ind],rizn[2,m+n+ind]];

end

else

if (TT[rizn[2,m+n+ind],n+1] < TT[m+1,rizn[1,m+n+ind]-m]) then

begin

TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m] := TT[rizn[2,m+n+ind],n+1];

TT[rizn[2,m+n+ind],n+1] := 0;

TT[m+1,rizn[1,m+n+ind]-m] := TT[m+1,rizn[1,m+n+ind]-m] - TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m];

end

else

begin

TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m] := TT[m+1,rizn[1,m+n+ind]-m];

TT[m+1,rizn[1,m+n+ind]-m] := 0;

TT[rizn[2,m+n+ind],n+1] := TT[rizn[2,m+n+ind],n+1] - TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m];

end

end

end

else

// Одна максимальна різниця по строкам і стовпцям

begin

ind := 1;

if (rizn[1,m+n+ind] <= m) then

if (TT[rizn[1,m+n+ind],n+1] < TT[m+1,rizn[2,m+n+ind]]) then

begin

TT[rizn[1,m+n+ind],rizn[2,m+n+ind]] := TT[rizn[1,m+n+ind],n+1];

TT[rizn[1,m+n+ind],n+1] := 0;

TT[m+1,rizn[2,m+n+ind]] := TT[m+1,rizn[2,m+n+ind]] - TT[rizn[1,m+n+ind],rizn[2,m+n+ind]];

end

else

begin

TT[rizn[1,m+n+ind],rizn[2,m+n+ind]] := TT[m+1,rizn[2,m+n+ind]];

TT[m+1,rizn[2,m+n+ind]] := 0;

TT[rizn[1,m+n+ind],n+1] := TT[rizn[1,m+n+ind],n+1] - TT[rizn[1,m+n+ind],rizn[2,m+n+ind]];

end

else

if (TT[rizn[2,m+n+ind],n+1] < TT[m+1,rizn[1,m+n+ind]-m]) then

begin

TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m] := TT[rizn[2,m+n+ind],n+1];

TT[rizn[2,m+n+ind],n+1] := 0;

TT[m+1,rizn[1,m+n+ind]-m] := TT[m+1,rizn[1,m+n+ind]-m] - TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m];

end

else

begin

TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m] := TT[m+1,rizn[1,m+n+ind]-m];

TT[m+1,rizn[1,m+n+ind]-m] := 0;

TT[rizn[2,m+n+ind],n+1] := TT[rizn[2,m+n+ind],n+1] - TT[rizn[2,m+n+ind],rizn[1,m+n+ind]-m];

end

end;

if (rizn[1,m+n+ind] <= m) then

begin

if (TT[rizn[1,m+n+ind],n+1] = 0) then

for j:=1 to n do

A[rizn[1,m+n+ind],j] := 999;

if (TT[m+1,rizn[2,m+n+ind]] = 0) then

for i:=1 to m do

A[i,rizn[2,m+n+ind]] := 999;

end

else

begin

if (TT[rizn[2,m+n+ind],n+1] = 0) then

for j:=1 to n do

A[rizn[2,m+n+ind],j] := 999;

if (TT[m+1,rizn[1,m+n+ind]-m] = 0) then

for i:=1 to m do

A[i,rizn[1,m+n+ind]-m] := 999;

end;

sum_vid := 0;

for i:=1 To m do

sum_vid := sum_vid + TT[i,n+1];

sum_pryz := 0;

for j:=1 To n do

sum_pryz := sum_pryz + TT[m+1,j];

end;

Додаток 16