Автор работы: Пользователь скрыл имя, 09 Декабря 2011 в 19:50, курсовая работа
Целью выполнения курсовой работы является разработка приложения для решения транспортной задачи линейного программирования и сравнения методов нахождения первоначального распределения. Достижение указанной цели потребовало постановки и решения следующих задач:
Изучить суть и общую математическую постановку транспортной задачи.
Изучить и сравнить методы нахождения первоначального распределения.
Разработать приложение, которое позволяло бы решать вышеуказанные задачи.
ВВЕДЕНИЕ 2
ТРАНСПОРТНАЯ ЗАДАЧА: ПОСТАНОВКА И МАТЕМАТИЧЕСКАЯ МОДЕЛЬ 4
НАХОЖДЕНИЕ ПЕРВОНАЧАЛЬНОГО РАСПРЕДЕЛЕНИЯ 8
МЕТОД СЕВЕРО-ЗАПАДНОГО УГЛА 8
МЕТОД НАИМЕНЬШЕЙ СТОИМОСТИ 10
МЕТОД АППРОКСИМАЦИИ ФОГЕЛЯ 11
РЕШЕНИЕ ОТКРЫТОЙ ТРАНСПОРТНОЙ ЗАДАЧИ 11
ТЕСТИРОВАНИЕ ПРОГРАММЫ 14
ЗАКЛЮЧЕНИЕ 17
СПИСОК ЛИТЕРАТУРЫ 18
ЛИСТИНГ ПРОГРАММЫ 19
var
z: Integer;
Matr: TMatr;
Postavshiki, Customers: TArray;
Plan: TMatr;
procedure Solve(NorthWestCorner: TMatr);
function NorthWestCorner: TMatr;
function MinCost: TMatr;
function Fogel: TMatr;
implementation
uses Types, Unit1, Unit2;
function Fun(AMatr, APlan: TMatr): integer;
var
i, j, F: Integer;
begin
F:=0;
for i:= 0 to Length(APlan) - 1 do
for j:= 0 to Length(APlan[0]) - 1 do
if APlan[i, j] <> -1 then
F:= F + APlan[i, j] * AMatr[i, j];
Fun:=F;
end;
function NorthWestCorner: TMatr;
var
i, j, k, m: Integer;
begin
SetLength(Result, Length(Postavshiki), Length(Customers));
for i:= 0 to Length(Matr) - 1 do begin
for j:= 0 to Length(Matr[0]) - 1 do begin
if Result[i, j] = 0 then begin
m:= Min(Customers[j], Postavshiki[i]);
Result[i, j]:= m;
Customers[j]:= Customers[j] - m;
Postavshiki[i]:= Postavshiki[i] - m;
if Customers[j] = 0 then begin
for k:= i + 1 to Length(Postavshiki) - 1 do begin
Result[k, j]:= -1;
end;
end;
if Postavshiki[i] = 0 then begin
for k:= j + 1 to Length(Customers) - 1 do begin
Result[i, k]:= -1;
end;
end;
end;
end;
end;
end;
function MinCost: TMatr;
function AllEmpty: Boolean;
var
i: Integer;
begin
for i:= 0 to Length(Customers) - 1 do
if Customers[i] <> 0 then begin
Result:= False;
Exit;
end;
for i:= 0 to Length(Postavshiki) - 1 do
if Postavshiki[i] <> 0 then begin
Result:= False;
Exit;
end;
Result:= True;
end;
var
i, j,
MinI, MinJ,
m: Integer;
begin
SetLength(Result, Length(Postavshiki), Length(Customers));
for i:= 0 to Length(Result) - 1 do
for j:= 0 to Length(Result[0]) - 1 do
Result[i, j]:= -1;
while not AllEmpty do begin
MinI:= -1;
MinJ:= -1;
for i:= 0 to Length(Matr) - 1 do begin
for j:= 0 to Length(Matr[0]) - 1 do begin
if (Postavshiki[i] = 0) or (Customers[j] = 0) then
Continue;
if MinI = -1 then begin
MinI:= i;
MinJ:= j;
end;
if Matr[MinI, MinJ] > Matr[i, j] then begin
MinI:= i;
MinJ:= j;
end;
end;
end;
m:= Min(Customers[MinJ], Postavshiki[MinI]);
Result[MinI, MinJ]:= m;
Customers[MinJ]:= Customers[MinJ] - m;
Postavshiki[MinI]:= Postavshiki[MinI] - m;
end;
end;
function Fogel: TMatr;
function AllEmpty: Boolean;
var
i: Integer;
begin
for i:= 0 to Length(Customers) - 1 do
if Customers[i] <> 0 then begin
Result:= False;
Exit;
end;
for i:= 0 to Length(Postavshiki) - 1 do
if Postavshiki[i] <> 0 then begin
Result:= False;
Exit;
end;
Result:= True;
end;
const
MAX = High(Integer);
MIX = Low(Integer);
var
i, j,
fMin, sMin, SubRowMax, SubColMax, m ,imax, jmax: Integer;
SubRow, SubCol: TMatr;
begin
SetLength(Result, Length(Postavshiki), Length(Customers));
for i:= 0 to Length(Result) - 1 do
for j:= 0 to Length(Result[0]) - 1 do
Result[i, j]:= -1;
while not AllEmpty do begin
// Цикл по строкам
for i:= 0 to Length(Matr) - 1 do begin
fMin:=MAX;
for j:= 0 to Length(Matr[0]) - 1 do begin
if (Postavshiki[i] = 0) or (Customers[j] = 0) then
Continue;
SetLength(SubRow, Length(Postavshiki), 2);
if Matr[i,j] < fMin then begin
fMin:=Matr[i,j];
SubRow[i,1]:=j;
end;
end;
sMin:=MAX;
for j:= 0 to Length(Matr[0]) - 1 do begin
if (Postavshiki[i] = 0) or (Customers[j] = 0) then
Continue;
if j <> SubRow[i,1] then begin
if Matr[i,j] < sMin then
sMin:=Matr[i,j];
end;
end; // Вычисляем разность между 2мя наименьшими тарифами
SubRow[i,0]:=sMin-fMin;
end;
// цикл по столбцам
for j:= 0 to Length(Matr[0]) - 1 do begin
fMin:=MAX;
for i:= 0 to Length(Matr) - 1 do begin
if (Postavshiki[i] = 0) or (Customers[j] = 0) then
Continue;
SetLength(SubCol, Length(Customers), 2);
if Matr[i,j] < fMin then begin
fMin:=Matr[i,j];
SubCol[j,1]:=i;
end;
end;
sMin:=MAX;
for i:= 0 to Length(Matr) - 1 do begin
if (Postavshiki[i] = 0) or (Customers[j] = 0) then
Continue;
if i <> SubCol[j,1] then begin
if Matr[i,j] < sMin then
sMin:=Matr[i,j];
end;
end; // Вычисляем разность между 2мя наименьшими тарифами
SubCol[j,0]:=sMin-fMin;
end;
// отыскиваем максимальное значение в получившемся столбце
SubRowMax:=MIX;
for i:= 0 to Length(Matr) - 1 do begin
if SubRow[i,0] > SubRowMax then begin
SubRowMax:=SubRow[i,0];
imax:=i;
end;
end;
// отыскиваем максимальное значение в получившемся строке
SubColMax:=MIX;
for j:= 0 to Length(Matr[0]) - 1 do begin
if SubCol[j,0] > SubColMax then begin
SubColMax:=SubCol[j,0];
jmax:=j;
end;
end;
// сравниваем максимальное значение разности по строкам и столбцам
if SubRowMax > SubColMax then begin
m:= Min(Customers[SubRow[imax,1]], Postavshiki[imax]);
Result[imax, SubRow[imax,1]]:= m;
Customers[SubRow[imax,1]]:= Customers[SubRow[imax,1]] - m;
Postavshiki[imax]:= Postavshiki[imax] - m;
end
else begin
m:= Min(Customers[jmax], Postavshiki[SubCol[jmax,1]]);
Result[SubCol[jmax,1], jmax]:= m;
Customers[jmax]:= Customers[jmax] - m;
Postavshiki[SubCol[jmax,1]]:= Postavshiki[SubCol[jmax,1]] - m;
end;
end;
end;
function RightPlan(APlan: TMatr): Boolean;
var
i, j, c: Integer;
begin
if Length(APlan) = 0 then begin
Result:= False;
Exit;
end;
c:= 0;
for i:= 0 to Length(APlan) - 1 do
for j:= 0 to Length(APlan[0]) - 1 do
if APlan[i, j] <> -1 then
inc(c);
Result:= Length(APlan) + Length(APlan[0]) - 1 = c;
end;
function PotencialMethod(AMatr, APlan: TMatr): TMatr;
function NewPlan(AMatr, APlan: TMatr; var OptPlan: Boolean): TMatr;
type
TPoints = array of TPoint;
function FindCicl(APlan: TMatr; AI, AJ: Integer): TPoints;
var
i, j, k, c, m: Integer;
Plan: TMatr;
begin
SetLength(Plan, Length(APlan), Length(APlan[0]));
for i:= 0 to Length(APlan) - 1 do begin
for j:= 0 to Length(APlan[0]) - 1 do begin
Plan[i, j]:= APlan[i, j];
end;
end;
SetLength(Result, 1);
Result[0].X:= AI;
Result[0].Y:= AJ;
Plan[AI, AJ]:= 0;
repeat
m:= 0;
for i:= 0 to Length(Plan) - 1 do begin
for j:= 0 to Length(Plan[0]) - 1 do begin
if Plan[i, j] = -1 then
Continue;
c:= 0;
for k:= 0 to Length(Plan) - 1 do
if Plan[k, j] <> -1 then
inc(c);
if c < 2 then begin
inc(m);
Plan[i, j]:= -1;
Continue;
end;
c:= 0;
for k:= 0 to Length(Plan[0]) - 1 do
if Plan[i, k] <> -1 then
inc(c);
if c < 2 then begin
inc(m);
Plan[i, j]:= -1;
end;
end;
end;
until m = 0;
repeat
if Length(Result) mod 2 = 0 then begin
for k:= 0 to Length(Plan[0]) - 1 do begin
if (Plan[Result[Length(Result) - 1].X, k] <> -1) and
(k <> Result[Length(Result) - 1].Y) then begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1].Y:= k;
Result[Length(Result) - 1].X:= Result[Length(Result) - 2].X;
Break;
end;
end;
end
else begin
for k:= 0 to Length(Plan) - 1 do begin
if (Plan[k, Result[Length(Result) - 1].Y] <> -1) and
(k <> Result[Length(Result) - 1].X) then begin
SetLength(Result, Length(Result) + 1);
Информация о работе Транспортная задача: сравнение методов нахождения первоначального распределения