Автор: Пользователь скрыл имя, 07 Мая 2013 в 08:32, курсовая работа
Целями курсовой работы являются:
построить математическую модель задачи;
рассмотреть классификацию задач данного типа;
рассмотреть методы решения транспортных задач;
написать и отладить программу для решения транспортных задач с ограничениями на пропускную способность.
Работа состоит из введения, трёх глав, и приложения, содержащего исходный код программного продукта.
Во введении рассмотрена краткая история транспортной задачи, и поставлены цели работы.
Введение 3
1. Транспортная задача 5
1.1 Математическая модель задачи 5
1.2 Классификация транспортных задач 8
1.3 Методы решения транспортных задач 8
2. Решение практической задачи 13
3. Спецификация программного продукта 22
Заключение 24
Список использованной литературы 25
Ribs: array [1..MaxVer, 1..2] of Byte; {Отобранные ребра: Ribs[i,1],
Ribs[i,2] начальная и конечная вершины ребра i}
Pred: PBound {Указатель на неразработ. границу предыдущего уровня}
end;
{Описание вспомогательных
function BegVerInRibs(Ver: Byte; Bound: PBound): Boolean;
{Возвращает True, если вершина Ver является начальной
вершиной какого-либо ребра Bound^.Ribs и False в
противном случае}
var
i: Byte;
begin
BegVerInRibs := False;
for i:=1 to Bound^.RibCol do
if Bound^.Ribs[i,1] = Ver then
begin
BegVerInRibs := True;
Break
end
end; {BegVerInRibs}
function EndVerInRibs(Ver: Byte; Bound: PBound): Boolean;
{Возвращает True, если вершина Ver является конечной
вершиной какого-либо ребра Bound^.Ribs и False в
противном случае}
var
i: Byte;
begin
EndVerInRibs := False;
for i:=1 to Bound^.RibCol do
if Bound^.Ribs[i,2] = Ver then
begin
EndVerInRibs := True;
Break
end
end; {EndVerInRibs}
procedure ReductMatr(Bound: PBound; N: Byte);
{Осуществляет приведение матрицы Bound^.M размером NxN
Увеличивает Bound^.Fi на сумму констант приведения}
var
i,j: Byte;
Min: Double; {Миним. элемент в строке или столбце}
begin
{Приведение по строкам}
for i:=1 to N do
if not BegVerInRibs(i, Bound) then
begin
Min := 2*INFINITY;
{Ищем минимальный элемент}
for j:=1 to N do
if (EndVerInRibs(j, Bound)=False)and(Bound^.M[i,j]
Min := Bound^.M[i,j];
{Производим приведение}
Bound^.Fi := Bound^.Fi+Min;
for j:=1 to N do
if not EndVerInRibs(j, Bound) then
Bound^.M[i,j] := Bound^.M[i,j]-Min
end;
{Приведение по столбцам}
for j:=1 to N do
if not EndVerInRibs(j, Bound) then
begin
Min := 2*INFINITY;
{Ищем минимальный элемент}
for i:=1 to N do
if (BegVerInRibs(i, Bound)=False)and(Bound^.M[i,j]
Min := Bound^.M[i,j];
{Производим приведение}
Bound^.Fi := Bound^.Fi+Min;
for i:=1 to N do
if not BegVerInRibs(i, Bound) then
Bound^.M[i,j] := Bound^.M[i,j]-Min
end
end; {ReductMatr}
procedure FindHeavyZero(Bound: PBound; N: Byte; var Row: Byte; var Col: Byte);
{Находит тяжелейщий ноль матрицы Bound^.M и возвращает
его индексы}
var
TmpBound: TBound; {Вспомогательная переменная для приведения матриц}
MaxW: Double; {Вес "самого тяжелого нуля"}
i,j: Byte;
begin
Row := 0; {Еще ничего}
Col := 0; {не найдено}
MaxW := -1.0;
for i:=1 to N do
if not BegVerInRibs(i, Bound) then
for j:=1 to N do
if not EndVerInRibs(j, Bound) then
if Bound^.M[i,j] < ZERO then
begin {Нашли очередной ноль - подсчитать его вес}
TmpBound := Bound^;
TmpBound.M[i,j] := 2*INFINITY;
TmpBound.Fi := 0.0;
ReductMatr(@TmpBound, N);
if TmpBound.Fi > MaxW then
begin
Row := i;
Col := j;
MaxW := TmpBound.Fi
end
end
end; {FindHeavyZero}
function IsCycle(Bound: PBound; V1, V2: Byte): Boolean;
{Проверяет, образует ли ребро (V1,V2) замкнутый контур с ребрами из
Bound^.Ribs}
var
i: Byte;
V: Byte; {Конечная вершина текущего построения}
CycLen: Byte; {Количество ребер в текущем построении}
label
loop;
begin
IsCycle := False;
V := V2; {Начинаем строить цикл от ребра (V1,V2)}
CycLen := 1;
with Bound^ do
while CycLen < RibCol+1 do
begin
for i:=1 to RibCol do
if Ribs[i,1] = V then
begin {Нашли очередное ребро}
V := Ribs[i,2];
CycLen := CycLen + 1;
if V = V1 then
IsCycle:=True {Контур замкнулся полностью}
else
goto loop {Продолжим искать ребра}
end;
Break; {Не находим продолжения обхода - выход}
loop:
end
end; {IsCycle}
procedure NewLevel(Bound: PBound; var Left: PBound; var Right: PBound);
var
i,j,k: Byte;
Row, Col: Byte;
begin
{Находим "самый тяжелый ноль"}
FindHeavyZero(Bound, N, Row, Col);
{Создаем элемент Left}
New(Left);
Left^ := Bound^; {Копируем структуру полностью}
with Left^ do
begin
{Добавить ребро (Row, Col)}
RibCol := RibCol+1;
Ribs[RibCol,1]:=Row;
Ribs[RibCol,2]:=Col;
{Заменить на бесконечность клетки ребер,
позволяющие замкнуть ребра из Ribs в цикл без обхода всех вершин}
if RibCol < N-1 then
{Нужно добавить в цикл более одного ребра - нельзя допускать,
чтобы одно ребро завершило цикл}
for i:=1 to N do
if not BegVerInRibs(i, Left) then {Строка не вычеркнута}
for j:=1 to N do
if not EndVerInRibs(j, Left) then {Столбец не вычеркнут}
if M[i,j] < INFINITY then {Ребро (i,j) существует}
if IsCycle(Left, i, j) then {Оно может завершить цикл}
M[i,j] := 2*INFINITY {Удаляем это ребро}
end;
ReductMatr(Left, N); {Приводим матрицу}
{Создаем элемент Right}
New(Right);
Right^ := Bound^; {Копируем структуру полностью}
Right^.M[Row, Col] := 2*INFINITY; {Убрать циклы, в которые входит (Row,Col)}
ReductMatr(Right, N) {Приводим матрицу}
end; {NewLevel}
procedure BuildRecord(Bound: PBound; N: Byte);
var
i,j: Byte;
begin
with Bound^ do
for i:=1 to N do
{Ищем невычеркнутую строку}
if not BegVerInRibs(i, Bound) then
for j:=1 to N do
{Ищем невычеркнутый столбец}
if not EndVerInRibs(j, Bound) then
begin {Добавляем ребро (i,j) в множество Ribs}
RibCol := RibCol + 1;
Ribs[RibCol,1] := i;
Ribs[RibCol,2] := j;
Fi := Fi + M[i,j];
Exit
end
end;
function BuildPath(Bound: PBound; var Matr: MatrType; N, BegVer: Byte;
var Path: ShortPath): Boolean;
var
i,j: Byte;
PathLen: Double; {Длина пути}
begin
PathLen := 0.0;
Path[1] := BegVer;
with Bound^ do
begin
for i:=2 to N do
for j:=1 to RibCol do
if Ribs[j,1] = Path[i-1] then
begin
Path[i] := Ribs[j,2];
PathLen := PathLen + Matr[Path[i-1], Path[i]];
Break
end;
Path[RibCol+1] := BegVer;
PathLen := PathLen + Matr[Path[RibCol], Path[RibCol+1]]
end;
BuildPath := PathLen < INFINITY
end; {BuildPath}
{BranchAndBound}
var
i,j: Byte;
WMatr: MatrType; {Весовая матрица, где "нули" заменены на "бесконечность"}
CurBound: PBound; {Граница, разрабатываемая на текущем шаге}
Left, Right: PBound;{Результаты разбиения границы на две дочерних}
Rec: PBound; {Текущий рекорд}
TmpBound: PBound; {Вспомогательная переменная для обхода списка}
label
loop;
begin
{По исходной матрице инициализируем рабочую}
for i:=1 to N do
for j:=1 to N do
if Abs(Matr[i,j]) < ZERO then
WMatr[i,j] := 2*INFINITY
else
WMatr[i,j] := Matr[i,j];
{Инициализируем начальную границу рабочей матрицей}
New(CurBound);
with CurBound^ do
begin
M := WMatr;
Fi := 0.0;
RibCol := 0;
Pred := NIL
end;
ReductMatr(CurBound, N); {Привести матрицу}
loop:
{Прямой ход алгоритма
- разработка границ до
while CurBound^.RibCol < N-1 do
begin
{Разбиваем границу CurBound на две дочерних: Left и Right}
NewLevel(CurBound, Left, Right);
{Выбираем: какую из границ разрабатывать дальше}
if Left^.Fi <= Right^.Fi then
begin {Идем налево}
Right^.Pred := CurBound^.Pred;
Left^.Pred := Right;
Dispose(CurBound);
CurBound := Left;
end
else
begin {Идем направо}
Left^.Pred := CurBound^.Pred;
Right^.Pred := Left;
Dispose(CurBound);
CurBound := Right;
end
end;
{Имеем матрицу из 1-й клетки - превращаем ее в рекорд}
BuildRecord(CurBound, N);
Rec := CurBound; {Зафиксировать ссылку на рекорд}
CurBound := CurBound^.Pred; {Перейти на ближайшую неразработанную границу}
{Обратный ход алгоритма - улучшение рекорда}
<span class="dash041e_0431_044b_